Tecsitel_FactuGES2/Source/Cliente/VCLFixPack.pas

{**************************************************************************************************}
{                                                                                                  }
{ VCLFixPack unit - Unoffical bug fixes for Delphi/C++Builder                                      }
{ Version 1.2 (2009-03-03)                                                                         }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is VCLFixPack.pas.                                                             }
{                                                                                                  }
{ The Initial Developer of the Original Code is Andreas Hausladen (Andreas.Hausladen@gmx.de).      }
{ Portions created by Andreas Hausladen are Copyright (C) 2008 Andreas Hausladen.                  }
{ All Rights Reserved.                                                                             }
{                                                                                                  }
{**************************************************************************************************}
                                   
{$IFNDEF CONDITIONALEXPRESSIONS}
  Delphi5_is_not_supported
{$ENDIF}

{$A8,B-,C+,D-,E-,F-,G+,H+,I+,J-,K-,L+,M-,N-,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}

{ If you define VCLFIXPACK_DEBUG the patches are compiled with debug information. }
{$IFDEF VCLFIXPACK_DEBUG} {$D+} {$ENDIF}

{ If you use Delphi 6/7/2005 Personal you must disable the VCLFIXPACK_DB_SUPPORT define. }
{$DEFINE VCLFIXPACK_DB_SUPPORT}

unit VCLFixPack;

