Permalink
Browse files

New attempt to fix menu and buttons flicker on Win10, this time by wi…

…th the help of Delphi Detours library. See https://www.heidisql.com/forum.php?t=19141
  • Loading branch information...
ansgarbecker committed Nov 1, 2017
1 parent b5765c9 commit ef13e15de632e71695d62f45ec61b555a8379ddb
Showing with 13,399 additions and 14 deletions.
  1. +35 −0 components/detours/Clean.bat
  2. +18 −0 components/detours/Demo/DetoursDemo/COM/Demo1/Demo1.dpr
  3. +539 −0 components/detours/Demo/DetoursDemo/COM/Demo1/Demo1.dproj
  4. BIN components/detours/Demo/DetoursDemo/COM/Demo1/Demo1.res
  5. +54 −0 components/detours/Demo/DetoursDemo/COM/Demo1/uMain.dfm
  6. +78 −0 components/detours/Demo/DetoursDemo/COM/Demo1/uMain.pas
  7. +47 −0 components/detours/Demo/DetoursDemo/Delphi/Hook_Overloaded_Method/Hook_Overloaded_Method.dpr
  8. +625 −0 components/detours/Demo/DetoursDemo/Delphi/Hook_Overloaded_Method/Hook_Overloaded_Method.dproj
  9. +18 −0 components/detours/Demo/DetoursDemo/Delphi/Interfaces/Demo1/Demo1.dpr
  10. +521 −0 components/detours/Demo/DetoursDemo/Delphi/Interfaces/Demo1/Demo1.dproj
  11. +44 −0 components/detours/Demo/DetoursDemo/Delphi/Interfaces/Demo1/uMain.dfm
  12. +81 −0 components/detours/Demo/DetoursDemo/Delphi/Interfaces/Demo1/uMain.pas
  13. +18 −0 components/detours/Demo/DetoursDemo/Delphi/Objects/Demo1/Demo1.dpr
  14. +521 −0 components/detours/Demo/DetoursDemo/Delphi/Objects/Demo1/Demo1.dproj
  15. +52 −0 components/detours/Demo/DetoursDemo/Delphi/Objects/Demo1/uMain.dfm
  16. +62 −0 components/detours/Demo/DetoursDemo/Delphi/Objects/Demo1/uMain.pas
  17. +18 −0 components/detours/Demo/DetoursDemo/Delphi/RTL/Demo1/Demo1.dpr
  18. +539 −0 components/detours/Demo/DetoursDemo/Delphi/RTL/Demo1/Demo1.dproj
  19. BIN components/detours/Demo/DetoursDemo/Delphi/RTL/Demo1/Demo1.res
  20. +38 −0 components/detours/Demo/DetoursDemo/Delphi/RTL/Demo1/uMain.dfm
  21. +93 −0 components/detours/Demo/DetoursDemo/Delphi/RTL/Demo1/uMain.pas
  22. +17 −0 components/detours/Demo/DetoursDemo/MultiHook/Demo1/Demo1.dpr
  23. +521 −0 components/detours/Demo/DetoursDemo/MultiHook/Demo1/Demo1.dproj
  24. +91 −0 components/detours/Demo/DetoursDemo/MultiHook/Demo1/uMain.dfm
  25. +122 −0 components/detours/Demo/DetoursDemo/MultiHook/Demo1/uMain.pas
  26. +17 −0 components/detours/Demo/DetoursDemo/win32api/Demo1/Demo1.dpr
  27. +521 −0 components/detours/Demo/DetoursDemo/win32api/Demo1/Demo1.dproj
  28. +44 −0 components/detours/Demo/DetoursDemo/win32api/Demo1/uMain.dfm
  29. +61 −0 components/detours/Demo/DetoursDemo/win32api/Demo1/uMain.pas
  30. +18 −0 components/detours/Demo/DetoursDemo/win32api/Demo2/Demo2.dpr
  31. +521 −0 components/detours/Demo/DetoursDemo/win32api/Demo2/Demo2.dproj
  32. +61 −0 components/detours/Demo/DetoursDemo/win32api/Demo2/uMain.dfm
  33. +65 −0 components/detours/Demo/DetoursDemo/win32api/Demo2/uMain.pas
  34. +57 −0 components/detours/Demo/InstDecodeDemo/Demo1/Demo1.dpr
  35. +623 −0 components/detours/Demo/InstDecodeDemo/Demo1/Demo1.dproj
  36. +279 −0 components/detours/Source/CPUID.pas
  37. +2,861 −0 components/detours/Source/DDetours.pas
  38. +48 −0 components/detours/Source/Defs.inc
  39. +2,383 −0 components/detours/Source/InstDecode.pas
  40. +140 −0 components/detours/Source/ModRmFlagsTables.inc
  41. +1,158 −0 components/detours/Source/OpCodesTables.inc
  42. +38 −0 components/detours/packages/DelphiXE5/detours.dpk
  43. +173 −0 components/detours/packages/DelphiXE5/detours.dproj
  44. +2 −0 components/detours/packages/DelphiXE5/detours.dproj.local
  45. BIN components/detours/packages/DelphiXE5/detours.res
  46. +2 −1 packages/delphiXE5/heidisql.dpr
  47. +36 −9 packages/delphiXE5/heidisql.dproj
  48. +15 −3 packages/delphiXE5/heidisql.groupproj
  49. +123 −0 source/Vcl.FormsFix.pas
  50. +1 −1 source/main.pas
