diff --git a/Code/DDevExtensions/D_D130/DDevExtensions.dproj b/Code/DDevExtensions/D_D130/DDevExtensions.dproj index 2917cd9..4cf0803 100644 --- a/Code/DDevExtensions/D_D130/DDevExtensions.dproj +++ b/Code/DDevExtensions/D_D130/DDevExtensions.dproj @@ -1,17 +1,17 @@ - + {13bb5c7c-bee9-44e9-863a-a43268dc0228} DDevExtensions.dpr Debug DCC32 - ..\bin\DDevExtensionsD130.dll + ..\bin\$(Platform)\DDevExtensionsD130.dll 20.3 Release True Library VCL True - Win32 + Win64 3 DDevExtensions @@ -64,12 +64,12 @@ D130 off false - ..\bin + ..\bin\$(Platform) 53900000 - lib + lib\$(Platform) true false - ..\bin\DDevExtensionsD130.dll + ..\bin\$(Platform)\DDevExtensionsD130.dll true vcl;rtl;designide;$(DCC_UsePackage) @@ -77,7 +77,7 @@ -rBDSPlain -pDelphi true Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - false $(BDS)\Bin\bds.exe @@ -87,6 +87,8 @@ $(PreBuildEvent)]]> Debug CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 1 + 0 0 none @@ -96,8 +98,8 @@ $(PreBuildEvent)]]> 0 False 0 - lib - lib + lib\$(Platform) + lib\$(Platform) OldPalette;$(DCC_ResourcePath) OldPalette;$(DCC_ObjPath) OldPalette;$(DCC_IncludePath) @@ -110,14 +112,14 @@ $(PreBuildEvent)]]> CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - lib\debug + lib\$(Platform)\debug 3 DetailedSegments true 7.0 3 - lib - lib + lib\$(Platform) + lib\$(Platform) OldPalette;$(DCC_ResourcePath) OldPalette;$(DCC_ObjPath) OldPalette;$(DCC_IncludePath) @@ -1176,7 +1178,17 @@ $(PreBuildEvent)]]> - copy /Y "$(PROJECTDIR)\..\..\..\CompileInterceptor\Bin\CompileInterceptorW.dll" "$(OUTPUTDIR)" + copy /Y "$(PROJECTDIR)\..\..\..\CompileInterceptor\Bin\Win32\CompileInterceptorW.dll" "$(OUTPUTDIR)" + + False + + False + + False + + + copy /Y "$(PROJECTDIR)\..\..\..\CompileInterceptor\Bin\Win64\CompileInterceptorW.dll" "$(OUTPUTDIR)" + False False @@ -1184,7 +1196,17 @@ $(PreBuildEvent)]]> False - copy /Y "$(PROJECTDIR)\..\..\..\CompileInterceptor\Bin\CompileInterceptorW.dll" "$(OUTPUTDIR)" + copy /Y "$(PROJECTDIR)\..\..\..\CompileInterceptor\Bin\Win32\CompileInterceptorW.dll" "$(OUTPUTDIR)" + + False + + False + + False + + + copy /Y "$(PROJECTDIR)\..\..\..\CompileInterceptor\Bin\Win64\CompileInterceptorW.dll" "$(OUTPUTDIR)" + False False diff --git a/Code/DDevExtensions/Source/CompileProgress/CompileProgress.pas b/Code/DDevExtensions/Source/CompileProgress/CompileProgress.pas index 9220428..d1d2838 100644 --- a/Code/DDevExtensions/Source/CompileProgress/CompileProgress.pas +++ b/Code/DDevExtensions/Source/CompileProgress/CompileProgress.pas @@ -359,6 +359,7 @@ function CompileActiveProject(Instance: TObject; CompileMode: TCompileMode; Wait end; {$IF CompilerVersion >= 21.0} // Delphi 2010+ +{$IFDEF CPUX86} procedure HookedProjectGroupCompileActive; asm // Only show the dialog if we are called by TAppBuilder.Compile() @@ -384,13 +385,38 @@ procedure HookedProjectGroupCompileActive; jb CompileActiveProject jmp CallOrgProjectGroupCompileActive end; +{$ENDIF CPUX86} +{$IFDEF CPUX64} +procedure HookedProjectGroupCompileActive; +asm + // Only show the dialog if we are called by TAppBuilder.Compile() + // Win64 calling convention: RCX=Self, RDX=CompileMode, R8=Wait + // Return address is at [RSP], RAX and R9 are volatile scratch registers + mov rax, [rsp] // ret-addr + sub rax, 5 // call instruction size + mov r9, OrgAppBuilderCompile + sub rax, r9 // rax = difference between TAppBuilder.Compile and the return address + jns @@Compare + neg rax +@@Compare: + cmp rax, 30 // We can be called from TAppBuilder.Compile() within 30 bytes + jb CompileActiveProject + jmp CallOrgProjectGroupCompileActive +end; +{$ENDIF CPUX64} procedure InitPlugin(Unload: Boolean); // We can't hook into bds.exe because the copy protection will catch us. So we need to go a different // way than what we used to do in Delphi 2009. const + {$IFDEF CPUX86} StartCompileSymbol = '@Comprgrs@TProgressForm@StartCompile$qqrv'; ProjectGroupCompileActiveSymbol = '@Projectgroup@TProjectGroup@CompileActive$qqr21Compintf@TCompileModeo'; + {$ENDIF} + {$IFDEF CPUX64} + StartCompileSymbol = '_ZN8Comprgrs13TProgressForm12StartCompileEv'; + ProjectGroupCompileActiveSymbol = '_ZN12Projectgroup13TProjectGroup13CompileActiveEN8Compintf12TCompileModeEb'; + {$ENDIF} var Ctx: TRttiContext; MainType: TRttiType; diff --git a/Code/DDevExtensions/Source/CompileProgress/CompilerClearOtherStates.pas b/Code/DDevExtensions/Source/CompileProgress/CompilerClearOtherStates.pas index fc9b6b6..8106e30 100644 --- a/Code/DDevExtensions/Source/CompileProgress/CompilerClearOtherStates.pas +++ b/Code/DDevExtensions/Source/CompileProgress/CompilerClearOtherStates.pas @@ -98,7 +98,10 @@ TBuildControl = record FSilent: Boolean; FWait: Boolean; end; +{$IFEND} +{$IFDEF CPUX86} +{$IF CompilerVersion >= 22.0} // XE+ procedure TCompiler_Compile(Compiler: TObject; var BuildInfo: TProjectBuildInfo; const BuildControl: TBuildControl; const FileName: string); external delphicoreide_bpl name '@Basepascomintf@TCompiler@Compile$qqrr26Compintf@TProjectBuildInforx22Compintf@TBuildControlx20System@UnicodeString'; var @@ -114,7 +117,15 @@ function TCompiler_Compile(Compiler: TObject; const FileName: string; const Proj var Org_TCompiler_Compile: function(Compiler: TObject; const FileName: string; const Project: ICustomProject; CompileMode: TCompileMode; Wait, ClearPackages, ClearMessages: Boolean; FinishProc: TCompileFinishedProc): TCompileResult; {$IFEND} +{$ENDIF CPUX86} +{$IFDEF CPUX64} +procedure TCompiler_Compile(Compiler: TObject; var BuildInfo: TProjectBuildInfo; const BuildControl: TBuildControl; const FileName: string); + external delphicoreide_bpl name '_ZN14Basepascomintf9TCompiler7CompileERN8Compintf17TProjectBuildInfoERKNS1_13TBuildControlEN6System13UnicodeStringE'; +var + Org_TCompiler_Compile: procedure(Compiler: TObject; var BuildInfo: TProjectBuildInfo; const BuildControl: TBuildControl; const FileName: string); +{$ENDIF CPUX64} +{$IFDEF CPUX86} {$IF CompilerVersion >= 23.0} // XE2+ function TCustomCodeIProject_GetCompState(Project: TObject; const PlatformName: string): Integer; external coreide_bpl name '@Projectmodule@TCustomCodeIProject@GetCompState$qqrx20System@UnicodeString'; @@ -122,6 +133,11 @@ function TCustomCodeIProject_GetCompState(Project: TObject; const PlatformName: function TCustomCodeIProject_GetCompState(Project: TObject): Integer; external coreide_bpl name '@Projectmodule@TCustomCodeIProject@GetCompState$qqrv'; {$IFEND} +{$ENDIF CPUX86} +{$IFDEF CPUX64} +function TCustomCodeIProject_GetCompState(Project: TObject; const PlatformName: string): Integer; + external coreide_bpl name '_ZN13Projectmodule19TCustomCodeIProject12GetCompStateEN6System13UnicodeStringE'; +{$ENDIF CPUX64} procedure NopClearCompState(CompState: Integer); stdcall; begin diff --git a/Code/DDevExtensions/Source/CompileProgress/NativeProgressForm.pas b/Code/DDevExtensions/Source/CompileProgress/NativeProgressForm.pas index 58b39af..78cf6c2 100644 --- a/Code/DDevExtensions/Source/CompileProgress/NativeProgressForm.pas +++ b/Code/DDevExtensions/Source/CompileProgress/NativeProgressForm.pas @@ -101,8 +101,14 @@ implementation sCurrFileLabelName = 'CurrFile'; {$IFEND} +{$IFDEF CPUX86} procedure ProgressFormPtr; external coreide_bpl name '@Comprgrs@ProgressForm'; +{$ENDIF} +{$IFDEF CPUX64} +procedure ProgressFormPtr; + external coreide_bpl name '_ZN8Comprgrs12ProgressFormE'; +{$ENDIF} var ProgressFormP: ^TForm; diff --git a/Code/DDevExtensions/Source/DSUFeatures/DSUFeatures.pas b/Code/DDevExtensions/Source/DSUFeatures/DSUFeatures.pas index 99fe871..9f11015 100644 --- a/Code/DDevExtensions/Source/DSUFeatures/DSUFeatures.pas +++ b/Code/DDevExtensions/Source/DSUFeatures/DSUFeatures.pas @@ -235,11 +235,20 @@ function HookedLoadPackageEx(const Name: string; AValidatePackage: TValidatePack procedure PreInit; const + {$IFDEF CPUX86} sLoadPackageCache = '@Pascpppakmgr@TProfileData@LoadPackageCache$qqr' + _xp_ + System_Inifiles_TCustomIniFile; sSavePackageCache = '@Pascpppakmgr@TProfileData@SavePackageCache$qqr' + _xp_ + System_Inifiles_TCustomIniFile + 'o'; sPaletteItemDelegateSaveData = '@Comppalmgr@TComponentPalettePageItemDelegate@SaveData$qqr' + _xp_ + System_Inifiles_TCustomIniFile; sPaletteItemDelegateLoadData = '@Comppalmgr@TComponentPalettePageItemDelegate@LoadData$qqr' + _xp_ + System_Inifiles_TCustomIniFile; + {$ENDIF CPUX86} + {$IFDEF CPUX64} + sLoadPackageCache = '_ZN12Pascpppakmgr12TProfileData16LoadPackageCacheEPN6System8Inifiles14TCustomIniFileE'; + sSavePackageCache = '_ZN12Pascpppakmgr12TProfileData16SavePackageCacheEPN6System8Inifiles14TCustomIniFileEb'; + + sPaletteItemDelegateSaveData = '_ZN10Comppalmgr33TComponentPalettePageItemDelegate8SaveDataEPN6System8Inifiles14TCustomIniFileE'; + sPaletteItemDelegateLoadData = '_ZN10Comppalmgr33TComponentPalettePageItemDelegate8LoadDataEv'; + {$ENDIF CPUX64} RetCode: Byte = $C3; var @@ -263,7 +272,12 @@ procedure PreInit; procedure InitPlugin(Unload: Boolean); const + {$IFDEF CPUX86} sLoadPackageEx = Unit_System_SysUtils + '@LoadPackage$qqrx20System@UnicodeStringpqqrui$o'; + {$ENDIF CPUX86} + {$IFDEF CPUX64} + sLoadPackageEx = '_ZN6System8Sysutils11LoadPackageENS_13UnicodeStringEPFbyE'; + {$ENDIF CPUX64} var LibCoreide, LibRtl: THandle; begin diff --git a/Code/DDevExtensions/Source/DSUFeatures/DisableAlphaSortClassCompletion.pas b/Code/DDevExtensions/Source/DSUFeatures/DisableAlphaSortClassCompletion.pas index f867faa..cd1d3da 100644 --- a/Code/DDevExtensions/Source/DSUFeatures/DisableAlphaSortClassCompletion.pas +++ b/Code/DDevExtensions/Source/DSUFeatures/DisableAlphaSortClassCompletion.pas @@ -95,11 +95,23 @@ TMethodSymbol = class(TBaseSymbol) CallAddrTSortedThingList_SetSortedP: PByte; CompleteMethodSymbolTableIteratorP: PByte; +{$IFDEF CPUX86} function TClassSymbol_MethodAddPos(Instance: TClassSymbol; const Name: string): Integer; external delphicoreide_bpl name '@Pasmgr@TClassSymbol@MethodAddPos$qqrx20System@UnicodeString'; +{$ENDIF} +{$IFDEF CPUX64} +function TClassSymbol_MethodAddPos(Instance: TClassSymbol; const Name: string): Integer; + external delphicoreide_bpl name '_ZN6Pasmgr12TClassSymbol12MethodAddPosEN6System13UnicodeStringE'; +{$ENDIF} +{$IFDEF CPUX86} procedure TPascalClassCompleter_Complete; external delphicoreide_bpl name '@Completers@TPascalClassCompleter@Complete$qqrx20System@UnicodeString'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TPascalClassCompleter_Complete; + external delphicoreide_bpl name '_ZN10Completers21TPascalClassCompleter8CompleteEN6System13UnicodeStringE'; +{$ENDIF} function TClassSymbol_MethodAddPos_AlphSort(Instance: TClassSymbol; const Name: string): Integer; begin @@ -266,6 +278,7 @@ function TTableIterator_Create(ASymbolTable: TSymbolTable): TTableIterator; Result := TTableIterator.Create(ASymbolTable); end; +{$IFDEF CPUX86} function MethodSymbolTableIteratorFactory(AClass: TClass; DL: Integer; ASymbolTable: TSymbolTable): TTableIterator; asm push ecx @@ -284,6 +297,13 @@ function MethodSymbolTableIteratorFactory(AClass: TClass; DL: Integer; ASymbolTa pop eax call TTableIterator_Create end; +{$ELSE} +function MethodSymbolTableIteratorFactory(AClass: TClass; DL: Integer; ASymbolTable: TSymbolTable): TTableIterator; +begin + // Win64: simplified fallback - just create the iterator without sorting hack + Result := TTableIterator_Create(ASymbolTable); +end; +{$ENDIF CPUX86} {begin // Sort all items that are already collected OrgTSortedThingList_SetSorted(ThingList, True); @@ -296,6 +316,7 @@ function MethodSymbolTableIteratorFactory(AClass: TClass; DL: Integer; ASymbolTa {-------------------------------------------------------------------------------------------------} procedure InstallDisableAlphaSortClassCompletion(Value: Boolean); +{$IFDEF CPUX86} const CompleteSetSortedBytes: array[0..18] of SmallInt = ( $B2, $01, // mov dl,$01 // 0 @@ -403,5 +424,10 @@ procedure InstallDisableAlphaSortClassCompletion(Value: Boolean); ReplaceRelCallOffset(@CallAddrTSortedThingList_SetSortedP[CallOffsetSetSorted], OrgTSortedThingList_SetSorted); end; end; +{$ELSE} +begin + // Win64: x86 byte-pattern matching is not applicable, feature not available +end; +{$ENDIF CPUX86} end. diff --git a/Code/DDevExtensions/Source/DSUFeatures/FrmeOptionPageDSUFeatures.pas b/Code/DDevExtensions/Source/DSUFeatures/FrmeOptionPageDSUFeatures.pas index dfca66f..673cce0 100644 --- a/Code/DDevExtensions/Source/DSUFeatures/FrmeOptionPageDSUFeatures.pas +++ b/Code/DDevExtensions/Source/DSUFeatures/FrmeOptionPageDSUFeatures.pas @@ -252,8 +252,14 @@ procedure TFrameOptionPageDSUFeatures.Unselected; type TOpenControl = class(TControl); +{$IFDEF CPUX86} procedure OrgLoadRuntimeDesktop(Instance: TObject); external coreide_bpl name '@Desktop@TDesktopStates@LoadRuntimeDesktop$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +procedure OrgLoadRuntimeDesktop(Instance: TObject); + external coreide_bpl name '_ZN7Desktop14TDesktopStates18LoadRuntimeDesktopEv'; +{$ENDIF} var HookDesktopLoadRuntimeDesktop: TRedirectCode; @@ -352,7 +358,9 @@ procedure TDSUFeaturesConfig.UpdateEditorDblClickAction; LibHandle := GetModuleHandle(coreide_bpl); if LibHandle <> 0 then begin - DblClick := DbgStrictGetProcAddress(LibHandle, '@Editorform@TEditWindow@TabControlDblClick$qqrp14System@TObject'); + DblClick := DbgStrictGetProcAddress(LibHandle, + {$IFDEF CPUX86}'@Editorform@TEditWindow@TabControlDblClick$qqrp14System@TObject'{$ENDIF} + {$IFDEF CPUX64}'_ZN10Editorform11TEditWindow18TabControlDblClickEPN6System7TObjectE'{$ENDIF}); if DblClick <> nil then begin if (DblClick.PushEbp = $55) and @@ -482,7 +490,7 @@ procedure TDSUFeaturesConfig.SetIncBuildNumOnBuildOnly(const Value: Boolean); Proc := DbgStrictGetProcAddress(GetModuleHandle(ModuleName), ProcName); if Proc <> nil then begin - P := FindMethodPtr(Cardinal(Proc), Bytes, 256); + P := FindMethodPtr(Proc, Bytes, 256); if P <> nil then WriteProcessMemory(GetCurrentProcess, @P[PatchIndex], Value, SizeOf(TPatchArray), n); @@ -498,6 +506,8 @@ procedure TDSUFeaturesConfig.SetIncBuildNumOnBuildOnly(const Value: Boolean); begin FIncBuildNumOnBuildOnly := Value; + {$IFDEF CPUX86} + // IncBuildNumOnBuildOnly uses x86 byte-pattern patching - not supported on x64 Patch(delphicoreide_bpl, '@Pasmgr@TPascalPackageCodeUpdater@AfterCompile$qqr21Compintf@TCompileModeroo', FIncBuildNumOnBuildOnly, PascalPackageCodeUpdaterBytes, PascalPackageCodeUpdaterBytesIdx); Patch(delphicoreide_bpl, '@Pasmgr@TPascalProjectUpdater@AfterCompile$qqr21Compintf@TCompileModeroo', @@ -510,6 +520,7 @@ procedure TDSUFeaturesConfig.SetIncBuildNumOnBuildOnly(const Value: Boolean); Patch(bcbide_bpl, '@Cppmgr@TCppPackageProjectUpdater@AfterCompile$qqr21Compintf@TCompileModeroo', FIncBuildNumOnBuildOnly, CppPackageProjectUpdaterBytes, CppPackageProjectUpdaterBytesIdx); end; + {$ENDIF CPUX86} end; end; {$IFEND} @@ -611,6 +622,7 @@ procedure TDSUFeaturesConfig.SetDisablePackageCache(Value: Boolean); var TProcess_stopOnFirstAddrHook: TRedirectCode; +{$IFDEF CPUX86} const {$IF CompilerVersion >= 28.0} // XE7+ _IDbkThread_ = '41System@%DelphiInterface$14Dbk@IDbkThread%'; // XE7+ @@ -620,6 +632,11 @@ procedure TDSUFeaturesConfig.SetDisablePackageCache(Value: Boolean); function TProcess_stopOnFirstAddr(Process: TObject; Addr: Pointer; const Intf: IInterface; var ShouldStop: LongWord): HRESULT; stdcall; external dbkdebugide_bpl name '@Debug@TProcess@stopOnFirstAddr$qqs' + _xp_ + '17Dbk@DbkProcAddr_tx' + _IDbkThread_ + 'rui'; +{$ENDIF CPUX86} +{$IFDEF CPUX64} +function TProcess_stopOnFirstAddr(Process: TObject; Addr: Pointer; const Intf: IInterface; var ShouldStop: LongWord): HRESULT; + external dbkdebugide_bpl name '_ZN5Debug8TProcess15stopOnFirstAddrEPN3Dbk13DbkProcAddr_tEN6System15DelphiInterfaceINS1_10IDbkThreadEEERj'; +{$ENDIF CPUX64} function DbgStopOnFirstAddr(Process: TObject; Addr: Pointer; const Intf: IInterface; var ShouldStop: LongWord): HRESULT; stdcall; begin @@ -718,11 +735,18 @@ procedure HookedPackage_AddProjectModule(Instance: TObject); procedure TDSUFeaturesConfig.SetReplacePackageAddContain(const Value: Boolean); const + {$IFDEF CPUX86} sAddProjectModule = '@Pasmgr@TPascalProjectUpdater@AddProjectModule$qqrv'; sPackage_AddProjectModule = '@Pasmgr@TPascalPackageCodeUpdater@AddProjectModule$qqrv'; - sProcessAddCommand = '@Pkgcontainers@TStdPackageProjectContainer@ProcessAddCommand$qqrx27Containerintf@TLocalCommand'; sAddToProject = '@Containers@TStdProjectContainer@AddToProject$qqrv'; + {$ENDIF} + {$IFDEF CPUX64} + sAddProjectModule = '_ZN6Pasmgr21TPascalProjectUpdater16AddProjectModuleEv'; + sPackage_AddProjectModule = ''; // NOT FOUND on x64 + sProcessAddCommand = ''; // NOT FOUND on x64 + sAddToProject = '_ZN10Containers20TStdProjectContainer12AddToProjectEv'; + {$ENDIF} var Lib: THandle; begin @@ -735,16 +759,20 @@ procedure TDSUFeaturesConfig.SetReplacePackageAddContain(const Value: Boolean); Lib := GetModuleHandle(delphicoreide_bpl); if Lib <> 0 then begin - TStdPackageProjectContainer_ProcessAddCommand := DbgStrictGetProcAddress(Lib, PAnsiChar(sProcessAddCommand)); - TPascalProjectUpdater_AddProjectModule := DbgStrictGetProcAddress(Lib, PAnsiChar(sAddProjectModule)); - TPascalPackageCodeUpdater_AddProjectModule := DbgStrictGetProcAddress(Lib, PAnsiChar(sPackage_AddProjectModule)); + if sProcessAddCommand <> '' then + TStdPackageProjectContainer_ProcessAddCommand := DbgStrictGetProcAddress(Lib, PAnsiChar(sProcessAddCommand)); + if sAddProjectModule <> '' then + TPascalProjectUpdater_AddProjectModule := DbgStrictGetProcAddress(Lib, PAnsiChar(sAddProjectModule)); + if sPackage_AddProjectModule <> '' then + TPascalPackageCodeUpdater_AddProjectModule := DbgStrictGetProcAddress(Lib, PAnsiChar(sPackage_AddProjectModule)); end; end; if not Assigned(TStdProjectContainer_AddToProject) then begin Lib := GetModuleHandle(coreide_bpl); if Lib <> 0 then - TStdProjectContainer_AddToProject := DbgStrictGetProcAddress(Lib, PAnsiChar(sAddToProject)); + if sAddToProject <> '' then + TStdProjectContainer_AddToProject := DbgStrictGetProcAddress(Lib, PAnsiChar(sAddToProject)); end; if Assigned(TStdPackageProjectContainer_ProcessAddCommand) and Assigned(TStdProjectContainer_AddToProject) and @@ -780,9 +808,16 @@ procedure TDSUFeaturesConfig.SetReplacePackageAddContain(const Value: Boolean); var OrgCallOpenModuleFile: procedure(const ModuleName, EditorFileName: string); +{$IFDEF CPUX86} procedure OpenModuleFile(const ModuleName, EditorFileName: string); external delphicoreide_bpl name '@Commonpasreg@OpenModuleFile$qqrx20System@UnicodeStringt1'; +{$ENDIF} +{$IFDEF CPUX64} +procedure OpenModuleFile(const ModuleName, EditorFileName: string); + external delphicoreide_bpl name '_ZN12Commonpasreg14OpenModuleFileEN6System13UnicodeStringES1_'; +{$ENDIF} +{$IFDEF CPUX86} {$IF CompilerVersion >= 22.0} // Delphi XE+ function ExpandRootMacro(const InString: string; const AdditionalVars: TObject = nil): string; external coreide_bpl name '@Uiutils@ExpandRootMacro$qqrx20System@UnicodeString' + _xp_ + '22Codemgr@TNameValueHash'; @@ -790,9 +825,20 @@ function ExpandRootMacro(const InString: string; const AdditionalVars: TObject = function ExpandRootMacro(const Name: string): string; external coreide_bpl name '@Uiutils@ExpandRootMacro$qqrx20System@UnicodeString'; {$IFEND} +{$ENDIF CPUX86} +{$IFDEF CPUX64} +function ExpandRootMacro(const InString: string; const AdditionalVars: TObject = nil): string; + external coreide_bpl name '_ZN7Uiutils15ExpandRootMacroEN6System13UnicodeStringEPN7Codemgr14TNameValueHashE'; +{$ENDIF CPUX64} +{$IFDEF CPUX86} procedure VarBorlandIDE; external coreide_bpl name '@Ideintf@BorlandIDE'; +{$ENDIF} +{$IFDEF CPUX64} +procedure VarBorlandIDE; + external coreide_bpl name '_ZN7Ideintf10BorlandIDEE'; +{$ENDIF} procedure HookedOpenModuleFile(const ModuleName, EditorFileName: string); const @@ -1172,11 +1218,24 @@ procedure TDSUFeaturesConfig.SetReplaceOpenFileAtCursor(const Value: Boolean); TDelphiProjectModuleHandler_GetFormListHook: TRedirectCode; TDelphiProjectModuleHandler_GetFormList: procedure(Instance: TObject; List: TStrings); +{$IFDEF CPUX86} procedure TPascalProjectUpdaterClass; external delphicoreide_bpl name '@Pasmgr@TPascalProjectUpdater@'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TPascalProjectUpdaterClass; + external delphicoreide_bpl name '_ZTVN6Pasmgr21TPascalProjectUpdaterE'; +{$ENDIF} +{$IFDEF CPUX86} procedure TPascalProjectUpdater_GetFormList(Instance: TObject; List: TStrings); external delphicoreide_bpl name '@Pasmgr@TPascalProjectUpdater@GetFormList$qqrp' + System_Classes_TStrings; +{$ENDIF} +{$IFDEF CPUX64} +procedure TPascalProjectUpdater_GetFormList(Instance: TObject; List: TStrings); + external delphicoreide_bpl name + '_ZN6Pasmgr21TPascalProjectUpdater11GetFormListEPN6System7Classes8TStringsE'; +{$ENDIF} procedure HookedTDelphiProjectModuleHandler_GetFormList(Instance: TObject; List: TStrings); const @@ -1217,7 +1276,12 @@ procedure HookedTDelphiProjectModuleHandler_GetFormList(Instance: TObject; List: procedure TDSUFeaturesConfig.SetShowAllFrames(const Value: Boolean); const + {$IFDEF CPUX86} sGetFormList = '@Basedelphiproject@TDelphiProjectModuleHandler@GetFormList$qqrp' + System_Classes_TStrings; + {$ENDIF} + {$IFDEF CPUX64} + sGetFormList = '_ZN17Basedelphiproject27TDelphiProjectModuleHandler11GetFormListEPN6System7Classes8TStringsE'; + {$ENDIF} begin if Value <> FShowAllFrames then begin @@ -1237,8 +1301,14 @@ procedure TDSUFeaturesConfig.SetShowAllFrames(const Value: Boolean); {----------------------------------------------------------------------------------} +{$IFDEF CPUX86} procedure TCustomEditControl_HelpKeyword(Editor: TControl); external coreide_bpl name '@Editorcontrol@TCustomEditControl@HelpKeyword$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TCustomEditControl_HelpKeyword(Editor: TControl); + external coreide_bpl name '_ZN13Editorcontrol18TCustomEditControl11HelpKeywordEv'; +{$ENDIF} var OrgEditorHelpKeyword: procedure(Editor: TControl); @@ -1412,7 +1482,9 @@ function TDSUFeaturesConfig.IsBackgroundParsing: Boolean; try if FParseThread = nil then begin - FParseThread := DbgStrictGetProcAddress(GetModuleHandle(coreide_bpl), '@Parserthread@ParseThread'); + FParseThread := DbgStrictGetProcAddress(GetModuleHandle(coreide_bpl), + {$IFDEF CPUX86}'@Parserthread@ParseThread'{$ENDIF} + {$IFDEF CPUX64}'_ZN12Parserthread11ParseThreadE'{$ENDIF}); if FParseThread <> nil then FParseThread := TThread(Pointer(FParseThread)^); end; diff --git a/Code/DDevExtensions/Source/Editor/CodeInsightHandling.pas b/Code/DDevExtensions/Source/Editor/CodeInsightHandling.pas index c184ff6..3c2fc9c 100644 --- a/Code/DDevExtensions/Source/Editor/CodeInsightHandling.pas +++ b/Code/DDevExtensions/Source/Editor/CodeInsightHandling.pas @@ -15,8 +15,14 @@ implementation uses Windows, Hooking, IDEHooks; +{$IFDEF CPUX86} procedure TIDEPopupListBox_EditorKey(Instance: TObject; Sender: TObject; var Key: Char); external coreide_bpl name '@Idepopuplistbox@TIDEPopupListBox@EditorKey$qqrp14System@TObjectrb'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TIDEPopupListBox_EditorKey(Instance: TObject; Sender: TObject; var Key: Char); + external coreide_bpl name '_ZN15Idepopuplistbox16TIDEPopupListBox9EditorKeyEPN6System7TObjectERw'; +{$ENDIF} var OrgIDEPopupListBox_EditorKey: procedure(Instance: TObject; Sender: TObject; var Key: Char); diff --git a/Code/DDevExtensions/Source/Editor/DocModuleHandler.pas b/Code/DDevExtensions/Source/Editor/DocModuleHandler.pas index 3922a40..50c803b 100644 --- a/Code/DDevExtensions/Source/Editor/DocModuleHandler.pas +++ b/Code/DDevExtensions/Source/Editor/DocModuleHandler.pas @@ -237,8 +237,19 @@ implementation var DocModuleIsDormantOffset: Integer; +{$IFDEF CPUX86} procedure Docmodul_ModuleListAddr; external coreide_bpl name '@Docmodul@ModuleList'; +{$ENDIF} +{$IFDEF CPUX64} +procedure Docmodul_ModuleListAddr; + external coreide_bpl name '_ZN8Docmodul10ModuleListE'; +{$ENDIF} + +{$IFDEF CPUX64} +procedure EnvironmentOptionsAddr; + external coreide_bpl name '_ZN10Envoptions18EnvironmentOptionsE'; +{$ENDIF} {$IF CompilerVersion >= 25.0} // XE4+ function IsEmbeddedDesigner: Boolean; @@ -299,6 +310,7 @@ TDocModuleVirtMethodRec = record {$J+} const + {$IFDEF CPUX86} DocModuleVirtMethods: array[TDocModuleVirtMethodType] of TDocModuleVirtMethodRec = ( (Import: '@Docmodul@TDocModule@CheckFileDate$qqrv'), (Import: '@Docmodul@TDocModule@CanReloadFile$qqrv'), @@ -318,37 +330,105 @@ TDocModuleVirtMethodRec = record (Import: '@Docmodul@TDocModule@Activate$qqro'), (Import: '@Docmodul@TDocModule@Modified$qqrv') ); + {$ENDIF CPUX86} + {$IFDEF CPUX64} + DocModuleVirtMethods: array[TDocModuleVirtMethodType] of TDocModuleVirtMethodRec = ( + (Import: '_ZN8Docmodul10TDocModule13CheckFileDateEv'), + (Import: '_ZN8Docmodul10TDocModule13CanReloadFileEv'), + (Import: '_ZN8Docmodul10TDocModule11GetModifiedEv'), + (Import: '_ZN8Docmodul10TDocModule10ReloadFileEv'), + (Import: '_ZN8Docmodul10TDocModule11GetFileNameEv'), + (Import: '_ZN8Docmodul10TDocModule13GetModuleNameEv'), + (Import: '_ZN8Docmodul10TDocModule7HasFormEv'), + (Import: '_ZN8Docmodul10TDocModule11GetFormNameEv'), + (Import: '_ZN8Docmodul10TDocModule18SwapSourceFormViewEv'), + (Import: '_ZN8Docmodul10TDocModule19GetDependentModulesEPN6System7Classes5TListE'), + (Import: '_ZN8Docmodul10TDocModule21GetModuleDependenciesEPN6System7Classes5TListE'), + (Import: '_ZN8Docmodul10TDocModule9GoDormantEv'), + (Import: '_ZN8Docmodul10TDocModule10ShowEditorEb'), + (Import: '_ZN8Docmodul10TDocModule14ShowEditorNameEN6System13UnicodeStringEb'), + (Import: '_ZN8Docmodul10TDocModule13GetFileSystemEv'), + (Import: '_ZN8Docmodul10TDocModule8ActivateEb'), + (Import: '_ZN8Docmodul10TDocModule8ModifiedEv') + ); + {$ENDIF CPUX64} {$J-} { TPascalCodeMgrModHandler } +{$IFDEF CPUX86} procedure ClassTPascalCodeMgrModHandler; external delphicoreide_bpl name '@Delphimodule@TPascalCodeMgrModHandler@'; +{$ENDIF} +{$IFDEF CPUX64} +procedure ClassTPascalCodeMgrModHandler; + external delphicoreide_bpl name '_ZTVN12Delphimodule24TPascalCodeMgrModHandlerE'; +{$ENDIF} +{$IFDEF CPUX86} procedure TPascalCodeMgrModHandler.ResurrectForm; external delphicoreide_bpl name '@Delphimodule@TPascalCodeMgrModHandler@ResurrectForm$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TPascalCodeMgrModHandler.ResurrectForm; + external delphicoreide_bpl name '_ZN12Delphimodule24TPascalCodeMgrModHandler13ResurrectFormEv'; +{$ENDIF} +{$IFDEF CPUX86} procedure TPascalCodeMgrModHandler.ReloadFile; external delphicoreide_bpl name '@Delphimodule@TPascalCodeMgrModHandler@ReloadFile$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TPascalCodeMgrModHandler.ReloadFile; + external delphicoreide_bpl name '_ZN12Delphimodule24TPascalCodeMgrModHandler10ReloadFileEv'; +{$ENDIF} { TDocModule } +{$IFDEF CPUX86} procedure ClassTDocModule; external coreide_bpl name '@Docmodul@TDocModule@'; +{$ENDIF} +{$IFDEF CPUX64} +procedure ClassTDocModule; + external coreide_bpl name '_ZTVN8Docmodul10TDocModuleE'; +{$ENDIF} +{$IFDEF CPUX86} procedure TDocModule_GoDormant; external coreide_bpl name '@Docmodul@TDocModule@GoDormant$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TDocModule_GoDormant; + external coreide_bpl name '_ZN8Docmodul10TDocModule9GoDormantEv'; +{$ENDIF} +{$IFDEF CPUX86} function TDocModule.GetCanFree: Boolean; external coreide_bpl name '@Docmodul@TDocModule@GetCanFree$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +function TDocModule.GetCanFree: Boolean; + external coreide_bpl name '_ZN8Docmodul10TDocModule10GetCanFreeEv'; +{$ENDIF} -{$IF CompilerVersion >= 22.0} // XE+ +{$IF (CompilerVersion >= 22.0) and Defined(CPUX86)} // XE+ function TDocModule.CanFreeOrGoDormant(const DormantOk: Boolean): Boolean; external coreide_bpl name '@Docmodul@TDocModule@CanFreeOrGoDormant$qqrxo'; {$IFEND} +{$IFDEF CPUX64} +function TDocModule.CanFreeOrGoDormant(const DormantOk: Boolean): Boolean; + external coreide_bpl name '_ZN8Docmodul10TDocModule18CanFreeOrGoDormantEb'; +{$ENDIF} +{$IFDEF CPUX86} function TDocModule.GetCodeIDocModule: TInterfacedObject; external coreide_bpl name '@Docmodul@TDocModule@GetCodeIDocModule$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +function TDocModule.GetCodeIDocModule: TInterfacedObject; + external coreide_bpl name '_ZN8Docmodul10TDocModule17GetCodeIDocModuleEv'; +{$ENDIF} function TDocModule.IsDormant: Boolean; begin @@ -442,6 +522,7 @@ function TDocModule.GetFileSystem: TVirtualFileSystem; { TDocModuleVirtMethodRec } +{$IFDEF CPUX86} function TDocModuleVirtMethodRec.CallBoolean(Instance: TDocModule): Boolean; asm jmp TDocModuleVirtMethodRec.Call @@ -491,9 +572,58 @@ procedure TDocModuleVirtMethodRec.Call2(Instance: TDocModule; P1, P2: Pointer); pop ebx end; +{$ENDIF CPUX86} + +{$IFDEF CPUX64} +function TDocModuleVirtMethodRec.CallBoolean(Instance: TDocModule): Boolean; +asm + jmp TDocModuleVirtMethodRec.Call +end; + +function TDocModuleVirtMethodRec.CallString(Instance: TDocModule): string; +asm + jmp TDocModuleVirtMethodRec.Call1 // String result is passed as hidden last parameter +end; + +function TDocModuleVirtMethodRec.CallObject(Instance: TDocModule): TObject; +asm + jmp TDocModuleVirtMethodRec.Call +end; + +procedure TDocModuleVirtMethodRec.Call(Instance: TDocModule); +asm + // RCX = Self (rec), RDX = Instance + mov eax, [rcx].TDocModuleVirtMethodRec.&VmtOffset // RAX = VmtOffset (zero-extended) + mov rcx, rdx // RCX = Instance (Self for target method) + mov r9, [rcx] // R9 = VMT pointer + jmp [r9+rax] // jump to VMT[VmtOffset] +end; + +procedure TDocModuleVirtMethodRec.Call1(Instance: TDocModule; P1: Pointer); +asm + // RCX = Self (rec), RDX = Instance, R8 = P1 + mov eax, [rcx].TDocModuleVirtMethodRec.&VmtOffset // RAX = VmtOffset (zero-extended) + mov rcx, rdx // RCX = Instance (Self for target method) + mov rdx, r8 // RDX = P1 (second param for target method) + mov r9, [rcx] // R9 = VMT pointer + jmp [r9+rax] // jump to VMT[VmtOffset] +end; + +procedure TDocModuleVirtMethodRec.Call2(Instance: TDocModule; P1, P2: Pointer); +asm + // RCX = Self (rec), RDX = Instance, R8 = P1, R9 = P2 + mov eax, [rcx].TDocModuleVirtMethodRec.&VmtOffset // RAX = VmtOffset (zero-extended) + mov rcx, rdx // RCX = Instance (Self for target method) + mov rdx, r8 // RDX = P1 (second param for target method) + mov r8, r9 // R8 = P2 (third param for target method) + mov r9, [rcx] // R9 = VMT pointer + jmp [r9+rax] // jump to VMT[VmtOffset] +end; +{$ENDIF CPUX64} function InitDocModuleHandler: Boolean; +{$IFDEF CPUX86} const GoDormantBytes: array[0..12] of SmallInt = ( $B3, $01, // mov bl,$01 // 0 @@ -502,6 +632,7 @@ function InitDocModuleHandler: Boolean; $8D, $55, $FC, // lea edx,[ebp-$04] // 8 $8B, $C6 // mov eax,esi // 11 ); +{$ENDIF CPUX86} var DocModuleClass: TClass; CoreIdeLib: THandle; @@ -573,6 +704,7 @@ function InitDocModuleHandler: Boolean; end; end; + {$IFDEF CPUX86} P := FindMethodPtr(THandle(GetActualAddr(@TDocModule_GoDormant)), GoDormantBytes, $40); if P = nil then begin @@ -580,6 +712,60 @@ function InitDocModuleHandler: Boolean; Exit; end; DocModuleIsDormantOffset := P[4]; + {$ELSE} + // Win64: Scan GoDormant machine code for "cmp byte ptr [reg+disp8], 0" to find IsDormant offset. + // On x64, Delphi saves Self (RCX) to a register and then does: cmp byte ptr [reg+offset], 0 + // Encoding: $80 ModR/M(01_111_rrr) disp8 $00 or with REX prefix + begin + var GoDormantAddr: PByte := PByte(GetActualAddr(@TDocModule_GoDormant)); + var FoundOffset: Boolean := False; + var I: Integer; + var ScanByte: Byte; + for I := 0 to 127 do + begin + // Look for: $80 $7x offset $00 (cmp byte ptr [reg+disp8], 0) + // ModR/M = 01_111_rrr where rrr = register (rcx=1, rbx=3, rsi=6, etc.) + // So ModR/M range: $79..$7F (excluding $7C which needs SIB) + ScanByte := GoDormantAddr[I]; + if (ScanByte = $80) and (I + 3 <= 127) then + begin + var ModRM: Byte := GoDormantAddr[I + 1]; + // mod=01, reg=111(/7=cmp), rm != 100(SIB) + if ((ModRM and $F8) = $78) and ((ModRM and $07) <> $04) then + begin + if GoDormantAddr[I + 3] = $00 then // imm8 = 0 + begin + DocModuleIsDormantOffset := GoDormantAddr[I + 2]; // disp8 + FoundOffset := True; + Break; + end; + end; + end; + // Also check with REX prefix (40-4F): REX $80 $7x offset $00 + if (ScanByte >= $40) and (ScanByte <= $4F) and (I + 4 <= 127) then + begin + if GoDormantAddr[I + 1] = $80 then + begin + var ModRM: Byte := GoDormantAddr[I + 2]; + if ((ModRM and $F8) = $78) and ((ModRM and $07) <> $04) then + begin + if GoDormantAddr[I + 4] = $00 then + begin + DocModuleIsDormantOffset := GoDormantAddr[I + 3]; + FoundOffset := True; + Break; + end; + end; + end; + end; + end; + if not FoundOffset then + begin + MessageDlg('DDevExtensions: Error finding TDocModule.IsDormant offset in GoDormant x64 code', mtError, [mbOk], 0); + Exit; + end; + end; + {$ENDIF} Result := True; diff --git a/Code/DDevExtensions/Source/Editor/FocusEditor.pas b/Code/DDevExtensions/Source/Editor/FocusEditor.pas index f62db7b..d5dface 100644 --- a/Code/DDevExtensions/Source/Editor/FocusEditor.pas +++ b/Code/DDevExtensions/Source/Editor/FocusEditor.pas @@ -62,7 +62,9 @@ procedure Hook_LoadDesktop(Instance: TObject; Desktop: TObject); procedure InitPlugin(Unload: Boolean); begin if not Unload then - HookFunction(coreide_bpl, '@Desktop@TDesktopStates@LoadDesktop$qqrp21Desktop@TDesktopState', + HookFunction(coreide_bpl, + {$IFDEF CPUX86}'@Desktop@TDesktopStates@LoadDesktop$qqrp21Desktop@TDesktopState'{$ENDIF} + {$IFDEF CPUX64}'_ZN7Desktop14TDesktopStates11LoadDesktopEPNS_13TDesktopStateE'{$ENDIF}, @Hook_LoadDesktop, LoadDesktopHook) else UnhookFunction(LoadDesktopHook); diff --git a/Code/DDevExtensions/Source/Editor/FrmReloadFiles.pas b/Code/DDevExtensions/Source/Editor/FrmReloadFiles.pas index e4529f3..bcff739 100644 --- a/Code/DDevExtensions/Source/Editor/FrmReloadFiles.pas +++ b/Code/DDevExtensions/Source/Editor/FrmReloadFiles.pas @@ -121,6 +121,7 @@ TWaitItem = class(TObject) //ReloadingModules: Boolean; ReloadFileForm: TFormReloadFiles; +{$IFDEF CPUX86} {$IF CompilerVersion >= 22.0} // XE+ procedure Docmodul_CheckFileDates(NoPrompt: Boolean); external coreide_bpl name '@Docmodul@CheckFileDates$qqro'; @@ -128,6 +129,11 @@ procedure Docmodul_CheckFileDates(NoPrompt: Boolean); procedure Docmodul_CheckFileDates; external coreide_bpl name '@Docmodul@CheckFileDates$qqrv'; {$IFEND} +{$ENDIF CPUX86} +{$IFDEF CPUX64} +procedure Docmodul_CheckFileDates(NoPrompt: Boolean); + external coreide_bpl name '_ZN8Docmodul14CheckFileDatesEb'; +{$ENDIF CPUX64} {$IF CompilerVersion >= 23.0} // XE2+ {var diff --git a/Code/DDevExtensions/Source/Keybindings/FrmeOptionPageKeybindings.pas b/Code/DDevExtensions/Source/Keybindings/FrmeOptionPageKeybindings.pas index 7543386..868ade4 100644 --- a/Code/DDevExtensions/Source/Keybindings/FrmeOptionPageKeybindings.pas +++ b/Code/DDevExtensions/Source/Keybindings/FrmeOptionPageKeybindings.pas @@ -121,8 +121,14 @@ procedure EnvironmentOptionsAddr; external coreide_bpl name '@Envoptions@EnvironmentOptions'; {$IFEND} +{$IFDEF CPUX86} procedure EditorActionListsPtr; external coreide_bpl name '@Editoractions@EditorActionLists'; +{$ENDIF} +{$IFDEF CPUX64} +procedure EditorActionListsPtr; + external coreide_bpl name '_ZN13Editoractions17EditorActionListsE'; +{$ENDIF} procedure InitPlugin(Unload: Boolean); begin diff --git a/Code/DDevExtensions/Source/OldPalette/OldPalette.pas b/Code/DDevExtensions/Source/OldPalette/OldPalette.pas index ca78c13..bcbf310 100644 --- a/Code/DDevExtensions/Source/OldPalette/OldPalette.pas +++ b/Code/DDevExtensions/Source/OldPalette/OldPalette.pas @@ -142,8 +142,14 @@ implementation var HookTToolForm_LoadPalette: TRedirectCode; +{$IFDEF CPUX86} procedure TToolForm_LoadPalette(Instance: TForm); external coreide_bpl name '@Toolfrm@TToolForm@LoadPalette$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TToolForm_LoadPalette(Instance: TForm); + external coreide_bpl name '_ZN7Toolfrm9TToolForm11LoadPaletteEv'; +{$ENDIF} procedure HookedTToolForm_LoadPalette(Instance: TForm); begin diff --git a/Code/DDevExtensions/Source/StartParameterManager/StartParameterManagerReg.pas b/Code/DDevExtensions/Source/StartParameterManager/StartParameterManagerReg.pas index b4aee91..b7cb0c3 100644 --- a/Code/DDevExtensions/Source/StartParameterManager/StartParameterManagerReg.pas +++ b/Code/DDevExtensions/Source/StartParameterManager/StartParameterManagerReg.pas @@ -43,9 +43,16 @@ TOpenControl = class(TControl); TDebugger = class(TObject); TDebugProjectOption = class(TObject); +{$IFDEF CPUX86} procedure TDebugger_Run(Self: TDebugger; Mode: TOTARunMode); external dbkdebugide_bpl name '@Debug@TDebugger@Run$qqr20Toolsapi@TOTARunMode'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TDebugger_Run(Self: TDebugger; Mode: TOTARunMode); + external dbkdebugide_bpl name '_ZN5Debug9TDebugger3RunEN8Toolsapi11TOTARunModeE'; +{$ENDIF} +{$IFDEF CPUX86} {$IF CompilerVersion <> 22.0} // not XE function _TDebugProjectOption_GetRunParams(Self: TDebugProjectOption): string; {$IF CompilerVersion >= 23.0} // Delphi XE2+ @@ -57,6 +64,11 @@ function _TDebugProjectOption_GetRunParams(Self: TDebugProjectOption): string; function TDebuggerProjectOptions_GetOptionClassInfo(Instance: TObject): Pointer; // ClassInfo external coreide_bpl name '@Debuggerprojectoptions@TDebuggerProjectOptions@GetOptionClassInfo$qqrv'; {$IFEND} +{$ENDIF CPUX86} +{$IFDEF CPUX64} +function _TDebugProjectOption_GetRunParams(Self: TDebugProjectOption): string; + external coreide_bpl name '_ZN22Debuggerprojectoptions19TDebugProjectOption12GetRunParamsEv'; +{$ENDIF CPUX64} var OrgTDebugger_Run: procedure(Self: TDebugger; Mode: TOTARunMode); diff --git a/Code/DDevExtensions/Source/UnitSelector/FrmeOptionPageUnitSelector.pas b/Code/DDevExtensions/Source/UnitSelector/FrmeOptionPageUnitSelector.pas index 636cc1a..07d5722 100644 --- a/Code/DDevExtensions/Source/UnitSelector/FrmeOptionPageUnitSelector.pas +++ b/Code/DDevExtensions/Source/UnitSelector/FrmeOptionPageUnitSelector.pas @@ -84,6 +84,7 @@ implementation HookTDelphiCommands_FileUseUnitCommandExecute: TRedirectCode; TDelphiCommands_FileUseUnitCommandExecute: procedure(Self: TObject; Sender: TObject) = nil; +{$IFDEF CPUX86} {$IF CompilerVersion < 21.0} // Delphi 2009 var HookTViewDialog_Execute: TRedirectCode; @@ -163,7 +164,7 @@ function Hooked_TViewDialog_Execute(ViewDialog: TForm): Boolean; end; {$IFEND} - +{$ENDIF CPUX86} procedure Hooked_TDelphiCommands_FileUseUnitCommandExecute(Self: TObject; Sender: TObject); var Project: IOTAProject; @@ -265,7 +266,12 @@ procedure TUnitSelectorConfig.SetReplaceUseUnit(const Value: Boolean); if Value <> FReplaceUseUnit then begin if not Assigned(TDelphiCommands_FileUseUnitCommandExecute) then + begin + {$IFDEF CPUX86} @TDelphiCommands_FileUseUnitCommandExecute := DbgStrictGetProcAddress(GetModuleHandle(PChar(DelphicmdsDll)), '@Delphicmds@TDelphiCommands@FileUseUnitCommandExecute$qqrp14System@TObject'); + {$ENDIF} + // x64: export name not known; feature disabled - TDelphiCommands_FileUseUnitCommandExecute stays nil + end; if Assigned(TDelphiCommands_FileUseUnitCommandExecute) then begin if FReplaceUseUnit then diff --git a/Code/DDevExtensions/Source/VirtTreeHandler.pas b/Code/DDevExtensions/Source/VirtTreeHandler.pas index 2c79a1d..e56a7de 100644 --- a/Code/DDevExtensions/Source/VirtTreeHandler.pas +++ b/Code/DDevExtensions/Source/VirtTreeHandler.pas @@ -39,7 +39,7 @@ TreeImport = class(TCustomAttribute) private FSignature: AnsiString; public - constructor Create(const ASignature: AnsiString); + constructor Create(const AX86Signature, AX64Signature: AnsiString); property Signature: AnsiString read FSignature; end; @@ -47,13 +47,17 @@ TIDEVirtualTreeHandler = class(TObject) private FTree: TCustomControl; - [TreeImport('@Idevirtualtrees@TCustomVirtualStringTree@GetText$qqrp28Idevirtualtrees@TVirtualNodei')] + [TreeImport('@Idevirtualtrees@TCustomVirtualStringTree@GetText$qqrp28Idevirtualtrees@TVirtualNodei', + '_ZN15Idevirtualtrees24TCustomVirtualStringTree7GetTextEPNS_12TVirtualNodeEi')] FTextGetter: function(Node: PVirtualNode; Column: Integer): WideString of object; - [TreeImport('@Idevirtualtrees@TBaseVirtualTree@GetSelected$qqrp28Idevirtualtrees@TVirtualNode')] + [TreeImport('@Idevirtualtrees@TBaseVirtualTree@GetSelected$qqrp28Idevirtualtrees@TVirtualNode', + '_ZN15Idevirtualtrees16TBaseVirtualTree11GetSelectedEPNS_12TVirtualNodeE')] FSelectedGetter: function(Node: PVirtualNode): Boolean of object; - [TreeImport('@Idevirtualtrees@TBaseVirtualTree@SetSelected$qqrp28Idevirtualtrees@TVirtualNodeo')] + [TreeImport('@Idevirtualtrees@TBaseVirtualTree@SetSelected$qqrp28Idevirtualtrees@TVirtualNodeo', + '_ZN15Idevirtualtrees16TBaseVirtualTree11SetSelectedEPNS_12TVirtualNodeEb')] FSelectedSetter: procedure(Node: PVirtualNode; Value: Boolean) of object; - [TreeImport('@Idevirtualtrees@TBaseVirtualTree@GetNodeParent$qqrp28Idevirtualtrees@TVirtualNode')] + [TreeImport('@Idevirtualtrees@TBaseVirtualTree@GetNodeParent$qqrp28Idevirtualtrees@TVirtualNode', + '_ZN15Idevirtualtrees16TBaseVirtualTree13GetNodeParentEPNS_12TVirtualNodeE')] FNodeParentGetter: function(Node: PVirtualNode): PVirtualNode of object; [TreePropertySetter('FocusedNode')] @@ -161,10 +165,15 @@ constructor TreePropertyAccessor.Create(const APropertyName: string); { TreeImport } -constructor TreeImport.Create(const ASignature: AnsiString); +constructor TreeImport.Create(const AX86Signature, AX64Signature: AnsiString); begin inherited Create; - FSignature := ASignature; + {$IFDEF CPUX86} + FSignature := AX86Signature; + {$ENDIF} + {$IFDEF CPUX64} + FSignature := AX64Signature; + {$ENDIF} end; { TIDEVirtualTreeHandler } diff --git a/CompileInterceptor/Bin/CompileInterceptorW.dll b/CompileInterceptor/Bin/CompileInterceptorW.dll index 015278f..ef36b43 100644 Binary files a/CompileInterceptor/Bin/CompileInterceptorW.dll and b/CompileInterceptor/Bin/CompileInterceptorW.dll differ diff --git a/CompileInterceptor/Source/CompileInterceptorW.dproj b/CompileInterceptor/Source/CompileInterceptorW.dproj index 66759ec..b68b140 100644 --- a/CompileInterceptor/Source/CompileInterceptorW.dproj +++ b/CompileInterceptor/Source/CompileInterceptorW.dproj @@ -12,7 +12,7 @@ None True Win32 - 1 + 3 true @@ -81,10 +81,10 @@ 1033 vclimg;vcl;vclx;dbrtl;Rave90VCL;bdertl;rtl;xmlrtl;vclactnband;VclSmp;svnui;svn;TeeUI;Tee;TeeDB;vcldb;vcldbx;vcltouch;dsnap;dsnapcon;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_110_150;Intraweb_110_150;vclie;webdsnap;inetdb;websnap;inetdbbde;inetdbxpress;soaprtl;vclribbon;DbxCommonDriver;DBXInterBaseDriver;DBXMySQLDriver;dbexpress;dbxcds;CodeSiteExpressVcl;EmbeddedWebBrowser_XE;VirtualTreesD15;ZComponent;ZParseSql;ZCore;ZDbc;ZPlain;AHComps;DbxClientDriver;AzureCloud;Jcl;JclDeveloperTools;JclVcl;JclContainers;JvCore;JvSystem;JvStdCtrls;JvAppFrm;JvBands;JvDB;JvDlgs;JvBDE;JvControls;JvCmp;JvCrypt;JvCustom;JvDocking;JvDotNetCtrls;JvGlobus;JvHMI;JvJans;JvManagedThreads;JvMM;JvNet;JvPageComps;JvPascalInterpreter;JvPluginSystem;JvPrintPreview;JvRuntimeDesign;JvTimeFramework;JvWizards;JvXPCtrls;$(DCC_UsePackage) B740000 - ..\bin - ..\lib - ..\lib - ..\bin\CompileInterceptorW.dll + ..\bin\$(Platform) + ..\lib\$(Platform) + ..\lib\$(Platform) + ..\bin\$(Platform)\CompileInterceptorW.dll true CompileInterceptorW @@ -114,8 +114,8 @@ False 0 23400000 - ..\lib - ..\lib + ..\lib\$(Platform) + ..\lib\$(Platform) RELEASE;$(DCC_Define) @@ -125,8 +125,8 @@ 7.0 - ..\lib - ..\lib + ..\lib\$(Platform) + ..\lib\$(Platform) DEBUG;$(DCC_Define) Z:\Jedi\jcl\lib\d11\debug;..\..\..\lib\Dcc32le;$(DCC_UnitSearchPath) Z:\Jedi\jcl\lib\d11\debug;..\..\..\lib\Dcc32le;$(DCC_ResourcePath) @@ -263,7 +263,7 @@ False False True - False + True 12 diff --git a/CompileInterceptor/Source/CompileInterceptorW.res b/CompileInterceptor/Source/CompileInterceptorW.res index 20cfa37..596006d 100644 Binary files a/CompileInterceptor/Source/CompileInterceptorW.res and b/CompileInterceptor/Source/CompileInterceptorW.res differ diff --git a/CompileInterceptor/Source/CompilerHooks.pas b/CompileInterceptor/Source/CompilerHooks.pas index d7380bf..e953c38 100644 --- a/CompileInterceptor/Source/CompilerHooks.pas +++ b/CompileInterceptor/Source/CompilerHooks.pas @@ -806,7 +806,12 @@ procedure InitCompileInterceptor; // >= 15 // sGetCppCallbacks = '@Pascppcominout@GetCppCallbacks$qqrv'; + {$IFDEF CPUX86} sGetDccCallbacks = '@Pascppcominout@GetDccCallbacks$qqrv'; + {$ENDIF} + {$IFDEF CPUX64} + sGetDccCallbacks = '_ZN14Pascppcominout15GetDccCallbacksEv'; + {$ENDIF} // in [5, 6, 7] // CPPCompilerInitSymbol5 = '@Cominout@CPPCompilerInit$qqrpqqsr22Cominout@TCppCallbacks$v'; @@ -895,9 +900,9 @@ procedure InitCompileInterceptor; if PascalProc <> nil then begin if DelphiVer >= 10 then - PascalProc := Pointer(Cardinal(PascalProc) + 10) + PascalProc := Pointer(PByte(PascalProc) + 10) else - PascalProc := Pointer(Cardinal(PascalProc) + 1); + PascalProc := Pointer(PByte(PascalProc) + 1); PascalComInOut := PascalProc^; OrgPascalComInOut := PascalComInOut^; diff --git a/Shared/Hooking.pas b/Shared/Hooking.pas index be8f116..3ab86af 100644 --- a/Shared/Hooking.pas +++ b/Shared/Hooking.pas @@ -24,17 +24,29 @@ interface SIZE_T = DWORD; {$IFEND} + {$IFDEF CPUX64} + TXRedirCode = packed record + Jmp: Word; // $FF25 (jmp [rip+0]) + Rel: Integer; // 0 + Target: UInt64; // absolute target address + end; // 14 bytes + {$ELSE} TXRedirCode = packed record Jump: Byte; Offset: Integer; - end; + end; // 5 bytes + {$ENDIF} TRedirectCode = packed record RealProc: Pointer; Count: Integer; case Byte of 0: (Code: TXRedirCode); + {$IFDEF CPUX64} + 1: (Backup: array[0..15] of Byte); + {$ELSE} 1: (Code2: Int64); + {$ENDIF} end; procedure CodeRedirect(Proc: Pointer; NewProc: Pointer; out Data: TRedirectCode); overload; @@ -168,7 +180,7 @@ function PeMapImgNtHeaders(const BaseAddress: Pointer): PImageNtHeaders; if (PImageDosHeader(BaseAddress)^.e_magic <> IMAGE_DOS_SIGNATURE) or (PImageDosHeader(BaseAddress)^._lfanew = 0) then Exit; - Result := PImageNtHeaders(DWORD(BaseAddress) + DWORD(PImageDosHeader(BaseAddress)^._lfanew)); + Result := PImageNtHeaders(PByte(BaseAddress) + PImageDosHeader(BaseAddress)^._lfanew); if IsBadReadPtr(Result, SizeOf(TImageNtHeaders)) or (Result^.Signature <> IMAGE_NT_SIGNATURE) then Result := nil @@ -205,7 +217,11 @@ function ReplaceDllImport(Base: Pointer; const ModuleName: string; FromProc, ToP ImportDir: TImageDataDirectory; ImportDesc: PImageImportDescriptor; CurrName, RefName: PAnsiChar; + {$IFDEF CPUX64} + ImportEntry: PUInt64; // On x64, IMAGE_THUNK_DATA uses 64-bit entries + {$ELSE} ImportEntry: PImageThunkData32; + {$ENDIF} LastProtect, Dummy: Cardinal; CurProcess: DWORD; begin @@ -217,7 +233,7 @@ function ReplaceDllImport(Base: Pointer; const ModuleName: string; FromProc, ToP if ImportDir.VirtualAddress = 0 then Exit; CurProcess := GetCurrentProcess; - ImportDesc := PImageImportDescriptor(DWORD(Base) + ImportDir.VirtualAddress); + ImportDesc := PImageImportDescriptor(PByte(Base) + ImportDir.VirtualAddress); RefName := PAnsiChar({$IFDEF UNICODE}UTF8Encode{$ENDIF}(ModuleName)); while ImportDesc^.Name <> 0 do begin @@ -228,6 +244,22 @@ function ReplaceDllImport(Base: Pointer; const ModuleName: string; FromProc, ToP if StrIComp(CurrName, RefName) = 0 then {$WARNINGS ON} begin + {$IFDEF CPUX64} + ImportEntry := PUInt64(PAnsiChar(Base) + ImportDesc^.FirstThunk); + while ImportEntry^ <> 0 do + begin + if Pointer(ImportEntry^) = FromProc then + begin + if VirtualProtectEx(CurProcess, ImportEntry, SizeOf(UInt64), PAGE_READWRITE, @LastProtect) then + begin + ImportEntry^ := UInt64(ToProc); + VirtualProtectEx(CurProcess, ImportEntry, SizeOf(UInt64), LastProtect, Dummy); + Result := True; + end; + end; + Inc(ImportEntry); + end; + {$ELSE} ImportEntry := PImageThunkData32(PAnsiChar(Base) + ImportDesc^.FirstThunk); while ImportEntry^.Function_ <> 0 do begin @@ -245,6 +277,7 @@ function ReplaceDllImport(Base: Pointer; const ModuleName: string; FromProc, ToP end; Inc(ImportEntry); end; + {$ENDIF} end; Inc(ImportDesc); end; @@ -265,9 +298,16 @@ procedure CodeRedirect(Proc: Pointer; NewProc: Pointer; out Data: TRedirectCode) if VirtualProtectEx(GetCurrentProcess, Proc, SizeOf(Data.Code) + 1, PAGE_EXECUTE_READWRITE, OldProtect) then begin Data.RealProc := Proc; + {$IFDEF CPUX64} + Move(Proc^, Data.Backup[0], SizeOf(Data.Code)); + TXRedirCode(Proc^).Jmp := $25FF; + TXRedirCode(Proc^).Rel := 0; + TXRedirCode(Proc^).Target := UInt64(NewProc); + {$ELSE} Data.Code2 := Int64(Proc^); TXRedirCode(Proc^).Jump := $E9; TXRedirCode(Proc^).Offset := PAnsiChar(NewProc) - PAnsiChar(Proc) - (SizeOf(Data.Code)); + {$ENDIF} VirtualProtectEx(GetCurrentProcess, Proc, SizeOf(Data.Code) + 1, OldProtect, @OldProtect); FlushInstructionCache(GetCurrentProcess, Proc, SizeOf(Data.Code) + 1); end; @@ -694,6 +734,7 @@ function ModRmSize(P: PByte): Integer; end; end; +{$IFDEF CPUX86} function GetStartCodeSize(CodePtr: Pointer; RequiredSize: Integer; OffsetTable: POffsetTable): Integer; // TODO: "Jcc rel": convert to Jcc dword-rel and adjust offsets var @@ -1083,6 +1124,235 @@ function GetStartCodeSize(CodePtr: Pointer; RequiredSize: Integer; OffsetTable: {$IFEND} end; end; +{$ENDIF CPUX86} + +{$IFDEF CPUX64} +function GetStartCodeSize(CodePtr: Pointer; RequiredSize: Integer; OffsetTable: POffsetTable = nil): Integer; +{ x64 instruction length decoder. Decodes enough complete instructions to reach + RequiredSize bytes. Tracks RIP-relative and call/jmp rel32 offsets in OffsetTable + for relocation. } +var + Code, P: PByte; + HasREX: Boolean; + REXByte, OpCode, ModRM, SIBByte: Byte; + Mod_, RM, Reg: Byte; + ImmSize, DispSize, InstrSize: Integer; + Is2Byte, HasModRMByte: Boolean; +begin + Code := PByte(CodePtr); + Result := 0; + + while Result < RequiredSize do + begin + P := Code; + HasREX := False; + REXByte := 0; + Is2Byte := False; + HasModRMByte := False; + ImmSize := 0; + + { Skip legacy prefixes } + while P^ in [$26, $2E, $36, $3E, $64, $65, $66, $67, $F0, $F2, $F3] do + Inc(P); + + { REX prefix (40-4F) } + if (P^ >= $40) and (P^ <= $4F) then + begin + HasREX := True; + REXByte := P^; + Inc(P); + end; + + OpCode := P^; + Inc(P); + + { Two-byte opcode escape } + if OpCode = $0F then + begin + Is2Byte := True; + OpCode := P^; + Inc(P); + end; + + if Is2Byte then + begin + case OpCode of + { Conditional jumps rel32 } + $80..$8F: ImmSize := 4; + { BT/BTS/BTR/BTC r/m, imm8 } + $BA: begin HasModRMByte := True; ImmSize := 1; end; + { NOP /r (multi-byte NOP) } + $1F: HasModRMByte := True; + { push/pop fs/gs } + $A0, $A1, $A8, $A9: ; + { Common 2-byte opcodes with ModR/M } + $10..$17, $28..$2F, $40..$4F, $51..$6F, $70..$77, + $7E, $7F, $90..$9F, $A3..$A5, $AB..$AF, + $B0..$B8, $BC..$BF, $C0..$C2, $C4..$C6, $D0..$FE: + HasModRMByte := True; + else + raise Exception.CreateFmt('GetStartCodeSize: Unknown 2-byte x64 opcode 0F %02X at %p', [OpCode, CodePtr]); + end; + end + else + begin + case OpCode of + { ALU r/m, r and ALU r, r/m } + $00..$03, $08..$0B, $10..$13, $18..$1B, + $20..$23, $28..$2B, $30..$33, $38..$3B: + HasModRMByte := True; + { ALU al, imm8 } + $04, $0C, $14, $1C, $24, $2C, $34, $3C: + ImmSize := 1; + { ALU eax/rax, imm32 } + $05, $0D, $15, $1D, $25, $2D, $35, $3D: + ImmSize := 4; + { push/pop register } + $50..$5F: ; + { movsxd } + $63: HasModRMByte := True; + { push imm32 } + $68: ImmSize := 4; + { imul r, r/m, imm32 } + $69: begin HasModRMByte := True; ImmSize := 4; end; + { push imm8 } + $6A: ImmSize := 1; + { imul r, r/m, imm8 } + $6B: begin HasModRMByte := True; ImmSize := 1; end; + { Jcc rel8 } + $70..$7F: ImmSize := 1; + { group1 r/m8, imm8 } + $80: begin HasModRMByte := True; ImmSize := 1; end; + { group1 r/m, imm32 } + $81: begin HasModRMByte := True; ImmSize := 4; end; + { group1 r/m, imm8 } + $83: begin HasModRMByte := True; ImmSize := 1; end; + { test, xchg r/m } + $84..$87: HasModRMByte := True; + { mov r/m,r mov r,r/m } + $88..$8B: HasModRMByte := True; + { mov sreg } + $8C, $8E: HasModRMByte := True; + { lea } + $8D: HasModRMByte := True; + { pop r/m } + $8F: HasModRMByte := True; + { nop, xchg eax,r } + $90..$97: ; + { cwde/cdq } + $98, $99: ; + { pushf/popf } + $9C, $9D: ; + { test al, imm8 } + $A8: ImmSize := 1; + { test eax, imm32 } + $A9: ImmSize := 4; + { mov r8, imm8 } + $B0..$B7: ImmSize := 1; + { mov r, imm32/imm64 } + $B8..$BF: + if HasREX and ((REXByte and $08) <> 0) then + ImmSize := 8 + else + ImmSize := 4; + { shift r/m, imm8 } + $C0, $C1: begin HasModRMByte := True; ImmSize := 1; end; + { ret imm16 } + $C2: ImmSize := 2; + { ret } + $C3: ; + { mov r/m8, imm8 } + $C6: begin HasModRMByte := True; ImmSize := 1; end; + { mov r/m, imm32 } + $C7: begin HasModRMByte := True; ImmSize := 4; end; + { leave } + $C9: ; + { int3 } + $CC: raise Exception.Create('Breakpoint found. Remove the breakpoint before hooking the function'); + { int imm8 } + $CD: ImmSize := 1; + { shift group } + $D0..$D3: HasModRMByte := True; + { loop/jcxz rel8 } + $E0..$E3: ImmSize := 1; + { call/jmp rel32 } + $E8, $E9: + begin + ImmSize := 4; + if OffsetTable <> nil then + OffsetTable.Add(PInteger(P)); + end; + { jmp rel8 } + $EB: ImmSize := 1; + { cmc/clc/stc/cli/sti/cld/std } + $F5, $F8..$FD: ; + { group3 - TEST may have immediate } + $F6: HasModRMByte := True; + $F7: HasModRMByte := True; + { inc/dec/call/jmp/push r/m } + $FE, $FF: HasModRMByte := True; + else + raise Exception.CreateFmt('GetStartCodeSize: Unknown x64 opcode %02X at %p', [OpCode, CodePtr]); + end; + end; + + { Parse ModR/M byte } + if HasModRMByte then + begin + ModRM := P^; + Inc(P); + Mod_ := (ModRM shr 6) and 3; + Reg := (ModRM shr 3) and 7; + RM := ModRM and 7; + + { group3 TEST with immediate } + if not Is2Byte then + begin + if (OpCode = $F6) and (Reg in [0, 1]) then ImmSize := 1; + if (OpCode = $F7) and (Reg in [0, 1]) then ImmSize := 4; + end; + + DispSize := 0; + SIBByte := 0; + + if Mod_ <> 3 then { memory operand } + begin + if RM = 4 then { SIB byte follows } + begin + SIBByte := P^; + Inc(P); + end; + + case Mod_ of + 0: begin + if RM = 5 then { RIP-relative addressing } + begin + DispSize := 4; + if OffsetTable <> nil then + OffsetTable.Add(PInteger(P)); + end + else if (RM = 4) and ((SIBByte and 7) = 5) then { SIB base=5 with mod=0 } + DispSize := 4; + end; + 1: DispSize := 1; + 2: DispSize := 4; + end; + + Inc(P, DispSize); + end; + end; + + Inc(P, ImmSize); + InstrSize := P - Code; + if InstrSize = 0 then + raise Exception.CreateFmt('GetStartCodeSize: Failed to decode x64 instruction at %p: %02X %02X %02X %02X', + [Code, Code[0], Code[1], Code[2], Code[3]]); + + Inc(Result, InstrSize); + Inc(Code, InstrSize); + end; +end; +{$ENDIF CPUX64} var OrgCallBlock: PByte; @@ -1092,25 +1362,32 @@ function GetStartCodeSize(CodePtr: Pointer; RequiredSize: Integer; OffsetTable: function CreateOrgCallMethodPtr(Proc: Pointer): Pointer; const BlockSize = 4096; + {$IFDEF CPUX64} + JmpBackSize = 14; // FF 25 00 00 00 00 + QWord target + MinPrologSize = JmpBackSize; + {$ELSE} + JmpBackSize = 5; // E9 + DWord relative offset + MinPrologSize = JmpBackSize; + {$ENDIF} var P: PByte; StartCodeSize, CodeSize, FullCodeSize: Integer; I: Integer; - JmpRelOffset: Integer; OffsetTable: TOffsetTable; RelPos: Integer; + {$IFDEF CPUX64} + NewOffset: Int64; + {$ENDIF} begin if Proc = nil then raise Exception.Create('CreateOrgCallMethodPtr called with nil'); - StartCodeSize := GetStartCodeSize(Proc, 5, @OffsetTable); + StartCodeSize := GetStartCodeSize(Proc, MinPrologSize, @OffsetTable); if StartCodeSize = 0 then raise Exception.Create('Cannot create OrgCallMethod for the specified function'); - // space for "jmp rel" - CodeSize := StartCodeSize; - JmpRelOffset := StartCodeSize; - Inc(CodeSize, 5); + // space for jump back to original + CodeSize := StartCodeSize + JmpBackSize; // alignment for the next OrgCallMethodPtr (filled with "INT 3") FullCodeSize := ((CodeSize + 1) + 3) and not $3; @@ -1141,19 +1418,42 @@ function CreateOrgCallMethodPtr(Proc: Pointer): Pointer; Inc(OrgCallBlockOffset, FullCodeSize); //LeaveCriticalSection(OrgCallBlockCritSect); - // Adjust the relative address to the new code position + // Copy original instructions to trampoline Move(Proc^, P^, StartCodeSize); - if OffsetTable.Offsets <> nil then // in 5 bytes only 1 call/jmp can be in it + + // Adjust relative offsets (call/jmp rel32 and RIP-relative on x64) + if OffsetTable.Offsets <> nil then begin - RelPos := PByte(OffsetTable.Offsets[0]) - PByte(Proc); - PInteger(P + RelPos)^ := (PByte(Proc) - P) + OffsetTable.Offsets[0]^; + for I := 0 to Length(OffsetTable.Offsets) - 1 do + begin + RelPos := PByte(OffsetTable.Offsets[I]) - PByte(Proc); + {$IFDEF CPUX64} + NewOffset := Int64(OffsetTable.Offsets[I]^) + (Int64(NativeUInt(Proc)) - Int64(NativeUInt(P))); + if (NewOffset < Low(Integer)) or (NewOffset > High(Integer)) then + raise Exception.CreateFmt('CreateOrgCallMethodPtr: Relative offset fixup overflow for instruction at %p (distance too large)', + [PByte(Proc) + RelPos]); + PInteger(P + RelPos)^ := Integer(NewOffset); + {$ELSE} + PInteger(P + RelPos)^ := (PByte(Proc) - P) + OffsetTable.Offsets[I]^; + {$ENDIF} + end; end; - P[JmpRelOffset] := $E9; - PInteger(@P[JmpRelOffset + 1])^ := (PByte(Proc) + StartCodeSize) - (P + JmpRelOffset + 5); - // Fill gab + {$IFDEF CPUX64} + // Absolute JMP back: FF 25 00 00 00 00 + QWord target + P[StartCodeSize] := $FF; + P[StartCodeSize + 1] := $25; + PInteger(@P[StartCodeSize + 2])^ := 0; + PUInt64(@P[StartCodeSize + 6])^ := UInt64(PByte(Proc) + StartCodeSize); + {$ELSE} + // Relative JMP back: E9 + DWord offset + P[StartCodeSize] := $E9; + PInteger(@P[StartCodeSize + 1])^ := (PByte(Proc) + StartCodeSize) - (P + StartCodeSize + 5); + {$ENDIF} + + // Fill gap with INT 3 for I := CodeSize to FullCodeSize - 1 do - Byte(PAnsiChar(P)[I]) := $CC; // int 3 + P[I] := $CC; Result := P; end; @@ -1170,14 +1470,20 @@ function RedirectOrgCall(OrgProc, NewProc: Pointer): Pointer; I: Integer; n: SIZE_T; begin - {$IFDEF CPUX64} - raise Exception.Create('RedirectOrgCall is not supported in x64 mode, yet'); - {$ENDIF CPUX64} - OrgProc := GetActualAddr(OrgProc); NewProc := GetActualAddr(NewProc); Result := CreateOrgCallMethodPtr(OrgProc); + {$IFDEF CPUX64} + StartCodeSize := GetStartCodeSize(OrgProc, 14); // need 14 bytes for absolute JMP + // Absolute JMP: FF 25 00 00 00 00 + QWord target = 14 bytes + Buffer[0] := $FF; + Buffer[1] := $25; + PInteger(@Buffer[2])^ := 0; + PUInt64(@Buffer[6])^ := UInt64(NewProc); + for I := 14 to StartCodeSize - 1 do + Buffer[I] := $90; // NOP padding + {$ELSE} StartCodeSize := GetStartCodeSize(OrgProc, 5); Buffer[0] := $E9; {$IF CompilerVersion >= 20.0} @@ -1187,6 +1493,7 @@ function RedirectOrgCall(OrgProc, NewProc: Pointer): Pointer; {$IFEND} for I := 5 to StartCodeSize - 1 do Buffer[I] := $90; + {$ENDIF} if not WriteProcessMemory(GetCurrentProcess, OrgProc, @Buffer[0], StartCodeSize, n) then RaiseLastOSError; end; @@ -1195,22 +1502,44 @@ procedure RestoreOrgCall(OrgProc, OrgCall: Pointer); var StartCodeSize: Integer; n: SIZE_T; + {$IFDEF CPUX64} + Buffer: array[0..63] of Byte; + {$ELSE} Buffer: array[0..4 + 4] of Byte; // if Buffer[4] = $E8/$E9 we need another 4 bytes + {$ENDIF} RelPos: Integer; OffsetTable: TOffsetTable; + {$IFDEF CPUX64} + I: Integer; + NewOffset: Int64; + {$ENDIF} begin if OrgCall = nil then Exit; OrgProc := GetActualAddr(OrgProc); + {$IFDEF CPUX64} + StartCodeSize := GetStartCodeSize(OrgCall, 14, @OffsetTable); + {$ELSE} StartCodeSize := GetStartCodeSize(OrgCall, 5, @OffsetTable); - if OffsetTable.Offsets <> nil then // in 5 bytes only 1 call/jmp can be in it + {$ENDIF} + + if OffsetTable.Offsets <> nil then begin - // Adjust the relative address to the original code position + // Adjust relative addresses back to the original code position Move(OrgCall^, Buffer[0], StartCodeSize); + {$IFDEF CPUX64} + for I := 0 to Length(OffsetTable.Offsets) - 1 do + begin + RelPos := PByte(OffsetTable.Offsets[I]) - PByte(OrgCall); + NewOffset := Int64(OffsetTable.Offsets[I]^) + (Int64(NativeUInt(OrgCall)) - Int64(NativeUInt(OrgProc))); + PInteger(@Buffer[RelPos])^ := Integer(NewOffset); + end; + {$ELSE} RelPos := PByte(OffsetTable.Offsets[0]) - PByte(OrgCall); PInteger(@Buffer[RelPos])^ := OffsetTable.Offsets[0]^ - (PByte(OrgProc) - PByte(OrgCall)); + {$ENDIF} WriteProcessMemory(GetCurrentProcess, OrgProc, @Buffer, StartCodeSize, n); end else @@ -1227,6 +1556,16 @@ procedure RedirectOrg(OrgProc, NewProc: Pointer); OrgProc := GetActualAddr(OrgProc); NewProc := GetActualAddr(NewProc); + {$IFDEF CPUX64} + StartCodeSize := GetStartCodeSize(OrgProc, 14); + // Absolute JMP: FF 25 00 00 00 00 + QWord target = 14 bytes + Buffer[0] := $FF; + Buffer[1] := $25; + PInteger(@Buffer[2])^ := 0; + PUInt64(@Buffer[6])^ := UInt64(NewProc); + for I := 14 to StartCodeSize - 1 do + Buffer[I] := $90; + {$ELSE} StartCodeSize := GetStartCodeSize(OrgProc, 5); Buffer[0] := $E9; {$IF CompilerVersion >= 20.0} @@ -1236,6 +1575,7 @@ procedure RedirectOrg(OrgProc, NewProc: Pointer); {$IFEND} for I := 5 to StartCodeSize - 1 do Buffer[I] := $90; + {$ENDIF} if not WriteProcessMemory(GetCurrentProcess, OrgProc, @Buffer[0], StartCodeSize, n) then RaiseLastOSError; end; diff --git a/Shared/IDE/IDEUtils.pas b/Shared/IDE/IDEUtils.pas index 5b55bfd..ceebc39 100644 --- a/Shared/IDE/IDEUtils.pas +++ b/Shared/IDE/IDEUtils.pas @@ -197,7 +197,7 @@ function DelphiInterfaceToObject(const Intf: IInterface): TObject; function GetQueryInterfaceImplFromDelphiInterface(const Intf: IInterface): Pointer; function GetMethodImplFromDelphiInterface(const Intf: IInterface; VmtOffset: Integer): Pointer; function FindObjectField(Obj: TObject; const AClassName: string; FindLast: Boolean = False): TObject; -function FindObjectFieldOffset(Obj: TObject; const AClassName: string; FindLast: Boolean): Cardinal; // Result=0 => not found +function FindObjectFieldOffset(Obj: TObject; const AClassName: string; FindLast: Boolean): {$IFDEF CPUX64}NativeUInt{$ELSE}Cardinal{$ENDIF}; // Result=0 => not found function VarToIntDef(const V: Variant; Default: Integer): Integer; function VarToBoolDef(const V: Variant; Default: Boolean): Boolean; @@ -541,9 +541,9 @@ function ClassIsOfClass(AClass: TClass; const AClassName: string): Boolean; Result := False; end; -function FindObjectFieldOffset(Obj: TObject; const AClassName: string; FindLast: Boolean): Cardinal; +function FindObjectFieldOffset(Obj: TObject; const AClassName: string; FindLast: Boolean): {$IFDEF CPUX64}NativeUInt{$ELSE}Cardinal{$ENDIF}; var - InstSize: Cardinal; + InstSize: {$IFDEF CPUX64}NativeUInt{$ELSE}Cardinal{$ENDIF}; Field: TObject; begin if Obj <> nil then @@ -554,8 +554,8 @@ function FindObjectFieldOffset(Obj: TObject; const AClassName: string; FindLast: while Result > SizeOf(Pointer) do // omit VMT begin try - Field := TObject(Pointer(Cardinal(Obj) + Result)^); - if (Cardinal(Field) >= $00010000) and + Field := TObject(PPointer(PByte(Obj) + Result)^); + if (NativeUInt(Field) >= $00010000) and not IsBadReadPtr(Field, SizeOf(TClass)) and not IsBadReadPtr(PPointer(Field)^, {TObject.InstanceSize} SizeOf(Pointer)) and not IsBadReadPtr(Pointer(INT_PTR(PPointer(Field)^) + vmtSelfPtr), SizeOf(Pointer)) and @@ -574,8 +574,8 @@ function FindObjectFieldOffset(Obj: TObject; const AClassName: string; FindLast: while Result < InstSize do begin try - Field := TObject(Pointer(Cardinal(Obj) + Result)^); - if (Cardinal(Field) >= $00010000) and + Field := TObject(PPointer(PByte(Obj) + Result)^); + if (NativeUInt(Field) >= $00010000) and not IsBadReadPtr(Field, SizeOf(TClass)) and not IsBadReadPtr(PPointer(Field)^, {TObject.InstanceSize} SizeOf(Pointer)) and not IsBadReadPtr(Pointer(INT_PTR(PPointer(Field)^) + vmtSelfPtr), SizeOf(Pointer)) and @@ -593,13 +593,13 @@ function FindObjectFieldOffset(Obj: TObject; const AClassName: string; FindLast: function FindObjectField(Obj: TObject; const AClassName: string; FindLast: Boolean): TObject; var - Offset: Cardinal; + Offset: {$IFDEF CPUX64}NativeUInt{$ELSE}Cardinal{$ENDIF}; begin Offset := FindObjectFieldOffset(Obj, AClassName, FindLast); if Offset = 0 then raise Exception.CreateFmt('%s object field not found', [AClassName]) else - Result := TObject(Pointer(Cardinal(Obj) + Offset)^); + Result := TObject(PPointer(PByte(Obj) + Offset)^); end; function MakeNotifyEvent(Data, Code: Pointer): TNotifyEvent; @@ -657,6 +657,7 @@ function VarToStrDef(const V: Variant; const Default: string): string; end; end; +{$IFDEF CPUX86} function HashString(const AItem: string): Integer; asm test eax, eax @@ -688,6 +689,31 @@ function HashString(const AItem: string): Integer; and eax, MaxBucketItems-1 @@Leave: end; +{$ENDIF CPUX86} + +{$IFDEF CPUX64} +function HashString(const AItem: string): Integer; +var + I, Len: Integer; + C: Word; +begin + if AItem = '' then + begin + Result := 0; + Exit; + end; + Len := Length(AItem); + Result := Len; + for I := 1 to Len do + begin + C := Word(AItem[I]); + Result := Result + C; + if C = 0 then + Break; + end; + Result := Result and (MaxBucketItems - 1); +end; +{$ENDIF CPUX64} { TStringIntegerHash } @@ -710,7 +736,7 @@ procedure TStringIntegerHash.Clear; while P <> nil do begin N := P.Next; - if (Cardinal(P) < Cardinal(@FCacheItems[0])) or (Cardinal(P) > Cardinal(@FCacheItems[High(FCacheItems)])) then + if (NativeUInt(P) < NativeUInt(@FCacheItems[0])) or (NativeUInt(P) > NativeUInt(@FCacheItems[High(FCacheItems)])) then Dispose(P); P := N; Dec(FCount); @@ -761,7 +787,7 @@ function TStringIntegerHash.Remove(const AItem: string): Integer; begin Result := N.Value; P := N.Next; - if (Cardinal(N) < Cardinal(@FCacheItems[0])) or (Cardinal(N) > Cardinal(@FCacheItems[High(FCacheItems)])) then + if (NativeUInt(N) < NativeUInt(@FCacheItems[0])) or (NativeUInt(N) > NativeUInt(@FCacheItems[High(FCacheItems)])) then Dispose(N); FItems[Index] := P; Dec(FCount); @@ -777,7 +803,7 @@ function TStringIntegerHash.Remove(const AItem: string): Integer; begin Result := N.Value; P.Next := N.Next; - if (Cardinal(N) < Cardinal(@FCacheItems[0])) or (Cardinal(N) > Cardinal(@FCacheItems[High(FCacheItems)])) then + if (NativeUInt(N) < NativeUInt(@FCacheItems[0])) or (NativeUInt(N) > NativeUInt(@FCacheItems[High(FCacheItems)])) then Dispose(N); Dec(FCount); Exit; @@ -881,7 +907,7 @@ procedure TStringStringHash.Clear; while P <> nil do begin N := P.Next; - if (Cardinal(P) < Cardinal(@FCacheItems[0])) or (Cardinal(P) > Cardinal(@FCacheItems[High(FCacheItems)])) then + if (NativeUInt(P) < NativeUInt(@FCacheItems[0])) or (NativeUInt(P) > NativeUInt(@FCacheItems[High(FCacheItems)])) then Dispose(P); P := N; Dec(FCount); @@ -931,7 +957,7 @@ function TStringStringHash.Remove(const AItem: string): string; begin Result := N.Value; P := N.Next; - if (Cardinal(N) < Cardinal(@FCacheItems[0])) or (Cardinal(N) > Cardinal(@FCacheItems[High(FCacheItems)])) then + if (NativeUInt(N) < NativeUInt(@FCacheItems[0])) or (NativeUInt(N) > NativeUInt(@FCacheItems[High(FCacheItems)])) then Dispose(N); FItems[Index] := P; Dec(FCount); @@ -947,7 +973,7 @@ function TStringStringHash.Remove(const AItem: string): string; begin Result := N.Value; P.Next := N.Next; - if (Cardinal(N) < Cardinal(@FCacheItems[0])) or (Cardinal(N) > Cardinal(@FCacheItems[High(FCacheItems)])) then + if (NativeUInt(N) < NativeUInt(@FCacheItems[0])) or (NativeUInt(N) > NativeUInt(@FCacheItems[High(FCacheItems)])) then Dispose(N); Dec(FCount); Exit; @@ -1182,6 +1208,7 @@ function ModuleFromAddr(const Addr: Pointer): HMODULE; {$STACKFRAMES ON} +{$IFDEF CPUX86} type PStackFrame = ^TStackFrame; TStackFrame = record @@ -1224,6 +1251,29 @@ function Caller(Level: Integer): Pointer; Result := nil; end; end; +{$ENDIF CPUX86} + +{$IFDEF CPUX64} +function RtlCaptureStackBackTrace(FramesToSkip, FramesToCapture: ULONG; + BackTrace: Pointer; BackTraceHash: PULONG): USHORT; stdcall; + external 'kernel32.dll' name 'RtlCaptureStackBackTrace'; + +function Caller(Level: Integer): Pointer; +var + BackTrace: array[0..15] of Pointer; + Count: USHORT; +begin + Result := nil; + try + // Skip 1 for Caller itself, then Level frames + Count := RtlCaptureStackBackTrace(1 + Level, 1, @BackTrace[0], nil); + if Count > 0 then + Result := Pointer(NativeUInt(BackTrace[0]) - 1); + except + Result := nil; + end; +end; +{$ENDIF CPUX64} function SupportsEx(const Instance: TObject; const IID: TGUID; out Intf): Boolean; begin @@ -1427,7 +1477,7 @@ procedure TCustomBucketList.SetData(AItem: Pointer; const Value: Pointer); function TCustomBucketList.BucketFor(AItem: Pointer): THashValue; begin - Result := THashValue(Cardinal(AItem) mod MaxBucketItems); + Result := THashValue(NativeUInt(AItem) mod MaxBucketItems); end; { TBucketList } @@ -1441,7 +1491,7 @@ constructor TBucketList.Create(ABuckets: TBucketListSizes); function TModuleBucketList.BucketFor(AItem: Pointer): THashValue; begin - Result := THashValue((Cardinal(AItem) shr 16) mod MaxBucketItems); + Result := THashValue((NativeUInt(AItem) shr 16) mod MaxBucketItems); end; {$IFDEF COMPILER10} @@ -1826,19 +1876,39 @@ function ExpandMacros(const Expression: string; const MacroNameValue: array of s { TIDEEvent } +{$IFDEF CPUX86} procedure TIDEEvent.Add(AHandler: TNotifyEvent); external designide_bpl name '@Events@TEvent@Add$qqrynpqqrp14System@TObject$v'; procedure TIDEEvent.ForceAdd(AHandler: TNotifyEvent); external designide_bpl name '@Events@TEvent@ForceAdd$qqrynpqqrp14System@TObject$v'; procedure TIDEEvent.Remove(AHandler: TNotifyEvent); external designide_bpl name '@Events@TEvent@Remove$qqrynpqqrp14System@TObject$v'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TIDEEvent.Add(AHandler: TNotifyEvent); + external designide_bpl name '_ZN6Events6TEvent3AddEU9__closurePFvPN6System7TObjectEE'; +procedure TIDEEvent.ForceAdd(AHandler: TNotifyEvent); + external designide_bpl name '_ZN6Events6TEvent8ForceAddEU9__closurePFvPN6System7TObjectEE'; +procedure TIDEEvent.Remove(AHandler: TNotifyEvent); + external designide_bpl name '_ZN6Events6TEvent6RemoveEU9__closurePFvPN6System7TObjectEE'; +{$ENDIF} +{$IFDEF CPUX86} function MainFormShown: TIDEEvent; external coreide_bpl name '@Ideintf@MainFormShown$qqrv'; function MainFormCreated: TIDEEvent; external coreide_bpl name '@Ideintf@MainFormCreated$qqrv'; function MainFormDestroyed: TIDEEvent; external coreide_bpl name '@Ideintf@MainFormDestroyed$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +function MainFormShown: TIDEEvent; + external coreide_bpl name '_ZN7Ideintf13MainFormShownEv'; +function MainFormCreated: TIDEEvent; + external coreide_bpl name '_ZN7Ideintf15MainFormCreatedEv'; +function MainFormDestroyed: TIDEEvent; + external coreide_bpl name '_ZN7Ideintf17MainFormDestroyedEv'; +{$ENDIF} procedure Init; var diff --git a/Shared/IDE/ProjectResource.pas b/Shared/IDE/ProjectResource.pas index 9d5dbad..a5af9c5 100644 --- a/Shared/IDE/ProjectResource.pas +++ b/Shared/IDE/ProjectResource.pas @@ -363,26 +363,68 @@ TResEntry = class(TObject) ResFile: TOTAHandle; end; +{$IFDEF CPUX86} procedure TProjectVersionInfo.LoadFromExistingProject(ResFile: TResFile); external coreide_bpl name '@Verinf@TVersionInfo@LoadFromExistingProject$qqrp17Resutils@TResFile'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TProjectVersionInfo.LoadFromExistingProject(ResFile: TResFile); + external coreide_bpl name '_ZN6Verinf12TVersionInfo23LoadFromExistingProjectEPN8Resutils8TResFileE'; +{$ENDIF} +{$IFDEF CPUX86} procedure TResFile.SaveToStream(Stream: TStream); external coreide_bpl name '@Resutils@TResFile@SaveToStream$qqrp' + System_Classes_TStream; +{$ENDIF} +{$IFDEF CPUX64} +procedure TResFile.SaveToStream(Stream: TStream); + external coreide_bpl name '_ZN8Resutils8TResFile12SaveToStreamEPN6System7Classes7TStreamE'; +{$ENDIF} +{$IFDEF CPUX86} procedure TResFile.LoadFromStream(Stream: TStream); external coreide_bpl name '@Resutils@TResFile@LoadFromStream$qqrp' + System_Classes_TStream; +{$ENDIF} +{$IFDEF CPUX64} +procedure TResFile.LoadFromStream(Stream: TStream); + external coreide_bpl name '_ZN8Resutils8TResFile14LoadFromStreamEPN6System7Classes7TStreamE'; +{$ENDIF} +{$IFDEF CPUX86} procedure TResFile.GetIco(Name: PChar; Stream: TStream); external coreide_bpl name {$IFDEF UNICODE}'@Resutils@TResFile@GetIco$qqrpbp' + System_Classes_TStream;{$ELSE}'@Resutils@TResFile@GetIco$qqrpcp15Classes@TStream';{$ENDIF} +{$ENDIF} +{$IFDEF CPUX64} +procedure TResFile.GetIco(Name: PChar; Stream: TStream); + external coreide_bpl name '_ZN8Resutils8TResFile6GetIcoEPwPN6System7Classes7TStreamE'; +{$ENDIF} +{$IFDEF CPUX86} procedure TResFile.AddIco(Name: PChar; Stream: TStream); external coreide_bpl name {$IFDEF UNICODE}'@Resutils@TResFile@AddIco$qqrpbp' + System_Classes_TStream;{$ELSE}'@Resutils@TResFile@AddIco$qqrpcp15Classes@TStream';{$ENDIF} +{$ENDIF} +{$IFDEF CPUX64} +procedure TResFile.AddIco(Name: PChar; Stream: TStream); + external coreide_bpl name '_ZN8Resutils8TResFile6AddIcoEPwPN6System7Classes7TStreamE'; +{$ENDIF} +{$IFDEF CPUX86} procedure TResFile.RemoveIco(Name: PChar); external coreide_bpl name {$IFDEF UNICODE}'@Resutils@TResFile@RemoveIco$qqrpb';{$ELSE}'@Resutils@TResFile@RemoveIco$qqrpc';{$ENDIF} +{$ENDIF} +{$IFDEF CPUX64} +procedure TResFile.RemoveIco(Name: PChar); + external coreide_bpl name '_ZN8Resutils8TResFile9RemoveIcoEPw'; +{$ENDIF} +{$IFDEF CPUX86} function TResFile.Find(ResType, Name: PChar): Pointer; external coreide_bpl name {$IFDEF UNICODE}'@Resutils@TResFile@Find$qqrpbt1';{$ELSE}'@Resutils@TResFile@Find$qqrpct1';{$ENDIF} +{$ENDIF} +{$IFDEF CPUX64} +function TResFile.Find(ResType, Name: PChar): Pointer; + external coreide_bpl name '_ZN8Resutils8TResFile4FindEPwS1_'; +{$ENDIF} function GetResFileFromResEntry(ResEntry: TOTAHandle): TResFile; begin @@ -428,8 +470,14 @@ TDelphiProjectModuleHandler = class(TInterfacedObject) function GetResourceFile: TResFile; end; +{$IFDEF CPUX86} function TDelphiProjectModuleHandler.GetResourceFile: TResFile; external delphicoreide_bpl name '@Basedelphiproject@TDelphiProjectModuleHandler@GetResourceFile$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +function TDelphiProjectModuleHandler.GetResourceFile: TResFile; + external delphicoreide_bpl name '_ZN17Basedelphiproject27TDelphiProjectModuleHandler15GetResourceFileEv'; +{$ENDIF} {$ENDIF COMPILER14_UP} const @@ -439,8 +487,14 @@ function TDelphiProjectModuleHandler.GetResourceFile: TResFile; _IProject_ = '44System@%DelphiInterface$t16Codemgr@IProject%'; {$IFEND} +{$IFDEF CPUX86} function TOTAProjectResource_Create(ResFile: TResFile; Project: IProject): TInterfacedObject; external coreide_bpl name '@Ideservices@TOTAProjectResource@$bctr$qqrp17Resutils@TResFile' + _IProject_; +{$ENDIF} +{$IFDEF CPUX64} +function TOTAProjectResource_Create(ResFile: TResFile; Project: IProject): TInterfacedObject; + external coreide_bpl name '_ZN11Ideservices19TOTAProjectResourceC3EPN8Resutils8TResFileEN6System15DelphiInterfaceIN7Codemgr8IProjectEEE'; +{$ENDIF} {$ENDIF COMPILER9_UP} @@ -490,7 +544,9 @@ function FindProjectResource(Project: IOTAProject): IOTAProjectResource; if ResFile <> nil then begin // create a coreide.TOTAProjectResource object - VT := GetProcAddress(GetModuleHandle(coreide_bpl), '@Ideservices@TOTAProjectResource@'); + VT := GetProcAddress(GetModuleHandle(coreide_bpl), + {$IFDEF CPUX86}'@Ideservices@TOTAProjectResource@'{$ENDIF} + {$IFDEF CPUX64}'_ZTVN11Ideservices19TOTAProjectResourceE'{$ENDIF}); if VT <> nil then begin asm @@ -963,10 +1019,18 @@ procedure TIconResource.LoadFromIconFile(const FileName: string); end; end;} +{$IFDEF CPUX86} {$IF CompilerVersion >= 23.0} // Delphi XE2+ - function ExpandRootMacro(const InString: string; const AdditionalVars: TObject = nil): string; external coreide_bpl name '@Uiutils@ExpandRootMacro$qqrx20System@UnicodeString' + _xp_ + '22Codemgr@TNameValueHash'; +{$IFEND} +{$ENDIF CPUX86} +{$IFDEF CPUX64} +function ExpandRootMacro(const InString: string; const AdditionalVars: TObject = nil): string; + external coreide_bpl name '_ZN7Uiutils15ExpandRootMacroEN6System13UnicodeStringEPN7Codemgr14TNameValueHashE'; +{$ENDIF CPUX64} + +{$IF CompilerVersion >= 23.0} // Delphi XE2+ procedure TIconResource.LoadFromProjectResource(AProject: IOTAProject); var diff --git a/Shared/IDE/ToolsAPIHelpers.pas b/Shared/IDE/ToolsAPIHelpers.pas index 7ea462c..d1b3afa 100644 --- a/Shared/IDE/ToolsAPIHelpers.pas +++ b/Shared/IDE/ToolsAPIHelpers.pas @@ -71,11 +71,23 @@ implementation { TPropField } +{$IFDEF CPUX86} function TPropField.GetValue: Variant; external vclide_bpl name '@Idepropset@TPropField@GetValue$qqrv'; +{$ENDIF} +{$IFDEF CPUX64} +function TPropField.GetValue: Variant; + external vclide_bpl name '_ZN10Idepropset10TPropField8GetValueEv'; +{$ENDIF} +{$IFDEF CPUX86} procedure TPropField.SetValue(const Value: Variant); external vclide_bpl name '@Idepropset@TPropField@SetValue$qqrrx14System@Variant'; +{$ENDIF} +{$IFDEF CPUX64} +procedure TPropField.SetValue(const Value: Variant); + external vclide_bpl name '_ZN10Idepropset10TPropField8SetValueERKN6System7VariantE'; +{$ENDIF} {------------------------------------------------------------------------------------------------------------} @@ -569,10 +581,18 @@ TPlatformManager = class(TObject) function GetEnvOptions(const APlatform, APersonality: string): PObject; end; +{$IFDEF CPUX86} function PlatformManager: TPlatformManager; external coreide_bpl name '@Platforms@PlatformManager$qqrv'; function TPlatformManager.GetEnvOptions(const APlatform: string; const APersonality: string): PObject; external coreide_bpl name '@Platforms@TPlatformManager@GetEnvOptions$qqrx20System@UnicodeStringt1'; +{$ENDIF} +{$IFDEF CPUX64} +function PlatformManager: TPlatformManager; + external coreide_bpl name '_ZN9Platforms15PlatformManagerEv'; +function TPlatformManager.GetEnvOptions(const APlatform: string; const APersonality: string): PObject; + external coreide_bpl name '_ZN9Platforms16TPlatformManager13GetEnvOptionsEN6System13UnicodeStringES2_'; +{$ENDIF} {$IFEND} function GetProjectEnvOptionPaths(const AProject: IOTAProject; const AOptionName: string): string; diff --git a/Shared/ImportHooking.pas b/Shared/ImportHooking.pas index 2f3c3cf..fea0af8 100644 --- a/Shared/ImportHooking.pas +++ b/Shared/ImportHooking.pas @@ -55,7 +55,7 @@ interface SysUtils; const - CurProcess = Cardinal(-1); + CurProcess = {$IFDEF CPUX64}NativeUInt{$ELSE}Cardinal{$ENDIF}(-1); // API hooking classes type @@ -187,12 +187,33 @@ _IMAGE_THUNK_DATA32 = record TImageThunkData32 = IMAGE_THUNK_DATA32; PImageThunkData32 = PIMAGE_THUNK_DATA32; +{$IFDEF CPUX64} + PIMAGE_THUNK_DATA64 = ^IMAGE_THUNK_DATA64; + _IMAGE_THUNK_DATA64 = record + case Integer of + 0: (ForwarderString: UInt64); + 1: (Function_: UInt64); + 2: (Ordinal: UInt64); + 3: (AddressOfData: UInt64); + end; + IMAGE_THUNK_DATA64 = _IMAGE_THUNK_DATA64; + TImageThunkData64 = IMAGE_THUNK_DATA64; + PImageThunkData64 = PIMAGE_THUNK_DATA64; + + IMAGE_THUNK_DATA = IMAGE_THUNK_DATA64; + {$EXTERNALSYM IMAGE_THUNK_DATA} + PIMAGE_THUNK_DATA = PIMAGE_THUNK_DATA64; + {$EXTERNALSYM PIMAGE_THUNK_DATA} + TImageThunkData = TImageThunkData64; + PImageThunkData = PImageThunkData64; +{$ELSE} IMAGE_THUNK_DATA = IMAGE_THUNK_DATA32; {$EXTERNALSYM IMAGE_THUNK_DATA} PIMAGE_THUNK_DATA = PIMAGE_THUNK_DATA32; {$EXTERNALSYM PIMAGE_THUNK_DATA} TImageThunkData = TImageThunkData32; PImageThunkData = PImageThunkData32; +{$ENDIF} function IsWinNT: Boolean; var @@ -449,7 +470,7 @@ class function TJclPeMapImgHooks.ReplaceImport(Base: Pointer; const ModuleName: if VirtualProtectEx(CurProcess, @ImportEntry^.Function_, SizeOf(ToProc), PAGE_READWRITE, @LastProtect) then begin - ImportEntry^.Function_ := Cardinal(ToProc); + ImportEntry^.Function_ := {$IFDEF CPUX64}UInt64{$ELSE}Cardinal{$ENDIF}(ToProc); // According to Platform SDK documentation, the last parameter // has to be (point to) a valid variable @@ -511,7 +532,7 @@ function TJclPeMapImgHooks.EnumImports(Base: Pointer; EvReplaceImport: TReplaceI if VirtualProtectEx(CurProcess, @ImportEntry^.Function_, SizeOf(ToProc), PAGE_READWRITE, @LastProtect) then begin - ImportEntry^.Function_ := Cardinal(ToProc); + ImportEntry^.Function_ := {$IFDEF CPUX64}UInt64{$ELSE}Cardinal{$ENDIF}(ToProc); // According to Platform SDK documentation, the last parameter // has to be (point to) a valid variable VirtualProtectEx(CurProcess, @ImportEntry^.Function_, SizeOf(ToProc),