{
 Usage
 =====
   Add the unit to the .dpr file's uses-list.
   C++Builder user can add the file to the project (Menu Project/Add to project)

 Example
 =======
   uses
     FastMM4, // optional memory manager
     VCLFixPack,
     Forms,
     Unit1 in 'Unit1.pas';


 Fixes the following bug
 =======================
   - [2006-2009]
     QC #68647: Infinite loop in Forms.GetNonToolWindowPopupParent
     (http://qc.codegear.com/wc/qcmain.aspx?d=68647)

   - [2007-2009]
     QC #68740: Lost focus after TOpenDialog when MainFormOnTaskBar is set
     (http://qc.codegear.com/wc/qcmain.aspx?d=68740)

   - [2005-2009]
     QC #59963: Closing non-modal forms after a task switch can deactivate the application
     (http://qc.codegear.com/wc/qcmain.aspx?d=59963)

   - [2009]
     QC #66892: Closing forms deactivates the application (missing "stdcall")
     (http://qc.codegear.com/wc/qcmain.aspx?d=66892)

   - [6-2007]
     Control resize bugfix for kernel stack overflow due to WH_CALLWNDPROC hook

   - [6-2007]
     QC #59654: TActionList access already released FActions field
     (http://qc.codegear.com/wc/qcmain.aspx?d=59654)

   - [6-2007]
     QC #54286 : Parent-PopupMenu overrides standard context menu (edit, memo, combobox, ...)
     (http://qc.codegear.com/wc/qcmain.aspx?d=54286)

   - [2006-2007]
     QC #50097: ObjAuto access violation on XEON (Data Execution Prevention bug)
     (http://qc.codegear.com/wc/qcmain.aspx?d=50097)

   - [6-2009]
     Classes.MakeObjectInstance memory leak fix
     (for usage in a DLL)

   - [2007]
     QC #58938: MainForm Minimize minimizes in the background
     (http://qc.codegear.com/wc/qcmain.aspx?d=58938)

   - [6-2009]
     QC #64484: SysUtils.Abort can raise an AccessViolation
     (http://qc.codegear.com/wc/qcmain.aspx?d=64484)

   - [2007]
     QC #58939: No taskbar button when starting from ShellLink with Show=Minimized
     (http://qc.codegear.com/wc/qcmain.aspx?d=58939)

   - [6-2009]
     QC #35001: MDIChild's active control focus is not set correctly
     (http://qc.codegear.com/wc/qcmain.aspx?d=35001)

   - [7-2009]
     QC #56252: TPageControl flickers a lot with active theming
     (http://qc.codegear.com/wc/qcmain.aspx?d=56252)
     QC #68730: TLabel is not painted on a themed, double-buffered TTabSheet in Vista
     (http://qc.codegear.com/wc/qcmain.aspx?d=68730)
     TLabels on TTabSheet are not painted (themes) if a TWinControl like TMemo is on the TTabSheet (TWinControl.PaintWindow bug)

   - [7-2009]
     Grid flickers with active theming (DBGrid, StringGrid and DrawGrid only, no derived classes)

   - [2009]
     QC #69112: TSpeedButton is painted as a black rectangle on a double buffered panel on a sheet of glass.

   - [2009]
     QC #69294: TProgressBar fails with PBS_MARQUEE and disabled Themes (Vista)
     http://qc.codegear.com/wc/qcmain.aspx?d=69294

   - [Windows Vista]
     Workaround for Windows Vista CompareString bug
     (Workaround is disabled by default, define "VistaCompareStringFix" to activate it)

   - [2007-2009]
     QC #52439: DbNavigator paints incorrectly when flat=true in themed mode

   - [2009]
     QC #70441: ToUpper and ToLower modify a Const argument

   - [2009]
     QC #69752: ToUpper and ToLower with NullString

   - [2009]
     QC #69875: StringBuilder.Replace is incorrect
     QC #67564: Error in TStringBuilder.Replace


 Changlog:
   2009-03-03:
     Fixed: Rewritten patch for QC #59963 (AppDeActivateZOrderFix) to fix the cause instead of the symptom
     Added: QC #52439: DbNavigator paints incorrectly when flat=true in themed mode
     Added: QC #70441: ToUpper and ToLower modify a Const argument
     Added: QC #69752: ToUpper and ToLower with NullString
     Added: QC #69875, #67564: StringBuilder.Replace is incorrect
            + a much faster implementation

   2009-01-25:
     Fixed: DBGrid ScrollBar gab wasn't painted correctly in BiDiMode <> bdLeftToRight
     Fixed: TTabSheet could throw an access violation if no PageControl was assigned to it
     Changed: Rewritten TaskModalDialog bugfix
     Added: QC #69294: TProgressBar fails with PBS_MARQUEE and disabled Themes (Vista)

}

interface

{ ---------------------------------------------------------------------------- }

{$DEFINE DBTextColorBugFix} // Delphi 6+

{$IF CompilerVersion >= 18.0} // Delphi 2006+
  {$DEFINE GetNonToolWindowPopupParentFix}
{$IFEND}

{$IF CompilerVersion >= 18.5} // Delphi 2007+
  {$DEFINE TaskModalDialogFix}
{$IFEND}

{$IF CompilerVersion >= 16.0} // Delphi 2005
  {$DEFINE AppDeActivateZOrderFix}
{$IFEND}

{$IF CompilerVersion = 20.0} // Delphi 2009
  {$DEFINE HideStackTrashingFix}
{$IFEND}

{$IF CompilerVersion < 20.0} // Delphi 6-2007
  {$DEFINE ControlResizeFix}
  { The OPTIMIZED_RESIZE_REDRAW option is experimental. It speeds up the resizing of forms
    by not redrawing each control when it is realigned but by invalidating them all after
    one align round is done. }
  {.$DEFINE OPTIMIZED_RESIZE_REDRAW}
{$IFEND}

{$IF CompilerVersion < 20.0} // Delphi 6-2007
  {$DEFINE ActionListAVFix}
{$IFEND}

{$IF CompilerVersion < 20.0} // Delphi 6-2007
  {$DEFINE ContextMenuFix}
{$IFEND}

{$IF (CompilerVersion >= 18.0) and (CompilerVersion < 20.0)} // Delphi 2006-2007
  {$DEFINE ObjAutoDEPFix}
{$IFEND}

{$DEFINE MkObjInstLeakFix} // Delphi 6+

{$DEFINE SysUtilsAbortFix} // Delphi 6+

{$IF CompilerVersion = 18.5} // Delphi 2007
  {$DEFINE AppMinimizeFix}
{$IFEND}

{$IF CompilerVersion = 18.5} // Delphi 2007
  {$DEFINE CmdShowMinimizeFix}
{$IFEND}

{$DEFINE MDIChildFocusFix} // Delphi 6+

{$IF CompilerVersion >= 15} // Delphi 7+
  {$DEFINE PageControlPaintingFix}
{$IFEND}

{$IF CompilerVersion >= 15} // Delphi 7+
  {$DEFINE GridFlickerFix}
{$IFEND}

{$IF CompilerVersion = 20.0} // Delphi 2009
  {$DEFINE SpeedButtonGlassFix}
{$IFEND}

{$IF CompilerVersion = 20.0} // Delphi 2009
  {$DEFINE VistaProgressBarMarqueeFix}
{$IFEND}

{$IF CompilerVersion = 20.0} // Delphi 2009
  {$DEFINE CharacterFix}
{$IFEND}

{$IF CompilerVersion = 20.0} // Delphi 2009
  {$DEFINE StringBuilderFix}
{$IFEND}

{$IF (CompilerVersion >= 18.5) and (CompilerVersion <= 20.0)} // Delphi 2007-2009
  {$IFDEF VCLFIXPACK_DB_SUPPORT}
    {$DEFINE DBNavigatorFix}
  {$ENDIF VCLFIXPACK_DB_SUPPORT}
{$IFEND}

{**************************************************************************************************}
{ Workaround for Windows Vista CompareString bug.                                                  }
{ The <20>/<2F> ($DC/$FC) and the UE/ue are treated equal in all locales, but they aren't equal. There   }
{ was a bugfix intended for Vista SP1 but it was removed before SP1 was released.                  }
{ Windows 2008 Server still includes this bugfix but Vista will never get this bugfix.             }
{ Microsoft: new versions are for correctness; service packs are for consistency and compatibility }
{**************************************************************************************************}
{ WARNING: This bugfix can slow down CompareString }
{.$DEFINE VistaCompareStringFix}


implementation

{$IF CompilerVersion >= 18.0}
 {$DEFINE DELPHI2006_UP}
{$IFEND}
{$IF CompilerVersion >= 17.0}
 {$DEFINE DELPHI2005_UP}
{$IFEND}

uses
  Windows, Messages, SysUtils, Classes, TypInfo, ActnList, SysConst,
  {$IFDEF ObjAutoDEPFix}
  ObjAuto,
  {$ENDIF ObjAutoDEPFix}
  {$IF CompilerVersion >= 15.0}
  Themes,
  {$IFEND}
  {$IF CompilerVersion >= 20.0}
  Character,
  {$IFEND}
  {$IFDEF VCLFIXPACK_DB_SUPPORT}
  DBGrids, DBCtrls,
  {$ENDIF VCLFIXPACK_DB_SUPPORT}
  Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, ComCtrls, Buttons,
  CommCtrl;

{ ---------------------------------------------------------------------------- }
{ Helper functions, shared }
type
  TOpenWinControl = class(TWinControl);
  TOpenCustomForm = class(TCustomForm);
  TOpenCommonDialog = class(TCommonDialog);
  TOpenCustomActionList = class(TCustomActionList);
  TOpenComponent = class(TComponent);
  TOpenCustomCombo = class(TCustomCombo);

  TJumpOfs = Integer;
  PPointer = ^Pointer;

type
  PXRedirCode = ^TXRedirCode;
  TXRedirCode = packed record
    Jump: Byte;
    Offset: TJumpOfs;
  end;

  PWin9xDebugThunk = ^TWin9xDebugThunk;
  TWin9xDebugThunk = packed record
    PUSH: Byte;
    Addr: Pointer;
    JMP: TXRedirCode;
  end;

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   //$FF25(Jmp, FF /4)
    Addr: PPointer;
  end;

var
  TaskActiveWindow: HWND;
  TaskFirstWindow: HWND;
  TaskFirstTopMost: HWND;

function DoFindWindow(Window: HWND; Param: LPARAM): Bool; stdcall;
begin
  if (Window <> TaskActiveWindow) and (Window <> Application.Handle) and
     IsWindowVisible(Window) and IsWindowEnabled(Window) then
  begin
    if GetWindowLong(Window, GWL_EXSTYLE) and WS_EX_TOPMOST = 0 then
    begin
      if TaskFirstWindow = 0 then
        TaskFirstWindow := Window;
    end else
    begin
      if TaskFirstTopMost = 0 then
        TaskFirstTopMost := Window;
    end;
  end;
  Result := True;
end;

function FindTopMostWindow(ActiveWindow: HWND): HWND;
begin
  TaskActiveWindow := ActiveWindow;
  TaskFirstWindow := 0;
  TaskFirstTopMost := 0;
  EnumThreadWindows(GetCurrentThreadID, @DoFindWindow, 0);
  if TaskFirstWindow <> 0 then
    Result := TaskFirstWindow
  else
    Result := TaskFirstTopMost;
end;

{ Hooking }

function GetActualAddr(Proc: Pointer): Pointer;

  function IsWin9xDebugThunk(AAddr: Pointer): Boolean;
  begin
    Result := (AAddr <> nil) and
              (PWin9xDebugThunk(AAddr).PUSH = $68) and
              (PWin9xDebugThunk(AAddr).JMP.Jump = $E9);
  end;

begin
  if Proc <> nil then
  begin
    if (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
      Proc := PWin9xDebugThunk(Proc).Addr;
    if (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;

procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
  n: DWORD;
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);
  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
  begin
    Code.Jump := $E9;
    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;

procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
  n: Cardinal;
begin
  if (BackupCode.Jump <> 0) and (Proc <> nil) then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);
    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
    BackupCode.Jump := 0;
  end;
end;

procedure ReplaceVmtField(AClass: TClass; OldProc, NewProc: Pointer);
type
  PVmt = ^TVmt;
  TVmt = array[0..MaxInt div SizeOf(Pointer) - 1] of Pointer;
var
  I: Integer;
  Vmt: PVmt;
  n: Cardinal;
  P: Pointer;
begin
  OldProc := GetActualAddr(OldProc);
  NewProc := GetActualAddr(NewProc);

  I := vmtSelfPtr div SizeOf(Pointer);
  Vmt := Pointer(AClass);
  while (I < 0) or (Vmt[I] <> nil) do
  begin
    P := Vmt[I];
    if (P <> OldProc) and (Integer(P) > $10000) and not IsBadReadPtr(P, 6) then
      P := GetActualAddr(P);
    if P = OldProc then
    begin
      WriteProcessMemory(GetCurrentProcess, @Vmt[I], @NewProc, SizeOf(NewProc), n);
      Exit;
    end;
    Inc(I);
  end;
end;

function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer;
asm
  call System.@FindDynaClass
end;

procedure DebugLog(const S: string);
begin
  OutputDebugString(PChar('VCLFixPack patch installed: ' + S));
end;
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #68647: Infinite loop in Forms.GetNonToolWindowPopupParent }
{$IFDEF GetNonToolWindowPopupParentFix}
{
Forms.pas.4712: Result := GetParent(WndParent);  <= must be "Result := GetParent(Result);"
56               push esi                        <= must be "push ebx"
E8181EFAFF       call GetParent
8BD8             mov ebx,eax
Forms.pas.4711: while (Result <> 0) and (GetWindowLong(Result, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = WS_EX_TOOLWINDOW) do
85DB             test ebx,ebx
}
procedure FixGetNonToolWindowPopupParent;
var
  P: PAnsiChar;
  Len: Integer;
  Buf: Byte;
  n: Cardinal;
begin
  P := GetActualAddr(@TOpenCustomForm.CreateParams);
  Dec(P);
  Len := 0;
  while Len < 112 do
  begin
    if //(P[0] = #$56) and // push esi
       (P[1] = #$E8) and // call GetParent
       (P[6] = #$8B) and (P[7] = #$D8) and // mov ebx,eax
       (P[8] = #$85) and (P[9] = #$DB) then // test ebx,ebx
    begin
      if P[0] = #$56 then // push esi
      begin
        Buf := $53; // push esi (WndParent) => push ebx (Result)
        WriteProcessMemory(GetCurrentProcess, P, @Buf, 1, n);
        DebugLog('GetNonToolWindowPopupParentFix');
        Exit;
      end else
      if P[0] = #$53 then // push ebx => already fixed, abort search
        Exit;
    end;
    Dec(P);
    Inc(Len);
  end;
end;
{$ENDIF GetNonToolWindowPopupParentFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #68740: Lost focus after TOpenDialog when MainFormOnTaskBar is set }
{$IFDEF TaskModalDialogFix}
var
  DialogsTaskModalDialogHook: TXRedirCode;
  DialogsTaskModalDialogCritSect: TRTLCriticalSection;

function TCommonDialog_TaskModalDialog(Instance: TObject; DialogFunc: Pointer; var DialogData): Bool;
var
  FocusWindow: HWND;
  Func: function(Instance: TObject; DialogFunc: Pointer; var DialogData): Bool;
begin
  EnterCriticalSection(DialogsTaskModalDialogCritSect);
  try
    UnhookProc(@TOpenCommonDialog.TaskModalDialog, DialogsTaskModalDialogHook);
    try
      FocusWindow := GetFocus;
      try
        Func := @TOpenCommonDialog.TaskModalDialog;
        Result := Func(Instance, DialogFunc, DialogData);
      finally
        SetFocus(FocusWindow);
      end;
    finally
      HookProc(@TOpenCommonDialog.TaskModalDialog, @TCommonDialog_TaskModalDialog, DialogsTaskModalDialogHook);
    end;
  finally
    LeaveCriticalSection(DialogsTaskModalDialogCritSect);
  end;
end;

procedure InitTaskModalDialogFix;
begin
  InitializeCriticalSection(DialogsTaskModalDialogCritSect);
  HookProc(@TOpenCommonDialog.TaskModalDialog, @TCommonDialog_TaskModalDialog, DialogsTaskModalDialogHook);
  DebugLog('FixTaskModalDialog');
end;

procedure FiniTaskModalDialogFix;
begin
  UnhookProc(@TOpenCommonDialog.TaskModalDialog, DialogsTaskModalDialogHook);
  DeleteCriticalSection(DialogsTaskModalDialogCritSect);
end;
{$ENDIF TaskModalDialogFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #59963: Closing non-modal forms after a task switch can deactivate the application }
{$IFDEF AppDeActivateZOrderFix}
{
// Release
0047B1FD F6401C08         test byte ptr [eax+$1c],$08
0047B201 7522             jnz $0047b225     << replace by $90 $90 => nop nop
0047B203 8BC3             mov eax,ebx
0047B205 8B150C824500     mov edx,[$0045820c]
0047B20B E85C8BF8FF       call @IsClass
0047B210 84C0             test al,al
0047B212 7509             jnz $0047b21d
0047B214 83BBCC01000000   cmp dword ptr [ebx+$000001cc],$00
0047B21B 7408             jz $0047b225
0047B21D 8B45FC           mov eax,[ebp-$04]
0047B220 E8DFFDFFFF       call TWinControl.UpdateShowing
0047B225 5E               pop esi
0047B226 5B               pop ebx
0047B227 59               pop ecx
0047B228 5D               pop ebp
0047B229 C3               ret
}

procedure InitAppDeActivateZOrderFix;
var
  P: PAnsiChar;
  Len: Integer;
  Buf: Word;
  n: Cardinal;
begin
  P := GetActualAddr(@TWinControl.UpdateControlState);
  Len := 0;
  while Len < 200 do
  begin
    if (P[0] = #$F6) and (P[1] = #$40) and (P[2] = #$1C) and (P[3] = #$08) and // test byte ptr [eax+$1c],$08
       (P[4] = #$75) and (P[5] = #$22) and                                     // jnz +$22
       (P[6] = #$8B) and (P[7] = #$C3) and                                     // mov eax,ebx
       (P[8] = #$8B) then                                                      // mov edx,[TCustomForm]
    begin
      Buf := $9090; // nop nop
      WriteProcessMemory(GetCurrentProcess, @P[4], @Buf, SizeOf(Buf), n);
      DebugLog('AppDeActivateZOrderFix');
      Exit;
    end
    else
    if (P[0] = #$59) and (P[0] = #$5D) and (P[1] = #$C3) then // function end reached
      Break;

    Inc(P);
    Inc(Len);
  end;
end;

procedure FiniAppDeActivateZOrderFix;
begin
end;

{$ENDIF AppDeActivateZOrderFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #66892: Closing forms deactivates the application (missing "stdcall") }
{$IFDEF HideStackTrashingFix}
var
  FindTopMostWindowHook: TXRedirCode;
  FindTopMostWindowProc: Pointer;

{
Forms.pas.1880: begin
53               push ebx
Forms.pas.1881: TaskActiveWindow := ActiveWindow;
A3D8784700       mov [$004778d8],eax
Forms.pas.1882: TaskFirstWindow := 0;
33C0             xor eax,eax
A3DC784700       mov [$004778dc],eax
Forms.pas.1883: TaskFirstTopMost := 0;
33C0             xor eax,eax
A3E0784700       mov [$004778e0],eax
Forms.pas.1884: EnumProc := @DoFindWindow;
BBBCB64500       mov ebx,$0045b6bc
Forms.pas.1885: EnumThreadWindows(GetCurrentThreadID, EnumProc, 0);
6A00             push $00
53               push ebx
E8DBCBFAFF       call GetCurrentThreadId
50               push eax
E821D1FAFF       call EnumThreadWindows

}
function GetAddrOfFindTopMostWindow: Pointer;
var
  P: PByte;
  Len: Integer;
  NeedsFix: Boolean;
begin
  NeedsFix := False;
  P := GetActualAddr(@EnableTaskWindows);
  Len := 0;
  while Len < 2048 do
  begin
    {  DoFindWindow "begin" }
    if (P[0] = $53) and
       (P[1] = $8B) and (P[2] = $D8) then
    begin
      if (P[3] = $3B) and (P[4] = $1D) and
         (P[9] = $74) and ({Release}(P[10] = $4D) or {Debug}(P[10] = $4F)) then
      begin
        NeedsFix := True;
      end
    end
    else { FindTopMostWindow "begin", Release & Debug }
    if (P[0] = $53) and
       (P[1] = $A3) then
    begin
      if (P[6] = $33) and (P[7] = $C0) and
         (P[8] = $A3) and
         (P[13] = $33) and (P[14] = $C0) and
         (P[15] = $A3) and
         (P[20] = $BB) and
         (P[25] = $6A) and (P[26] = $00) and
         (P[27] = $53) then
      begin
        Result := nil;
        if NeedsFix then
          Result := P;
        Exit;
      end;
    end;
    Inc(P);
    Inc(Len);
  end;
  Result := nil;
end;
{$ENDIF HideStackTrashingFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ Control resize bugfix for kernel stack overflow due to WH_CALLWNDPROC hook }
{$IFDEF ControlResizeFix}
{2008-05-25:
  - Added code to detect endless resizing controls.
  - Added experimental OPTIMIZED_RESIZE_REDRAW option for faster form resizing }
var
  WinControl_AlignControlProc, WinControl_WMSize, WinControl_SetBounds: Pointer;
  BackupAlignControl, BackupWMSize, BackupSetBounds: TXRedirCode;

type
  TControlResizeFixWinControl = class(TWinControl)
  private
    procedure AlignControl(AControl: TControl);
    procedure HandleAlignControls(AControl: TControl; var R: TRect);
  protected
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  end;

  {$IFNDEF DELPHI2005_UP}
  TD5WinControlPrivate = class(TControl)
  public
    FAlignLevel: Word;
  end;
  {$ENDIF ~DELPHI2005_UP}

threadvar
  AlignControlList: TList;

procedure TControlResizeFixWinControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  WindowPlacement: TWindowPlacement;
begin
  if (ALeft <> Left) or (ATop <> Top) or
    (AWidth <> Width) or (AHeight <> Height) then
  begin
    if HandleAllocated and not IsIconic(WindowHandle) then
    begin
      if AlignControlList <> nil then
        SetWindowPos(WindowHandle, 0, ALeft, ATop, AWidth, AHeight,
          SWP_NOZORDER or SWP_NOACTIVATE or SWP_DEFERERASE)
      else
        SetWindowPos(WindowHandle, 0, ALeft, ATop, AWidth, AHeight,
          SWP_NOZORDER or SWP_NOACTIVATE);
    end
    else
    begin
      PInteger(@Left)^ := ALeft;
      PInteger(@Top)^ := ATop;
      PInteger(@Width)^ := AWidth;
      PInteger(@Height)^ := AHeight;
      if HandleAllocated then
      begin
        WindowPlacement.Length := SizeOf(WindowPlacement);
        GetWindowPlacement(WindowHandle, @WindowPlacement);
        WindowPlacement.rcNormalPosition := BoundsRect;
        SetWindowPlacement(WindowHandle, @WindowPlacement);
      end;
    end;
    UpdateBoundsRect(Rect(Left, Top, Left + Width, Top + Height));
    RequestAlign;
  end;
end;

procedure TControlResizeFixWinControl.HandleAlignControls(AControl: TControl; var R: TRect);

  function AlignWork: Boolean;
  var
    I: Integer;
  begin
    Result := True;
    for I := ControlCount - 1 downto 0 do
      if (Controls[I].Align <> alNone) or
         (Controls[I].Anchors <> [akLeft, akTop]) then
        Exit;
    Result := False;
  end;

var
  OwnAlignControlList, TempAlignControlList: TList;
  ResizeList: TList;
  ResizeCounts: TList; // of Integer
  Ctrl: TWinControl;
  I, Index: Integer;
begin
  if AlignWork then
  begin
    OwnAlignControlList := nil;
    try
      if AlignControlList = nil then
      begin
        OwnAlignControlList := TList.Create;
        AlignControlList := OwnAlignControlList;
      end;

      AlignControls(AControl, R);

      if (OwnAlignControlList <> nil) and (OwnAlignControlList.Count > 0) then
      begin
        { Convert recursion into an iteration to prevent the kernel stack overflow }
        ResizeList := TList.Create;
        ResizeCounts := TList.Create;
        try
          { The controls in the OwnAlignControlList must be added to ResizeList in reverse order.
            Otherwise the OnResize events aren't fired in correct order. }
          AlignControlList := TList.Create;
          try
            repeat
              try
                for I := OwnAlignControlList.Count - 1 downto 0 do
                begin
                  Ctrl := TWinControl(OwnAlignControlList[I]);
                  Index := ResizeList.IndexOf(Ctrl);

                  { An endless resizing component was stopped by the kernel stack overflow bug.
                    So we must catch this condition to prevent an endless loop. }
                  if (Index = -1) or (Integer(ResizeCounts[Index]) < 30) then
                  begin
                    Ctrl.Realign;

                    if Index <> -1 then
                      ResizeCounts[Index] := Pointer(Integer(ResizeCounts[Index]) + 1);
                    ResizeCounts.Add(Pointer(0)); // keep index in sync
                    ResizeList.Add(Ctrl);
                  end
                  else if Index <> -1 then
                  begin
                    {$WARNINGS OFF}
                    if DebugHook <> 0 then
                    {$WARNINGS ON}
                      OutputDebugString(PChar(Format('The component "%s" of class %s has an endless resize loop', [Ctrl.Name, Ctrl.ClassName])));
                  end;
                end;
              finally
                OwnAlignControlList.Clear;

                { Switch lists }
                TempAlignControlList := AlignControlList;
                AlignControlList := OwnAlignControlList;
                OwnAlignControlList := TempAlignControlList;
              end;
            until (OwnAlignControlList.Count = 0) {or EndlessResizeDetection};
          finally
            { Let another AlignControlList handle any alignment that comes from the
              OnResize method. }
            FreeAndNil(AlignControlList);
          end;

          { Fire Resize events }
          for I := ResizeList.Count - 1 downto 0 do
          begin
            Ctrl := TWinControl(ResizeList[I]);
            if not (csLoading in Ctrl.ComponentState) then
              TOpenWinControl(Ctrl).Resize;
          end;
        finally
          ResizeCounts.Free;
          ResizeList.Free;
        end;
        {$IFDEF OPTIMIZED_RESIZE_REDRAW}
        Invalidate;
        {$ENDIF OPTIMIZED_RESIZE_REDRAW}
      end;
    finally
      if OwnAlignControlList <> nil then
      begin
        AlignControlList := nil;
        FreeAndNil(OwnAlignControlList);
      end;
    end;
  end
  else
    AlignControls(AControl, R);
end;

procedure TControlResizeFixWinControl.WMSize(var Message: TWMSize);
begin
  {$IFDEF DELPHI2005_UP}
  UpdateBounds;
    {$IFDEF DELPHI2006_UP}
  UpdateExplicitBounds;
    {$ENDIF DELPHI2006_UP}
  {$ELSE}
  if HandleAllocated then
    Perform(WM_MOVE, 0, LPARAM(Left and $0000ffff) or (Top shl 16)); // calls the private UpdateBounds
  {$ENDIF DELPHI2005_UP}
  DefaultHandler(Message);
  if AlignControlList <> nil then
  begin
    if AlignControlList.IndexOf(Self) = -1 then
      AlignControlList.Add(Self)
  end
  else
  begin
    Realign;
    if not (csLoading in ComponentState) then
      Resize;
  end;
end;

procedure TControlResizeFixWinControl.AlignControl(AControl: TControl);
var
  Rect: TRect;
begin
  if not HandleAllocated or (csDestroying in ComponentState) then
    Exit;
  {$IFDEF DELPHI2005_UP}
  if AlignDisabled then
  {$ELSE}
  if TD5WinControlPrivate(Self).FAlignLevel <> 0 then
  {$ENDIF DELPHI2005_UP}
    ControlState := ControlState + [csAlignmentNeeded]
  else
  begin
    DisableAlign;
    try
      Rect := GetClientRect;

      HandleAlignControls(AControl, Rect);
    finally
      ControlState := ControlState - [csAlignmentNeeded];
      EnableAlign;
    end;
  end;
end;

function GetAlignControlProc: Pointer;
var
  P: PByteArray;
  Offset: Integer;
  MemInfo: TMemoryBasicInformation;
begin
  P := GetActualAddr(@TWinControl.Realign);
  if (P <> nil) and (VirtualQuery(P, MemInfo, SizeOf(MemInfo)) = SizeOf(MemInfo)) then
  begin
    if (MemInfo.AllocationProtect <> PAGE_NOACCESS) then
    begin
      Offset := 0;
      while Offset < $40 do
      begin
        if ((P[0] = $33) and (P[1] = $D2)) or   // xor edx,edx
           ((P[0] = $31) and (P[1] = $D2)) then // xor edx,edx
        begin
          if P[2] = $E8 then // call TWinControl.AlignControl
          begin
            Inc(PByte(P), 2);
            Result := PAnsiChar(P) + 5 + PInteger(PAnsiChar(P) + 1)^;
            Exit;
          end
          else if (P[2] = $8B) and (P[3] = $45) and (P[4] = $FC) and // mov eax,[ebp-$04]
                  (P[5] = $E8) then // call TWinControl.AlignControl
          begin
            Inc(PByte(P), 5);
            Result := PAnsiChar(P) + 5 + PInteger(PAnsiChar(P) + 1)^;
            Exit;
          end;
        end;
        Inc(PByte(P));
        Inc(Offset);
      end;
    end;
  end;
  Result := nil;
end;

procedure InitControlResizeFix;
begin
  WinControl_AlignControlProc := GetAlignControlProc;
  WinControl_WMSize := GetDynamicMethod(TWinControl, WM_SIZE);
  WinControl_SetBounds := @TOpenWinControl.SetBounds;
  if (WinControl_AlignControlProc <> nil) and (WinControl_WMSize <> nil) then
  begin
    DebugLog('ControlResizeFix');
    { Redirect the original function to the bug fixed version }
    HookProc(WinControl_AlignControlProc, @TControlResizeFixWinControl.AlignControl, BackupAlignControl);
    HookProc(WinControl_WMSize, @TControlResizeFixWinControl.WMSize, BackupWMSize);
    {$IFDEF OPTIMIZED_RESIZE_REDRAW}
    HookProc(WinControl_SetBounds, @TControlResizeFixWinControl.SetBounds, BackupSetBounds);
    {$ENDIF OPTIMIZED_RESIZE_REDRAW}
  end;
end;

procedure FiniControlResizeFix;
begin
  { Restore the original function }
  UnhookProc(WinControl_AlignControlProc, BackupAlignControl);
  UnhookProc(WinControl_WMSize, BackupWMSize);
  UnhookProc(WinControl_SetBounds, BackupSetBounds);
end;

{$ENDIF ControlResizeFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #59654: TActionList access already released FActions field }
{$IFDEF ActionListAVFix}
var
  HookTCustomActionList_Notification: TXRedirCode;

type
  TCustomActionListFix = class(TCustomActionList)
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  end;

procedure TCustomActionListFix.Notification(AComponent: TComponent; Operation: TOperation);
var
  P: procedure(Instance: TComponent; AComponent: TComponent; Operation: TOperation);
begin
  { inherited: }
  P := @TOpenComponent.Notification;
  P(Self, AComponent, Operation);

  if Operation = opRemove then
  begin
    if AComponent = Images then
      Images := nil
    else if {<*}not (csDestroying in ComponentState) and{*>} (AComponent is TContainedAction) then
      RemoveAction(TContainedAction(AComponent));
  end;
end;

procedure InitActionListAVFix;
begin
  DebugLog('ActionListAVFix');
  HookProc(@TOpenCustomActionList.Notification, @TCustomActionListFix.Notification, HookTCustomActionList_Notification);
end;

procedure FiniActionListAVFix;
begin
  UnhookProc(@TOpenCustomActionList.Notification, HookTCustomActionList_Notification);
end;
{$ENDIF ActionListAVFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #54286 : Parent-PopupMenu overrides standard context menu (edit, memo, combobox, ...) }
{$IFDEF ContextMenuFix}
type
  TContextMenuFixWinControl = class(TWinControl)
  public
    procedure DefaultHandler(var Message); override;
  end;

var
  RM_GetObjectInstance: DWORD;
  BackupDefaultHandler: TXRedirCode;

procedure TContextMenuFixWinControl.DefaultHandler(var Message);
type
  TDefHandler = procedure(Self: TControl; var Message);
begin
  if HandleAllocated then
  begin
    with TMessage(Message) do
    begin
      { Here was the WM_CONTEXTMENU Code that is not necessary because
        DefWndProc will send this message to the parent control. }

      { Keep the odd bahavior for grids because everybody seems to be used to it. }
      if (Msg = WM_CONTEXTMENU) and (Parent <> nil) and (Parent is TCustomGrid) then
      begin
        Result := Parent.Perform(Msg, WParam, LParam);
        if Result <> 0 then Exit;
      end;

      case Msg of
        WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
          Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
        CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
          begin
            SetTextColor(WParam, ColorToRGB(Font.Color));
            SetBkColor(WParam, ColorToRGB(Brush.Color));
            Result := Brush.Handle;
          end;
      else
        if Msg = RM_GetObjectInstance then
          Result := LRESULT(Self)
        else
          Result := CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
      end;
      if Msg = WM_SETTEXT then
        SendDockNotification(Msg, WParam, LParam);
    end;
  end
  else
    //inherited DefaultHandler(Message);
    TDefHandler(@TControl.DefaultHandler)(Self, Message);
end;

procedure InitContextMenuFix;
var
  HInst: HMODULE;
begin
  HInst := FindHInstance(Pointer(TWinControl)); // get the HInstance of the module that contains Controls.pas
  RM_GetObjectInstance := RegisterWindowMessage(PChar(Format('ControlOfs%.8X%.8X', [HInst, GetCurrentThreadId])));

  DebugLog('ContextMenuFix');
  { Redirect the original function to the bug fixed version }
  HookProc(@TWinControl.DefaultHandler, @TContextMenuFixWinControl.DefaultHandler, BackupDefaultHandler);
end;

procedure FiniContextMenuFix;
begin
  UnhookProc(@TWinControl.DefaultHandler, BackupDefaultHandler);
end;
{$ENDIF ContextMenuFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #50097: ObjAuto access violation on XEON (Data Execution Prevention bug) }
{$IFDEF ObjAutoDEPFix}

type
  PParameterInfos = ^TParameterInfos;
  TParameterInfos = array[0..255] of ^PTypeInfo;

  TMethodHandlerInstance = class
  protected
    MethodHandler: IMethodHandler;
    TypeData: PTypeData;
    ParamInfos: PParameterInfos;
    Return: array[0..2] of Byte;
    ParamOffsets: array of Word;
  end;

{ procedure TMethodHandlerInstance.RegisterStub;
 50               push eax
 51               push ecx
 52               push edx
 89E2             mov edx,esp
 E866FDFFFF       call TMethodHandlerInstance.Handler
 89442404         mov [esp+$04],eax
 58               pop eax
 58               pop eax
 59               pop ecx
 8D4910           lea ecx,[ecx+$10]
 FFE1             jmp ecx
 C3               ret }

type
  PRegisterStubRec = ^TRegisterStubRec;
  TRegisterStubRec = packed record
    Push3Reg: array[0..2] of Byte;
    MovEdxEsp: Word;
    CallHandler: array[0..4] of Byte;
    SaveRetValue: LongWord;
    Pop3Reg: array[0..2] of Byte;
    case Integer of
      0: (LeaEcxEcx: Word;
          Off: Byte;
          JmpEcx: Word);
      1: (Jmp: Byte;
          Offset: TJumpOfs);
  end;

var
  RegisterStub: PRegisterStubRec;
  OrgCode: array[0..4] of Byte;

procedure RegisterStubRet;
asm
  lea ecx, [ecx].TMethodHandlerInstance.Return
  cmp byte ptr [ecx], $C2
  jne @@Leave
  movzx ecx, word ptr [ecx+$01]
  add ecx, 3
  and ecx, $FC
  add esp, ecx

  { restore return address }
  neg ecx
  mov ecx, [esp+ecx] // load return address
  push ecx // restore return address
@@Leave:
end;

procedure InitObjAutoDEPFix;
var
  Func: TTypeData;
  M: TMethod;
  OldProtect: Cardinal;
begin
  FillChar(Func, SizeOf(Func), 0);
  Func.MethodKind := mkProcedure;
  Func.ParamCount := 0;
  M := CreateMethodPointer(nil, @Func);
  RegisterStub := M.Code;
  ReleaseMethodPointer(M);

  if (RegisterStub.Push3Reg[0] = $50) and
     (RegisterStub.Push3Reg[1] = $51) and
     (RegisterStub.Push3Reg[2] = $52) and
     (RegisterStub.MovEdxEsp = $E289) and
     (RegisterStub.SaveRetValue = $04244489) and
     (RegisterStub.Pop3Reg[0] = $58) and
     (RegisterStub.Pop3Reg[1] = $58) and
     (RegisterStub.Pop3Reg[2] = $59) and
     (RegisterStub.LeaEcxEcx = $498D) and
     (RegisterStub.JmpEcx = $E1FF) then
  begin
    if VirtualProtect(@RegisterStub.Jmp, SizeOf(TXRedirCode), PAGE_EXECUTE_READWRITE, OldProtect) then
    begin
      DebugLog('ObjAutoDEPFix');
      Move(RegisterStub.Jmp, OrgCode[0], SizeOf(OrgCode));
      RegisterStub.Jmp := $E9;
      RegisterStub.Offset := TJumpOfs(@RegisterStubRet) - (TJumpOfs(@RegisterStub.Jmp) + SizeOf(TXRedirCode));
      VirtualProtect(@RegisterStub.Jmp, SizeOf(TXRedirCode), OldProtect, OldProtect);
      FlushInstructionCache(GetCurrentProcess, @RegisterStub.Jmp, SizeOf(TXRedirCode));
    end;
  end
  else
    RegisterStub := nil;
end;

procedure FiniObjAutoDEPFix;
var
  OldProtect: Cardinal;
begin
  if RegisterStub <> nil then
  begin
    if VirtualProtect(@RegisterStub.Jmp, SizeOf(TXRedirCode), PAGE_EXECUTE_READWRITE, OldProtect) then
    begin
      Move(OrgCode[0], RegisterStub.Jmp, SizeOf(OrgCode));
      VirtualProtect(@RegisterStub.Jmp, SizeOf(TXRedirCode), OldProtect, OldProtect);
      FlushInstructionCache(GetCurrentProcess, @RegisterStub.Jmp, SizeOf(TXRedirCode));
    end;
  end;
end;
{$ENDIF ObjAutoDEPFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ Classes.MakeObjectInstance memory leak fix }
{$IFDEF MkObjInstLeakFix}
{ Limitation:
    The memory is only released if there is no dangling object instance in the
    memory block. }
var
  UnRegisterModuleClassesHook: TXRedirCode;
  MkObjInstLeakHooked: Boolean;

procedure HookedUnRegisterModuleClasses(Module: HMODULE);
  forward;


const
  InstanceCount = 313;
  PageSize = 4096;

{ Object instance management }

type
  PPObjectInstance = ^PObjectInstance;
  PObjectInstance = ^TObjectInstance;
  TObjectInstance = packed record
    Code: Byte;
    Offset: Integer;
    case Integer of
      0: (Next: PObjectInstance);
      1: (Method: TWndMethod);
  end;

  PPInstanceBlock = ^PInstanceBlock;
  PInstanceBlock = ^TInstanceBlock;
  TInstanceBlock = packed record
    Next: PInstanceBlock;
    Code: array[1..2] of Byte;
    WndProcPtr: Pointer;
    Instances: array[0..InstanceCount] of TObjectInstance;
  end;

(*
 procedure FreeObjectInstance(ObjectInstance: Pointer);
 begin
   if ObjectInstance <> nil then
   begin
    // 85C0             test eax,eax
    // 740E             jz $0041b2f6
     PObjectInstance(ObjectInstance)^.Next := InstFreeList;
    // 8B15E8594600     mov edx,[$004659e8]
    // 895005           mov [eax+$05],edx
     InstFreeList := ObjectInstance;
    // A3E8594600       mov [$004659e8],eax
   end;
 end;
    // C3               ret
*)

type
  TParamRec = packed record
    Op: Word;
    Off: Byte;
  end;

  PFreeObjInstRec = ^TFreeObjInstRec;
  TFreeObjInstRec = packed record
    TestEaxEax: Word;
    Jz1: Word;
    AssignToNext: packed record
                    MovEdx: Word;
                    Address: Cardinal;
                    MovEaxOffEdx: Word;
                    Off: Byte;
                  end;
    AssignToInstFreeList: packed record
                            MovMemToEax: Byte;
                            Address: Cardinal;
                          end;
    Ret: Byte;
  end;

  PFreeObjInstNoOptRec = ^TFreeObjInstNoOptRec;
  TFreeObjInstNoOptRec = packed record
    PushEbp: Byte;                 // $55
    MovEbpEsp: Word;               // $8B EC
    PushEcx: Byte;                 // $51
    MovOffReg: TParamRec;          // $89 45 FC
    Cmp: packed record
           Op: Word;               // $83 7D
           Off: Byte;              // $FC
           Value: Byte;            // $00
         end;
    Jz1: Word;                     // $74 14
    LoadParam1: TParamRec;         // $8B 45 FC
    AssignToNext: packed record
                    MovEdx: Word;  // $8B 15
                    Address: Cardinal;
                  end;
  end;

procedure GetObjectInstancePointers(out InstFreeListP: PPObjectInstance; out InstBlockListP: PPInstanceBlock);
var
  FreeObjInst: PFreeObjInstRec;
  FreeObjInstNoOpt: PFreeObjInstNoOptRec;
begin
  InstFreeListP := nil;
  InstBlockListP := nil;
  FreeObjInst := GetActualAddr(@Classes.FreeObjectInstance);
  FreeObjInstNoOpt := Pointer(FreeObjInst);

  if (FreeObjInst.TestEaxEax = $C085) and (FreeObjInst.Jz1 = $0E74) and
     (FreeObjInst.AssignToNext.MovEdx = $158B) and
     (FreeObjInst.AssignToNext.MovEaxOffEdx = $5089) and (FreeObjInst.AssignToNext.Off = $05) and
     (FreeObjInst.AssignToInstFreeList.MovMemToEax = $A3) and
     (FreeObjInst.Ret = $C3) then
  begin
    InstFreeListP := PPObjectInstance(FreeObjInst.AssignToNext.Address);
    InstBlockListP := PPInstanceBlock(FreeObjInst.AssignToNext.Address - SizeOf(Pointer));
  end
  else
  if (FreeObjInstNoOpt.PushEbp = $55) and (FreeObjInstNoOpt.MovEbpEsp = $EC8B) and
     (FreeObjInstNoOpt.PushEcx = $51) and
     (FreeObjInstNoOpt.MovOffReg.Op = $4589) and (FreeObjInstNoOpt.MovOffReg.Off = $FC) and
     (FreeObjInstNoOpt.Cmp.Op = $7D83) and (FreeObjInstNoOpt.Cmp.Off = $FC) and (FreeObjInstNoOpt.Cmp.Value = $00) and
     (FreeObjInstNoOpt.Jz1 = $1474) and
     (FreeObjInstNoOpt.LoadParam1.Op = $458B) and (FreeObjInstNoOpt.LoadParam1.Off = $FC) and
     (FreeObjInstNoOpt.AssignToNext.MovEdx = $158B) then
  begin
    InstFreeListP := PPObjectInstance(FreeObjInstNoOpt.AssignToNext.Address);
    InstBlockListP := PPInstanceBlock(FreeObjInstNoOpt.AssignToNext.Address - SizeOf(Pointer));
  end;
end;

procedure CleanupInstFreeList(var InstFreeList: PObjectInstance; BlockStart, BlockEnd: PAnsiChar);
var
  Prev, Next, Item: PObjectInstance;
begin
  Prev := nil;
  Item := InstFreeList;
  while Item <> nil do
  begin
    Next := Item.Next;
    if (PAnsiChar(Item) >= BlockStart) and (PAnsiChar(Item) <= BlockEnd) then
    begin
      Item := Prev;
      if Prev = nil then
        InstFreeList := Next
      else
        Prev.Next := Next;
    end;
    Prev := Item;
    Item := Next;
  end;
end;

function CalcFreeInstBlockItems(Item: PObjectInstance; Block: PInstanceBlock): Integer;
var
  I: Integer;
begin
  Result := 0;
  while Item <> nil do
  begin
    for I := High(Block.Instances) downto 0 do
    begin
      if @Block.Instances[I] = Item then
      begin
        Inc(Result);
        Break;
      end;
    end;
    Item := Item.Next;
  end;
end;

procedure ReleaseObjectInstanceBlocks;
var
  InstFreeListP: PPObjectInstance;
  InstBlockListP: PPInstanceBlock;
  NextBlock, Block, PrevBlock: PInstanceBlock;
  FreeCount: Integer;
begin
  GetObjectInstancePointers(InstFreeListP, InstBlockListP);
  if (InstFreeListP = nil) or (InstBlockListP = nil) then
  begin
    OutputDebugString('Cannot apply Classes.FreeObjectInstance memory leak-fix');
    Exit;
  end;

  Block := InstBlockListP^;
  PrevBlock := nil;
  while Block <> nil do
  begin
    NextBlock := Block.Next;

    { Obtain the number of free items in the InstanceBlock }
    FreeCount := CalcFreeInstBlockItems(InstFreeListP^, Block);

    { Release memory if the InstanceBlock contains only "free" items }
    if FreeCount = Length(Block.Instances) then
    begin
      { Remove all InstFreeList items that refer to the InstanceBlock }
      CleanupInstFreeList(InstFreeListP^, PAnsiChar(Block), PAnsiChar(Block) + SizeOf(TInstanceBlock) - 1);

      VirtualFree(Block, 0, MEM_RELEASE);

      Block := PrevBlock;
      if PrevBlock = nil then
        InstBlockListP^ := NextBlock
      else
        PrevBlock.Next := NextBlock;
    end;

    { Next InstanceBlock }
    PrevBlock := Block;
    Block := NextBlock;
  end;

  { Maybe the finalization was executed before the Application object was destroyed.
    Classes.Finalization calls UnRegisterModuleClasses(). We hook into that function
    to execute our finalization in the Classes.Finalization. }
  if (InstBlockListP^ <> nil) and not MkObjInstLeakHooked and
     (FindHInstance(GetActualAddr(@UnRegisterModuleClasses)) = HInstance) then
  begin
    MkObjInstLeakHooked := True;
    HookProc(@UnRegisterModuleClasses, @HookedUnRegisterModuleClasses, UnRegisterModuleClassesHook);
  end;
end;

procedure HookedUnRegisterModuleClasses(Module: HMODULE);
begin
  UnhookProc(@UnRegisterModuleClasses, UnRegisterModuleClassesHook);
  try
    UnRegisterModuleClasses(Module);
    if Module = HInstance then
      ReleaseObjectInstanceBlocks;
  finally
    HookProc(@UnRegisterModuleClasses, @HookedUnRegisterModuleClasses, UnRegisterModuleClassesHook);
  end;
end;
{$ENDIF MkObjInstLeakFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #58938: MainForm Minimize minimizes in the background }
{$IFDEF AppMinimizeFix}
var
  AppMinimizePatchAddress: ^TJumpOfs;
  OrgAppMinimizeSetActiveWindowOffset: TJumpOfs;

function ApplicationMinimizeSetActiveWindow(hWnd: HWND): HWND; stdcall;
begin
  if Application.MainFormOnTaskBar then
    Result := GetActiveWindow
  else
    Result := SetActiveWindow(hWnd);
end;

{
Forms.pas.7850: NormalizeTopMosts;
8BC3             mov eax,ebx
E84AF4FFFF       call TApplication.NormalizeTopMosts
Forms.pas.7851: SetActiveWindow(FHandle); // WM_ACTIVATEAPP can set AppIconic to False
8B4330           mov eax,[ebx+$30]
50               push eax
E87D1AFAFF       call SetActiveWindow
Forms.pas.7852: AppIconic := True;        // Set AppIconic here just to be safe
C605A8EC4B0001   mov byte ptr [$004beca8],$01
}

procedure InitAppMinimizeFix;
var
  P: PAnsiChar;
  Len: Integer;
  NewOffset: TJumpOfs;
  n: Cardinal;
begin
  P := GetActualAddr(@TApplication.Minimize);
  Len := 0;
  while Len < 64 do
  begin
    if (P[0] = #$8B) and (P[1] = #$C3) and // mov eax,ebx
       (P[2] = #$E8) and // call TApplication.NormalizeTopMosts
       (P[7] = #$8B) and (P[8] = #$43) and (P[9] = #$30) and // mov eax,[ebx+$30]
       (P[10] = #$50) and // push eax
       (P[11] = #$E8) and // call SetActiveWindow
       (P[16] = #$C6) and (P[17] = #$05) and (P[22] = #$01) then // mov byte ptr [$004beca8],$01
    begin
      DebugLog('AppMinimizeFix');
      AppMinimizePatchAddress := Pointer(P + 12);
      OrgAppMinimizeSetActiveWindowOffset := AppMinimizePatchAddress^;
      NewOffset := PAnsiChar(@ApplicationMinimizeSetActiveWindow) - PAnsiChar(AppMinimizePatchAddress) - SizeOf(TJumpOfs);
      WriteProcessMemory(GetCurrentProcess, AppMinimizePatchAddress, @NewOffset, SizeOf(NewOffset), n);
      Exit;
    end;
    Inc(P);
    Inc(Len);
  end;
end;

procedure FiniAppMinimizeFix;
var
  n: Cardinal;
begin
  if AppMinimizePatchAddress <> nil then
    WriteProcessMemory(GetCurrentProcess, AppMinimizePatchAddress, @OrgAppMinimizeSetActiveWindowOffset, SizeOf(TJumpOfs), n);
end;
{$ENDIF AppMinimizeFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #64484: SysUtils.Abort can raise an AccessViolation }
{$IFDEF SysUtilsAbortFix}
var
  SysUtilsAbortHook: TXRedirCode;

procedure SysUtilsAbort;
{ No dependency on EBP register }

  procedure ThrowException(ReturnAddr: Pointer);
  begin
    raise EAbort.CreateRes(@SOperationAborted) at ReturnAddr;
  end;

asm
  pop eax
  jmp ThrowException
end;

procedure InitSysUtilsAbortFix;
begin
  DebugLog('SysUtilsAbortFix');
  HookProc(@SysUtils.Abort, @SysUtilsAbort, SysUtilsAbortHook);
end;

procedure FiniSysUtilsAbortFix;
begin
  UnhookProc(@SysUtils.Abort, SysUtilsAbortHook);
end;
{$ENDIF SysUtilsAbortFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #58939: No taskbar button when starting from shelllink with Show=Minimized }
{$IFDEF CmdShowMinimizeFix}
var
  ApplicationRunHook: TXRedirCode;
  InitialMainFormState: ^TWindowState;

procedure ApplicationRun(App: TApplication);
begin
  UnhookProc(@TApplication.Run, ApplicationRunHook);
  ApplicationRunHook.Jump := 0;
  {$WARNINGS OFF}
  if (CmdShow = SW_SHOWMINNOACTIVE) and (InitialMainFormState <> nil) then
  {$WARNINGS ON}
    InitialMainFormState^ := wsMinimized;
  App.Run;
end;

{
Forms.pas.8214: if (FMainForm.FWindowState = wsMinimized) or (InitialMainFormState = wsMinimized) then
8B45FC           mov eax,[ebp-$04]
8B4044           mov eax,[eax+$44]
80B87302000001   cmp byte ptr [eax+$00000273],$01
7409             jz $004669a5
803DC8784B0001   cmp byte ptr [$004b78c8],$01
751E             jnz $004669c3
Forms.pas.8216: Minimize;
8B45FC           mov eax,[ebp-$04]
E8FFF5FFFF       call TApplication.Minimize
Forms.pas.8217: if (InitialMainFormState = wsMinimized) then
803DC8784B0001   cmp byte ptr [$004b78c8],$01
7514             jnz $004669ca
}

function FindInitialMainFormState: Pointer;
var
  P: PAnsiChar;
  Len: Integer;
begin
  P := GetActualAddr(@TApplication.Run);
  Len := 0;
  while Len < 128 do
  begin
    if (P[0] = #$74) and (P[1] = #$09) and // jz $004669a5
       (P[2] = #$80) and (P[3] = #$3D) and (P[8] = #$01) and // cmp byte ptr [$004b78c8],$01
       (P[9] = #$75) and (P[10] = #$1E) and // jnz $004669c3
       (P[11] = #$8B) and (P[12] = #$45) and (P[13] = #$FC) then // mov eax,[ebp-$04]
    begin
      DebugLog('CmdShowMinimizeFix');
      Result := PPointer(P + 4)^;
      Exit;
    end;
    Inc(P);
    Inc(Len);
  end;
  Result := nil;
end;

procedure InitCmdShowMinimizeFix;
begin
  InitialMainFormState := FindInitialMainFormState;
  if InitialMainFormState <> nil then
    HookProc(@TApplication.Run, @ApplicationRun, ApplicationRunHook);
end;

procedure FiniCmdShowMinimizeFix;
begin
  UnhookProc(@TApplication.Run, ApplicationRunHook);
end;

{$ENDIF CmdShowMinimizeFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #35001: MDIChild's active control focus is not set correctly }
{$IFDEF MDIChildFocusFix}
var
  CustomFormFocusControlHook: TXRedirCode;

procedure CustomFormFocusControl(Self: TOpenCustomForm; Control: TWinControl);
var
  WasActive: Boolean;
begin
  with Self do
  begin
    WasActive := Active;

    { Synchronize Windows's focus with VCL's focus }
    if WasActive and (FormStyle = fsMDIChild) and (Control <> nil) and (Control = ActiveControl) and
       Control.HandleAllocated and not Control.Focused then
    begin
      Windows.SetFocus(Control.Handle);
    end;

    ActiveControl := Control;
    if not WasActive then
      SetFocus;
  end;
end;

procedure InitMDIChildFocusFix;
begin
  DebugLog('MDIChildFocusFix');
  HookProc(@TOpenCustomForm.FocusControl, @CustomFormFocusControl, CustomFormFocusControlHook);
end;

procedure FiniMDIChildFocusFix;
begin
  UnhookProc(@TOpenCustomForm.FocusControl, CustomFormFocusControlHook);
end;
{$ENDIF MDIChildFocusFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #56252: TPageControl flickers a lot with active theming }
{ QC #68730: TLabel is not painted on a themed, double-buffered TTabSheet in Vista }
{ TLabels on TTabSheet are not painted (themes) if a TWinControl like TMemo is on the TTabSheet (TWinControl.PaintWindow bug) }
{$IFDEF PageControlPaintingFix}
type
  TFlickerlessPageControl = class(TPageControl)
    procedure NewWndProc(var Msg: TMessage);
  end;

  TFlickerlessTabSheet = class(TTabSheet)
  protected
    procedure NewCreateParams(var Params: TCreateParams);
    procedure WMPrintClient(var Message: TWMPrintClient); message WM_PRINTCLIENT;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;

    procedure NewWndProc(var Msg: TMessage);
  end;

{ TFlickerlessPageControl }

procedure TFlickerlessPageControl.NewWndProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_SIZE:
      begin
        inherited WndProc(Msg);
        { Update the page control immediately to prevent flicker }
        if ThemeServices.ThemesEnabled then
          RedrawWindow(Handle, nil, 0, RDW_UPDATENOW or RDW_ERASE);
      end;
  else
    inherited WndProc(Msg); // "inherited" is required here, otherwise this would be an endless recursion
  end;
end;

{ TFlickerlessTabSheet }

procedure TFlickerlessTabSheet.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  R: TRect;
begin
  if (PageControl <> nil) and (PageControl.Style = tsTabs) and ThemeServices.ThemesEnabled then
  begin
    { Paint the TabSheet background without filling the gray color from the parent.
      And fill it in WM_ERASEBKGND where it belongs instead of WM_PRINTCLIENT. }
    GetWindowRect(Handle, R);
    OffsetRect(R, -R.Left, -R.Top);
    ThemeServices.DrawElement(Message.DC, ThemeServices.GetElementDetails(ttBody), R);
    Message.Result := 1;
  end
  else
    inherited;
end;

procedure TFlickerlessTabSheet.WMPrintClient(var Message: TWMPrintClient);
begin
  { Fixes "Labels are not painted if themes are enabled" bug }

  { Description see QC #3850 / RAID #159864, same as in TFrame.

    A better solution would be to change TWinControl.PaintWindow to
    use WM_PRINTCLIENT if it is called from a WM_PRINTCLIENT handler
    and to use WM_PAINT only if it is called from a WM_PAINT handler. }

  DefaultHandler(Message);
  PaintControls(Message.DC, nil);
end;

procedure TFlickerlessTabSheet.NewCreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if ThemeServices.ThemesEnabled then
    Params.WindowClass.style := Params.WindowClass.style and not (CS_VREDRAW or CS_HREDRAW);
end;

procedure TFlickerlessTabSheet.NewWndProc(var Msg: TMessage);
begin
  { Instead of hooking the DMT we simply call the replacement handlers directly }
  case Msg.Msg of
    WM_ERASEBKGND:
      WMEraseBkgnd(TWMEraseBkgnd(Msg));
    WM_PRINTCLIENT:
      WMPrintClient(TWMPrintClient(Msg));
    WM_SIZE:
      begin
        inherited WndProc(Msg);
        if ThemeServices.ThemesEnabled then
          RedrawWindow(Handle, nil, 0, RDW_UPDATENOW or RDW_INVALIDATE or RDW_ERASE or RDW_ALLCHILDREN);
      end;
  else
    inherited WndProc(Msg); // "inherited" is required here, otherwise this would be an endless recursion
  end;
end;

procedure InitPageControlPaintingFix;
begin
  DebugLog('PageControlPaintingFix');
  ReplaceVmtField(TTabSheet, @TFlickerlessTabSheet.WndProc, @TFlickerlessTabSheet.NewWndProc);
  ReplaceVmtField(TTabSheet, @TFlickerlessTabSheet.CreateParams, @TFlickerlessTabSheet.NewCreateParams);
  ReplaceVmtField(TPageControl, @TFlickerlessPageControl.WndProc, @TFlickerlessPageControl.NewWndProc);
end;

procedure FiniPageControlPaintingFix;
begin
  ReplaceVmtField(TTabSheet, @TFlickerlessTabSheet.NewWndProc, @TFlickerlessTabSheet.WndProc);
  ReplaceVmtField(TTabSheet, @TFlickerlessTabSheet.NewCreateParams, @TFlickerlessTabSheet.CreateParams);
  ReplaceVmtField(TPageControl, @TFlickerlessPageControl.NewWndProc, @TFlickerlessPageControl.WndProc);
end;
{$ENDIF PageControlPaintingFix}
{---------------------------------------------------------------------------}



{---------------------------------------------------------------------------}
{$IFDEF GridFlickerFix}
type
  {$IFDEF VCLFIXPACK_DB_SUPPORT}
  TFlickerlessDBGrid = class(TDBGrid)
  protected
    procedure NewWndProc(var Msg: TMessage);
  end;
  {$ENDIF VCLFIXPACK_DB_SUPPORT}

  TFlickerlessStringGrid = class(TStringGrid)
  protected
    procedure NewWndProc(var Msg: TMessage);
  end;

  TFlickerlessDrawGrid = class(TDrawGrid)
  protected
    procedure NewWndProc(var Msg: TMessage);
  end;

{ TFlickerlessDBGrid }

procedure GridWMEraseBkgnd(Grid: TCustomGrid; var Message: TWMEraseBkgnd);
var
  R: TRect;
  Size: TSize;
begin
  { Fill the area between the two scroll bars. }
  Size.cx := GetSystemMetrics(SM_CXVSCROLL);
  Size.cy := GetSystemMetrics(SM_CYHSCROLL);
  if {Grid.BiDiMode <> bdLeftToRight}Grid.UseRightToLeftAlignment then
    R := Bounds(0, Grid.Height - Size.cy, Size.cx, Size.cy)
  else
    R := Bounds(Grid.Width - Size.cx, Grid.Height - Size.cy, Size.cx, Size.cy);
  FillRect(Message.DC, R, Grid.Brush.Handle);
  Message.Result := 1;
end;

{$IFDEF VCLFIXPACK_DB_SUPPORT}
procedure TFlickerlessDBGrid.NewWndProc(var Msg: TMessage);
{var
  Rect: TRect;}
begin
  if Msg.Msg = WM_ERASEBKGND then
    GridWMEraseBkgnd(Self, TWMEraseBkgnd(Msg))
  else if Msg.Msg = WM_PAINT then
  begin
    {if UseRightToLeftAlignment then
    Begin
      Rect.TopLeft := ClientRect.TopLeft;
      Rect.BottomRight := ClientRect.BottomRight;
      InvalidateRect(Handle, @Rect, False);
    end;}
    inherited WndProc(Msg);
  end
  else
    inherited WndProc(Msg);
end;
{$ENDIF VCLFIXPACK_DB_SUPPORT}

procedure TFlickerlessStringGrid.NewWndProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_ERASEBKGND then
    GridWMEraseBkgnd(Self, TWMEraseBkgnd(Msg))
  else
    inherited WndProc(Msg);
end;

procedure TFlickerlessDrawGrid.NewWndProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_ERASEBKGND then
    GridWMEraseBkgnd(Self, TWMEraseBkgnd(Msg))
  else
    inherited WndProc(Msg);
end;

procedure InitGridFlickerFix;
begin
  DebugLog('GridFlickerFix');
  {$IFDEF VCLFIXPACK_DB_SUPPORT}
  ReplaceVmtField(TDBGrid, @TFlickerlessDBGrid.WndProc, @TFlickerlessDBGrid.NewWndProc);
  {$ENDIF VCLFIXPACK_DB_SUPPORT}
  ReplaceVmtField(TStringGrid, @TFlickerlessStringGrid.WndProc, @TFlickerlessStringGrid.NewWndProc);
  ReplaceVmtField(TDrawGrid, @TFlickerlessDrawGrid.WndProc, @TFlickerlessDrawGrid.NewWndProc);
end;

procedure FiniGridFlickerFix;
begin
  {$IFDEF VCLFIXPACK_DB_SUPPORT}
  ReplaceVmtField(TDBGrid, @TFlickerlessDBGrid.NewWndProc, @TFlickerlessDBGrid.WndProc);
  {$ENDIF VCLFIXPACK_DB_SUPPORT}
  ReplaceVmtField(TStringGrid, @TFlickerlessStringGrid.NewWndProc, @TFlickerlessStringGrid.WndProc);
  ReplaceVmtField(TDrawGrid, @TFlickerlessDrawGrid.NewWndProc, @TFlickerlessDrawGrid.WndProc);
end;
{$ENDIF GridFlickerFix}
{---------------------------------------------------------------------------}



{ ---------------------------------------------------------------------------- }
{ QC #69112: TSpeedButton is painted as a black rectangle on a double buffered panel on a sheet of glass. }
{$IFDEF SpeedButtonGlassFix}
type
  TGlassableSpeedButton = class(TSpeedButton)
    procedure NewWndProc(var Msg: TMessage);
  end;

function ControlInGlassPaint(AControl: TControl): Boolean;
var
  Parent: TWinControl;
begin
  Result := csGlassPaint in AControl.ControlState;
  if Result then
  begin
    { Control could be on a double buffered control. In that case the csGlassPaint flag
      shouldn't be set. }
    Parent := AControl.Parent;
    while (Parent <> nil) and not Parent.DoubleBuffered and not (Parent is TCustomForm) do
      Parent := Parent.Parent;
    Result := (Parent = nil) or not Parent.DoubleBuffered or (Parent is TCustomForm);
  end;
end;

{ TGlassableSpeedButton }

procedure TGlassableSpeedButton.NewWndProc(var Msg: TMessage);
begin
  if (Msg.Msg = WM_PAINT) and (csGlassPaint in ControlState) and
     not ControlInGlassPaint(Self) then
  begin
    ControlState := ControlState - [csGlassPaint];
    try
      inherited WndProc(Msg);
    finally
      ControlState := ControlState + [csGlassPaint];
    end;
  end
  else
    inherited WndProc(Msg);
end;

procedure InitSpeedButtonGlassFix;
begin
  DebugLog('SpeedButtonGlassFix');
  ReplaceVmtField(TSpeedButton, @TGlassableSpeedButton.WndProc, @TGlassableSpeedButton.NewWndProc);
  {$IFDEF VCLFIXPACK_DB_SUPPORT}
  ReplaceVmtField(TNavButton, @TGlassableSpeedButton.WndProc, @TGlassableSpeedButton.NewWndProc);
  {$ENDIF VCLFIXPACK_DB_SUPPORT}
end;

procedure FiniSpeedButtonGlassFix;
begin
  ReplaceVmtField(TSpeedButton, @TGlassableSpeedButton.NewWndProc, @TGlassableSpeedButton.WndProc);
  {$IFDEF VCLFIXPACK_DB_SUPPORT}
  ReplaceVmtField(TNavButton, @TGlassableSpeedButton.NewWndProc, @TGlassableSpeedButton.WndProc);
  {$ENDIF VCLFIXPACK_DB_SUPPORT}
end;
{$ENDIF SpeedButtonGlassFix}
{ ---------------------------------------------------------------------------- }



{ ---------------------------------------------------------------------------- }
{ QC #69294: TProgressBar fails with PBS_MARQUEE and disabled Themes }
{$IFDEF VistaProgressBarMarqueeFix}
type
  TVistaProgressBarMarqueeFix = class(TProgressBar)
  protected
    procedure SetMarqueeInterval(Value: Integer);
    procedure CreateParamsFix(var Params: TCreateParams);
    procedure CreateWndFix;
  end;

var
  SetMarqueeIntervalHook: TXRedirCode;
  SetMarqueeInterval: Pointer;

procedure TVistaProgressBarMarqueeFix.SetMarqueeInterval(Value: Integer);
var
  MarqueeEnabled: Boolean;
begin
  PInteger(@MarqueeInterval)^ := Value;
  if (Style = pbstMarquee) and HandleAllocated then
  begin
    MarqueeEnabled := Style = pbstMarquee;
    SendMessage(Handle, PBM_SETMARQUEE, WPARAM(MarqueeEnabled), LPARAM(MarqueeInterval));
  end;
end;

procedure TVistaProgressBarMarqueeFix.CreateParamsFix(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if Style = pbstMarquee then
    Params.Style := Params.Style or PBS_MARQUEE;
end;

procedure TVistaProgressBarMarqueeFix.CreateWndFix;
var
  MarqueeEnabled: Boolean;
begin
  inherited CreateWnd;
  MarqueeEnabled := Style = pbstMarquee;
  SendMessage(Handle, PBM_SETMARQUEE, WPARAM(THandle(MarqueeEnabled)), LPARAM(MarqueeInterval));
end;

procedure InitVistaProgressBarMarqueeFix;
var
  PropInfo: PPropInfo;
begin
  if CheckWin32Version(6, 0) then
  begin
    ReplaceVmtField(TProgressBar, @TVistaProgressBarMarqueeFix.CreateParams, @TVistaProgressBarMarqueeFix.CreateParamsFix);
    ReplaceVmtField(TProgressBar, @TVistaProgressBarMarqueeFix.CreateWnd, @TVistaProgressBarMarqueeFix.CreateWndFix);
    PropInfo := GetPropInfo(TProgressBar, 'MarqueeInterval');
    if (PropInfo <> nil) and (PropInfo.SetProc <> nil) and
       not (Byte(DWORD_PTR(PropInfo.SetProc) shr 24) in [$FF, $FE]) then
    begin
      SetMarqueeInterval := PropInfo.SetProc;
      HookProc(SetMarqueeInterval, @TVistaProgressBarMarqueeFix.SetMarqueeInterval, SetMarqueeIntervalHook);
    end;
    DebugLog('VistaProgressBarMarqueeFix');
  end;
end;

procedure FiniVistaProgressBarMarqueeFix;
begin
  if CheckWin32Version(6, 0) then
  begin
    ReplaceVmtField(TProgressBar, @TVistaProgressBarMarqueeFix.CreateParamsFix, @TVistaProgressBarMarqueeFix.CreateParams);
    ReplaceVmtField(TProgressBar, @TVistaProgressBarMarqueeFix.CreateWndFix, @TVistaProgressBarMarqueeFix.CreateWnd);
    UnhookProc(SetMarqueeInterval, SetMarqueeIntervalHook);
  end;
end;
{$ENDIF VistaProgressBarMarqueeFix}
{ ---------------------------------------------------------------------------- }


{ ---------------------------------------------------------------------------- }
{ QC #52439: DbNavigator paints incorrectly when flat=true in themed mode }
{$IFDEF DBNavigatorFix}
type
  TOpenDBNavigator = class(TDBNavigator)
  public
    procedure SetFlatFixed(Value: Boolean);
  end;

var
  DBNavigatorSetFlat: Pointer;
  DBNavigatorSetFlatHook: TXRedirCode;

procedure TOpenDBNavigator.SetFlatFixed(Value: Boolean);
var
  I: TNavigateBtn;
begin
  if Flat <> Value then
  begin
    Boolean(Pointer(@Flat)^) := Value; // FFlat := Value
    for I := Low(Buttons) to High(Buttons) do
      Buttons[I].Flat := Value;
    if Flat then
      ControlStyle := ControlStyle - [csOpaque]
    else
      ControlStyle := ControlStyle + [csOpaque];
  end;
end;

procedure InitDBNavigatorFix;
var
  Info: PPropInfo;
begin
  Info := GetPropInfo(TDBNavigator, 'Flat');
  if (Info <> nil) and (Info.SetProc <> nil) then
  begin
    DBNavigatorSetFlat := Info.SetProc;
    HookProc(DBNavigatorSetFlat, @TOpenDBNavigator.SetFlatFixed, DBNavigatorSetFlatHook);
    DebugLog('DBNavigatorFix');
  end;
end;

procedure FiniDBNavigatorFix;
begin
  UnhookProc(DBNavigatorSetFlat, DBNavigatorSetFlatHook);
end;
{$ENDIF DBNavigatorFix}
{ ---------------------------------------------------------------------------- }


{ ---------------------------------------------------------------------------- }
{ QC #70441: ToUpper and ToLower modify a Const argument
  QC #69752: ToUpper and ToLower with NullString }
{$IFDEF CharacterFix}
var
  TCharacter_ToLowerHook, TCharacter_ToUpperHook: TXRedirCode;

function TCharacter_ToLower(const S: string): string;
var
  Len: Integer;
begin
  if S <> '' then
  begin
    Len := Length(S);
    SetLength(Result, Len);
    if LCMapString(GetThreadLocale, LCMAP_LOWERCASE, PChar(S), Len, PChar(Result), Len) = 0 then
      RaiseLastOSError;
  end
  else
    Result := S;
end;

function TCharacter_ToUpper(const S: string): string;
var
  Len: Integer;
begin
  if S <> '' then
  begin
    Len := Length(S);
    SetLength(Result, Len);
    if LCMapString(GetThreadLocale, LCMAP_UPPERCASE, PChar(S), Len, PChar(Result), Len) = 0 then
      RaiseLastOSError;
  end
  else
    Result := S;
end;

procedure InitCharacterFix;
begin
  DebugLog('CharacterFix');
  HookProc(@TCharacter.ToLower, @TCharacter_ToLower, TCharacter_ToLowerHook);
  HookProc(@TCharacter.ToUpper, @TCharacter_ToUpper, TCharacter_ToUpperHook);
end;

procedure FiniCharacterFix;
begin
  UnhookProc(@TCharacter.ToLower, TCharacter_ToLowerHook);
  UnhookProc(@TCharacter.ToUpper, TCharacter_ToUpperHook);
end;
{$ENDIF CharacterFix}
{ ---------------------------------------------------------------------------- }


{ ---------------------------------------------------------------------------- }
{ QC #69875: StringBuilder.Replace is incorrect
             + a much faster implementation }
{$IFDEF StringBuilderFix}
var
  TStringBuilder_ReplaceHook: TXRedirCode;

type
  TStringBuilderFix = class(TStringBuilder)
  public
    function Replace(const OldValue, NewValue: string; StartIndex, Count: Integer): TStringBuilder;
  end;

function TStringBuilderFix.Replace(const OldValue, NewValue: string;
  StartIndex, Count: Integer): TStringBuilder;

  procedure OffsetChars(Data: PChar; Offset: Integer; EndP: PChar); inline;
  begin
    Move(Data^, PChar(Data + Offset)^, (EndP - Data) * SizeOf(Char));
  end;

var
  P, EndP, F: PChar;
  FirstChar: Char;
  OldValueLen, NewValueLen, DataLen: Integer;
  FoundCount, I: Integer;
  StackStart: Pointer;
  StackP: ^PChar;
  SizeChange: Integer;
  NewLength: Integer;
begin
  { Bounds checking }
  DataLen := System.Length(FData);
  if StartIndex + Count >= DataLen then
    Count := DataLen - StartIndex;

  if (Count <= 0) or (StartIndex < 0) or (StartIndex >= DataLen) or (OldValue = '') then
    Exit(Self);

  OldValueLen := System.Length(OldValue);
  NewValueLen := System.Length(NewValue);
  SizeChange := NewValueLen - OldValueLen;

  { Start stack position-buffer }
  asm mov StackStart, esp end;

  FoundCount := 0;
  FirstChar := PChar(Pointer(OldValue))^;

  P := PChar(@FData[StartIndex]);
  while Count > 0 do
  begin
    while (Count > 0) and (P^ <> FirstChar) do
    begin
      Inc(P);
      Dec(Count);
    end;

    if Count > 0 then
    begin
      if (OldValueLen = 1) or (StrLComp(P + 1, PChar(Pointer(OldValue)) + 1, OldValueLen - 1) = 0) then
      begin
        if SizeChange = 0 then
        begin
          { Replace inplace }
          Move(NewValue[1], P^, OldValueLen * SizeOf(Char));
        end
        else
        begin
          { Save position to the stack and proceed }
          asm push P end;
          Inc(FoundCount);
        end;
        Inc(P, OldValueLen - 1);
        Dec(Count, OldValueLen - 1);
      end;
    end;
    Inc(P);
    Dec(Count);
  end;

  NewLength := FLength + SizeChange * FoundCount;
  if FoundCount > 0 then { Expand }
  begin
    { Offset the data from right to left }
    if SizeChange > 0 then
    begin
      { Resize FData to the new length }
      F := @FData[0];
      if NewLength > System.Length(FData) then
        SetLength(FData, NewLength);
      EndP := PChar(@FData[FLength - 1]) + 1;

      while FoundCount > 0 do
      begin
        asm pop P end; { take the last position from the stack }
        P := PChar(@FData[0]) + (P - F);
        { Offset all chars right to the OldValue by FoundCount*SizeChange }
        OffsetChars(P + OldValueLen, FoundCount * SizeChange, EndP);
        EndP := P;
        { Put the NewValue into the buffer }
        Move(NewValue[1], PChar(P + (FoundCount - 1) * SizeChange)^, NewValueLen * SizeOf(Char));
        Dec(FoundCount);
      end;
    end
    else { SizeChange < 0, Shrink }
    begin
      { Offset the data from left to right }

      { Push the terminator to the stack; the loop uses the "next position" as EndP }
      EndP := PChar(@FData[FLength - 1]) + 1;
      asm push EndP end;

      StackP := Pointer(INT_PTR(StackStart) - SizeOf(Pointer));
      I := 0;
      while FoundCount > 0 do
      begin
        P := StackP^;
        Dec(StackP);
        EndP := StackP^;
        { Offset all chars right to the OldValue by FoundCount*SizeChange }
        OffsetChars(@P[OldValueLen], (I + 1) * SizeChange, EndP);
        { Put the NewValue into the buffer }
        if NewValue <> '' then
          Move(NewValue[1], P[I * SizeChange], NewValueLen * SizeOf(Char));
        Inc(I);
        Dec(FoundCount);
      end;

      {if NewLength > System.Length(FData) then
        SetLength(FData, NewLength);}
    end;
  end;

  { Release stack memory }
  asm mov esp, StackStart end;

  FLength := NewLength;
  Result := Self;
end;

procedure InitStringBuilderFix;
var
  Proc: function(const OldValue: string; const NewValue: string; StartIndex: Integer; Count: Integer): TStringBuilder of object;
begin
  DebugLog('StringBuilderFix');
  Proc := TStringBuilder(nil).Replace;
  HookProc(TMethod(Proc).Code, @TStringBuilderFix.Replace, TStringBuilder_ReplaceHook);
end;

procedure FiniStringBuilderFix;
var
  Proc: function(const OldValue: string; const NewValue: string; StartIndex: Integer; Count: Integer): TStringBuilder of object;
begin
  Proc := TStringBuilder(nil).Replace;
  UnhookProc(TMethod(Proc).Code, TStringBuilder_ReplaceHook);
end;
{$ENDIF StringBuilderFix}
{ ---------------------------------------------------------------------------- }


{ ---------------------------------------------------------------------------- }
{ Workaround for Windows Vista CompareString bug }
{$IFDEF VistaCompareStringFix}

{**************************************************************************************************}
{                                                                                                  }
{ CompareString Fix                                                                                }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is CompareStringFix.pas.                                                       }
{                                                                                                  }
{ The Initial Developer of the Original Code is Andreas Hausladen.                                 }
{ Portions created by Andreas Hausladen are Copyright (C) 2008 Andreas Hausladen.                  }
{ All Rights Reserved.                                                                             }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{ Apr 18, 2008 A. Garrels - When parameter Locale or user default LCID matches (German-Germany)    }
{ and sort order equals SORT_GERMAN_PHONE_BOOK the patch must not be applied.                      }
{                                                                                                  }
{**************************************************************************************************}
{ This unit contains a workaround for a Windows Vista bug.                                         }
{ The <20>/<2F> ($DC/$FC) and the UE/ue are treated equal in all locales, but they aren't equal. There   }
{ was a bugfix intended for Vista SP1 but it was removed before SP1 was released.                  }
{ Windows 2008 Server still includes this bugfix but Vista will never get this bugfix.             }
{ Microsoft: new versions are for correctness; service packs are for consistency and compatibility }
{**************************************************************************************************}

function _CompareStringA(Locale: LCID; dwCmpFlags: DWORD; lpString1: PAnsiChar;
  cchCount1: Integer; lpString2: PAnsiChar; cchCount2: Integer): Integer; stdcall;
  external kernel32 name 'CompareStringA';
function _CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
  cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer; stdcall;
  external kernel32 name 'CompareStringW';

var
  CompareStringAProc: function(Locale: LCID; dwCmpFlags: DWORD; lpString1: PAnsiChar;
    cchCount1: Integer; lpString2: PAnsiChar; cchCount2: Integer): Integer; stdcall;
  CompareStringWProc: function(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
    cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer; stdcall;
  CompareStringFixRequired: Boolean;

const
  MaxCompareStringFixBuffer = 2047;
var
  CachedUserDefaultLCID: LCID = 0;
  CachedSystemDefaultLCID: LCID = 0;

function IsGermanPhonebookSortOrder(ALcid: LCID): Boolean; {$IF CompilerVersion >= 18.0} inline; {$IFEND}
begin
  if ALcid <> 0 then
  begin
    if ALcid = LOCALE_USER_DEFAULT then
    begin
      if CachedUserDefaultLCID = 0 then
        CachedUserDefaultLCID := GetUserDefaultLCID();
      ALcid := CachedUserDefaultLCID;
    end
    else if ALcid = LOCALE_SYSTEM_DEFAULT then
    begin
      if CachedSystemDefaultLCID = 0 then
        CachedSystemDefaultLCID := GetSystemDefaultLCID();
      ALcid := CachedSystemDefaultLCID;
    end;

    Result := (Word(ALcid) = $0407) and (ALcid shr 16 and $0F = SORT_GERMAN_PHONE_BOOK);
  end
  else
    Result := False;
end;

function GetUmlautFixedString(P: PWideChar; var Count: Integer; Buf: PWideChar): PWideChar;
const
  CombiningDiaresis = $308;
var
  ValidCount, EndIndex, EndCount, I, CollationCount, Size, Cnt: Integer;
  Ch: WideChar;
  Source, Dest: PWideChar;
begin
  ValidCount := -1;
  CollationCount := 0;
  EndIndex := -1;
  Source := P;

  { Test for the affected code points }
  if Count = -1 then
  begin
    Ch := Source^;
    while Ch <> #0 do
    begin
      while Ch <> #0 do
      begin
        case Ch of
          #$00DC, #$00FC:
            Break;
        end;
        Inc(Source);
        Ch := Source^;
      end;

      if Ch <> #0 then
      begin
        I := Source - P;
        if ValidCount = -1 then
          ValidCount := I;
        EndIndex := I + 1;
        Inc(CollationCount);
        Inc(Source);
        Ch := Source^;
      end;
    end;

    Count := Source - P;
  end
  else
  begin
    Cnt := Count;
    while Cnt > 0 do
    begin
      while Cnt <> 0 do
      begin
        case Source^ of
          #$00DC, #$00FC:
            Break;
        end;
        Inc(Source);
        Dec(Cnt);
      end;

      if Cnt <> 0 then
      begin
        I := Source - P;
        if ValidCount = -1 then
          ValidCount := I;
        EndIndex := I + 1;
        Inc(CollationCount);
        Inc(Source);
        Dec(Cnt);
      end;
    end;
  end;

  if CollationCount > 0 then
  begin
    { Re-encode the string with combining diaresis }

    EndCount := Count - EndIndex;
    if EndCount < 4 then
    begin
      { Move() isn't faster if there are too less code points to copy }
      EndIndex := Count;
      EndCount := 0;
    end;

    { Allocate enough memory or use the stack based buffer if the string fits
      into it. }
    Inc(Count, CollationCount);
    Size := (Count + 1) * SizeOf(WideChar);
    if Count < MaxCompareStringFixBuffer then
      Result := Buf
    else
      GetMem(Result, Size);

    { Copy untouched code points }
    if ValidCount >= 4 then
      Move(P^, Result^, ValidCount * SizeOf(WideChar))
    else
      ValidCount := 0;

    { Copy code points and replace "<22>" ($DC) and "<22>" ($FC) with "U"/"u" + combining diaresis }
    Source := P + ValidCount;
    Dest := Result + ValidCount;
    for I := ValidCount to EndIndex - 1 do
    begin
      Ch := Source^;
      case Ch of
        #$00DC:
          begin
            PLongint(Dest)^ := (CombiningDiaresis shl 16) or $55;
            Inc(Dest);
          end;
        #$00FC:
          begin
            PLongint(Dest)^ := (CombiningDiaresis shl 16) or $75;
            Inc(Dest);
          end;
      else
        Dest^ := Ch;
      end;
      Inc(Dest);
      Inc(Source);
    end;

    { Copy remaining untouched code points }
    if EndCount > 0 then
    begin
      Move(Source^, Dest^, EndCount * SizeOf(WideChar));
      Inc(Dest, EndCount);
    end;
    Dest^ := #0;
  end
  else
    Result := P;
end;

function CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
  cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer; stdcall;
var
  String1, String2: PWideChar;
  // Stack allocation is much faster than heap allocation
  Buf1, Buf2: array[0..MaxCompareStringFixBuffer] of WideChar;
begin
  if (lpString1 <> nil) and (lpString2 <> nil) and (cchCount1 <> 0) and (cchCount2 <> 0) and
     (lpString1 <> lpString2) and
     not IsGermanPhonebookSortOrder(Locale) then
  begin
    String1 := GetUmlautFixedString(lpString1, cchCount1, Buf1);
    String2 := GetUmlautFixedString(lpString2, cchCount2, Buf2);

    Result := CompareStringWProc(Locale, dwCmpFlags, String1, cchCount1, String2, cchCount2);

    if (String1 <> lpString1) and (String1 <> @Buf1[0]) then
      FreeMem(String1);
    if (String2 <> lpString2) and (String2 <> @Buf2[0]) then
      FreeMem(String2);
  end
  else
    Result := CompareStringWProc(Locale, dwCmpFlags, lpString1, cchCount1, lpString2, cchCount2);
end;

function CompareStringA(Locale: LCID; dwCmpFlags: DWORD; lpString1: PAnsiChar;
  cchCount1: Integer; lpString2: PAnsiChar; cchCount2: Integer): Integer; stdcall;

  function ContainsProblematicUmlaut(P: PAnsiChar; Count: Integer): Boolean;
  begin
    Result := True;
    while Count > 0 do
    begin
      if P^ in [#$DC, #$FC] then
        Exit;
      Inc(P);
      Dec(Count);
    end;
    Result := False;
  end;

var
  String1, String2: WideString;
begin
  if (lpString1 <> nil) and (lpString2 <> nil) and (cchCount1 <> 0) and (cchCount2 <> 0) and
     (lpString1 <> lpString2) and
     not IsGermanPhonebookSortOrder(Locale) then
  begin
    case GetACP of
      {1250,} 1252{, 1254, 1257, 1258}:
        begin
          if cchCount1 = -1 then
            cchCount1 := StrLen(lpString1);
          if cchCount2 = -1 then
            cchCount2 := StrLen(lpString2);

          if ContainsProblematicUmlaut(lpString1, cchCount1) or
             ContainsProblematicUmlaut(lpString2, cchCount2) then
          begin
            SetString(String1, lpString1, cchCount1);
            SetString(String2, lpString2, cchCount2);
            Result := CompareStringW(Locale, dwCmpFlags, PWideChar(String1), Length(String1),
                                     PWideChar(String2), Length(String2));
            Exit;
          end;
        end;
    end;
  end;
  Result := CompareStringAProc(Locale, dwCmpFlags, lpString1, cchCount1, lpString2, cchCount2);
end;

type
  TJumpItem = packed record
    Code: TXRedirCode;
    Jump: Byte;
    Offset: Integer;
  end;
  PJumpTable = ^TJumpTable;
  TJumpTable = array[0..1] of TJumpItem;

var
  JumpTable: PJumpTable;

procedure PatchWinAPI(Proc, Dest: Pointer; var JumpItem: TJumpItem);
var
  n: DWORD;
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);

  if ReadProcessMemory(GetCurrentProcess, Proc, @JumpItem.Code, SizeOf(JumpItem.Code), n) then
  begin
    JumpItem.Jump := $E9;
    JumpItem.Offset := Integer(Proc) - Integer(@JumpItem) - SizeOf(JumpItem.Code);

    Code.Jump := $E9;
    Code.Offset := Integer(Dest) - Integer(Proc) - SizeOf(Code);

    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;

procedure UnpatchWinAPI(Proc: Pointer; const JumpItem: TJumpItem);
var
  n: Cardinal;
begin
  if JumpItem.Code.Jump <> 0 then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);

    WriteProcessMemory(GetCurrentProcess, Proc, @JumpItem.Code, SizeOf(JumpItem.Code), n);
  end;
end;

procedure InitCompareStringFix;
const
  CSTR_EQUAL = 2;
begin
  { Only Vista is affected, Windows 2008 Server is not affected }
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and
     (Win32MajorVersion = 6) and (Win32MinorVersion = 0) then
  begin
    CompareStringFixRequired := _CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE, #$FC, 1, 'ue', 2) = CSTR_EQUAL;
    if CompareStringFixRequired then
    begin
      OutputDebugStringW('Installing CompareString workaround for Windows Vista');
      JumpTable := VirtualAlloc(nil, SizeOf(TJumpTable), MEM_COMMIT, PAGE_EXECUTE_READWRITE);

      PatchWinAPI(@_CompareStringA, @CompareStringA, JumpTable[0]);
      CompareStringAProc := @JumpTable[0];
      PatchWinAPI(@_CompareStringW, @CompareStringW, JumpTable[1]);
      CompareStringWProc := @JumpTable[1];
    end;
  end;
end;

procedure FiniCompareStringFix;
begin
  if CompareStringFixRequired then
  begin
    UnpatchWinAPI(@_CompareStringA, JumpTable[0]);
    UnpatchWinAPI(@_CompareStringW, JumpTable[1]);

    VirtualFree(JumpTable, 0, MEM_RELEASE);
    JumpTable := nil;
  end;
end;
{$ENDIF VistaCompareStringFix}
{ ---------------------------------------------------------------------------- }


initialization
  {$IFDEF GetNonToolWindowPopupParentFix}
  FixGetNonToolWindowPopupParent;
  {$ENDIF GetNonToolWindowPopupParentFix}

  {$IFDEF TaskModalDialogFix}
  InitTaskModalDialogFix;
  {$ENDIF TaskModalDialogFix}

  {$IFDEF AppDeActivateZOrderFix}
  InitAppDeActivateZOrderFix;
  {$ENDIF AppDeActivateZOrderFix}

  {$IFDEF HideStackTrashingFix}
  FindTopMostWindowProc := GetAddrOfFindTopMostWindow;
  if FindTopMostWindowProc <> nil then
  begin
    DebugLog('HideStackTrashingFix');
    HookProc(FindTopMostWindowProc, @FindTopMostWindow, FindTopMostWindowHook);
  end;
  {$ENDIF HideStackTrashingFix}

  {$IFDEF ControlResizeFix}
  InitControlResizeFix;
  {$ENDIF ControlResizeFix}

  {$IFDEF ActionListAVFix}
  InitActionListAVFix;
  {$ENDIF ActionListAVFix}

  {$IFDEF ContextMenuFix}
  InitContextMenuFix;
  {$ENDIF ContextMenuFix}

  {$IFDEF ObjAutoDEPFix}
  InitObjAutoDEPFix;
  {$ENDIF ObjAutoDEPFix}

  {$IFDEF AppMinimizeFix}
  InitAppMinimizeFix;
  {$ENDIF AppMinimizeFix}

  {$IFDEF SysUtilsAbortFix}
  InitSysUtilsAbortFix;
  {$ENDIF SysUtilsAbortFix}

  {$IFDEF CmdShowMinimizeFix}
  InitCmdShowMinimizeFix;
  {$ENDIF CmdShowMinimizeFix}

  {$IFDEF MDIChildFocusFix}
  InitMDIChildFocusFix;
  {$ENDIF MDIChildFocusFix}

  {$IFDEF PageControlPaintingFix}
  InitPageControlPaintingFix;
  {$ENDIF PageControlPaintingFix}

  {$IFDEF GridFlickerFix}
  InitGridFlickerFix;
  {$ENDIF GridFlickerFix}

  {$IFDEF SpeedButtonGlassFix}
  InitSpeedButtonGlassFix;
  {$ENDIF SpeedButtonGlassFix}

  {$IFDEF VistaProgressBarMarqueeFix}
  InitVistaProgressBarMarqueeFix;
  {$ENDIF VistaProgressBarMarqueeFix}

  {$IFDEF DBNavigatorFix}
  InitDBNavigatorFix;
  {$ENDIF DBNavigatorFix}

  {$IFDEF CharacterFix}
  InitCharacterFix;
  {$ENDIF CharacterFix}

  {$IFDEF StringBuilderFix}
  InitStringBuilderFix;
  {$ENDIF StringBuilderFix}

  {$IFDEF VistaCompareStringFix}
  InitCompareStringFix;
  {$ENDIF VistaCompareStringFix}

finalization
  // In revers order

  {$IFDEF VistaCompareStringFix}
  FiniCompareStringFix;
  {$ENDIF VistaCompareStringFix}

  {$IFDEF StringBuilderFix}
  FiniStringBuilderFix;
  {$ENDIF StringBuilderFix}

  {$IFDEF CharacterFix}
  FiniCharacterFix;
  {$ENDIF CharacterFix}

  {$IFDEF DBNavigatorFix}
  FiniDBNavigatorFix;
  {$ENDIF DBNavigatorFix}

  {$IFDEF VistaProgressBarMarqueeFix}
  FiniVistaProgressBarMarqueeFix;
  {$ENDIF VistaProgressBarMarqueeFix}

  {$IFDEF SpeedButtonGlassFix}
  FiniSpeedButtonGlassFix;
  {$ENDIF SpeedButtonGlassFix}

  {$IFDEF GridFlickerFix}
  FiniGridFlickerFix;
  {$ENDIF GridFlickerFix}

  {$IFDEF PageControlPaintingFix}
  FiniPageControlPaintingFix;
  {$ENDIF PageControlPaintingFix}

  {$IFDEF MDIChildFocusFix}
  FiniMDIChildFocusFix;
  {$ENDIF MDIChildFocusFix}

  {$IFDEF CmdShowMinimizeFix}
  FiniCmdShowMinimizeFix;
  {$ENDIF CmdShowMinimizeFix}

  {$IFDEF SysUtilsAbortFix}
  FiniSysUtilsAbortFix;
  {$ENDIF SysUtilsAbortFix}

  {$IFDEF AppMinimizeFix}
  FiniAppMinimizeFix;
  {$ENDIF AppMinimizeFix}

  {$IFDEF ObjAutoDEPFix}
  FiniObjAutoDEPFix;
  {$ENDIF ObjAutoDEPFix}

  {$IFDEF ContextMenuFix}
  FiniContextMenuFix;
  {$ENDIF ContextMenuFix}

  {$IFDEF ActionListAVFix}
  FiniActionListAVFix;
  {$ENDIF ActionListAVFix}

  {$IFDEF ControlResizeFix}
  FiniControlResizeFix;
  {$ENDIF ControlResizeFix}

  {$IFDEF HideStackTrashingFix}
  if FindTopMostWindowProc <> nil then
    UnhookProc(FindTopMostWindowProc, FindTopMostWindowHook);
  {$ENDIF HideStackTrashingFix}

  {$IFDEF TaskModalDialogFix}
  FiniTaskModalDialogFix;
  {$ENDIF TaskModalDialogFix}

  {$IFDEF AppDeActivateZOrderFix}
  FiniAppDeActivateZOrderFix;
  {$ENDIF AppDeActivateZOrderFix}

  {$IFDEF MkObjInstLeakFix}
  MkObjInstLeakHooked := False;
  ReleaseObjectInstanceBlocks;
  {$ENDIF MkObjInstLeakFix}

end.