@@ -0,0 +1,35 @@
rem *****************************************
rem * Delphi CleanUp Batch. *
rem * *
rem * Clean identcache,local,dcu,exe, *
rem * map,drc files. *
rem * Clean hidden __history folder. *
rem * *
rem * Author: Mahdi Safsafi *
rem *****************************************
@echo off
Setlocal EnableDelayedExpansion
Del "*.identcache" /s/q
Del "*.local" /s/q
Del "*.dcu" /s/q
Del "*.exe" /s/q
Del "*.drc" /s/q
Del "*.map" /s/q
set mustdel=false
For /r %%f in (.) do (
set "mustdel=false"
if %%~nf==Win32 (
if exist "%%~ff\Debug\" set "mustdel=true"
if exist "%%~ff\Release\" set "mustdel=true"
) else if %%~nf==Win64 (
if exist "%%~ff\Debug\" set "mustdel=true"
if exist "%%~ff\Release\" set "mustdel=true"
)
if %%~nf==__history set "mustdel=true"
if !mustdel!==true (
if exist "%%~ff" rd /s/q "%%~ff"
)
)
@@ -0,0 +1,18 @@
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
program Demo1;
uses
Vcl.Forms,
uMain in 'uMain.pas' {Main},
CPUID in '..\..\..\..\Source\CPUID.pas',
DDetours in '..\..\..\..\Source\DDetours.pas',
InstDecode in '..\..\..\..\Source\InstDecode.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMain, Main);
Application.Run;
end.

Large diffs are not rendered by default.

Oops, something went wrong.
Binary file not shown.
@@ -0,0 +1,54 @@
object Main: TMain
Left = 0
Top = 0
BorderStyle = bsSizeToolWin
Caption = 'Hooking IFileOpenDialog.Show Method'
ClientHeight = 196
ClientWidth = 447
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object BtnOpenDialog: TButton
Left = 304
Top = 97
Width = 121
Height = 25
Caption = 'Open File Dialog'
TabOrder = 0
OnClick = BtnOpenDialogClick
end
object MemLog: TMemo
Left = 0
Top = 0
Width = 447
Height = 81
Align = alTop
Lines.Strings = (
'MemLog')
TabOrder = 1
end
object BtnEnableHook: TButton
Left = 304
Top = 128
Width = 121
Height = 25
Caption = 'Enable Hook'
TabOrder = 2
OnClick = BtnEnableHookClick
end
object BtnDisableHook: TButton
Left = 304
Top = 159
Width = 121
Height = 25
Caption = 'Disable Hook'
TabOrder = 3
OnClick = BtnDisableHookClick
end
end
@@ -0,0 +1,78 @@
unit uMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DDetours;
type
TMain = class(TForm)
BtnOpenDialog: TButton;
MemLog: TMemo;
BtnEnableHook: TButton;
BtnDisableHook: TButton;
procedure BtnOpenDialogClick(Sender: TObject);
procedure BtnEnableHookClick(Sender: TObject);
procedure BtnDisableHookClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Main: TMain;
implementation
uses ShlObj, ComObj;
{$R *.dfm}
var
Trampoline_FileOpenDialog_Show: function(const Self; hwndParent: HWND): HRESULT; stdcall;
Trampoline_FileOpenDialog_SetTitle: function(const Self; pszTitle: LPCWSTR): HRESULT; stdcall;
function FileOpenDialog_SetTitle_Hook(const Self; pszTitle: LPCWSTR): HRESULT; stdcall;
begin
Result := Trampoline_FileOpenDialog_SetTitle(Self, 'Hooked');
end;
function FileOpenDialog_Show_Hook(const Self; hwndParent: HWND): HRESULT; stdcall;
begin
Main.MemLog.Lines.Add('Execution FileOpenDialog.Show ..');
Result := Trampoline_FileOpenDialog_Show(Self, hwndParent);
end;
var
FileOpenDialog: IFileOpenDialog;
procedure TMain.BtnOpenDialogClick(Sender: TObject);
begin
MemLog.Clear;
FileOpenDialog.SetTitle('Open..');
FileOpenDialog.Show(Handle);
end;
procedure TMain.BtnEnableHookClick(Sender: TObject);
begin
if not Assigned(Trampoline_FileOpenDialog_Show) then
@Trampoline_FileOpenDialog_Show := InterceptCreate(FileOpenDialog, 3, @FileOpenDialog_Show_Hook);
Trampoline_FileOpenDialog_SetTitle := InterceptCreate(FileOpenDialog, 17, @FileOpenDialog_SetTitle_Hook);
end;
procedure TMain.BtnDisableHookClick(Sender: TObject);
begin
if Assigned(Trampoline_FileOpenDialog_Show) then
begin
InterceptRemove(@Trampoline_FileOpenDialog_Show);
Trampoline_FileOpenDialog_Show := nil;
end;
InterceptRemove(@Trampoline_FileOpenDialog_SetTitle)
end;
initialization
FileOpenDialog := CreateComObject(CLSID_FileOpenDialog) as IFileOpenDialog;
end.
@@ -0,0 +1,47 @@
program Hook_Overloaded_Method;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
CPUID in '..\..\..\..\Source\CPUID.pas',
DDetours in '..\..\..\..\Source\DDetours.pas',
InstDecode in '..\..\..\..\Source\InstDecode.pas';
type
TShowMsg = procedure(Value: Integer);
var
TrampoShowMsg: TShowMsg;
{ When hooking overloaded method ,
Delphi does not reconize the desired method .
So we need to use this trick!
}
MyMethodPtr: TShowMsg;
procedure ShowMsg(const S: String); overload;
begin
Writeln(S);
end;
procedure ShowMsg(Value: Integer); overload;
begin
Writeln(Value);
end;
procedure ShowMsgHooked(Value: Integer);
begin
Writeln('Method hooked successfully!');
TrampoShowMsg(Value + 1);
end;
begin
MyMethodPtr := ShowMsg;
@TrampoShowMsg := InterceptCreate(@MyMethodPtr, @ShowMsgHooked);
ShowMsg('Hi');
ShowMsg(2015);
ReadLn;
end.
Oops, something went wrong.

0 comments on commit ef13e15

Please sign in to comment.