Showing preview only (316K chars total). Download the full file or copy to clipboard to get everything.
Repository: MahdiSafsafi/delphi-detours-library
Branch: master
Commit: 0083d1e0cfb1
Files: 28
Total size: 303.9 KB
Directory structure:
gitextract_bn3fmd73/
├── .gitignore
├── CHANGELOG
├── Clean.bat
├── Demo/
│ ├── Delphi/
│ │ ├── D7/
│ │ │ ├── D7.dpr
│ │ │ ├── uMain.dfm
│ │ │ └── uMain.pas
│ │ └── Demo1/
│ │ ├── Demo1.dpr
│ │ ├── Demo1.dproj
│ │ ├── uMain.dfm
│ │ └── uMain.pas
│ └── Lazarus/
│ └── Demo1/
│ ├── Demo1.lpi
│ ├── Demo1.lpr
│ ├── Demo1.lps
│ ├── umain.lfm
│ └── umain.pas
├── LICENSE
├── README.md
├── Source/
│ ├── CPUID.pas
│ ├── DDetours.pas
│ ├── DDetoursDefs.inc
│ ├── InstDecode.pas
│ ├── LegacyTypes.pas
│ ├── ModRmFlagsTables.inc
│ ├── OpCodesTables.inc
│ └── TlHelp32.inc
└── Test/
├── Test.dpr
├── Test.dproj
└── uTest.pas
================================================
FILE CONTENTS
================================================
================================================
FILE: .gitignore
================================================
# Uncomment these types if you want even more clean repository. But be careful.
# It can make harm to an existing project source. Read explanations below.
#
# Resource files are binaries containing manifest, project icon and version info.
# They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files.
*.res
#
# Type library file (binary). In old Delphi versions it should be stored.
# Since Delphi 2009 it is produced from .ridl file and can safely be ignored.
#*.tlb
#
# Diagram Portfolio file. Used by the diagram editor up to Delphi 7.
# Uncomment this if you are not using diagrams or use newer Delphi version.
#*.ddp
#
# Visual LiveBindings file. Added in Delphi XE2.
# Uncomment this if you are not using LiveBindings Designer.
#*.vlb
#
# Deployment Manager configuration file for your project. Added in Delphi XE2.
# Uncomment this if it is not mobile development and you do not use remote debug feature.
#*.deployproj
#
# Delphi compiler-generated binaries (safe to delete)
#*.exe
*.dll
*.bpl
*.bpi
*.dcp
*.so
*.apk
*.drc
*.map
*.dres
*.rsm
*.tds
*.dcu
*.lib
# Delphi autogenerated files (duplicated info)
*.cfg
*Resource.rc
# Delphi local files (user-specific info)
*.local
*.identcache
*.projdata
*.tvsconfig
*.dsk
# Delphi history and backups
__history/
*.~*
# Castalia statistics file
*.stat
================================================
FILE: CHANGELOG
================================================
version 2.2(Jun 9, 2020):
+Added support for older Delphi version: Now the minimal supported Delphi version is D7.
+Added support for FPC.
+Added recursive section feature: EnterRecursiveSection/ExitRecursiveSection.
+Added param/tag feature for all InterceptCreate functions.
+Added GetTrampolineParam function to get user param.
+Added GetCreatorThreadIdFromTrampoline function to get thread id that created the hook/trampoline.
+Added detection for non valid trampoline pointer.
+Added unittest.
+Replaced BeginHooks/BeginUnHooks by BeginTransaction.
+Replaced EndHooks/EndUnHooks by EndTransaction.
+Replaced GetNHook by GetHookCount.
+Replaced TDetours<T> by TIntercept<T,U>/TIntercept<T>
+Fixed many bugs related to MultiBytesNop.
+Fixed wrong displacement value for some branch instructions on x64.
+Fixed wrong offset size on x86 for GetJmpType function.
+Removed v1 compatibility.
+Now the library does not rely on Object.
+Code refactoring.
Jan 24,2015:
+Added support for vtable patching.
+Added GetNHook/IsHooked support for Interface.
Jan 20,2015:
+Added support to hook Delphi Interface by name.
Version2 , Mahdi Safsafi:
+Many bug fix.
+Added new hooking model architecture.
+Added multi hook support.
+Added COM hook support.
+Added instruction maping feature.
+Added hook detecting feature.
+Added BeginHooks/EndHooks.
+Added BeginUnHooks/EndUnHooks.
+Added IDetours interface.
+Added MultiNop instructions support.
+Generate better opcodes.
+Improved support for x64.
+Improved AllocMemAt function.
================================================
FILE: Clean.bat
================================================
rem *****************************************
rem * Delphi CleanUp Batch. *
rem * *
rem * Clean identcache,local,dcu,exe, *
rem * map,drc files. *
rem * Clean hidden __history folder. *
rem * *
rem * Author: Mahdi Safsafi *
rem *****************************************
@echo off
Setlocal EnableDelayedExpansion
Del "*.identcache" /s/q
Del "*.local" /s/q
Del "*.dcu" /s/q
Del "*.exe" /s/q
Del "*.drc" /s/q
Del "*.map" /s/q
set mustdel=false
For /r %%f in (.) do (
set "mustdel=false"
if %%~nf==Win32 (
if exist "%%~ff\Debug\" set "mustdel=true"
if exist "%%~ff\Release\" set "mustdel=true"
) else if %%~nf==Win64 (
if exist "%%~ff\Debug\" set "mustdel=true"
if exist "%%~ff\Release\" set "mustdel=true"
)
if %%~nf==__history set "mustdel=true"
if !mustdel!==true (
if exist "%%~ff" rd /s/q "%%~ff"
)
)
================================================
FILE: Demo/Delphi/D7/D7.dpr
================================================
program D7;
uses
Forms,
uMain in 'uMain.pas' {Main};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMain, Main);
Application.Run;
end.
================================================
FILE: Demo/Delphi/D7/uMain.dfm
================================================
object Main: TMain
Left = 192
Top = 125
Width = 238
Height = 191
BorderStyle = bsSizeToolWin
Caption = 'Main'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object BtnHook: TButton
Left = 46
Top = 24
Width = 131
Height = 25
Caption = 'Hook'
TabOrder = 0
OnClick = BtnHookClick
end
object BtnMsgBox: TButton
Left = 46
Top = 64
Width = 131
Height = 25
Caption = 'MsgBox'
TabOrder = 1
OnClick = BtnMsgBoxClick
end
object BtnUnhook: TButton
Left = 46
Top = 104
Width = 131
Height = 25
Caption = 'Unhook'
TabOrder = 2
OnClick = BtnUnhookClick
end
end
================================================
FILE: Demo/Delphi/D7/uMain.pas
================================================
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DDetours;
type
TMain = class(TForm)
BtnHook: TButton;
BtnMsgBox: TButton;
BtnUnhook: TButton;
procedure BtnHookClick(Sender: TObject);
procedure BtnMsgBoxClick(Sender: TObject);
procedure BtnUnhookClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Main: TMain;
implementation
{$R *.dfm}
type TMessageBox = function (hWnd: HWND; lpText, lpCaption: PChar; uType: UINT): Integer; stdcall;
var TrampolineMessageBox : TMessageBox;
function InterceptMessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: UINT): Integer; stdcall;
var
Self: TMain;
begin
Self := GetTrampolineParam(TrampolineMessageBox);
Self.Caption := 'MessageBox hooked !';
Result := TrampolineMessageBox(hWnd, 'this text was hooked', 'this title was hooked', MB_ICONWARNING);
end;
procedure TMain.FormCreate(Sender: TObject);
begin
BtnUnHook.Enabled := False;
end;
procedure TMain.BtnHookClick(Sender: TObject);
begin
TrampolineMessageBox := InterceptCreate(@MessageBox, @InterceptMessageBox, Self);
BtnUnHook.Enabled := True;
BtnHook.Enabled := False;
end;
procedure TMain.BtnMsgBoxClick(Sender: TObject);
begin
MessageBox(0, 'text', 'caption', 0);
end;
procedure TMain.BtnUnHookClick(Sender: TObject);
begin
if Assigned(TrampolineMessageBox) then
begin
InterceptRemove(@TrampolineMessageBox);
TrampolineMessageBox := nil;
BtnHook.Enabled := True;
BtnUnHook.Enabled := False;
end;
end;
initialization
finalization
if Assigned(TrampolineMessageBox) then
InterceptRemove(@TrampolineMessageBox);
end.
================================================
FILE: Demo/Delphi/Demo1/Demo1.dpr
================================================
program Demo1;
uses
Vcl.Forms,
uMain in 'uMain.pas' {Main},
CPUID in '..\..\..\Source\CPUID.pas',
DDetours in '..\..\..\Source\DDetours.pas',
InstDecode in '..\..\..\Source\InstDecode.pas',
LegacyTypes in '..\..\..\Source\LegacyTypes.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMain, Main);
Application.Run;
end.
================================================
FILE: Demo/Delphi/Demo1/Demo1.dproj
================================================
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{F3F06688-F7C7-4A42-B09B-18B38AB06934}</ProjectGuid>
<ProjectVersion>18.7</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>Demo1.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<SanitizedProjectName>Demo1</SanitizedProjectName>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;StyleControls_dxe103Rio;vclFireDAC;IndySystem;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;MyIdePlugin;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;dclAbsDBd26;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;vclAbsDBd26;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;StyleControls_dxe103Rio;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="uMain.pas">
<Form>Main</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\Source\CPUID.pas"/>
<DCCReference Include="..\..\..\Source\DDetours.pas"/>
<DCCReference Include="..\..\..\Source\InstDecode.pas"/>
<DCCReference Include="..\..\..\Source\LegacyTypes.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Application</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">Demo1.dpr</Source>
</Source>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="Win32\Debug\Demo1.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>Demo1.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidFileProvider">
<Platform Name="Android">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiFile">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeMipsFile">
<Platform Name="Android">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashImageDef">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStyles">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStylesV21">
<Platform Name="Android">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Colors">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon144">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon24">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage470">
<Platform Name="Android">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage640">
<Platform Name="Android">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage960">
<Platform Name="Android">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Strings">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Android">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1024x768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1536x2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1668">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1668x2388">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048x1536">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048x2732">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2224">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2388x1668">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2732x2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768x1024">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1125">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1136x640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1242">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1242x2688">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1334">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1792">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2208">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2436">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2688x1242">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch320">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640x1136">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch750">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch828">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceResourceRules">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements">
<Platform Name="iOSDevice32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSInfoPList">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXDebug">
<Platform Name="OSX64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXEntitlements">
<Platform Name="OSX32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXInfoPList">
<Platform Name="OSX32">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>
================================================
FILE: Demo/Delphi/Demo1/uMain.dfm
================================================
object Main: TMain
Left = 0
Top = 0
BorderStyle = bsToolWindow
Caption = 'Main'
ClientHeight = 134
ClientWidth = 257
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object BtnHook: TButton
Left = 48
Top = 16
Width = 161
Height = 25
Caption = 'Hook'
TabOrder = 0
OnClick = BtnHookClick
end
object BtnMsgBox: TButton
Left = 48
Top = 55
Width = 161
Height = 25
Caption = 'MessageBox'
TabOrder = 1
OnClick = BtnMsgBoxClick
end
object BtnUnHook: TButton
Left = 48
Top = 91
Width = 161
Height = 25
Caption = 'Unhook'
TabOrder = 2
OnClick = BtnUnHookClick
end
end
================================================
FILE: Demo/Delphi/Demo1/uMain.pas
================================================
unit uMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DDetours;
type
TMain = class(TForm)
BtnHook: TButton;
BtnMsgBox: TButton;
BtnUnHook: TButton;
procedure BtnHookClick(Sender: TObject);
procedure BtnUnHookClick(Sender: TObject);
procedure BtnMsgBoxClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Main: TMain;
implementation
{$R *.dfm}
type
TMessageBox = function(hWnd: hWnd; lpText, lpCaption: LPCWSTR; uType: UINT): Integer; stdcall;
var
TrampolineMessageBox: TMessageBox = nil;
function InterceptMessageBox(hWnd: hWnd; lpText, lpCaption: LPCWSTR; uType: UINT): Integer; stdcall;
var
Self: TMain;
begin
Self := GetTrampolineParam(TrampolineMessageBox);
Self.Caption := 'MessageBox hooked !';
Result := TrampolineMessageBox(hWnd, 'this text was hooked', 'this title was hooked', MB_ICONWARNING);
end;
procedure TMain.FormCreate(Sender: TObject);
begin
BtnUnHook.Enabled := False;
end;
procedure TMain.BtnHookClick(Sender: TObject);
begin
TrampolineMessageBox := InterceptCreate(@MessageBox, @InterceptMessageBox, Self);
BtnUnHook.Enabled := True;
BtnHook.Enabled := False;
end;
procedure TMain.BtnMsgBoxClick(Sender: TObject);
begin
MessageBox(0, 'text', 'caption', 0);
end;
procedure TMain.BtnUnHookClick(Sender: TObject);
begin
if Assigned(TrampolineMessageBox) then
begin
InterceptRemove(@TrampolineMessageBox);
TrampolineMessageBox := nil;
BtnHook.Enabled := True;
BtnUnHook.Enabled := False;
end;
end;
initialization
finalization
if Assigned(TrampolineMessageBox) then
InterceptRemove(@TrampolineMessageBox);
end.
================================================
FILE: Demo/Lazarus/Demo1/Demo1.lpi
================================================
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="Demo1"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="Demo1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="umain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Main"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="Demo1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\..\..\Source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>
================================================
FILE: Demo/Lazarus/Demo1/Demo1.lpr
================================================
program Demo1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, uMain
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMain, Main);
Application.Run;
end.
================================================
FILE: Demo/Lazarus/Demo1/Demo1.lps
================================================
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="4">
<Unit0>
<Filename Value="Demo1.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="umain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Main"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMain"/>
<IsVisibleTab Value="True"/>
<TopLine Value="40"/>
<CursorPos X="38" Y="50"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="C:\lazarus\fpc\3.0.4\source\rtl\win\wininc\ascdef.inc"/>
<EditorIndex Value="2"/>
<TopLine Value="248"/>
<CursorPos Y="257"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\..\Source\DDetours.pas"/>
<EditorIndex Value="1"/>
<TopLine Value="2291"/>
<CursorPos Y="2299"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
</Units>
<JumpHistory Count="21" HistoryIndex="20">
<Position1>
<Filename Value="umain.pas"/>
</Position1>
<Position2>
<Filename Value="umain.pas"/>
<Caret Line="37" Column="21" TopLine="25"/>
</Position2>
<Position3>
<Filename Value="umain.pas"/>
<Caret Line="34" Column="28" TopLine="24"/>
</Position3>
<Position4>
<Filename Value="umain.pas"/>
<Caret Line="50" Column="6" TopLine="37"/>
</Position4>
<Position5>
<Filename Value="umain.pas"/>
<Caret Line="9" Column="20"/>
</Position5>
<Position6>
<Filename Value="umain.pas"/>
<Caret Line="49" TopLine="39"/>
</Position6>
<Position7>
<Filename Value="umain.pas"/>
<Caret Line="68" Column="42" TopLine="53"/>
</Position7>
<Position8>
<Filename Value="umain.pas"/>
<Caret Line="53" Column="5" TopLine="44"/>
</Position8>
<Position9>
<Filename Value="umain.pas"/>
<Caret Line="61" Column="9" TopLine="45"/>
</Position9>
<Position10>
<Filename Value="umain.pas"/>
<Caret Line="53" Column="5" TopLine="45"/>
</Position10>
<Position11>
<Filename Value="umain.pas"/>
<Caret Line="56" Column="51" TopLine="45"/>
</Position11>
<Position12>
<Filename Value="umain.pas"/>
<Caret Line="53" Column="54" TopLine="45"/>
</Position12>
<Position13>
<Filename Value="umain.pas"/>
<Caret Line="4" Column="2"/>
</Position13>
<Position14>
<Filename Value="umain.pas"/>
<Caret Line="69" Column="20" TopLine="54"/>
</Position14>
<Position15>
<Filename Value="umain.pas"/>
<Caret Line="70" Column="35" TopLine="54"/>
</Position15>
<Position16>
<Filename Value="umain.pas"/>
<Caret Line="75" Column="21" TopLine="59"/>
</Position16>
<Position17>
<Filename Value="umain.pas"/>
<Caret Line="74" TopLine="60"/>
</Position17>
<Position18>
<Filename Value="umain.pas"/>
<Caret Line="75" TopLine="60"/>
</Position18>
<Position19>
<Filename Value="umain.pas"/>
<Caret Line="74" TopLine="60"/>
</Position19>
<Position20>
<Filename Value="umain.pas"/>
<Caret Line="80" TopLine="64"/>
</Position20>
<Position21>
<Filename Value="umain.pas"/>
<Caret Line="48" Column="25" TopLine="35"/>
</Position21>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0" ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>
================================================
FILE: Demo/Lazarus/Demo1/umain.lfm
================================================
object Main: TMain
Left = 256
Height = 137
Top = 145
Width = 242
BorderStyle = bsToolWindow
Caption = 'Main'
ClientHeight = 137
ClientWidth = 242
OnCreate = FormCreate
LCLVersion = '2.0.8.0'
object BtnHook: TButton
Left = 49
Height = 27
Top = 23
Width = 141
Caption = 'Hook'
OnClick = BtnHookClick
TabOrder = 0
end
object BtnMsgBox: TButton
Left = 48
Height = 25
Top = 56
Width = 141
Caption = 'MessageBox'
OnClick = BtnMsgBoxClick
TabOrder = 1
end
object BtnUnhook: TButton
Left = 49
Height = 26
Top = 88
Width = 141
Caption = 'Unhook'
OnClick = BtnUnhookClick
TabOrder = 2
end
end
================================================
FILE: Demo/Lazarus/Demo1/umain.pas
================================================
unit uMain;
{$mode Delphi}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
Windows, DDetours;
type
{ TMain }
TMain = class(TForm)
BtnHook: TButton;
BtnMsgBox: TButton;
BtnUnhook: TButton;
procedure BtnHookClick(Sender: TObject);
procedure BtnMsgBoxClick(Sender: TObject);
procedure BtnUnhookClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Main: TMain;
implementation
{$R *.lfm}
type
TMessageBox = function(hWnd: HWND; lpText: LPCSTR; lpCaption: LPCSTR;
uType: UINT): longint; stdcall;
var
TrampolineMessageBox: TMessageBox = nil;
function InterceptMessageBox(hWnd: HWND; lpText: LPCSTR; lpCaption: LPCSTR;
uType: UINT): longint; stdcall;
var
Form: TMain;
begin
Form := GetTrampolineParam(TrampolineMessageBox);
Form.Caption := 'MessageBox Hooked!';
Result := TrampolineMessageBox(hWnd, 'this text was hooked.',
'this caption was hooked.', MB_ICONEXCLAMATION);
end;
{ TMain }
procedure TMain.BtnHookClick(Sender: TObject);
begin
BtnUnhook.Enabled := True;
BtnHook.Enabled := False;
@TrampolineMessageBox := InterceptCreate(@MessageBox, @InterceptMessageBox, Self);
end;
procedure TMain.BtnMsgBoxClick(Sender: TObject);
begin
MessageBox(0, 'text', 'caption', 0);
end;
procedure TMain.BtnUnhookClick(Sender: TObject);
begin
BtnHook.Enabled := True;
BtnUnHook.Enabled := False;
if Assigned(TrampolineMessageBox) then
begin
InterceptRemove(@TrampolineMessageBox);
TrampolineMessageBox := nil;
end;
end;
procedure TMain.FormCreate(Sender: TObject);
begin
BtnUnhook.Enabled := False;
end;
initialization
finalization
if Assigned(TrampolineMessageBox) then
InterceptRemove(@TrampolineMessageBox);
end.
================================================
FILE: LICENSE
================================================
Mozilla Public License Version 2.0
==================================
1. Definitions
--------------
1.1. "Contributor"
means each individual or legal entity that creates, contributes to
the creation of, or owns Covered Software.
1.2. "Contributor Version"
means the combination of the Contributions of others (if any) used
by a Contributor and that particular Contributor's Contribution.
1.3. "Contribution"
means Covered Software of a particular Contributor.
1.4. "Covered Software"
means Source Code Form to which the initial Contributor has attached
the notice in Exhibit A, the Executable Form of such Source Code
Form, and Modifications of such Source Code Form, in each case
including portions thereof.
1.5. "Incompatible With Secondary Licenses"
means
(a) that the initial Contributor has attached the notice described
in Exhibit B to the Covered Software; or
(b) that the Covered Software was made available under the terms of
version 1.1 or earlier of the License, but not also under the
terms of a Secondary License.
1.6. "Executable Form"
means any form of the work other than Source Code Form.
1.7. "Larger Work"
means a work that combines Covered Software with other material, in
a separate file or files, that is not Covered Software.
1.8. "License"
means this document.
1.9. "Licensable"
means having the right to grant, to the maximum extent possible,
whether at the time of the initial grant or subsequently, any and
all of the rights conveyed by this License.
1.10. "Modifications"
means any of the following:
(a) any file in Source Code Form that results from an addition to,
deletion from, or modification of the contents of Covered
Software; or
(b) any new file in Source Code Form that contains any Covered
Software.
1.11. "Patent Claims" of a Contributor
means any patent claim(s), including without limitation, method,
process, and apparatus claims, in any patent Licensable by such
Contributor that would be infringed, but for the grant of the
License, by the making, using, selling, offering for sale, having
made, import, or transfer of either its Contributions or its
Contributor Version.
1.12. "Secondary License"
means either the GNU General Public License, Version 2.0, the GNU
Lesser General Public License, Version 2.1, the GNU Affero General
Public License, Version 3.0, or any later versions of those
licenses.
1.13. "Source Code Form"
means the form of the work preferred for making modifications.
1.14. "You" (or "Your")
means an individual or a legal entity exercising rights under this
License. For legal entities, "You" includes any entity that
controls, is controlled by, or is under common control with You. For
purposes of this definition, "control" means (a) the power, direct
or indirect, to cause the direction or management of such entity,
whether by contract or otherwise, or (b) ownership of more than
fifty percent (50%) of the outstanding shares or beneficial
ownership of such entity.
2. License Grants and Conditions
--------------------------------
2.1. Grants
Each Contributor hereby grants You a world-wide, royalty-free,
non-exclusive license:
(a) under intellectual property rights (other than patent or trademark)
Licensable by such Contributor to use, reproduce, make available,
modify, display, perform, distribute, and otherwise exploit its
Contributions, either on an unmodified basis, with Modifications, or
as part of a Larger Work; and
(b) under Patent Claims of such Contributor to make, use, sell, offer
for sale, have made, import, and otherwise transfer either its
Contributions or its Contributor Version.
2.2. Effective Date
The licenses granted in Section 2.1 with respect to any Contribution
become effective for each Contribution on the date the Contributor first
distributes such Contribution.
2.3. Limitations on Grant Scope
The licenses granted in this Section 2 are the only rights granted under
this License. No additional rights or licenses will be implied from the
distribution or licensing of Covered Software under this License.
Notwithstanding Section 2.1(b) above, no patent license is granted by a
Contributor:
(a) for any code that a Contributor has removed from Covered Software;
or
(b) for infringements caused by: (i) Your and any other third party's
modifications of Covered Software, or (ii) the combination of its
Contributions with other software (except as part of its Contributor
Version); or
(c) under Patent Claims infringed by Covered Software in the absence of
its Contributions.
This License does not grant any rights in the trademarks, service marks,
or logos of any Contributor (except as may be necessary to comply with
the notice requirements in Section 3.4).
2.4. Subsequent Licenses
No Contributor makes additional grants as a result of Your choice to
distribute the Covered Software under a subsequent version of this
License (see Section 10.2) or under the terms of a Secondary License (if
permitted under the terms of Section 3.3).
2.5. Representation
Each Contributor represents that the Contributor believes its
Contributions are its original creation(s) or it has sufficient rights
to grant the rights to its Contributions conveyed by this License.
2.6. Fair Use
This License is not intended to limit any rights You have under
applicable copyright doctrines of fair use, fair dealing, or other
equivalents.
2.7. Conditions
Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
in Section 2.1.
3. Responsibilities
-------------------
3.1. Distribution of Source Form
All distribution of Covered Software in Source Code Form, including any
Modifications that You create or to which You contribute, must be under
the terms of this License. You must inform recipients that the Source
Code Form of the Covered Software is governed by the terms of this
License, and how they can obtain a copy of this License. You may not
attempt to alter or restrict the recipients' rights in the Source Code
Form.
3.2. Distribution of Executable Form
If You distribute Covered Software in Executable Form then:
(a) such Covered Software must also be made available in Source Code
Form, as described in Section 3.1, and You must inform recipients of
the Executable Form how they can obtain a copy of such Source Code
Form by reasonable means in a timely manner, at a charge no more
than the cost of distribution to the recipient; and
(b) You may distribute such Executable Form under the terms of this
License, or sublicense it under different terms, provided that the
license for the Executable Form does not attempt to limit or alter
the recipients' rights in the Source Code Form under this License.
3.3. Distribution of a Larger Work
You may create and distribute a Larger Work under terms of Your choice,
provided that You also comply with the requirements of this License for
the Covered Software. If the Larger Work is a combination of Covered
Software with a work governed by one or more Secondary Licenses, and the
Covered Software is not Incompatible With Secondary Licenses, this
License permits You to additionally distribute such Covered Software
under the terms of such Secondary License(s), so that the recipient of
the Larger Work may, at their option, further distribute the Covered
Software under the terms of either this License or such Secondary
License(s).
3.4. Notices
You may not remove or alter the substance of any license notices
(including copyright notices, patent notices, disclaimers of warranty,
or limitations of liability) contained within the Source Code Form of
the Covered Software, except that You may alter any license notices to
the extent required to remedy known factual inaccuracies.
3.5. Application of Additional Terms
You may choose to offer, and to charge a fee for, warranty, support,
indemnity or liability obligations to one or more recipients of Covered
Software. However, You may do so only on Your own behalf, and not on
behalf of any Contributor. You must make it absolutely clear that any
such warranty, support, indemnity, or liability obligation is offered by
You alone, and You hereby agree to indemnify every Contributor for any
liability incurred by such Contributor as a result of warranty, support,
indemnity or liability terms You offer. You may include additional
disclaimers of warranty and limitations of liability specific to any
jurisdiction.
4. Inability to Comply Due to Statute or Regulation
---------------------------------------------------
If it is impossible for You to comply with any of the terms of this
License with respect to some or all of the Covered Software due to
statute, judicial order, or regulation then You must: (a) comply with
the terms of this License to the maximum extent possible; and (b)
describe the limitations and the code they affect. Such description must
be placed in a text file included with all distributions of the Covered
Software under this License. Except to the extent prohibited by statute
or regulation, such description must be sufficiently detailed for a
recipient of ordinary skill to be able to understand it.
5. Termination
--------------
5.1. The rights granted under this License will terminate automatically
if You fail to comply with any of its terms. However, if You become
compliant, then the rights granted under this License from a particular
Contributor are reinstated (a) provisionally, unless and until such
Contributor explicitly and finally terminates Your grants, and (b) on an
ongoing basis, if such Contributor fails to notify You of the
non-compliance by some reasonable means prior to 60 days after You have
come back into compliance. Moreover, Your grants from a particular
Contributor are reinstated on an ongoing basis if such Contributor
notifies You of the non-compliance by some reasonable means, this is the
first time You have received notice of non-compliance with this License
from such Contributor, and You become compliant prior to 30 days after
Your receipt of the notice.
5.2. If You initiate litigation against any entity by asserting a patent
infringement claim (excluding declaratory judgment actions,
counter-claims, and cross-claims) alleging that a Contributor Version
directly or indirectly infringes any patent, then the rights granted to
You by any and all Contributors for the Covered Software under Section
2.1 of this License shall terminate.
5.3. In the event of termination under Sections 5.1 or 5.2 above, all
end user license agreements (excluding distributors and resellers) which
have been validly granted by You or Your distributors under this License
prior to termination shall survive termination.
************************************************************************
* *
* 6. Disclaimer of Warranty *
* ------------------------- *
* *
* Covered Software is provided under this License on an "as is" *
* basis, without warranty of any kind, either expressed, implied, or *
* statutory, including, without limitation, warranties that the *
* Covered Software is free of defects, merchantable, fit for a *
* particular purpose or non-infringing. The entire risk as to the *
* quality and performance of the Covered Software is with You. *
* Should any Covered Software prove defective in any respect, You *
* (not any Contributor) assume the cost of any necessary servicing, *
* repair, or correction. This disclaimer of warranty constitutes an *
* essential part of this License. No use of any Covered Software is *
* authorized under this License except under this disclaimer. *
* *
************************************************************************
************************************************************************
* *
* 7. Limitation of Liability *
* -------------------------- *
* *
* Under no circumstances and under no legal theory, whether tort *
* (including negligence), contract, or otherwise, shall any *
* Contributor, or anyone who distributes Covered Software as *
* permitted above, be liable to You for any direct, indirect, *
* special, incidental, or consequential damages of any character *
* including, without limitation, damages for lost profits, loss of *
* goodwill, work stoppage, computer failure or malfunction, or any *
* and all other commercial damages or losses, even if such party *
* shall have been informed of the possibility of such damages. This *
* limitation of liability shall not apply to liability for death or *
* personal injury resulting from such party's negligence to the *
* extent applicable law prohibits such limitation. Some *
* jurisdictions do not allow the exclusion or limitation of *
* incidental or consequential damages, so this exclusion and *
* limitation may not apply to You. *
* *
************************************************************************
8. Litigation
-------------
Any litigation relating to this License may be brought only in the
courts of a jurisdiction where the defendant maintains its principal
place of business and such litigation shall be governed by laws of that
jurisdiction, without reference to its conflict-of-law provisions.
Nothing in this Section shall prevent a party's ability to bring
cross-claims or counter-claims.
9. Miscellaneous
----------------
This License represents the complete agreement concerning the subject
matter hereof. If any provision of this License is held to be
unenforceable, such provision shall be reformed only to the extent
necessary to make it enforceable. Any law or regulation which provides
that the language of a contract shall be construed against the drafter
shall not be used to construe this License against a Contributor.
10. Versions of the License
---------------------------
10.1. New Versions
Mozilla Foundation is the license steward. Except as provided in Section
10.3, no one other than the license steward has the right to modify or
publish new versions of this License. Each version will be given a
distinguishing version number.
10.2. Effect of New Versions
You may distribute the Covered Software under the terms of the version
of the License under which You originally received the Covered Software,
or under the terms of any subsequent version published by the license
steward.
10.3. Modified Versions
If you create software not governed by this License, and you want to
create a new license for such software, you may create and use a
modified version of this License if you rename the license and remove
any references to the name of the license steward (except to note that
such modified license differs from this License).
10.4. Distributing Source Code Form that is Incompatible With Secondary
Licenses
If You choose to distribute Source Code Form that is Incompatible With
Secondary Licenses under the terms of this version of the License, the
notice described in Exhibit B of this License must be attached.
Exhibit A - Source Code Form License Notice
-------------------------------------------
This Source Code Form is subject to the terms of the Mozilla Public
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.
If it is not possible or desirable to put the notice in a particular
file, then You may include the notice in a location (such as a LICENSE
file in a relevant directory) where a recipient would be likely to look
for such a notice.
You may add additional accurate notices of copyright ownership.
Exhibit B - "Incompatible With Secondary Licenses" Notice
---------------------------------------------------------
This Source Code Form is "Incompatible With Secondary Licenses", as
defined by the Mozilla Public License, v. 2.0.
================================================
FILE: README.md
================================================
The **DDetours** is a library allowing you to hook Delphi and Windows API functions. It provides an easy way to insert and remove hook.
## What's new in Version 2.2 ? ##
* Support for FPC and older Delphi version notably D7.
* Support for recursive section.
* Support for custom parameter/tag for each trampoline function.
* See CHANGELOG for complete changes.
## Features : ##
* Supports **x86** and **x64** architecture.
* Supports <u><b>multiple hook</b></u> for a single function.
* Supports Delphi 7/2005-2010/XE-Rio(Delphi 10.3).
* Supports Lazarus/FPC.
* Supports recursive function inside the hook function.
* Supports hooking interfaces methods by **MethodName** or **MethodIndex**.
* Supports COM **vtable** patching.
* Supports hooking object methods.
* Allows calling the original function via <u><b>Trampoline/NextHook</b></u> function.
* **COM**/**Interfaces**/**win32api** support.
* Thread-safe for hooking and unhooking.
* 64 bit address is supported.
* The library does not use any external library.
* The library can insert and remove the hook at any time.
* The library contains InstDecode library, that allows you to decode CPU instructions (x86/x64).
This project contains two sub project : **DDetours** and **InstDecode*** library.
The InstDecode Library is a library that can decode both (x86/x64) instructions. You can consider it as a small disassembler routine.
It can decode instruction and getting information about the instruction (size of instruction, displacement, immediate data, jump address,..) without displaying mnemonics making it very faster and very small in size.
These two libraries were coded in pure Pascal language with Delphi XE7.
See the [Wiki](https://github.com/MahdiSafsafi/DDetours/wiki) page for more information about how to use the library.
Please, if you find any bug, feel free to report it.
================================================
FILE: Source/CPUID.pas
================================================
// **************************************************************************************************
// CPUID for Delphi.
// Unit CPUID
// https://github.com/MahdiSafsafi/DDetours
//
// This Source Code Form is subject to the terms of the Mozilla
// Public License, v. 2.0. If a copy of the MPL was not distributed
// with this file, You can obtain one at
// https://mozilla.org/MPL/2.0/.
// **************************************************************************************************
unit CPUID;
{$IFDEF FPC}
{$MODE DELPHI}
{$WARN 4055 OFF}
{$WARN 4082 OFF}
{$WARN 5057 OFF}
{$ENDIF FPC}
interface
{$I DDetoursDefs.inc}
uses
SysUtils
{$IFNDEF FPC}, LegacyTypes{$ENDIF FPC}
;
type
{ Do not change registers order ! }
TCPUIDStruct = packed record
rEAX: Cardinal; { EAX Register }
rEBX: Cardinal; { EBX Register }
rEDX: Cardinal; { EDX Register }
rECX: Cardinal; { ECX Register }
end;
PCPUIDStruct = ^TCPUIDStruct;
procedure CallCPUID(ID: NativeUInt; var CPUIDStruct: TCPUIDStruct);
function IsCPUIDSupported(): Boolean;
type
TCPUVendor = (vUnknown, vIntel, vAMD, vNextGen);
TCPUEncoding = set of (REX, VEX, EVEX);
TCPUInstructions = set of (iMultiNop);
var
CPUVendor: TCPUVendor;
CPUEncoding: TCPUEncoding;
CPUInsts: TCPUInstructions;
implementation
var
CPUIDSupported: Boolean = False;
function ___IsCPUIDSupported: Boolean;
asm
{$IFDEF CPUX64}
PUSH RCX
MOV RCX,RCX
PUSHFQ
POP RAX
MOV RCX, RAX
XOR RAX, $200000
PUSH RAX
POPFQ
PUSHFQ
POP RAX
XOR RAX, RCX
SHR RAX, 21
AND RAX, 1
PUSH RCX
POPFQ
POP RCX
{$ELSE !CPUX64}
PUSH ECX
PUSHFD
POP EAX { EAX = EFLAGS }
MOV ECX, EAX { Save the original EFLAGS value . }
{
CPUID is supported only if we can modify
bit 21 of EFLAGS register !
}
XOR EAX, $200000
PUSH EAX
POPFD { Set the new EFLAGS value }
PUSHFD
POP EAX { Read EFLAGS }
{
Check if the 21 bit was modified !
If so ==> Return True .
else ==> Return False.
}
XOR EAX, ECX
SHR EAX, 21
AND EAX, 1
PUSH ECX
POPFD { Restore original EFLAGS value . }
POP ECX
{$ENDIF CPUX64}
end;
procedure ___CallCPUID(const ID: NativeInt; var CPUIDStruct);
asm
{
ALL REGISTERS (rDX,rCX,rBX) MUST BE SAVED BEFORE
EXECUTING CPUID INSTRUCTION !
}
{$IFDEF CPUX64}
PUSH R9
PUSH RBX
PUSH RDX
MOV RAX,RCX
MOV R9,RDX
CPUID
{$IFNDEF FPC}
MOV R9.TCPUIDStruct.rEAX,EAX
MOV R9.TCPUIDStruct.rEBX,EBX
MOV R9.TCPUIDStruct.rECX,ECX
MOV R9.TCPUIDStruct.rEDX,EDX
{$ELSE FPC}
MOV [R9].TCPUIDStruct.rEAX,EAX
MOV [R9].TCPUIDStruct.rEBX,EBX
MOV [R9].TCPUIDStruct.rECX,ECX
MOV [R9].TCPUIDStruct.rEDX,EDX
{$ENDIF !FPC}
POP RDX
POP RBX
POP R9
{$ELSE !CPUX64}
PUSH EDI
PUSH ECX
PUSH EBX
MOV EDI,EDX
CPUID
{$IFNDEF FPC}
MOV EDI.TCPUIDStruct.rEAX,EAX
MOV EDI.TCPUIDStruct.rEBX,EBX
MOV EDI.TCPUIDStruct.rECX,ECX
MOV EDI.TCPUIDStruct.rEDX,EDX
{$ELSE FPC}
MOV [EDI].TCPUIDStruct.rEAX,EAX
MOV [EDI].TCPUIDStruct.rEBX,EBX
MOV [EDI].TCPUIDStruct.rECX,ECX
MOV [EDI].TCPUIDStruct.rEDX,EDX
{$ENDIF !FPC}
POP EBX
POP ECX
POP EDI
{$ENDIF CPUX64}
end;
function ___IsAVXSupported: Boolean;
asm
{
Checking for AVX support requires 3 steps:
1) Detect CPUID.1:ECX.OSXSAVE[bit 27] = 1
=> XGETBV enabled for application use
2) Detect CPUID.1:ECX.AVX[bit 28] = 1
=> AVX instructions supported.
3) Issue XGETBV and verify that XCR0[2:1] = ‘11b’
=> XMM state and YMM state are enabled by OS.
}
{ Steps : 1 and 2 }
{$IFDEF CPUX64}
MOV RAX, 1
PUSH RCX
PUSH RBX
PUSH RDX
{$ELSE !CPUX64}
MOV EAX, 1
PUSH ECX
PUSH EBX
PUSH EDX
{$ENDIF CPUX64}
CPUID
AND ECX, $018000000
CMP ECX, $018000000
JNE @@NOT_SUPPORTED
XOR ECX,ECX
{
Delphi does not support XGETBV !
=> We need to use the XGETBV opcodes !
}
DB $0F DB $01 DB $D0 // XGETBV
{ Step :3 }
AND EAX, $06
CMP EAX, $06
JNE @@NOT_SUPPORTED
MOV EAX, 1
JMP @@END
@@NOT_SUPPORTED:
XOR EAX,EAX
@@END:
{$IFDEF CPUX64}
POP RDX
POP RBX
POP RCX
{$ELSE !CPUX64}
POP EDX
POP EBX
POP ECX
{$ENDIF CPUX64}
end;
procedure CallCPUID(ID: NativeUInt; var CPUIDStruct: TCPUIDStruct);
begin
FillChar(CPUIDStruct, SizeOf(TCPUIDStruct), #0);
if not CPUIDSupported then
raise Exception.Create('CPUID instruction not supported.')
else
___CallCPUID(ID, CPUIDStruct);
end;
function IsCPUIDSupported: Boolean;
begin
Result := CPUIDSupported;
end;
type
TVendorName = array [0 .. 12] of AnsiChar;
function GetVendorName(): TVendorName;
var
Info: PCPUIDStruct;
P: PByte;
begin
Result := '';
if not IsCPUIDSupported then
Exit;
Info := GetMemory(SizeOf(TCPUIDStruct));
CallCPUID(0, Info^);
P := PByte(NativeInt(Info) + 4); // Skip EAX !
Move(P^, PByte(@Result[0])^, 12);
FreeMemory(Info);
end;
procedure __Init__;
var
vn: TVendorName;
Info: TCPUIDStruct;
r: Cardinal;
begin
CPUVendor := vUnknown;
{$IFDEF CPUX64}
CPUEncoding := [REX];
{$ELSE !CPUX64}
CPUEncoding := [];
{$ENDIF CPUX64}
CPUInsts := [];
if IsCPUIDSupported then
begin
vn := GetVendorName();
if vn = 'GenuineIntel' then
CPUVendor := vIntel
else if vn = 'AuthenticAMD' then
CPUVendor := vAMD
else if vn = 'NexGenDriven' then
CPUVendor := vNextGen;
CallCPUID(1, Info);
r := Info.rEAX and $F00;
case r of
$F00, $600:
Include(CPUInsts, iMultiNop);
end;
if ___IsAVXSupported then
Include(CPUEncoding, VEX);
end;
end;
initialization
CPUIDSupported := ___IsCPUIDSupported;
__Init__;
end.
================================================
FILE: Source/DDetours.pas
================================================
// **************************************************************************************************
// Delphi Detours Library.
// Unit DDetours
// https://github.com/MahdiSafsafi/DDetours
//
// This Source Code Form is subject to the terms of the Mozilla
// Public License, v. 2.0. If a copy of the MPL was not distributed
// with this file, You can obtain one at
// https://mozilla.org/MPL/2.0/.
// **************************************************************************************************
//
// Contributors:
// - David Millington : Added TDetours<T> class.
// **************************************************************************************************
unit DDetours;
{define FIX_MADEXCEPT if you are using crash on buffer overrun/underrun feature from MadExcept }
{.$DEFINE FIX_MADEXCEPT}
{.$define DEVMODE}
{$IFDEF FPC}
{$MODE DELPHI}
{$HINTS OFF}
{$WARN 4045 OFF}
{$WARN 4055 OFF}
{$WARN 4056 OFF}
{$WARN 4082 OFF}
{$WARN 5024 OFF}
{$WARN 5028 OFF}
{$WARN 5057 OFF}
{$WARN 5058 OFF}
{$ENDIF FPC}
interface
{$I DDetoursDefs.inc}
uses
{$IFDEF RENAMED_NAMESPACE}
System.SysUtils,
System.Classes,
WinApi.Windows,
WinApi.TLHelp32,
{$IFNDEF SUPPORTS_MONITOR}
System.SyncObjs,
{$ENDIF SUPPORTS_MONITOR}
{$ELSE !RENAMED_NAMESPACE}
SysUtils,
Windows,
Classes,
{$IFNDEF SUPPORTS_MONITOR}
SyncObjs,
{$ENDIF SUPPORTS_MONITOR}
{$IFNDEF FPC}
TLHelp32,
{$ENDIF FPC}
{$ENDIF RENAMED_NAMESPACE}
{$IFDEF SUPPORTS_RTTI}
System.Generics.Collections,
System.Typinfo, System.RTTI,
{$ENDIF SUPPORTS_RTTI}
LegacyTypes,
CPUID,
InstDecode;
type
InterceptException = Exception;
TTransactionOption = (toSuspendThread);
TTransactionOptions = set of TTransactionOption;
TInterceptOption = (ioForceLoad, ioRecursive);
TInterceptOptions = set of TInterceptOption;
const
{ Maximum allowed number of hooks. }
MAX_HOOKS = 7;
DefaultInterceptOptions = [];
SErrorInvalidTType = '<T> must be a method';
{ ========================================= DDetours Interface ========================================= }
function InterceptCreate(const TargetProc, InterceptProc: Pointer; const Param: Pointer = nil; const Options: TInterceptOptions = DefaultInterceptOptions)
: Pointer; overload;
function InterceptCreate(const TargetInterface; MethodIndex: Integer; const InterceptProc: Pointer; const Param: Pointer = nil;
const Options: TInterceptOptions = DefaultInterceptOptions): Pointer; overload;
function InterceptCreate(const Module, MethodName: String; const InterceptProc: Pointer; const Param: Pointer = nil;
const Options: TInterceptOptions = DefaultInterceptOptions): Pointer; overload;
procedure InterceptCreate(const TargetProc, InterceptProc: Pointer; var TrampoLine: Pointer; const Param: Pointer = nil;
const Options: TInterceptOptions = DefaultInterceptOptions); overload;
{$IFDEF SUPPORTS_RTTI}
function InterceptCreate(const TargetInterface; const MethodName: String; const InterceptProc: Pointer; const Param: Pointer = nil;
const Options: TInterceptOptions = DefaultInterceptOptions): Pointer; overload;
{$ENDIF SUPPORTS_RTTI}
function InterceptRemove(const TrampoLine: Pointer): Integer; overload;
function GetHookCount(const TargetProc: Pointer): Integer; overload;
function GetHookCount(const TargetInterface; MethodIndex: Integer): Integer; overload;
{$IFDEF SUPPORTS_RTTI}
function GetHookCount(const TargetInterface; const MethodName: String): Integer; overload;
{$ENDIF SUPPORTS_RTTI}
function IsHooked(const TargetProc: Pointer): Boolean; overload;
function IsHooked(const TargetInterface; MethodIndex: Integer): Boolean; overload;
{$IFDEF SUPPORTS_RTTI}
function IsHooked(const TargetInterface; const MethodName: String): Boolean; overload;
{$ENDIF SUPPORTS_RTTI}
function PatchVt(const TargetInterface; MethodIndex: Integer; InterceptProc: Pointer): Pointer;
function UnPatchVt(const TrampoLine: Pointer): Boolean;
function BeginTransaction(Options: TTransactionOptions = [toSuspendThread]): THandle;
function EndTransaction(Handle: THandle): Boolean;
function EnterRecursiveSection(var TrampoLine; MaxRecursionLevel: NativeInt = 0): Boolean;
function ExitRecursiveSection(var TrampoLine): Boolean;
function GetCreatorThreadIdFromTrampoline(var TrampoLine): TThreadId;
function GetTrampolineParam(var TrampoLine): Pointer;
{$IFDEF SUPPORTS_GENERICS}
type
IIntercept<T, U> = interface(IInterface)
['{EECBF3C2-3938-4923-835A-B0A6AD27744D}']
function GetTrampoline(): T;
function GetParam(): U;
function GetCreatorThreadId(): TThreadId;
function GetInterceptOptions(): TInterceptOptions;
function EnterRecursive(MaxRecursionLevel: NativeInt = 0): Boolean;
function ExitRecursive(): Boolean;
property NextHook: T read GetTrampoline;
property TrampoLine: T read GetTrampoline; // alias to NextHook
property Param: U read GetParam;
property CreatorThreadId: TThreadId read GetCreatorThreadId;
property InterceptOptions: TInterceptOptions read GetInterceptOptions;
end;
{
Based on David Millington's original implementation TDetours<T>.
}
TIntercept<T, U> = class(TInterfacedObject, IIntercept<T, U>)
private
FNextHook: T;
FTrampolinePtr: Pointer;
FParam: U;
FCreatorThreadId: TThreadId;
FInterceptOptions: TInterceptOptions;
function TToPointer(const A): Pointer;
function PointerToT(const P): T;
function EnsureTIsMethod(): Boolean;
public
function GetTrampoline(): T;
function GetParam(): U;
function GetCreatorThreadId(): TThreadId;
function GetInterceptOptions(): TInterceptOptions;
function EnterRecursive(MaxRecursionLevel: NativeInt = 0): Boolean;
function ExitRecursive(): Boolean;
constructor Create(const TargetProc, InterceptProc: T; const AParam: U; const AInterceptOptions: TInterceptOptions = DefaultInterceptOptions); virtual;
destructor Destroy(); override;
property Param: U read FParam;
property NextHook: T read FNextHook;
property TrampoLine: T read FNextHook; // alias to NextHook
property CreatorThreadId: TThreadId read FCreatorThreadId;
property InterceptOptions: TInterceptOptions read FInterceptOptions;
end;
TIntercept<T> = class(TIntercept<T, Pointer>)
public
constructor Create(const TargetProc, InterceptProc: T; const AParam: Pointer = nil;
const AInterceptOptions: TInterceptOptions = DefaultInterceptOptions); override;
end;
{$ENDIF SUPPORTS_GENERICS}
type
DetourException = Exception;
implementation
const
{ Nops }
Nop9: array [0 .. 8] of Byte = ($66, $0F, $1F, $84, $00, $00, $00, $00, $00);
Nop8: array [0 .. 7] of Byte = ($0F, $1F, $84, $00, $00, $00, $00, $00);
Nop7: array [0 .. 6] of Byte = ($0F, $1F, $80, $00, $00, $00, $00);
Nop6: array [0 .. 5] of Byte = ($66, $0F, $1F, $44, $00, $00);
Nop5: array [0 .. 4] of Byte = ($0F, $1F, $44, $00, $00);
Nop4: array [0 .. 3] of Byte = ($0F, $1F, $40, $00);
Nop3: array [0 .. 2] of Byte = ($0F, $1F, $00);
Nop2: array [0 .. 1] of Byte = ($66, $90);
Nop1: array [0 .. 0] of Byte = ($90);
MultiNops: array [0 .. 8] of PByte = ( //
@Nop1, { Standard Nop }
@Nop2, { 2 Bytes Nop }
@Nop3, { 3 Bytes Nop }
@Nop4, { 4 Bytes Nop }
@Nop5, { 5 Bytes Nop }
@Nop6, { 6 Bytes Nop }
@Nop7, { 7 Bytes Nop }
@Nop8, { 8 Bytes Nop }
@Nop9 { 9 Bytes Nop }
);
{ Arithmetic operands }
arNone = $00;
arPlus = $08;
arMin = $10;
arAdd = arPlus or $01;
arSub = arMin or $01;
arInc = arPlus or $02;
arDec = arMin or $02;
{ Instructions OpCodes }
opJmpRelz = $E9;
opJmpRelb = $EB;
opJmpMem = $25FF;
opTestb = $85;
opPrfOpSize = $66;
opPrfAddrSize = $67;
opNop = $90;
{ thread constants }
THREAD_SUSPEND_RESUME = $0002;
{ Error messages }
SErrorSmallFunctionSize = 'Size of function is too small, risk to override others adjacent functions.';
SErrorInvalidJmp = 'Invalid JMP Type.';
SErrorInvalidJmp64 = 'Invalid JMP Type for x64.';
SErrorInvalidJmp32 = 'Invalid JMP Type for x32.';
SErrorInvalidDstSave = 'Invalid DstSave Address pointer.';
SErrorUnsupportedMultiNop = 'Multi Bytes Nop Instructions not supported by your CPU.';
SErrorRipDisp = 'Failed to correcr RIP Displacement.';
SErrorBigTrampoSize = 'Exceed maximum TrampoSize.';
SErrorMaxHook = 'Exceed maximum allowed of hooks.';
SErrorInvalidTargetProc = 'Invalid TargetProc Pointer.';
SErrorInvalidInterceptProc = 'Invalid InterceptProc Pointer.';
SErrorInvalidDescriptor = 'Invalid Descriptor.';
SErrorInvalidTrampoline = 'Invalid TrampoLine Pointer.';
SErrorBeginUnHook = 'BeginUnHooks must be called outside BeginHooks/EndHooks.';
SErrorRecursiveSectionUnsupported = 'Trampoline was not marked to use recursive section.';
SErrorTlsOutOfIndexes = 'Tls out of indexes.';
{ JMP Type }
JT_NONE = 0;
JT_REL8 = 1;
JT_REL16 = 2;
JT_REL32 = 3;
JT_MEM16 = 4;
JT_MEM32 = 5;
JT_MEM64 = 6;
JT_RIPZ = 7;
{$IFDEF CPUX64}
JT_MEMN = JT_MEM64;
{$ELSE !CPUX64}
JT_MEMN = JT_MEM32;
{$ENDIF CPUX64}
{ Jmp Type To Size }
JmpTypeToSize: array [0 .. 7] of Byte = ( //
0, { None }
2, { JT_REL8 = $EB + Rel8 }
4, { JT_REL16 = OpSizePrf + $E9 + Rel16 }
5, { JT_REL32 = $E9 + Rel32 }
7, { JT_MEM16 = OpSizePrf + $FF /4 + Disp32 }
6, { JT_MEM32 = $FF /4 + Disp32 }
6, { JT_MEM64 = $FF /4 + Disp32 }
14 { JT_RIPZ = $FF /4 + Disp32 + DQ }
);
SizeToJmpType: array [0 .. 4] of Byte = ( //
{$IFDEF CPUX86}
JT_REL8, { db }
JT_REL16, { dw }
JT_REL32, { dd }
JT_MEM32, { dd }
JT_MEM32 { dd }
{$ELSE !CPUX86}
JT_REL8, { db }
JT_REL32, { dw }
JT_REL32, { dd }
JT_MEM64, { dq }
JT_MEM64 { dq }
{$ENDIF CPUX86}
);
DscrSigSize = $08;
TmpSize = 32;
TrampolineSignature = $544C544C;
type
TArrayOfThreadId = array [0 .. HIGH(SmallInt) - 1] of DWORD;
PArrayOfThreadId = ^TArrayOfThreadId;
TTransactionStruct = record
Options: TTransactionOptions;
TID: DWORD;
PID: DWORD;
ThreadPriority: Integer;
SuspendedThreadCount: Integer;
SuspendedThreads: PArrayOfThreadId;
end;
PTransactionStruct = ^TTransactionStruct;
TOpenThread = function(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwThreadId: DWORD): THandle; stdcall;
TDscrSig = array [0 .. DscrSigSize - 1] of Byte;
TVirtualProtect = function(lpAddress: Pointer; dwSize: SIZE_T; flNewProtect: DWORD; var OldProtect: DWORD): BOOL; stdcall;
TVirtualAlloc = function(lpvAddress: Pointer; dwSize: SIZE_T; flAllocationType, flProtect: DWORD): Pointer; stdcall;
TVirtualQuery = function(lpAddress: Pointer; var lpBuffer: TMemoryBasicInformation; dwLength: SIZE_T): SIZE_T; stdcall;
TFlushInstructionCache = function(hProcess: THandle; const lpBaseAddress: Pointer; dwSize: SIZE_T): BOOL; stdcall;
TGetCurrentProcess = function: THandle; stdcall;
TVirtualFree = function(lpAddress: Pointer; dwSize: SIZE_T; dwFreeType: DWORD): BOOL; stdcall;
{ TEnumThreadCallBack for EnumProcessThreads }
TEnumThreadCallBack = function(ID: DWORD; Param: Pointer): Boolean;
TInternalFuncs = record
VirtualAlloc: TVirtualAlloc;
VirtualFree: TVirtualFree;
VirtualProtect: TVirtualProtect;
VirtualQuery: TVirtualQuery;
FlushInstructionCache: TFlushInstructionCache;
GetCurrentProcess: TGetCurrentProcess;
end;
TTrampoInfo = record
Addr: PByte; // Pointer to first trampoline instruction .
Size: Byte; // Stolen bytes size .
PData: PByte; // Original Stolen bytes.
end;
PTrampoInfo = ^TTrampoInfo;
TJmpMem = packed record
OpCode: WORD; // $0F$25
Disp32: Integer;
end;
PJmpMem = ^TJmpMem;
TDescriptor = packed record
Sig: TDscrSig; { Table signature. }
DscrAddr: PByte; { Pointer that hold jmp address (if Used)! }
nHook: Byte; { Number of hooks . }
Flags: Byte; { Reserved for future use! }
ExMem: PByte; { Reserved for jmp (if used) & for Trampoline ! }
OrgPtr: PByte; { Original Target Proc address. }
Trampo: PTrampoInfo; { Pointer to TrampoInfo struct. }
{ Array that hold jmp destination address. }
JmpAddrs: array [0 .. MAX_HOOKS] of PByte;
{
Mark the beginning of descriptor code executing .
==> Must be NOP .
}
CodeEntry: Byte;
{ Jmp Instruction for NextHook call and Trampoline call ! }
JmpMems: array [0 .. MAX_HOOKS] of TJmpMem;
end;
PDescriptor = ^TDescriptor;
TNextHook = packed record
ID: Byte; { Hook ID . }
PDscr: PDescriptor;
Signature: Cardinal;
threadid: TThreadId;
Param: Pointer;
TlsRecursionLevelIndex: DWORD;
InterceptOptions: TInterceptOptions;
end;
PNextHook = ^TNextHook;
TTrampoDataVt = record
vAddr: Pointer;
Addr: Pointer;
end;
PTrampoDataVt = ^TTrampoDataVt;
const
TrampoSize = SizeOf(TNextHook) + 64;
{ Descriptor Signature }
{$IFDEF CPUX64}
DscrSig: TDscrSig = ( //
$90, { NOP }
$40, { REX }
$40, { REX }
$40, { REX }
$0F, { ESCAPE TWO BYTE }
$1F, { HINT_NOP }
$F3, { PRF }
$F3 { PRF }
);
{$ELSE !CPUX64}
DscrSig: TDscrSig = ( //
$90, { NOP }
$40, { INC EAX }
$48, { DEC EAX }
$90, { NOP }
$0F, { ESCAPE TWO BYTE }
$1F, { HINT_NOP }
$F3, { PRF }
$F3 { PRF }
);
{$ENDIF CPUX64}
{$IFDEF FPC}
{$I 'TlHelp32.inc'}
{$ENDIF FPC}
var
OpenThread: TOpenThread = nil;
{$IFDEF FPC}
CreateToolhelp32Snapshot: TCreateToolhelp32Snapshot = nil;
Thread32First: TThread32First = nil;
Thread32Next: TThread32Next = nil;
{$ENDIF FPC}
hKernel: THandle;
OpenThreadExist: Boolean = False;
FreeKernel: Boolean = False;
SizeOfAlloc: DWORD = 0; // See initialization !
SysInfo: TSystemInfo;
InternalFuncs: TInternalFuncs;
{$IFDEF SUPPORTS_MONITOR}
FLock: TObject = nil;
{$ELSE !SUPPORTS_MONITOR}
FLock: TCriticalSection = nil;
{$ENDIF SUPPORTS_MONITOR }
{ ================================== Utils ================================== }
function GetUInt64Size(const Value: UInt64): Integer; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF SUPPORTS_INLINE}
begin
if UInt8(Value) = Value then
Result := 1
else if UInt16(Value) = Value then
Result := 2
else if UInt32(Value) = Value then
Result := 4
else
Result := 8;
end;
function GetInt64Size(const Value: Int64): Integer; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF SUPPORTS_INLINE}
begin
if Int8(Value) = Value then
Result := 1
else if Int16(Value) = Value then
Result := 2
else if Int32(Value) = Value then
Result := 4
else
Result := 8;
end;
procedure EnterLook(LockedObject: TObject); {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF SUPPORTS_INLINE}
begin
{$IFDEF SUPPORTS_MONITOR}
TMonitor.Enter(LockedObject);
{$ELSE !SUPPORTS_MONITOR}
TCriticalSection(LockedObject).Enter();
{$ENDIF SUPPORTS_MONITOR}
end;
procedure LeaveLook(LockedObject: TObject); {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF SUPPORTS_INLINE}
begin
{$IFDEF SUPPORTS_MONITOR}
TMonitor.Exit(LockedObject);
{$ELSE !SUPPORTS_MONITOR}
TCriticalSection(LockedObject).Leave();
{$ENDIF SUPPORTS_MONITOR}
end;
function EnumProcessThreads(PID: DWORD; CallBack: TEnumThreadCallBack; Param: Pointer): BOOL;
var
hSnap: THandle;
te: TThreadEntry32;
Next: Boolean;
begin
hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, PID);
Result := hSnap <> INVALID_HANDLE_VALUE;
if Result then
begin
te.dwSize := SizeOf(TThreadEntry32);
Next := Thread32First(hSnap, te);
while Next do
begin
if (te.th32OwnerProcessID = PID) then
begin
try
if not CallBack(te.th32ThreadID, Param) then
break;
except
end;
end;
Next := Thread32Next(hSnap, te);
end;
Result := CloseHandle(hSnap);
end;
end;
function SetMemPermission(const P: Pointer; const Size: SIZE_T; const NewProtect: DWORD): DWORD;
const
PAGE_EXECUTE_FLAGS = PAGE_EXECUTE or PAGE_EXECUTE_READ or PAGE_EXECUTE_READWRITE or PAGE_EXECUTE_WRITECOPY;
begin
Result := 0;
if Assigned(P) and (Size > 0) and (NewProtect > 0) then
begin
if InternalFuncs.VirtualProtect(P, Size, NewProtect, Result) then
if (NewProtect and PAGE_EXECUTE_FLAGS <> 0) then
{
If the protected region will be executed
=> We need to update the cpu cache !
}
InternalFuncs.FlushInstructionCache(InternalFuncs.GetCurrentProcess(), P, Size);
end;
end;
function GetDispDataSize(PInst: PInstruction): Integer;
begin
Result := 0;
if PInst^.Disp.Flags and dfUsed <> 0 then
begin
if PInst^.Archi = CPUX32 then
begin
if PInst^.Prefixes and Prf_OpSize <> 0 then
Result := ops16bits
else
Result := ops32bits;
Exit;
end
else
begin
case PInst^.OperandFlags of
opdD64:
begin
{
Defaults to O64 in PM64.
PrfOpSize results in O16.
}
if PInst^.Prefixes and Prf_OpSize <> 0 then
Result := ops16bits
else
Result := ops64bits;
end;
opdF64, opdDv64:
begin
{ The operand size is forced to a 64-bit operand size in PM64 ! }
Result := (ops64bits);
Exit;
end;
opdDf64:
begin
{
Defaults to O64 in PM64.
PrfOpSize results in O16 in AMD64.
PrfOpSize is ignored in EM64T.
}
if (CPUVendor = vAMD) and (PInst^.Prefixes and Prf_OpSize <> 0) then
Result := (ops16bits)
else
Result := (ops64bits);
Exit;
end;
else
begin
if PInst^.Rex.W then
Result := (ops64bits)
else if (PInst^.Prefixes and Prf_OpSize <> 0) then
Result := (ops16bits)
else
Result := (ops32bits);
Exit;
end;
end;
end;
end;
end;
function fDecodeInst(PInst: PInstruction): Integer;
var
IsNxtInstData: Boolean;
begin
{ Include VEX decoding if the cpu support it! }
if (VEX in CPUEncoding) then
PInst.Options := DecodeVex;
Result := DecodeInst(PInst);
{$IFDEF CPUX64}
IsNxtInstData := ((PInst^.Disp.Flags and (dfUsed or dfRip) = (dfUsed or dfRip)) and (PInst^.Disp.Value = 0));
{$ELSE !CPUX64}
IsNxtInstData := (PInst^.Disp.Value = Int64(PInst^.NextInst));
{$ENDIF CPUX64}
if IsNxtInstData then
begin
{
Check if the Next Instruction is data !
If so , That's mean it's not a valid instruction .
We must skip this data ..
otherwise , disassembling next instructions will fail !
}
Inc(Result, GetDispDataSize(PInst));
PInst^.InstSize := Result;
end;
end;
function RoundMultipleOf(const Value, MultipleOf: NativeInt): NativeInt; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF SUPPORTS_INLINE}
begin
if Value = 0 then
begin
Result := (MultipleOf);
Exit;
end;
Result := ((Value + (MultipleOf - 1)) and not(MultipleOf - 1));
end;
function AllocMemAt(const Addr: Pointer; const MemSize, flProtect: DWORD): Pointer;
var
mbi: TMemoryBasicInformation;
SysInfo: TSystemInfo;
pBase: PByte;
P: PByte;
Q: PByte;
pMax, pMin: PByte;
dwAllocGran: DWORD;
begin
{ Alloc memory on the specific nearest address from the Addr . }
Result := nil;
P := PByte(Addr);
if not Assigned(P) then
begin
Result := InternalFuncs.VirtualAlloc(nil, MemSize, MEM_RESERVE or MEM_COMMIT, flProtect);
Exit;
end;
GetSystemInfo(SysInfo);
pMin := SysInfo.lpMinimumApplicationAddress;
pMax := SysInfo.lpMaximumApplicationAddress;
dwAllocGran := SysInfo.dwAllocationGranularity;
if (NativeUInt(P) < NativeUInt(pMin)) or (NativeUInt(P) > NativeUInt(pMax)) then
Exit;
if InternalFuncs.VirtualQuery(P, mbi, SizeOf(mbi)) = 0 then
Exit;
pBase := mbi.BaseAddress;
Q := pBase;
while NativeUInt(Q) < NativeUInt(pMax) do
begin
if InternalFuncs.VirtualQuery(Q, mbi, SizeOf(mbi)) = 0 then
Exit;
if (mbi.State = MEM_FREE) and (mbi.RegionSize >= dwAllocGran) and (mbi.RegionSize >= MemSize) then
begin
{ The address (P) must be multiple of the allocation granularity (dwAllocationGranularity) . }
P := PByte(RoundMultipleOf(NativeInt(Q), dwAllocGran));
Result := InternalFuncs.VirtualAlloc(P, MemSize, MEM_RESERVE or MEM_COMMIT, flProtect);
if Assigned(Result) then
Exit;
end;
Inc(Q, mbi.RegionSize); // Next Region .
end;
{
If thre is no memory available in the range [Addr - pMax]
try to allocate at the range [pMin - Addr]
}
Q := pBase;
while NativeUInt(Q) > NativeUInt(pMin) do
begin
if InternalFuncs.VirtualQuery(Q, mbi, SizeOf(mbi)) = 0 then
Exit;
if (mbi.State = MEM_FREE) and (mbi.RegionSize >= dwAllocGran) and (mbi.RegionSize >= MemSize) then
begin
P := PByte(RoundMultipleOf(NativeInt(Q), dwAllocGran));
Result := InternalFuncs.VirtualAlloc(P, MemSize, MEM_RESERVE or MEM_COMMIT, flProtect);
if Assigned(Result) then
Exit;
end;
Dec(Q, mbi.RegionSize); // Previous Region.
end;
end;
function TryAllocMemAt(const Addr: Pointer; const MemSize, flProtect: DWORD): Pointer;
var
MEM_64: DWORD;
begin
MEM_64 := 0;
Result := AllocMemAt(Addr, MemSize, flProtect);
if not Assigned(Result) then
begin
{$IFDEF CPUX64}
{ Allocates memory at the highest possible address }
if (UInt64(Addr) and $FFFFFFFF00000000 <> 0) then
MEM_64 := MEM_TOP_DOWN;
{$ENDIF CPUX64}
Result := InternalFuncs.VirtualAlloc(nil, MemSize, MEM_RESERVE or MEM_COMMIT or MEM_64, flProtect);
end;
end;
function InsertJmp(Src, Dst: PByte; JmpType: Integer; const DstSave: PByte = nil): Integer;
var
Offset: NativeInt;
JmpSize: Integer;
begin
Result := 1;
JmpSize := JmpTypeToSize[JmpType];
Offset := NativeInt(NativeInt(Dst) - NativeInt(Src)) - JmpSize;
case JmpType of
JT_NONE:
begin
raise InterceptException.Create(SErrorInvalidJmp);
end;
JT_REL8:
begin
PByte(Src)^ := opJmpRelb;
Inc(Src);
PInt8(Src)^ := Int8(Offset);
end;
JT_REL16:
begin
{$IFDEF CPUX64}
{
JMP Rel16
==> Not supported on x64!
}
raise InterceptException.Create(SErrorInvalidJmp64);
{$ENDIF CPUX64}
PByte(Src)^ := opPrfOpSize;
Inc(Src);
PByte(Src)^ := opJmpRelz;
Inc(Src);
PInt16(Src)^ := Int16(Offset);
end;
JT_REL32:
begin
PByte(Src)^ := opJmpRelz;
Inc(Src);
PInt32(Src)^ := Offset;
end;
JT_MEM16:
begin
{$IFDEF CPUX64}
{
JMP WORD [012345]
==> Not supported on x64!
}
raise InterceptException.Create(SErrorInvalidJmp64);
{$ENDIF CPUX64}
if not Assigned(DstSave) then
raise InterceptException.Create(SErrorInvalidDstSave);
PByte(Src)^ := opPrfOpSize;
Inc(Src);
PWord(Src)^ := opJmpMem;
Inc(Src, 2);
PUInt32(Src)^ := UInt32(DstSave);
PUInt16(DstSave)^ := UInt16(Dst);
end;
JT_MEM32:
begin
{$IFDEF CPUX64}
{
JMP DWORD [012345]
==> Not supported on x64!
}
raise InterceptException.Create(SErrorInvalidJmp64);
{$ENDIF CPUX64}
if not Assigned(DstSave) then
raise InterceptException.Create(SErrorInvalidDstSave);
PWord(Src)^ := opJmpMem;
Inc(Src, 2);
PUInt32(Src)^ := UInt32(DstSave);
PUInt32(DstSave)^ := UInt32(Dst);
end;
JT_MEM64:
begin
{$IFDEF CPUX86}
{
JMP QWORD [0123456789]
==> Not supported on x32!
}
raise InterceptException.Create(SErrorInvalidJmp32);
{$ENDIF CPUX86}
if not Assigned(DstSave) then
raise InterceptException.Create(SErrorInvalidDstSave);
{ RIP Disp ! }
PUInt64(DstSave)^ := UInt64(Dst);
Offset := NativeInt(NativeInt(DstSave) - NativeInt(Src)) - JmpSize;
PWord(Src)^ := opJmpMem;
Inc(Src, 2);
PInt32(Src)^ := Offset;
end;
JT_RIPZ:
begin
{$IFDEF CPUX86}
raise InterceptException.Create(SErrorInvalidJmp32);
{$ENDIF CPUX86}
{
This is the most harder way to insert a jump !
Why ?
because we are going to mix code & data !
Thats mean when disassembling instructions after
this branch .. you will have a corrupted dissambled
structure !
The only way to detect this kind of jmp is:
to use fDecodeInst rather than DecodeInst routine .
==> We should avoid using this kind of jmp
in the original target proc .
==> It's Ok to use in others situation .
}
PWord(Src)^ := opJmpMem;
Inc(Src, 2);
PInt32(Src)^ := $00;
Inc(Src, 4);
PUInt64(Src)^ := UInt64(Dst);
end;
end;
end;
function GetJmpType(Src, Dst, DstSave: PByte): Integer;
var
Offset: NativeInt;
OffsetSize: Integer;
begin
Offset := NativeInt(NativeInt(Src) - NativeInt(Dst));
OffsetSize := GetInt64Size(Offset);
Result := SizeToJmpType[OffsetSize shr 1];
{$IFDEF CPUX64}
if Result = JT_MEM64 then
begin
if not Assigned(DstSave) then
raise InterceptException.Create(SErrorInvalidDstSave);
Offset := NativeInt(NativeInt(DstSave) - NativeInt(Src)) - 7;
if Integer(Offset) <> Offset then
begin
Result := (JT_RIPZ);
Exit;
end;
end;
{$ENDIF CPUX64}
end;
function IsMultiBytesNop(P: Pointer; Size: Integer): Boolean;
var
i: Integer;
begin
Result := False;
if Size > 0 then
begin
while (Size > 0) do
begin
for i := Length(MultiNops) downto 1 do
begin
if Size >= i then
begin
Result := CompareMem(MultiNops[i - 1], P, i);
if Result then
begin
Inc(PByte(P), i);
Dec(Size, i);
break;
end;
end;
end;
if not Result then
Exit;
end;
Result := True;
end;
end;
procedure FillMultiNop(var Buffer; Size: Integer);
var
i: Integer;
P: PByte;
begin
{ Multi Bytes Nop Instruction is fast to execute compared to
the traditional NOP instruction.
However it's not supported by all CPU !
==> Use FillNop(P,Size,True).
==> CPUID implements a routine to detect
if the CPU supports Multi Bytes Nop .
}
if not(iMultiNop in CPUInsts) then
raise InterceptException.Create(SErrorUnsupportedMultiNop);
P := PByte(@Buffer);
for i := Length(MultiNops) downto 1 do
begin
while Size >= i do
begin
Move(MultiNops[i - 1]^, P^, i);
Dec(Size, i);
Inc(P, i);
end;
if Size = 0 then
Exit;
end;
end;
function IsNop(P: PByte; Size: Integer): Boolean;
var
i: Integer;
begin
{ Return True if the first instructions are nop/multi nop. }
Result := False;
if iMultiNop in CPUInsts then
Result := IsMultiBytesNop(P, Size)
else
for i := 0 to Size - 1 do
begin
Result := (P^ = opNop);
if not Result then
Exit;
Inc(P); // Next Byte.
end;
end;
procedure FillNop(var P; Size: Integer; MultipleNop: Boolean);
begin
if MultipleNop and (iMultiNop in CPUInsts) then
FillMultiNop(P, Size)
else
FillChar(P, Size, opNop);
end;
function GetPrefixesCount(Prefixes: WORD): Byte;
var
Prf: WORD;
i: Byte;
begin
{ Get prefixes count used by the instruction. }
Result := 0;
if Prefixes = 0 then
Exit;
Prf := 0;
i := 0;
Prefixes := Prefixes and not Prf_VEX;
while Prf < $8000 do
begin
Prf := (1 shl i);
if (Prf and Prefixes = Prf) then
Inc(Result);
Inc(i);
end;
end;
function GetInstOpCodes(PInst: PInstruction; P: PByte): ShortInt;
var
nPrfs: Byte;
begin
{
Return opcodes length
Instruction OpCodes in arg P .
}
Result := 0;
FillChar(P^, MAX_INST_LENGTH_N, $90);
nPrfs := GetPrefixesCount(PInst^.Prefixes);
Inc(Result, nPrfs);
case PInst^.OpTable of
tbTwoByte:
if PInst^.Prefixes and Prf_VEX3 = 0 then
Inc(Result); // $0F
tbThreeByte:
begin
if PInst^.Prefixes and Prf_VEX3 = 0 then
Inc(Result, 2); // 0F + 38|3A !
end;
tbFPU:
Inc(Result, 2); // [$D8..$D9] + ModRm !
end;
if PInst^.Prefixes and Prf_Vex2 <> 0 then
Inc(Result); // VEX.P0
if PInst^.Prefixes and Prf_VEX3 <> 0 then
Inc(Result, 2); // VEX.P0 + VEX.P1
if PInst^.OpKind = kGrp then
Inc(Result, 2) // Group + ModRm
else
Inc(Result); // OpCode
if Assigned(P) then
Move(PInst^.Addr^, P^, Result);
end;
function GetJccOpCode(PInst: PInstruction; RelSize: Integer): DWORD;
var
OpCode: Byte;
Opcodes: array [0 .. 3] of Byte;
begin
FillChar(PByte(@Opcodes[0])^, 4, #00);
OpCode := PInst^.OpCode and $F;
case RelSize of
ops8bits:
begin
Opcodes[0] := $70 or OpCode;
end;
ops16bits:
begin
Opcodes[0] := opPrfOpSize;
Opcodes[1] := $0F;
Opcodes[2] := $80 or OpCode;
end;
ops32bits:
begin
Opcodes[0] := $0F;
Opcodes[1] := $80 or OpCode;
end;
end;
Result := PDWORD(@Opcodes[0])^;
end;
function CorrectJ(PInst: PInstruction; NewAddr: PByte): Integer;
const
{ Convert LOOP instruction to relative word jcc ! }
LOOP_To_JccZ: array [0 .. 3] of WORD = ($850F, $840F, $840F, $9090);
{ Convert LOOP instruction to relative byte jcc ! }
LOOP_To_JccB: array [0 .. 3] of Byte = ($75, $74, $75, $90);
var
Offset: Int64;
POpc: PByte;
NOpc: DWORD;
PQ: PByte;
Relsz: Integer;
JmpType: Integer;
JmpSize: Integer;
begin
PQ := NewAddr;
JmpSize := 0;
GetMem(POpc, MAX_INST_LENGTH_N + 1);
try
// Opcsz := GetInstOpCodes(PInst, POpc);
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(PQ) - 6);
Relsz := GetInt64Size(Offset);
{$IFDEF CPUX64}
if Relsz = ops16bits then
Relsz := ops32bits;
{$ENDIF CPUX64}
if PInst^.OpType and otJcc = 0 then
begin
{ Not Jcc ! }
if PInst^.OpCode in [$E0 .. $E2] then
begin
{ LOOPNE/LOOPZ/LOOP }
if Relsz = ops8bits then
begin
if PInst^.Prefixes and Prf_AddrSize <> 0 then
begin
PQ^ := opPrfAddrSize;
Inc(PQ);
end;
PQ^ := PInst^.OpCode;
Inc(PQ);
PQ^ := Int8(Offset);
Inc(PQ);
end
else
case PInst^.AddrMode of
am16:
begin
{ Dec CX ! }
{$IFDEF CPUX64}
{ . $49 result in REX
==> Use $FF group !
}
PQ^ := opPrfOpSize;
Inc(PQ);
PQ^ := $FF;
Inc(PQ);
PQ^ := $C9;
Inc(PQ);
{$ELSE !CPUX64}
PQ^ := opPrfOpSize;
Inc(PQ);
PQ^ := $49;
Inc(PQ);
{$ENDIF CPUX64}
end;
am32:
begin
{ Dec ECX ! }
{$IFDEF CPUX64}
PQ^ := $FF;
Inc(PQ);
PQ^ := $C9;
Inc(PQ);
{$ELSE !CPUX64}
PQ^ := $49;
Inc(PQ);
{$ENDIF CPUX64}
end;
am64:
begin
{ Dec RCX ! }
PQ^ := $48; // REX.W = True !
Inc(PQ);
PQ^ := $FF;
Inc(PQ);
PQ^ := $C9;
Inc(PQ);
end;
end;
case Relsz of
ops16bits:
begin
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(PQ) - 5);
PQ^ := opPrfOpSize;
Inc(PQ);
PWord(PQ)^ := LOOP_To_JccZ[PInst^.OpCode and 3];
Inc(PQ, 2);
PInt16(PQ)^ := Int16(Offset);
Inc(PQ, 2);
end;
ops32bits:
begin
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(PQ) - 6);
PWord(PQ)^ := LOOP_To_JccZ[PInst^.OpCode and 3];
Inc(PQ, 2);
PInt32(PQ)^ := Int32(Offset);
Inc(PQ, 4);
end;
ops64bits:
begin
{
Dec RCX
Jcc @Tmp
Jmp @NextInst
@Tmp:
Jmp @LoopDst
}
{ Insert Jcc ! }
PQ^ := LOOP_To_JccB[PInst^.OpCode and 3];
Inc(PQ);
PQ^ := 2;
Inc(PQ);
{ Insert Jmp NextInst }
PQ^ := opJmpRelb;
Inc(PQ);
PQ^ := 14;
Inc(PQ);
{ Insert Jmp @LoopDst }
InsertJmp(PQ, PInst.Branch.Target, JT_RIPZ);
Inc(PQ, 14);
end;
end;
end
else if PInst^.OpCode = $E3 then
begin
{ JCXZ/JECX/JRCX }
if Relsz = ops8bits then
begin
if PInst^.Prefixes and Prf_AddrSize <> 0 then
begin
PQ^ := opPrfAddrSize;
Inc(PQ);
end;
PQ^ := PInst^.OpCode;
Inc(PQ);
PQ^ := Int8(Offset);
Inc(PQ);
end
else
case PInst^.AddrMode of
am16:
begin
{ TEST CX,CX }
PQ^ := opPrfOpSize;
Inc(PQ);
PQ^ := opTestb;
Inc(PQ);
PQ^ := $C9; // ModRm [Mod = 3; Reg = Rm = CX = 1]
Inc(PQ);
end;
am32:
begin
{ TEST ECX,ECX }
PQ^ := opTestb;
Inc(PQ);
PQ^ := $C9;
Inc(PQ);
end;
am64:
begin
{ TEST RCX,RCX }
PQ^ := $48; // REX.W = True !
Inc(PQ);
PQ^ := opTestb;
Inc(PQ);
PQ^ := $C9;
Inc(PQ);
end;
end;
case Relsz of
ops16bits:
begin
{
TEST CX,CX
JZ @Dst
}
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(PQ) - 5);
PQ^ := opPrfOpSize;
Inc(PQ);
PQ^ := $0F;
Inc(PQ);
PQ^ := $84; // JZ !
Inc(PQ);
PInt16(PQ)^ := Int16(Offset);
Inc(PQ, 2);
end;
ops32bits:
begin
{
TEST ECX,ECX
JZ @Dst
}
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(PQ) - 6);
PQ^ := $0F;
Inc(PQ);
PQ^ := $84; // JZ !
Inc(PQ);
PInt32(PQ)^ := Int32(Offset);
Inc(PQ, 4);
end;
ops64bits:
begin
{
TEST RCX,RCX
JZ @Tmp
Jmp @NextInst
@Tmp:
Jmp @Dst
}
{ Insert JZ ! }
PQ^ := $74;
Inc(PQ);
PQ^ := 2;
Inc(PQ);
{ Insert Jmp NextInst }
PQ^ := opJmpRelb;
Inc(PQ);
PQ^ := 14;
Inc(PQ);
{ Insert Jmp @Dst }
InsertJmp(PQ, PInst.Branch.Target, JT_RIPZ);
Inc(PQ, 14);
end;
end;
end;
end
else
begin
{ Jcc ! }
NOpc := GetJccOpCode(PInst, Relsz);
case Relsz of
ops8bits:
begin
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(PQ) - 2);
PInt8(PQ)^ := UInt8(NOpc);
Inc(PQ);
PInt8(PQ)^ := Int8(Offset);
Inc(PQ);
end;
ops16bits:
begin
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(PQ) - 5);
PUInt32(PQ)^ := UInt32(NOpc);
Inc(PQ, 3);
PInt16(PQ)^ := Int16(Offset);
Inc(PQ, 2);
end;
ops32bits:
begin
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(PQ) - 6);
PUInt16(PQ)^ := UInt16(NOpc);
Inc(PQ, 2);
PInt32(PQ)^ := Int32(Offset);
Inc(PQ, 4);
end;
ops64bits:
begin
{
Unfortunately there is no Jcc Rel 64bits !
===>Original implementation<===
test eax,eax
jz @DstAddr
===>New implementation<===
test eax,eax
Q: jz @tmp
Q+2: jmp @NextInst
Q+4: @tmp:
Q+4: jmp @DstAddr
Q+4+jmpsize: [DstAddr]
@NextInstruction:
}
{ jz @tmp is guaranteed to be 2 Bytes in length ! }
{ Trampo.NextInstruction = Q + 4 + jmp @DstAddr Size }
PQ^ := PInst^.OpCode;
Inc(PQ);
PQ^ := 2;
Inc(PQ);
JmpType := GetJmpType(PByte(NativeInt(NewAddr) + 4), PInst^.Branch.Target, PByte(NativeInt(NewAddr) + 4 + 6));
JmpSize := JmpTypeToSize[JmpSize];
if JmpType > JT_REL32 then
Inc(JmpSize, SizeOf(Pointer));
{ Jmp To Next Valid Instruction ! }
PQ^ := opJmpRelb;
Inc(PQ);
PQ^ := JmpSize;
Inc(PQ);
InsertJmp(PByte(NativeInt(NewAddr) + 4), PInst^.Branch.Target, JmpType, PByte(NativeInt(NewAddr) + 4 + 6));
Inc(PQ, JmpSize);
end;
end;
end;
finally
FreeMem(POpc);
end;
Result := Integer(NativeInt(PQ) - NativeInt(NewAddr));
if Result = 00 then
begin
Move(PInst^.Addr^, NewAddr^, PInst^.InstSize);
Result := PInst^.InstSize;
end;
end;
function MakeModRm(iMod, Reg, Rm: Byte): Byte; {$IFDEF MustInline}inline; {$ENDIF}
begin
Result := (iMod shl 6) or (Reg shl 3) or (Rm);
end;
function CorrectRipDisp(PInst: PInstruction; NewAddr: PByte): Integer;
var
Offset: Int64;
P: PByte;
rReg: Byte;
POpc: PByte;
pMR: PByte;
pFrst: PByte;
L: ShortInt;
begin
pFrst := NewAddr;
P := PInst^.NextInst;
{
If AddressMode is 32-bits :
===> EIP + Disp32 !
else
If AddressMode is 64-bits:
===> RIP + Disp32 !
}
if PInst^.AddrMode = am32 then
P := PByte(UInt64(P) and $FFFFFFFF);
P := PByte(Int64(P) + Int64(PInst^.Disp.Value));
Offset := Int64(Int64(P) - Int64(NewAddr) - PInst^.InstSize);
if Int32(Offset) <> Offset then
begin
rReg := rEAX;
if PInst^.ModRm.Flags and mfUsed <> 0 then
begin
Assert(PInst^.Disp.Flags and dfRip <> 0);
if PInst^.ModRm.Reg = rReg then
rReg := rECX;
{ PUSH UsedReg }
PByte(NewAddr)^ := $50 + (rReg and $7);
Inc(NewAddr);
{$IFDEF CPUX64}
PByte(NewAddr)^ := $48; // REX.W!
Inc(NewAddr);
{$ENDIF CPUX64}
{ MOV REG,Imm(NativeInt) }
PByte(NewAddr)^ := $B8 + (rReg and $7);
Inc(NewAddr);
PNativeInt(NewAddr)^ := NativeInt(P);
Inc(NewAddr, SizeOf(NativeInt));
{ Set the original instruction opcodes }
POpc := GetMemory(MAX_INST_LENGTH_N);
L := GetInstOpCodes(PInst, POpc);
Move(POpc^, NewAddr^, L);
Inc(NewAddr, L);
pMR := NewAddr;
if (PInst^.OpKind and kGrp <> 0) or (PInst^.OpTable = tbFPU) then
Dec(pMR);
PByte(pMR)^ := MakeModRm($00, PInst^.ModRm.Reg, rReg);
Inc(pMR);
NewAddr := pMR;
{ POP UsedReg }
PByte(NewAddr)^ := $58 + (rReg and $7);
Inc(NewAddr);
FreeMemory(POpc);
Result := (NativeInt(NewAddr) - NativeInt(pFrst));
Exit;
end
else
raise InterceptException.Create(SErrorRipDisp);
end;
Move(PInst^.Addr^, NewAddr^, PInst^.InstSize);
Inc(NewAddr, PInst^.InstSize);
PInt32(NativeInt(NewAddr) - SizeOf(Int32))^ := Int32(Offset);
Result := PInst^.InstSize;
end;
function CorrectJmpRel(PInst: PInstruction; NewAddr: PByte): Integer;
var
JmpType: Byte;
begin
JmpType := GetJmpType(NewAddr, PInst^.Branch.Target, PByte(NativeInt(NewAddr) + 6));
InsertJmp(NewAddr, PInst^.Branch.Target, JmpType, PByte(NativeInt(NewAddr) + 6));
Result := JmpTypeToSize[JmpType];
end;
function CorrectCallRel(PInst: PInstruction; NewAddr: PByte): Integer;
var
Offset: Int64;
Relsz: Byte;
P: PByte;
begin
P := NewAddr;
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(P) - 6);
Relsz := GetInt64Size(Offset);
{$IFDEF CPUX64}
{ Only 32-bits relative offset is supported on x64! }
if Relsz < ops32bits then
Relsz := ops32bits;
{$ELSE !CPUX64}
{ Only 16/32-bits relative offset is supported on x32! }
if Relsz < ops16bits then
Relsz := ops32bits;
{$ENDIF CPUX64}
case Relsz of
ops16bits:
begin
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(P) - 4);
P^ := opPrfOpSize;
Inc(P);
P^ := $E8;
Inc(P);
PInt16(P)^ := Int16(Offset);
Inc(P, 2);
end;
ops32bits:
begin
Offset := Int64(Int64(PInst^.Branch.Target) - Int64(P) - 5);
P^ := $E8;
Inc(P);
PInt32(P)^ := Int32(Offset);
Inc(P, 4);
end;
ops64bits:
begin
{
64-bits Relative offset is not supported
==> Map to a new opcode !
}
{
CALL [02]
Jmp @NextValidInstruction
dq : Call dst address !
@NextValidInstruction:
}
P^ := $FF; // Group 5 !
Inc(P);
{
ModRm.Mod = 00
ModRm.Reg = 02
ModRm.Rm = 05
==> ModRm = $15 !
}
P^ := MakeModRm($00, $02, $05);
Inc(P);
P^ := 2;
Inc(P, 4);
{ Jmp Next Instruction ! }
P^ := opJmpRelb;
Inc(P);
P^ := $08;
Inc(P);
PUInt64(P)^ := UInt64(PInst^.Branch.Target);
Inc(P, SizeOf(UInt64));
end;
end;
Result := NativeInt(P) - NativeInt(NewAddr);
if Result = 0 then
begin
Move(PInst^.Addr^, P^, PInst^.InstSize);
Result := PInst^.InstSize;
end;
end;
function MapInsts(Addr, NewAddr: PByte; Size: Integer): Integer;
var
P, Q: PByte;
PInst: PInstruction;
sz, iz, nz: Integer;
begin
{ Map Data from Addr to NewAddr ! }
{ This function will fix Relative offset & RIP displacement . }
Result := 0;
sz := 0;
P := Addr;
Q := NewAddr;
PInst := GetMemory(SizeOf(TInstruction));
FillChar(PInst^, SizeOf(TInstruction), #0);
PInst^.Archi := CPUX;
PInst^.NextInst := P;
PInst^.VirtualAddr := nil;
while sz < Size do
begin
PInst^.Addr := PInst^.NextInst;
iz := fDecodeInst(PInst);
nz := iz;
if PInst^.Disp.Flags and (dfUsed or dfRip) = (dfUsed or dfRip) then
nz := CorrectRipDisp(PInst, Q)
else if (PInst^.Branch.Falgs and bfRel = bfRel) then
begin
{ Instruction use relative offset }
if (PInst^.OpType = otJMP) then
nz := CorrectJmpRel(PInst, Q)
else if (PInst^.OpType = otCALL) then
nz := CorrectCallRel(PInst, Q)
else
nz := CorrectJ(PInst, Q)
end
else
Move(PInst^.Addr^, Q^, nz);
Inc(Q, nz);
Inc(Result, nz);
Inc(sz, iz);
end;
FreeMemory(PInst);
end;
{$IFNDEF FPC}
{$WARN COMPARISON_TRUE OFF}
{$ENDIF FPC}
function GetInstArithmeticType(PInst: PInstruction): Integer;
function IsInstAdd(PInst: PInstruction): Boolean;
begin
Result := False;
if PInst^.OpTable = tbOneByte then
begin
if (PInst^.OpCode >= $00) and (PInst^.OpCode < $06) then
begin
Result := (True);
Exit;
end;
end;
if (PInst^.OpKind = kGrp) and (PInst^.ModRm.Reg = $00) then
begin
if (PInst^.OpCode > $7F) and (PInst^.OpCode < $84) then
begin
Result := (True);
Exit;
end;
end;
end;
function IsInstSub(PInst: PInstruction): Boolean;
begin
Result := False;
if PInst^.OpTable = tbOneByte then
begin
if (PInst^.OpCode > $27) and (PInst^.OpCode < $2E) then
begin
Result := (True);
Exit;
end;
end;
if (PInst^.OpKind = kGrp) and (PInst^.ModRm.Reg = $05) then
begin
if (PInst^.OpCode > $7F) and (PInst^.OpCode < $84) then
begin
Result := (True);
Exit;
end;
end;
end;
function IsInstInc(PInst: PInstruction): Boolean;
begin
Result := False;
if (PInst^.Archi = CPUX32) and (PInst^.OpTable = tbOneByte) then
begin
if (PInst^.OpCode >= $40) and (PInst^.OpCode <= $47) then
begin
Result := (True);
Exit;
end;
end;
if (PInst^.OpKind = kGrp) and (PInst^.ModRm.Reg = $00) then
begin
if (PInst^.OpCode = $FE) or (PInst^.OpCode = $FF) then
begin
Result := (True);
Exit;
end;
end;
end;
function IsInstDec(PInst: PInstruction): Boolean;
begin
Result := False;
if (PInst^.Archi = CPUX32) and (PInst^.OpTable = tbOneByte) then
begin
if (PInst^.OpCode >= $48) and (PInst^.OpCode <= $4F) then
begin
Result := (True);
Exit;
end;
end;
if (PInst^.OpKind = kGrp) and (PInst^.ModRm.Reg = $01) then
begin
if (PInst^.OpCode = $FE) or (PInst^.OpCode = $FF) then
begin
Result := (True);
Exit;
end;
end;
end;
begin
{ Return Instruction Arithmetic (+ or - or ..) }
Result := arNone;
if IsInstAdd(PInst) or IsInstInc(PInst) then
Result := (arAdd)
else if IsInstSub(PInst) or IsInstDec(PInst) then
Result := (arSub);
end;
{$IFNDEF FPC}
{$WARN COMPARISON_TRUE ON}
{$ENDIF FPC}
function EvalArith(Arith: Integer; Value: NativeInt; Offset: NativeInt): NativeInt;
begin
Result := Value;
case Arith of
arAdd:
Inc(Result, Offset);
arInc:
Inc(Result);
arSub:
Dec(Result, Offset);
arDec:
Dec(Result);
end;
end;
{$HINTS OFF}
function InterfaceToObj(const AIntf): TObject;
const
{
Delphi insert QueryInterface,_AddRef,_Release methods
as the last functions in the code entry.
=> We must skip them to point to the first function declared in the interface.
}
Offset = SizeOf(Pointer) * 3;
{$IFDEF CPUX64}
ObjReg = rECX;
{$ELSE !CPUX64}
ObjReg = rEAX;
{$ENDIF CPUX64}
var
Pvt, PCode: PByte;
Inst: TInstruction;
PObj: PByte;
imm: Int64;
Arith: Integer;
Skip: Boolean;
sReg: ShortInt;
begin
if not Assigned(@AIntf) then
begin
Result := nil;
Exit;
end;
sReg := -1;
PObj := PByte(AIntf);
FillChar(Inst, SizeOf(TInstruction), #00);
Inst.Archi := CPUX;
Pvt := PPointer(AIntf)^; // vTable !
PCode := PPointer(NativeInt(Pvt) + Offset)^; // Code Entry !
Inst.NextInst := PCode;
{
At the top of code entry delphi will generate :
int 3
add/sub eax/rcx,offset <===
jmp FirstFunction
}
while True do
begin
Inst.imm.Value := 0;
Inst.Addr := Inst.NextInst;
fDecodeInst(@Inst);
{ Keep looping until JMP/RET ! }
if (Inst.Branch.Falgs and bfUsed <> 0) or (Inst.OpType = otRET) then
break;
Arith := GetInstArithmeticType(@Inst);
Skip := (Arith = arNone);
if not Skip then
begin
{$IFDEF CPUX86}
if Inst.ModRm.iMod <> $03 then
begin
{
====> stdcall ! <====
If the method (declared in interface)
calling convention is stdcall,
Delphi will generate :
add/sub [esp+offset],imm !
}
if Inst.Sib.Flags and sfUsed <> 0 then
sReg := Inst.Sib.Index
else
sReg := Inst.ModRm.Rm;
Skip := not(sReg = rESP);
end
else
{$ENDIF CPUX86}
begin
if (Inst.ModRm.Flags and mfUsed <> 0) then
Skip := not((Inst.ModRm.iMod = $03) and (Inst.ModRm.Rm = ObjReg))
else if Arith in [arInc, arDec] then
{ Is Inc/Dec EAX/RCX ? }
Skip := (Inst.OpCode and $07 <> ObjReg);
end;
end;
if not Skip then
begin
imm := Inst.imm.Value;
PObj := PByte(EvalArith(Arith, NativeInt(PObj), imm));
end;
end;
Result := TObject(PObj);
end;
{$HINTS ON}
function GetInterfaceMethodPtrByIndex(const PInterface; MethodIndex: Integer): PByte;
var
Pvt: PPointer;
P: PPointer;
PDst: PByte;
Inst: TInstruction;
i: Integer;
begin
{
Return original method ptr
=> Return first instruction that was
implemented on Interface object !
}
FillChar(Inst, SizeOf(TInstruction), #00);
Inst.Archi := CPUX;
Pvt := PPointer(PInterface)^; // Virtual Table !
P := Pvt;
Inc(P, MethodIndex);
P := PPointer(P)^;
PDst := PByte(P);
Inst.NextInst := PByte(P);
for i := 0 to 3 do
begin
Inst.Addr := Inst.NextInst;
fDecodeInst(@Inst);
if Assigned(Inst.Branch.Target) then
begin
PDst := Inst.Branch.Target;
break;
end;
end;
Result := PDst;
end;
{$IFDEF SUPPORTS_RTTI}
function GetMethodPtrFromObjByName(Obj: TObject; const MethodName: String): Pointer;
var
LCtx: TRttiContext;
LType: TRttiType;
LMethods: TArray<TRttiMethod>;
LMethod: TRttiMethod;
begin
Result := nil;
if (not Assigned(Obj)) or (MethodName = EmptyStr) then
Exit;
LCtx := TRttiContext.Create;
LType := LCtx.GetType(Obj.ClassType);
LMethods := LType.GetMethods;
for LMethod in LMethods do
begin
if SameText(LMethod.Name, MethodName) then
begin
Result := LMethod.CodeAddress;
Exit;
end;
end;
end;
function GetInterfaceMethodPtrByName(const PInterface; const MethodName: String): PByte;
var
Obj: TObject;
begin
Result := nil;
if (not Assigned(@PInterface)) or (MethodName = EmptyStr) then
Exit;
Obj := InterfaceToObj(PInterface);
if Assigned(Obj) then
begin
Result := GetMethodPtrFromObjByName(Obj, MethodName);
end;
end;
{$ENDIF SUPPORTS_RTTI}
function GetRoot(P: PByte): PByte;
var
Inst: TInstruction;
begin
Result := P;
FillChar(Inst, SizeOf(TInstruction), #00);
Inst.Addr := P;
Inst.Archi := CPUX;
Inst.VirtualAddr := nil;
{
While the opcode is jmp and the jmp destination
address is known get the next jmp .
}
fDecodeInst(@Inst);
if (Inst.OpType = otJMP) and (Assigned(Inst.Branch.Target)) then
Result := GetRoot(Inst.Branch.Target);
end;
function IsValidDescriptor(P: PByte): Boolean;
begin
Result := CompareMem(P, PByte(@DscrSig[0]), SizeOf(DscrSig));
end;
function GetDescriptor(P: PByte): PDescriptor;
var
Inst: TInstruction;
function IsDscrpInst(PInst: PInstruction): Boolean;
begin
Result := Assigned(PInst.Branch.Target) or IsNop(PInst.Addr, 6);
end;
begin
Result := nil;
FillChar(Inst, SizeOf(TInstruction), #00);
Inst.Archi := CPUX;
Inst.VirtualAddr := nil;
{ Find last JMP ! }
P := GetRoot(P);
Inst.Addr := P;
fDecodeInst(@Inst);
{ The first instruction must be NOP ! }
if Inst.OpCode = opNop then
begin
Inst.Addr := Inst.NextInst;
fDecodeInst(@Inst);
if IsDscrpInst(@Inst) then
begin
Inc(P); // Skip CodeEntry !
Inc(P, SizeOf(TJmpMem) * (MAX_HOOKS + 1)); // Skip JmpMems !
{ Go to the Top ! }
Dec(P, SizeOf(TDescriptor));
if IsValidDescriptor(P) then
Result := PDescriptor(P);
end;
end;
end;
function CreateNewDescriptor(): PDescriptor;
begin
{ Create a new descriptor tables ! }
Result := AllocMem(SizeOf(TDescriptor));
FillNop(Result^, SizeOf(TDescriptor), False);
FillNop(Result^.JmpMems[0], SizeOf(TJmpMem) * (MAX_HOOKS + 1), True);
{ A valid descriptor have a valid signature . }
CopyMemory(Result, PByte(@DscrSig[0]), DscrSigSize);
Result^.nHook := 0;
Result^.Flags := 0;
Result^.ExMem := nil;
end;
procedure InsertDescriptor(PAt: PByte; PDscr: PDescriptor);
const
{ JMP from Target to Code Entry }
kJmpCE = 1;
{ JMP from Target to Temporal address than JMP to Code Entry }
kJmpTmpJmpCE = 2;
{ JMP from Target to Temporal address than JMP (Rip Zero) to Code Entry }
kJmpTmpJmpRipZCE = 3;
{ JMP (Rip Zero) from Target to Code Entry }
kJmpRipZCE = 4;
var
fJmpType: Byte; { First JMP }
{$IFDEF CPUX64}
sJmpType: Byte; { Second JMP (if used !) }
Tmp: PByte;
{$ENDIF CPUX64}
JmpKind: Byte;
P, T: PByte;
JmpSize: Byte;
Inst: TInstruction;
Sb: Byte;
OrgAccess: DWORD;
Tsz: Integer;
PExMem: PByte;
LPExMem: PByte;
begin
Sb := 0;
P := PAt;
PDscr^.OrgPtr := P;
fJmpType := GetJmpType(P, @PDscr^.CodeEntry, @PDscr^.DscrAddr);
{$IFDEF CPUX64}
Tmp := nil;
PExMem := TryAllocMemAt(P, SizeOfAlloc, PAGE_EXECUTE_READWRITE);
LPExMem := PExMem;
sJmpType := JT_NONE;
JmpKind := kJmpRipZCE;
{ Try to find the perfect jump instruction ! }
{
That's mean that we try to avoid using tJmpRelN on TargetProc .
==> Because it use more than 6 bytes in length .
}
if JmpTypeToSize[fJmpType] > 6 then
begin
Tmp := PExMem;
Inc(PExMem, TmpSize);
if Assigned(Tmp) then
begin
JmpKind := kJmpRipZCE;
fJmpType := GetJmpType(P, Tmp, Tmp + 6);
if JmpTypeToSize[fJmpType] < 7 then
begin
JmpKind := kJmpTmpJmpRipZCE;
sJmpType := GetJmpType(Tmp, @PDscr^.CodeEntry, Tmp + 6 + 8);
if JmpTypeToSize[sJmpType] < 7 then
JmpKind := kJmpTmpJmpCE;
end;
end;
end
else
begin
JmpKind := kJmpCE;
end;
{$ELSE !CPUX64}
PExMem := TryAllocMemAt(nil, SizeOfAlloc, PAGE_EXECUTE_READWRITE);
JmpKind := kJmpCE;
LPExMem := PExMem;
{$ENDIF CPUX64}
FillChar(Inst, SizeOf(TInstruction), #00);
Inst.Archi := CPUX;
Inst.NextInst := P;
Inst.VirtualAddr := nil;
JmpSize := JmpTypeToSize[fJmpType];
while Sb < JmpSize do
begin
if Inst.OpType = otRET then
raise InterceptException.Create(SErrorSmallFunctionSize);
Inst.Addr := Inst.NextInst;
Inc(Sb, fDecodeInst(@Inst));
end;
if Sb > TrampoSize then
raise InterceptException.Create(SErrorBigTrampoSize);
{ Trampoline momory }
T := PExMem;
FillNop(T^, TrampoSize, False);
PDscr^.Trampo := AllocMem(SizeOf(TTrampoInfo));
PDscr^.Trampo^.PData := AllocMem(Sb + 6);
FillNop(PDscr^.Trampo^.PData^, Sb + 6, False);
{ Save original target routine instruction . }
Move(P^, PDscr^.Trampo^.PData^, Sb);
PDscr^.Trampo^.Addr := T; // Pointer to the first trampoline instruction.
PDscr^.Trampo^.Size := Sb; // Size of stolen instructions .
Tsz := MapInsts(P, T, Sb);
OrgAccess := SetMemPermission(P, Sb, PAGE_EXECUTE_READWRITE);
try
FillNop(P^, Sb, False);
case JmpKind of
kJmpCE:
begin
{ A very good jump ! }
{
TargetProc :
JMP @PDscr^.CodeEntry
}
InsertJmp(P, @PDscr^.CodeEntry, fJmpType, @PDscr^.DscrAddr);
end;
{$IFDEF CPUX64}
kJmpTmpJmpCE:
begin
{
TargetProc :
JMP @Tmp ==> Tmp is allocated nearly from TargetProc !
Tmp:
JMP @PDscr^.CodeEntry
}
InsertJmp(P, Tmp, fJmpType, Tmp + 6);
InsertJmp(Tmp, @PDscr^.CodeEntry, sJmpType, Tmp + 6 + 8);
end;
kJmpTmpJmpRipZCE:
begin
{
TargetProc :
JMP @Tmp ==> Tmp is allocated nearly from TargetProc !
Tmp:
JMP @PDscr^.CodeEntry ==> JT_RIPZ
}
InsertJmp(P, Tmp, fJmpType, Tmp + 6);
InsertJmp(Tmp, @PDscr^.CodeEntry, JT_RIPZ, nil);
end;
kJmpRipZCE:
begin
{
Not a good jump !
TargetProc :
JMP @PDscr^.CodeEntry ==> JT_RIPZ
}
InsertJmp(P, @PDscr^.CodeEntry, JT_RIPZ, nil);
end;
{$ENDIF CPUX64}
end;
{
Insert a JMP instruction after the stolen instructions
on the trampoline.
==> This JMP will return to TargetProc to allow
executing originals instructions.
}
{$IFDEF CPUX64}
InsertJmp(T + Tsz, P + Sb, JT_RIPZ);
{$ELSE !CPUX64}
InsertJmp(PByte(NativeInt(T) + Tsz), PByte(NativeInt(P) + Sb), JT_MEM32, PByte(NativeInt(T) + Tsz + 6));
{$ENDIF CPUX64}
{ Save LPExMem ==> we need it when deleting descriptor }
PDscr^.ExMem := LPExMem;
SetMemPermission(LPExMem, SizeOfAlloc, PAGE_EXECUTE_READWRITE);
SetMemPermission(PDscr, SizeOf(TDescriptor), PAGE_EXECUTE_READWRITE);
finally
SetMemPermission(P, Sb, OrgAccess);
end;
end;
procedure MadExceptFreeMem(P: Pointer);
var
Page: Pointer;
mbi: TMemoryBasicInformation;
Permission: DWORD;
begin
if InternalFuncs.VirtualQuery(P, mbi, SizeOf(mbi)) <> 0 then
begin
Page := mbi.BaseAddress;
Permission := SetMemPermission(Page, SysInfo.dwPageSize, PAGE_READWRITE);
FreeMem(P);
SetMemPermission(Page, SysInfo.dwPageSize, Permission);
end
else
FreeMem(P);
end;
function GetNextHookPtrFromTrampoline(TrampoLine: Pointer): PNextHook;
begin
if Assigned(TrampoLine) then
begin
Result := PNextHook(NativeInt(TrampoLine) - SizeOf(TNextHook));
if Result^.Signature = TrampolineSignature then
Exit;
end;
raise DetourException.Create(SErrorInvalidTrampoline);
end;
function AddHook(PDscr: PDescriptor; InterceptProc: PByte; Param: Pointer; Options: TInterceptOptions): PByte;
var
n: ShortInt;
NxHook: PByte;
LTlsRecursionLevelIndex: DWORD;
begin
{
Return a pointer to a function that can
call next installed Hooks.
}
n := PDscr^.nHook;
if n + 1 > MAX_HOOKS then
raise InterceptException.Create(SErrorMaxHook);
{ Alloc memory for the NextHook ! }
NxHook := AllocMem(TrampoSize);
Result := NxHook;
FillNop(Result^, TrampoSize, False);
PNextHook(Result)^.PDscr := PDscr;
PNextHook(Result)^.ID := n + 1;
PNextHook(Result)^.threadid := GetCurrentThreadId();
PNextHook(Result)^.Param := Param;
PNextHook(Result)^.Signature := TrampolineSignature;
PNextHook(Result)^.InterceptOptions := Options;
if ioRecursive in Options then
begin
LTlsRecursionLevelIndex := TlsAlloc();
if LTlsRecursionLevelIndex <> TLS_OUT_OF_INDEXES then
PNextHook(Result)^.TlsRecursionLevelIndex := LTlsRecursionLevelIndex
else
raise DetourException.Create(SErrorTlsOutOfIndexes);
end;
Inc(Result, SizeOf(TNextHook));
{ Redirect code to InterceptProc ! }
InsertJmp(@PDscr^.JmpMems[n], InterceptProc, JT_MEMN, @PDscr^.JmpAddrs[n]);
{ Redirect code to TrampoLine ! }
InsertJmp(@PDscr^.JmpMems[n + 1], PDscr^.Trampo^.Addr, JT_MEMN, @PDscr^.JmpAddrs[n + 1]);
{ Redirect code to next hook ! }
InsertJmp(Result, @PDscr^.JmpMems[n + 1], JT_MEMN, PByte(NativeInt(Result) + 6));
Inc(PDscr^.nHook);
SetMemPermission(Result, JmpTypeToSize[JT_RIPZ], PAGE_EXECUTE_READWRITE);
end;
function InstallHook(TargetProc, InterceptProc: PByte; Param: Pointer; Options: TInterceptOptions): PByte;
var
P: PByte;
PDscr: PDescriptor;
begin
if not Assigned(TargetProc) then
raise InterceptException.Create(SErrorInvalidTargetProc);
if not Assigned(InterceptProc) then
raise InterceptException.Create(SErrorInvalidInterceptProc);
PDscr := GetDescriptor(TargetProc);
if not Assigned(PDscr) then
begin
P := GetRoot(TargetProc);
PDscr := CreateNewDescriptor();
try
InsertDescriptor(P, PDscr);
except
FreeMem(PDscr);
raise;
end;
end;
Result := AddHook(PDscr, InterceptProc, Param, Options);
end;
procedure RemoveDescriptor(PDscr: PDescriptor);
var
OrgAccess: DWORD;
P: PByte;
sz: Integer;
vr: Boolean;
begin
P := PDscr^.OrgPtr;
sz := PDscr^.Trampo^.Size;
OrgAccess := SetMemPermission(P, sz, PAGE_EXECUTE_READWRITE);
try
SetMemPermission(PDscr^.ExMem, TrampoSize, PAGE_EXECUTE_READWRITE);
{ Restore the old stolen instructions ! }
Move(PDscr^.Trampo^.PData^, PDscr^.OrgPtr^, PDscr^.Trampo^.Size);
FillNop(PDscr^.ExMem^, SizeOfAlloc, False);
FreeMem(PDscr^.Trampo^.PData);
FreeMem(PDscr^.Trampo);
if Assigned(PDscr^.ExMem) then
begin
vr := InternalFuncs.VirtualFree(PDscr^.ExMem, 0, MEM_RELEASE);
if not vr then
RaiseLastOSError;
end;
FillNop(PDscr^, SizeOf(TDescriptor), False);
{$IFDEF FIX_MADEXCEPT}
MadExceptFreeMem(PDscr);
{$ELSE !FIX_MADEXCEPT}
FreeMem(PDscr);
{$ENDIF FIX_MADEXCEPT}
finally
SetMemPermission(P, sz, OrgAccess);
end;
end;
function RemoveHook(TrampoLine: PByte): Integer;
var
PNxtHook: PNextHook;
PDscr: PDescriptor;
n: Byte;
begin
if not Assigned(TrampoLine) then
raise InterceptException.Create(SErrorInvalidTrampoline);
PNxtHook := GetNextHookPtrFromTrampoline(TrampoLine);
if not Assigned(PNxtHook) then
raise InterceptException.Create(SErrorInvalidTrampoline);
PDscr := PNxtHook^.PDscr;
if not IsValidDescriptor(PByte(PDscr)) then
raise InterceptException.Create(SErrorInvalidDescriptor);
n := PNxtHook^.ID;
Dec(PDscr^.nHook);
PDscr^.JmpAddrs[n - 1] := nil;
{ Remove JMP from descriptor table }
FillNop(PByte(@PDscr^.JmpMems[n - 1])^, SizeOf(TJmpMem), True);
{
Return the number of hooks
that are still alive !
}
Result := PDscr^.nHook;
if Result = 0 then
RemoveDescriptor(PDscr);
if ioRecursive in PNxtHook^.InterceptOptions then
TlsFree(PNxtHook^.TlsRecursionLevelIndex);
{$IFDEF FIX_MADEXCEPT}
MadExceptFreeMem(PNxtHook);
{$ELSE !FIX_MADEXCEPT}
FreeMem(PNxtHook);
{$ENDIF FIX_MADEXCEPT}
end;
{ ======================================= InterceptCreate ======================================= }
function InterceptCreate(const TargetProc, InterceptProc: Pointer; const Param: Pointer = nil;
const Options: TInterceptOptions = DefaultInterceptOptions): Pointer;
begin
Result := InstallHook(TargetProc, InterceptProc, Param, Options);
end;
function InterceptCreate(const TargetInterface; MethodIndex: Integer; const InterceptProc: Pointer; const Param: Pointer = nil;
const Options: TInterceptOptions = DefaultInterceptOptions): Pointer;
var
P: PByte;
begin
Result := nil;
if not Assigned(@TargetInterface) then
Exit;
P := GetInterfaceMethodPtrByIndex(TargetInterface, MethodIndex);
if Assigned(P) then
begin
Result := InterceptCreate(P, InterceptProc, Param, Options);
end;
end;
function InterceptCreate(const Module, MethodName: string; const InterceptProc: Pointer; const Param: Pointer = nil;
const Options: TInterceptOptions = DefaultInterceptOptions): Pointer;
var
pOrgPointer: Pointer;
LModule: THandle;
begin
{ RRUZ's idea ==> Looks great ! }
Result := nil;
LModule := GetModuleHandle(PChar(Module));
if (LModule = 0) and (ioForceLoad in Options) then
LModule := LoadLibrary(PChar(Module));
if LModule <> 0 then
begin
pOrgPointer := GetProcAddress(LModule, PChar(MethodName));
if Assigned(pOrgPointer) then
Result := InterceptCreate(pOrgPointer, InterceptProc, Param, Options);
end;
end;
procedure InterceptCreate(const TargetProc, InterceptProc: Pointer; var TrampoLine: Pointer; const Param: Pointer = nil;
const Options: TInterceptOptions = DefaultInterceptOptions);
begin
TrampoLine := InstallHook(TargetProc, InterceptProc, Param, Options);
end;
{$IFDEF SUPPORTS_RTTI}
function InterceptCreate(const TargetInterface; const MethodName: String; const InterceptProc: Pointer; const Param: Pointer = nil;
const Options: TInterceptOptions = DefaultInterceptOptions): Pointer; overload;
var
P: PByte;
begin
{ Interface support }
Result := nil;
if (not Assigned(@TargetInterface)) or (MethodName = EmptyStr) then
Exit;
P := GetInterfaceMethodPtrByName(TargetInterface, MethodName);
if Assigned(P) then
Result := InterceptCreate(P, InterceptProc);
end;
{$ENDIF SUPPORTS_RTTI}
{ ======================================= InterceptRemove ======================================= }
function InterceptRemove(const TrampoLine: Pointer): Integer;
begin
if Assigned(TrampoLine) then
Result := RemoveHook(TrampoLine)
else
Result := -1;
end;
{ ======================================= GetHookCount ======================================= }
function GetHookCount(const TargetProc: Pointer): Integer;
var
PDscr: PDescriptor;
begin
{ Return the number of installed hooks. }
if Assigned(TargetProc) then
begin
PDscr := GetDescriptor(TargetProc);
if Assigned(PDscr) then
begin
Result := PDscr^.nHook;
Exit;
end;
end
else
raise InterceptException.Create(SErrorInvalidTargetProc);
Result := 0;
end;
function GetHookCount(const TargetInterface; MethodIndex: Integer): Integer; overload;
var
P: PByte;
begin
P := GetInterfaceMethodPtrByIndex(TargetInterface, MethodIndex);
Result := GetHookCount(P);
end;
{$IFDEF SUPPORTS_RTTI}
function GetHookCount(const TargetInterface; const MethodName: String): Integer; overload;
var
P: PByte;
begin
{ Interface support }
P := GetInterfaceMethodPtrByName(TargetInterface, MethodName);
Result := GetHookCount(P);
end;
{$ENDIF SUPPORTS_RTTI}
{ ======================================= IsHooked ======================================= }
function IsHooked(const TargetProc: Pointer): Boolean;
begin
Result := GetHookCount(TargetProc) > 0;
end;
function IsHooked(const TargetInterface; MethodIndex: Integer): Boolean; overload;
var
P: PByte;
begin
P := GetInterfaceMethodPtrByIndex(TargetInterface, MethodIndex);
Result := IsHooked(P);
end;
{$IFDEF SUPPORTS_RTTI}
function IsHooked(const TargetInterface; const MethodName: String): Boolean; overload;
var
P: PByte;
begin
{ Interface support }
P := GetInterfaceMethodPtrByName(TargetInterface, MethodName);
Result := IsHooked(P);
end;
{$ENDIF SUPPORTS_RTTI}
{ ======================================= Patch ======================================= }
function PatchVt(const TargetInterface; MethodIndex: Integer; InterceptProc: Pointer): Pointer;
var
vt: PPointer;
P, DstAddr: PPointer;
Q: PByte;
OrgAccess: DWORD;
PInfo: PTrampoDataVt;
begin
{
NB: PatchVt does not support multi hook !!
PatchVt will patch only vtable !!
}
Result := nil;
if not Assigned(@TargetInterface) then
Exit;
if not Assigned(InterceptProc) then
Exit;
try
vt := PPointer(TargetInterface)^;
P := vt;
Inc(P, MethodIndex);
DstAddr := P^; // address !
OrgAccess := SetMemPermission(P, 32, PAGE_EXECUTE_READWRITE);
try
P^ := InterceptProc;
finally
SetMemPermission(P, 32, OrgAccess);
end;
Result := InternalFuncs.VirtualAlloc(nil, 32, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE);
SetMemPermission(Result, 32, PAGE_EXECUTE_READWRITE);
PInfo := Result;
PInfo^.vAddr := P;
PInfo^.Addr := DstAddr;
Inc(PByte(Result), SizeOf(TTrampoDataVt));
Q := Result;
{$IFDEF CPUX64}
{ Use JMP RipZero ! }
PWord(Q)^ := opJmpMem;
Inc(Q, 2);
PInt32(Q)^ := $00;
Inc(Q, 4);
PNativeInt(Q)^ := NativeInt(DstAddr);
{$ELSE !CPUX64}
PWord(Q)^ := opJmpMem;
Inc(Q, 2);
PUInt32(Q)^ := UInt32(NativeInt(Q) + 4);
PUInt32(NativeInt(Q) + 4)^ := UInt32(DstAddr);
{$ENDIF CPUX64}
finally
end;
end;
function UnPatchVt(const TrampoLine: Pointer): Boolean;
var
OrgAccess: DWORD;
PInfo: PTrampoDataVt;
begin
if not Assigned(TrampoLine) then
begin
Result := False;
Exit;
end;
try
PInfo := PTrampoDataVt(NativeInt(TrampoLine) - SizeOf(TTrampoDataVt));
OrgAccess := SetMemPermission(PInfo^.vAddr, 32, PAGE_EXECUTE_READWRITE);
try
PPointer(PInfo^.vAddr)^ := PInfo^.Addr;
finally
SetMemPermission(PInfo^.vAddr, 32, OrgAccess);
end;
Result := InternalFuncs.VirtualFree(TrampoLine, 0, MEM_RELEASE);
finally
end;
end;
{ ======================================= Trampoline misc =================================== }
function GetCreatorThreadIdFromTrampoline(var TrampoLine): TThreadId;
var
PNxtHook: PNextHook;
begin
PNxtHook := GetNextHookPtrFromTrampoline(PPointer(@TrampoLine)^);
Result := PNxtHook^.threadid;
end;
function GetTrampolineParam(var TrampoLine): Pointer;
var
PNxtHook: PNextHook;
begin
PNxtHook := GetNextHookPtrFromTrampoline(PPointer(@TrampoLine)^);
Result := PNxtHook^.Param;
end;
{ ======================================= Recursive Section ======================================= }
function EnterRecursiveSection(var TrampoLine; MaxRecursionLevel: NativeInt = 0): Boolean;
var
PNxtHook: PNextHook;
RecursionLevel: NativeInt;
begin
PNxtHook := GetNextHookPtrFromTrampoline(PPointer(@TrampoLine)^);
if ioRecursive in PNxtHook^.InterceptOptions then
begin
RecursionLevel := NativeInt(TlsGetValue(PNxtHook^.TlsRecursionLevelIndex));
Result := RecursionLevel <= MaxRecursionLevel;
if Result then
begin
Inc(RecursionLevel);
TlsSetValue(PNxtHook^.TlsRecursionLevelIndex, Pointer(RecursionLevel));
end;
end
else
raise DetourException.Create(SErrorRecursiveSectionUnsupported);
end;
function ExitRecursiveSection(var TrampoLine): Boolean;
var
PNxtHook: PNextHook;
RecursionLevel: NativeInt;
begin
PNxtHook := GetNextHookPtrFromTrampoline(PPointer(@TrampoLine)^);
if ioRecursive in PNxtHook^.InterceptOptions then
begin
RecursionLevel := NativeInt(TlsGetValue(PNxtHook^.TlsRecursionLevelIndex));
Result := RecursionLevel >= 0;
if Result then
begin
Dec(RecursionLevel);
TlsSetValue(PNxtHook^.TlsRecursionLevelIndex, Pointer(RecursionLevel));
end;
end
else
raise DetourException.Create(SErrorRecursiveSectionUnsupported);
end;
{ ======================================= Transaction ======================================= }
function CountThreadCallBack(ID: DWORD; Param: Pointer): BOOL;
begin
Assert(Assigned(Param));
Inc(PInteger(Param)^);
Result := True;
end;
function SuspendOrResumeThread(threadid: DWORD; Suspend: Boolean): DWORD;
var
hThread: THandle;
begin
hThread := OpenThread(THREAD_SUSPEND_RESUME, False, threadid);
if hThread <> THandle(0) then
begin
if Suspend then
Result := SuspendThread(hThread)
else
Result := ResumeThread(hThread);
CloseHandle(hThread);
end
else
Result := DWORD(-1);
end;
function SuspendThreadCallBack(ID: DWORD; Param: Pointer): BOOL;
var
PStruct: PTransactionStruct;
SuspendCount: DWORD;
begin
Assert(Assigned(Param));
PStruct := PTransactionStruct(Param);
if ID <> PStruct^.TID then
begin
SuspendCount := SuspendOrResumeThread(ID, True);
if SuspendCount <> DWORD(-1) then
// thread's previously was running .
begin
{ Only add threads that was running before suspending them ! }
PStruct^.SuspendedThreads^[PStruct^.SuspendedThreadCount] := ID;
Inc(PStruct^.SuspendedThreadCount);
end;
end;
Result := True;
end;
function BeginTransaction(Options: TTransactionOptions = [toSuspendThread]): THandle;
var
PStruct: PTransactionStruct;
ThreadCount: Integer;
P: Pointer;
ThreadHandle: THandle;
begin
EnterLook(FLock);
try
ThreadHandle := GetCurrentThread();
PStruct := GetMemory(SizeOf(TTransactionStruct));
FillChar(PStruct^, SizeOf(TTransactionStruct), #00);
PStruct^.Options := Options;
PStruct^.PID := GetCurrentProcessId();
PStruct^.TID := GetCurrentThreadId();
PStruct^.ThreadPriority := GetThreadPriority(ThreadHandle);
SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);
Result := THandle(PStruct);
if toSuspendThread in Options then
begin
ThreadCount := 0;
EnumProcessThreads(PStruct^.PID, @CountThreadCallBack, @ThreadCount);
if ThreadCount > 1 then
begin
P := GetMemory(ThreadCount * 2 * SizeOf(DWORD));
PStruct^.SuspendedThreads := P;
EnumProcessThreads(PStruct^.PID, @SuspendThreadCallBack, PStruct);
end;
end;
finally
LeaveLook(FLock);
end;
end;
function EndTransaction(Handle: THandle): Boolean;
var
PStruct: PTransactionStruct;
i: Integer;
begin
EnterLook(FLock);
Result := True;
PStruct := PTransactionStruct(Handle);
try
if PStruct^.SuspendedThreadCount > 0 then
begin
for i := 0 to PStruct^.SuspendedThreadCount - 1 do
begin
SuspendOrResumeThread(PStruct^.SuspendedThreads^[i], False);
end;
FreeMemory(PStruct^.SuspendedThreads);
end;
SetThreadPriority(GetCurrentThread(), PStruct^.ThreadPriority);
FreeMemory(PTransactionStruct(Handle));
finally
LeaveLook(FLock);
end;
end;
{$IFDEF SUPPORTS_GENERICS}
{ TIntercept<T,U> }
function TIntercept<T, U>.TToPointer(const A): Pointer;
begin
Result := Pointer(A);
end;
function TIntercept<T, U>.PointerToT(const P): T;
begin
Result := T(P);
end;
function TIntercept<T, U>.EnsureTIsMethod(): Boolean;
var
LPInfo: PTypeInfo;
begin
Result := SizeOf(T) = SizeOf(Pointer);
if Result then
begin
LPInfo := TypeInfo(T);
if LPInfo.Kind = tkProcedure then
Exit
else
raise DetourException.Create(SErrorInvalidTType);
end;
end;
constructor TIntercept<T, U>.Create(const TargetProc, InterceptProc: T; const AParam: U; const AInterceptOptions: TInterceptOptions = DefaultInterceptOptions);
begin
EnsureTIsMethod();
FCreatorThreadId := GetCurrentThreadId();
FInterceptOptions := AInterceptOptions;
FParam := AParam;
FTrampolinePtr := InterceptCreate(TToPointer(TargetProc), TToPointer(InterceptProc), @FParam, AInterceptOptions);
FNextHook := PointerToT(FTrampolinePtr);
end;
function TIntercept<T, U>.GetTrampoline(): T;
begin
Result := FNextHook;
end;
function TIntercept<T, U>.GetParam(): U;
begin
Result := FParam;
end;
function TIntercept<T, U>.GetCreatorThreadId(): TThreadId;
begin
Result := FCreatorThreadId;
end;
function TIntercept<T, U>.GetInterceptOptions(): TInterceptOptions;
begin
Result := FInterceptOptions;
end;
function TIntercept<T, U>.EnterRecursive(MaxRecursionLevel: NativeInt = 0): Boolean;
begin
Result := EnterRecursiveSection(FTrampolinePtr, MaxRecursionLevel);
end;
function TIntercept<T, U>.ExitRecursive(): Boolean;
begin
Result := ExitRecursiveSection(FTrampolinePtr);
end;
destructor TIntercept<T, U>.Destroy();
begin
InterceptRemove(TToPointer(FNextHook));
inherited;
end;
{ TIntercept<T> }
constructor TIntercept<T>.Create(const TargetProc, InterceptProc: T; const AParam: Pointer = nil;
const AInterceptOptions: TInterceptOptions = DefaultInterceptOptions);
begin
inherited Create(TargetProc, InterceptProc, AParam, InterceptOptions);
end;
{$ENDIF SUPPORTS_GENERICS}
{ ======================================= Initialization ======================================= }
procedure InitInternalFuncs();
function CloneFunc(Func: PByte): PByte;
var
mb, ns, Sb, fn: Byte;
P: PByte;
Inst: TInstruction;
begin
Sb := 0;
Func := GetRoot(Func);
Result := VirtualAlloc(nil, 64, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE);
P := Result;
mb := JmpTypeToSize[JT_RIPZ];
FillChar(Inst, SizeOf(TInstruction), #00);
Inst.Archi := CPUX;
Inst.NextInst := Func;
while Sb <= mb do
begin
Inst.Addr := Inst.NextInst;
ns := fDecodeInst(@Inst);
Inc(Sb, ns);
end;
fn := MapInsts(Func, P, Sb);
Inc(P, fn);
{$IFDEF CPUX64}
InsertJmp(P, PByte(NativeInt(Func) + Sb), JT_RIPZ);
{$ELSE !CPUX64}
InsertJmp(P, PByte(NativeInt(Func) + Sb), JT_REL32);
{$ENDIF CPUX64}
end;
begin
{$IFDEF HOOK_INTERNAL_FUNCTIONS}
@InternalFuncs.VirtualAlloc := CloneFunc(@VirtualAlloc);
@InternalFuncs.VirtualFree := CloneFunc(@VirtualFree);
@InternalFuncs.VirtualProtect := CloneFunc(@VirtualProtect);
@InternalFuncs.VirtualQuery := CloneFunc(@VirtualQuery);
@InternalFuncs.FlushInstructionCache := CloneFunc(@FlushInstructionCache);
@InternalFuncs.GetCurrentProcess := CloneFunc(@GetCurrentProcess);
{$ELSE !HOOK_INTERNAL_FUNCTIONS}
@InternalFuncs.VirtualAlloc := @VirtualAlloc;
@InternalFuncs.VirtualFree := @VirtualFree;
@InternalFuncs.VirtualProtect := @VirtualProtect;
@InternalFuncs.VirtualQuery := @VirtualQuery;
@InternalFuncs.FlushInstructionCache := @FlushInstructionCache;
@InternalFuncs.GetCurrentProcess := @GetCurrentProcess;
{$ENDIF HOOK_INTERNAL_FUNCTIONS}
end;
procedure FreeInternalFuncs;
begin
{$IFDEF HOOK_INTERNAL_FUNCTIONS}
InternalFuncs.VirtualFree(@InternalFuncs.VirtualAlloc, 0, MEM_RELEASE);
InternalFuncs.VirtualFree(@InternalFuncs.VirtualProtect, 0, MEM_RELEASE);
InternalFuncs.VirtualFree(@InternalFuncs.VirtualQuery, 0, MEM_RELEASE);
InternalFuncs.VirtualFree(@InternalFuncs.FlushInstructionCache, 0, MEM_RELEASE);
InternalFuncs.VirtualFree(@InternalFuncs.GetCurrentProcess, 0, MEM_RELEASE);
// VirtualFree must be the last one !
InternalFuncs.VirtualFree(@InternalFuncs.VirtualFree, 0, MEM_RELEASE);
{$ENDIF HOOK_INTERNAL_FUNCTIONS}
end;
initialization
{$IFDEF SUPPORTS_MONITOR}
FLock := TObject.Create();
{$ELSE SUPPORTS_MONITOR}
FLock := TCriticalSection.Create();
{$ENDIF SUPPORTS_MONITOR}
GetSystemInfo(SysInfo);
SizeOfAlloc := SysInfo.dwPageSize;
if SizeOfAlloc < (TmpSize + TrampoSize + 64) then
SizeOfAlloc := (TmpSize + TrampoSize + 64);
{$IFDEF FPC}
OpenThread := nil;
{$ELSE !FPC}
@OpenThread := nil;
{$ENDIF !FPC}
FreeKernel := False;
hKernel := GetModuleHandle(kernel32);
if hKernel <= 0 then
begin
hKernel := LoadLibrary(kernel32);
FreeKernel := (hKernel > 0);
end;
if hKernel > 0 then
begin
{$IFDEF FPC}
@OpenThread := GetProcAddress(hKernel, 'OpenThread');
@CreateToolhelp32Snapshot := GetProcAddress(hKernel, 'CreateToolhelp32Snapshot');
@Thread32First := GetProcAddress(hKernel, 'Thread32First');
@Thread32Next := GetProcAddress(hKernel, 'Thread32Next');
{$ELSE !FPC}
@OpenThread := GetProcAddress(hKernel, 'OpenThread');
{$ENDIF !FPC}
end;
{ The OpenThread function does not exist on OS version < Win XP }
OpenThreadExist := (@OpenThread <> nil);
InitInternalFuncs();
finalization
if (FreeKernel) and (hKernel > 0) then
FreeLibrary(hKernel);
FreeInternalFuncs();
if Assigned(FLock) then
FreeAndNil(FLock);
end.
================================================
FILE: Source/DDetoursDefs.inc
================================================
{.$DEFINE HOOK_INTERNAL_FUNCTIONS} // hook internal functions.
{$IFDEF FPC}
{$ASMMODE INTEL}
{$ELSE !FPC}
{$T-}
{$IF CompilerVersion >= 17.0}
{$DEFINE DELPHI_2005_UP}
{$IFEND}
{$IF CompilerVersion >= 18.5}
{$DEFINE DELPHI_2007_UP}
{$IFEND}
{$IF CompilerVersion >= 20}
{$DEFINE DELPHI_2009_UP}
{$IFEND}
{$IF CompilerVersion >= 21}
{$DEFINE DELPHI_2010_UP}
{$IFEND}
{$IF CompilerVersion >= 22}
{$DEFINE DELPHI_XE_UP}
{$IFEND}
{$IF CompilerVersion >= 23}
{$DEFINE DELPHI_XE2_UP}
{$IFEND}
{$IF CompilerVersion >= 33}
{$DEFINE DELPHI_RIO_UP}
{$IFEND}
{$IFDEF DELPHI_2005_UP}
{$DEFINE SUPPORTS_INLINE}
{$ENDIF}
{$IFDEF DELPHI_XE2_UP}
{$DEFINE SUPPORTS_RTTI}
{$DEFINE SUPPORTS_GENERICS}
{$DEFINE RENAMED_NAMESPACE}
{$ENDIF}
{$ENDIF FPC}
================================================
FILE: Source/InstDecode.pas
================================================
// **************************************************************************************************
// x86 Instruction Decode Library
// Unit InstDecode
// https://github.com/MahdiSafsafi/DDetours
//
// This Source Code Form is subject to the terms of the Mozilla
// Public License, v. 2.0. If a copy of the MPL was not distributed
// with this file, You can obtain one at
// https://mozilla.org/MPL/2.0/.
// **************************************************************************************************
{ ===============================> CHANGE LOG <======================================================
==> Jun, 7, 2020:
+Added support for older Delphi version (D7+).
+Added support for FPC.
+Fixed some bug related to displacement.
==> Dec 27,2014 , Mahdi Safsafi :
+BugFix : IN/INS/OUT/OUTS instructions decoding.
+BugFix : MOV with offset instructions decoding.
==> Version 2:
+Updated opcodes map .
+Added support to three byte escape Table
+Added support to vex decoding (vex three & two byte).
+Added support to groups opcodes instructions.
+Added support to decode invalid opcode .
+Added support to 16-bits ModRm .
+Added support to handling errors.
+Added support for mandatory prefixes.
+Improve Decoding Process .=> Very faster than the old one !
+Reduce memory usage .
+Removing inused fields.
+Better support for REX prefix.
+Reduce OpCodesTable data size (the old : 8670 bytes => the new one : 1020 bytes !)
+BugFix : FPU instructions length.
+BugFix : Instructions that use two immediat .
+BugFix : Invalid instructions .
+BugFix : Invalid instructions for some mandatory prefixes.
+Many Bug Fix.
====================================================================================================== }
unit InstDecode;
{$IFDEF FPC}
{$MODE DELPHI}
{$HINTS OFF}
{$WARN 4056 OFF}
{$WARN 4082 OFF}
{$ENDIF FPC}
interface
{$I DDetoursDefs.inc}
uses
SysUtils,
LegacyTypes;
const
{ CPUX }
CPUX32 = $00; { x86-32 }
CPUX64 = $01; { x86-64 }
CPUX = {$IFDEF CPUX64}CPUX64 {$ELSE}CPUX32 {$ENDIF};
{ Address Mode }
am16 = $01; { 16-bit addressing mode }
am32 = $02; { 32-bit addressing mode }
am64 = $03; { 64-bit addressing mode }
{ Default Addressing Mode Depending on CPUX (32/64)bit }
DefAddressMode: array [0 .. 1] of Byte = (am32, am64);
{ Used to select Addressing Mode when Address Mode Prefix is used ! }
AddressMode: array [0 .. 1] of Byte = (am16, am32);
{ Tables }
tbOneByte = $01; { One Byte OpCodes Table }
tbTwoByte = $02; { Two Byte OpCodes Table }
tbThreeByte = $03; { Three Byte OpCodes Table }
tbFPU = $04; { FPU OpCodes Table }
{ Prefixs }
Prf_Seg_CS = $01;
Prf_Seg_DS = $02;
Prf_Seg_ES = $04;
Prf_Seg_GS = $08;
Prf_Seg_FS = $10;
Prf_Seg_SS = $20;
Prf_OpSize = $40;
Prf_AddrSize = $80;
Prf_Lock = $100;
Prf_Repe = $200;
Prf_Repne = $400;
Prf_Rex = $800;
Prf_VEX = $1000;
Prf_Vex2 = Prf_VEX or $2000;
Prf_Vex3 = Prf_VEX or $4000;
{ Segment Registers }
Seg_CS = $01;
Seg_DS = $02;
Seg_ES = $03;
Seg_GS = $04;
Seg_FS = $05;
Seg_SS = $06;
{ OpSize }
ops8bits = $01;
ops16bits = $02;
ops32bits = $04;
ops48bits = $06;
ops64bits = $08;
ops128bits = $10;
ops256bits = $20;
ops512bits = $40;
{ OpType }
otNone = $00;
otRET = $01; { RET Instruction }
otCALL = $02; { CALL Instruction }
otJMP = $04; { JMP Instruction }
otJ = $08;
otJcc = $10; { Conditional JUMP Instruction }
{ OpKind }
kGrp = $01;
// kFPU = $02; Use OpTable !
{ Options }
DecodeVex = $01;
{ ModRm Flags }
mfUsed = $80; { ModRm Used }
{ Sib Flags }
sfUsed = $01; { Sib Used }
{ Displacement Flags }
dfUsed = $01; { Disp Used }
dfRip = $02; { RIP Disp }
dfSigned = $04; { Displacement can be signed ! }
dfDispOnly = $08; { Displacement Only without registers ! }
dfOffset = $10; { Offset coded after the opcode. }
{ Immediat Flags }
imfUsed = $01; { Imm Used }
{ Branch Flags }
bfUsed = $01; { JUMP/CALL Used }
bfRel = $02; { Relative Branch }
bfAbs = $04; { Absolute Branch }
bfIndirect = $08; { Indirect Branch }
bfReg = $10;
bfFar = bfAbs or $20; { Far Branch }
bfRip = $40;
{ Operand Flags }
opdD64 = $01;
opdF64 = $02;
opdDf64 = $03;
opdDv64 = $04;
{ Options }
UseVA = $01;
{ General Purpose Registers }
rEAX = $00;
rECX = $01;
rEDX = $02;
rEBX = $03;
rESP = $04;
rEBP = $05;
rESI = $06;
rEDI = $07;
{ Error }
NO_ERROR = $00;
INVALID_CPUX = $01;
INVALID_ADDRESS = $02;
INVALID_INSTRUCTION_LENGTH = $04;
ERROR_DISP_SIZE = $08;
ERROR_IMM_SIZE = $10;
ERROR_VEX_ESCAPE = $20;
INVALID_GROUP_OPCODE = $40;
UnknownErrorStr = 'Unknown Error';
InstErrorsStr: array [0 .. 7] of String = (
{ NO_ERROR }
'No error',
{ INVALID_CPUX }
'Invalid cpux',
{ INVALID_ADDRESS }
'Invalid address',
{ INVALID_INSTRUCTION_LENGTH }
'Invalid instruction length',
{ ERROR_DISP_SIZE }
'Invalid displacement size',
{ ERROR_IMM_SIZE }
'Invalid immediat size',
{ ERROR_VEX_ESCAPE }
'Invalid vex mmmmm field',
{ INVALID_GROUP_OPCODE }
'Invalid group opcode');
_vex3_ = $03;
_opcode_ = $01;
_modrm_ = $01;
_sib_ = $01;
_disp32_ = $04;
_imm32_ = $04;
_imm64_ = $08;
{ Intel define instruction length as a 15 bytes !
However , it's possible to incode instructions
that exceed the defined length !
}
MAX_INST_LENGTH_X32 = _vex3_ + _opcode_ + _modrm_ + _sib_ + _disp32_ + _imm32_;
MAX_INST_LENGTH_X64 = _vex3_ + _opcode_ + _modrm_ + _sib_ + _disp32_ + _imm64_;
CPUX_TO_INST_LENGTH: array [0 .. 1] of ShortInt = (MAX_INST_LENGTH_X32, MAX_INST_LENGTH_X64);
{$IFDEF CPUX64}
MAX_INST_LENGTH_N = MAX_INST_LENGTH_X64;
{$ELSE !CPUX64}
MAX_INST_LENGTH_N = MAX_INST_LENGTH_X32;
{$ENDIF CPUX64}
var
{ Raise Exception When Error Occurs ! }
RaiseExceptionOnError: Boolean = True;
type
InstException = class(Exception);
TModRM = record
iMod: Byte; { ModRm.Mod Field }
Reg: Byte; { ModRm.Reg Field }
Rm: Byte; { ModRm.Rm Field }
Value: Byte; { ModRm Value }
{ ModRm.Flags => See ModRmFlagsTable.inc }
Flags: Byte;
end;
PModRM = ^TModRM;
LPModRM = PModRM;
TSib = record
Scale: Byte; { SIB.Scale Field }
Index: Byte; { Register Index }
Base: Byte; { Register Base }
Value: Byte; { SIB Value }
Flags: Byte; { SIB Flags }
end;
PSib = ^TSib;
LPSib = PSib;
TImmediat = record
Size: Byte; { Size of Immediat => opsxxxbits }
Value: Int64; { Immediat Value }
Flags: Byte; { Sets of imfxxx }
end;
PImmediat = ^TImmediat;
TDisplacement = record
Size: Byte; { Size of Displacement => opsxxxbits }
Value: Int64; { Displacement Value }
Flags: Byte; { Sets of dfxxx }
end;
PDisplacement = ^TDisplacement;
TBranch = record
Size: Byte;
Value: Int64;
Target: PByte; { Destination Address }
Falgs: Byte; { Sets of bfxxx }
end;
PBranch = ^TBranch;
TRex = record
R: Boolean; { REX.R Field }
X: Boolean; { REX.X Field }
B: Boolean; { REX.B Field }
W: Boolean; { REX.W Field }
Value: Byte; { REX Value = [$40..$4F] }
end;
PRex = ^TRex;
TVex = record
{
==================> N.B <==================
1 => ALL FIELD ARE IN NO INVERTED FORM !
2 => VEX.[R,X,B & W] ARE ACCESSIBLE THROUGH REX FIELD !
}
vvvv: Byte; { VEX.vvvv ==> Vector Register }
L: Boolean; { VEX.L ==> You should use VL instead ! }
PP: Byte; { VEX.PP ==> Implied Mandatory Prefixes }
mmmmm: Byte; { VEX.mmmmm ==> Implied Escape }
VL: Byte; { Vector Length }
end;
PVex = ^TVex;
TInternalData = record
MndPrf: Byte; { Mandatory Prefix }
zOpSize: Byte; { word or dword depending on opsize prefix ! }
vOpSize: Byte; { word or dword or qword depending on opsize & REX prefix ! }
end;
PInternalData = ^TInternalData;
TInstruction = record
Archi: Byte; { CPUX32 or CPUX64 ! }
AddrMode: Byte; { Address Mode }
Addr: PByte;
VirtualAddr: PByte;
NextInst: PByte; { Pointer to the Next Instruction }
OpCode: Byte; { OpCode Value }
OpType: Byte;
OpKind: Byte;
OpTable: Byte; { tbOneByte,tbTwoByte,... }
OperandFlags: Byte;
Prefixes: Word; { Sets of Prf_xxx }
ModRm: TModRM;
Sib: TSib;
Disp: TDisplacement;
Imm: TImmediat; { Primary Immediat }
ImmEx: TImmediat; { Secondary Immediat if used ! }
Branch: TBranch; { JMP & CALL }
SegReg: Byte; { Segment Register }
Rex: TRex;
Vex: TVex;
LID: TInternalData; { Internal Data }
Errors: Byte;
InstSize: Integer;
Options: Byte;
UserTag: NativeInt;
end;
PInstruction = ^TInstruction;
TDecoderProc = procedure(PInst: PInstruction);
function DecodeInst(PInst: PInstruction): Integer;
{ Useful ModRm Routines }
function GetModRm_Mod(const Value: Byte): Byte; {$IFDEF MustInline}inline; {$ENDIF}
function GetModRm_Reg(const Value: Byte): Byte; {$IFDEF MustInline}inline; {$ENDIF}
function GetModRm_Rm(const Value: Byte): Byte; {$IFDEF MustInline}inline; {$ENDIF}
{ Useful Sib Routines }
function GetSib_Base(const Value: Byte): Byte; {$IFDEF MustInline}inline; {$ENDIF}
function GetSib_Index(const Value: Byte): Byte; {$IFDEF MustInline}inline; {$ENDIF}
function GetSib_Scale(const Value: Byte): Byte; {$IFDEF MustInline}inline; {$ENDIF}
function IsSibBaseRegValid(PInst: PInstruction): Boolean; {$IFDEF MustInline}inline; {$ENDIF}
implementation
{$I OpCodesTables.inc}
{$I ModRmFlagsTables.inc}
{ ================================== 00 ================================== }
procedure Decode_InvalidOpCode(PInst: PInstruction); forward;
{ ================================== 01 ================================== }
procedure Decode_NA_ModRm(PInst: PInstruction); forward;
{ ================================== 02 ================================== }
procedure Decode_NA_Ib(PInst: PInstruction); forward;
{ ================================== 03 ================================== }
procedure Decode_NA_Iz(PInst: PInstruction); forward;
{ ================================== 04 ================================== }
procedure Decode_NA_I64(PInst: PInstruction); forward;
{ ================================== 05 ================================== }
procedure Decode_Escape_2_Byte(PInst: PInstruction); forward;
{ ================================== 06 ================================== }
procedure Decode_ES_Prefix(PInst: PInstruction); forward;
{ ================================== 07 ================================== }
procedure Decode_CS_Prefix(PInst: PInstruction); forward;
{ ================================== 08 ================================== }
procedure Decode_SS_Prefix(PInst: PInstruction); forward;
{ ================================== 09 ================================== }
procedure Decode_DS_Prefix(PInst: PInstruction); forward;
{ ================================== 10 ================================== }
procedure Decode_REX_Prefix(PInst: PInstruction); forward;
{ ================================== 11 ================================== }
procedure Decode_NA_D64(PInst: PInstruction); forward;
{ ================================== 12 ================================== }
procedure Decode_NA_ModRm_I64(PInst: PInstruction); forward;
{ ================================== 13 ================================== }
procedure Decode_FS_Prefix(PInst: PInstruction); forward;
{ ================================== 14 ================================== }
procedure Decode_GS_Prefix(PInst: PInstruction); forward;
{ ================================== 15 ================================== }
procedure Decode_OPSIZE_Prefix(PInst: PInstruction); forward;
{ ================================== 16 ================================== }
procedure Decode_ADSIZE_Prefix(PInst: PInstruction); forward;
{ ================================== 17 ================================== }
procedure Decode_NA_Iz_D64(PInst: PInstruction); forward;
{ ================================== 18 ================================== }
procedure Decode_NA_ModRm_Iz(PInst: PInstruction); forward;
{ ================================== 19 ================================== }
procedure Decode_NA_Ib_D64(PInst: PInstruction); forward;
{ ================================== 20 ================================== }
procedure Decode_NA_ModRm_Ib(PInst: PInstruction); forward;
{ ================================== 21 ================================== }
procedure Decode_NA(PInst: PInstruction); forward;
{ ================================== 22 ================================== }
procedure Decode_NA_Jb_Df64(PInst: PInstruction); forward;
{ ================================== 23 ================================== }
procedure Decode_Group_1(PInst: PInstruction); forward;
{ ================================== 24 ================================== }
procedure Decode_Group_1A(PInst: PInstruction); forward;
{ ================================== 25 ================================== }
procedure Decode_NA_CALL_Ap_I64(PInst: PInstruction); forward;
{ ================================== 26 ================================== }
procedure Decode_NA_OfstV(PInst: PInstruction); forward;
{ ================================== 27 ================================== }
procedure Decode_NA_Iv(PInst: PInstruction); forward;
{ ================================== 28 ================================== }
procedure Decode_Group_2(PInst: PInstruction); forward;
{ ================================== 29 ================================== }
procedure Decode_NA_RET_Iw_Df64(PInst: PInstruction); forward;
{ ================================== 30 ================================== }
procedure Decode_NA_RET_Df64(PInst: PInstruction); forward;
{ ================================== 31 ================================== }
procedure Decode_VEX3_Prefix(PInst: PInstruction); forward;
{ ================================== 32 ================================== }
procedure Decode_VEX2_Prefix(PInst: PInstruction); forward;
{ ================================== 33 ================================== }
procedure Decode_Group_11(PInst: PInstruction); forward;
{ ================================== 34 ================================== }
procedure Decode_NA_Iw_Ib_D64(PInst: PInstruction); forward;
{ ================================== 35 ================================== }
procedure Decode_NA_RET_Iw(PInst: PInstruction); forward;
{ ================================== 36 ================================== }
procedure Decode_NA_RET(PInst: PInstruction); forward;
{ ================================== 37 ================================== }
procedure Decode_NA_Ib_I64(PInst: PInstruction); forward;
{ ================================== 38 ================================== }
procedure Decode_Escape_FPU_D8(PInst: PInstruction); forward;
{ ================================== 39 ================================== }
procedure Decode_Escape_FPU_D9(PInst: PInstruction); forward;
{ ================================== 40 ================================== }
procedure Decode_Escape_FPU_DA(PInst: PInstruction); forward;
{ ================================== 41 ================================== }
procedure Decode_Escape_FPU_DB(PInst: PInstruction); forward;
{ ================================== 42 ================================== }
procedure Decode_Escape_FPU_DC(PInst: PInstruction); forward;
{ ================================== 43 ================================== }
procedure Decode_Escape_FPU_DD(PInst: PInstruction); forward;
{ ================================== 44 ================================== }
procedure Decode_Escape_FPU_DE(PInst: PInstruction); forward;
{ ================================== 45 ================================== }
procedure Decode_Escape_FPU_DF(PInst: PInstruction); forward;
{ ================================== 46 ================================== }
procedure Decode_NA_CALL_Jz_Df64(PInst: PInstruction); forward;
{ ================================== 47 ================================== }
procedure Decode_NA_JMP_Jz_Df64(PInst: PInstruction); forward;
{ ================================== 48 ================================== }
procedure Decode_NA_JMP_Ap_I64(PInst: PInstruction); forward;
{ ================================== 49 ================================== }
procedure Decode_NA_JMP_Jb_Df64(PInst: PInstruction); forward;
{ ================================== 50 ================================== }
procedure Decode_LOCK_Prefix(PInst: PInstruction); forward;
{ ================================== 51 ================================== }
procedure Decode_REPNE_Prefix(PInst: PInstruction); forward;
{ ================================== 52 ================================== }
procedure Decode_REPE_Prefix(PInst: PInstruction); forward;
{ ================================== 53 ================================== }
procedure Decode_Group_3(PInst: PInstruction); forward;
{ ================================== 54 ================================== }
procedure Decode_Group_4_INC_DEC(PInst: PInstruction); forward;
{ ================================== 55 ================================== }
procedure Decode_Group_5_INC_DEC(PInst: PInstruction); forward;
{ ================================== 56 ================================== }
procedure Decode_Group_6(PInst: PInstruction); forward;
{ ================================== 57 ================================== }
procedure Decode_Group_7(PInst: PInstruction); forward;
{ ================================== 58 ================================== }
procedure Decode_NA_CALL(PInst: PInstruction); forward;
{ ================================== 59 ================================== }
procedure Decode_NA_66_F2_F3_ModRm(PInst: PInstruction); forward;
{ ================================== 60 ================================== }
procedure Decode_NA_66_ModRm(PInst: PInstruction); forward;
{ ================================== 61 ================================== }
procedure Decode_NA_66_F3_ModRm(PInst: PInstruction); forward;
{ ================================== 62 ================================== }
procedure Decode_Group_16(PInst: PInstruction); forward;
{ ================================== 63 ================================== }
procedure Decode_NA_ModRm_F64(PInst: PInstruction); forward;
{ ================================== 64 ================================== }
procedure Decode_Escape_3_Byte(PInst: PInstruction); forward;
{ ================================== 65 ================================== }
procedure Decode_NA_F3_ModRm(PInst: PInstruction); forward;
{ ================================== 66 ================================== }
procedure Decode_66_ModRm(PInst: PInstruction); forward;
{ ================================== 67 ================================== }
procedure Decode_NA_66_F2_F3_ModRm_Ib(PInst: PInstruction); forward;
{ ================================== 68 ================================== }
procedure Decode_Group_12(PInst: PInstruction); forward;
{ ================================== 69 ================================== }
procedure Decode_Group_13(PInst: PInstruction); forward;
{ ================================== 70 ================================== }
procedure Decode_Group_14(PInst: PInstruction); forward;
{ ================================== 71 ================================== }
procedure Decode_66_F2_ModRm(PInst: PInstruction); forward;
{ ================================== 72 ================================== }
procedure Decode_NA_Jz_Df64(PInst: PInstruction); forward;
{ ================================== 73 ================================== }
procedure Decode_Group_15(PInst: PInstruction); forward;
{ ================================== 74 ================================== }
procedure Decode_F3_ModRm(PInst: PInstruction); forward;
{ ================================== 75 ================================== }
procedure Decode_Group_10_UD2(PInst: PInstruction); forward;
{ ================================== 76 ================================== }
procedure Decode_Group_8(PInst: PInstruction); forward;
{ ================================== 77 ================================== }
procedure Decode_NA_66_ModRm_Ib(PInst: PInstruction); forward;
{ ================================== 78 ================================== }
procedure Decode_Group_9(PInst: PInstruction); forward;
{ ================================== 79 ================================== }
procedure Decode_66_F2_F3_ModRm(PInst: PInstruction); forward;
{ ================================== 80 ================================== }
procedure Decode_F2_ModRm(PInst: PInstruction); forward;
{ ================================== 81 ================================== }
procedure Decode_SP_T38_F0_F7(PInst: PInstruction); forward;
{ ================================== 82 ================================== }
procedure Decode_66_ModRm_Ib(PInst: PInstruction); forward;
{ ================================== 83 ================================== }
procedure Decode_F2_ModRm_Ib(PInst: PInstruction); forward;
procedure JumpError(PInst: PInstruction); forward;
procedure JumpToTableTwoByte(PInst: PInstruction); forward;
procedure JumpToTableThreeByte_38(PInst: PInstruction); forward;
procedure JumpToTableThreeByte_3A(PInst: PInstruction); forward;
procedure Decode_CALL_ModRm(PInst: PInstruction); forward;
procedure Decode_JMP_ModRm(PInst: PInstruction); forward;
procedure Decode_CALL_Mp(PInst: PInstruction); forward;
procedure Decode_JMP_Mp(PInst: PInstruction); forward;
const
{ Convert PP To Mandatory Prefixes ! }
PPToMndPrf: array [0 .. 3] of Byte = ($00, $66, $F3, $F2);
{ Convert LL To OpSize ! }
LLToOpSize: array [0 .. 3] of Word = (ops128bits, ops256bits, ops512bits, 0);
{ Call escaping procedure ! }
mmmmmToEscProc: array [0 .. 4] of TDecoderProc = ( //
JumpError, { }
JumpToTableTwoByte, { 00001: implied 0F leading opcode byte }
JumpToTableThreeByte_38, { 00010: implied 0F 38 leading opcode bytes }
JumpToTableThreeByte_3A, { 00011: implied 0F 3A leading opcode bytes }
JumpError { }
);
DecoderProcTable: array [0 .. $54 - 1] of TDecoderProc = ( //
{ 00 } Decode_InvalidOpCode,
{ 01 } Decode_NA_ModRm,
{ 02 } Decode_NA_Ib,
{ 03 } Decode_NA_Iz,
{ 04 } Decode_NA_I64,
{ 05 } Decode_Escape_2_Byte,
{ 06 } Decode_ES_Prefix,
{ 07 } Decode_CS_Prefix,
{ 08 } Decode_SS_Prefix,
{ 09 } Decode_DS_Prefix,
{ 10 } Decode_REX_Prefix,
{ 11 } Decode_NA_D64,
{ 12 } Decode_NA_ModRm_I64,
{ 13 } Decode_FS_Prefix,
{ 14 } Decode_GS_Prefix,
{ 15 } Decode_OPSIZE_Prefix,
{ 16 } Decode_ADSIZE_Prefix,
{ 17 } Decode_NA_Iz_D64,
{ 18 } Decode_NA_ModRm_Iz,
{ 19 } Decode_NA_Ib_D64,
{ 20 } Decode_NA_ModRm_Ib,
{ 21 } Decode_NA,
{ 22 } Decode_NA_Jb_Df64,
{ 23 } Decode_Group_1,
{ 24 } Decode_Group_1A,
{ 25 } Decode_NA_CALL_Ap_I64,
{ 26 } Decode_NA_OfstV,
{ 27 } Decode_NA_Iv,
{ 28 } Decode_Group_2,
{ 29 } Decode_NA_RET_Iw_Df64,
{ 30 } Decode_NA_RET_Df64,
{ 31 } Decode_VEX3_Prefix,
{ 32 } Decode_VEX2_Prefix,
{ 33 } Decode_Group_11,
{ 34 } Decode_NA_Iw_Ib_D64,
{ 35 } Decode_NA_RET_Iw,
{ 36 } Decode_NA_RET,
{ 37 } Decode_NA_Ib_I64,
{ 38 } Decode_Escape_FPU_D8,
{ 39 } Decode_Escape_FPU_D9,
{ 40 } Decode_Escape_FPU_DA,
{ 41 } Decode_Escape_FPU_DB,
{ 42 } Decode_Escape_FPU_DC,
{ 43 } Decode_Escape_FPU_DD,
{ 44 } Decode_Escape_FPU_DE,
{ 45 } Decode_Escape_FPU_DF,
{ 46 } Decode_NA_CALL_Jz_Df64,
{ 47 } Decode_NA_JMP_Jz_Df64,
{ 48 } Decode_NA_JMP_Ap_I64,
{ 49 } Decode_NA_JMP_Jb_Df64,
{ 50 } Decode_LOCK_Prefix,
{ 51 } Decode_REPNE_Prefix,
{ 52 } Decode_REPE_Prefix,
{ 53 } Decode_Group_3,
{ 54 } Decode_Group_4_INC_DEC,
{ 55 } Decode_Group_5_INC_DEC,
{ 56 } Decode_Group_6,
{ 57 } Decode_Group_7,
{ 58 } Decode_NA_CALL,
{ 59 } Decode_NA_66_F2_F3_ModRm,
{ 60 } Decode_NA_66_ModRm,
{ 61 } Decode_NA_66_F3_ModRm,
{ 62 } Decode_Group_16,
{ 63 } Decode_NA_ModRm_F64,
{ 64 } Decode_Escape_3_Byte,
{ 65 } Decode_NA_F3_ModRm,
{ 66 } Decode_66_ModRm,
{ 67 } Decode_NA_66_F2_F3_ModRm_Ib,
{ 68 } Decode_Group_12,
{ 69 } Decode_Group_13,
{ 70 } Decode_Group_14,
{ 71 } Decode_66_F2_ModRm,
{ 72 } Decode_NA_Jz_Df64,
{ 73 } Decode_Group_15,
{ 74 } Decode_F3_ModRm,
{ 75 } Decode_Group_10_UD2,
{ 76 } Decode_Group_8,
{ 77 } Decode_NA_66_ModRm_Ib,
{ 78 } Decode_Group_9,
{ 79 } Decode_66_F2_F3_ModRm,
{ 80 } Decode_F2_ModRm,
{ 81 } Decode_SP_T38_F0_F7,
{ 82 } Decode_66_ModRm_Ib,
{ 83 } Decode_F2_ModRm_Ib);
{ .$REGION 'COMMON' }
{ ========================== COMMON =============================== }
procedure SetInstError(PInst: PInstruction; Error: Byte);
var
ErrStr: String;
begin
ErrStr := EmptyStr;
if Error = NO_ERROR then
begin
{ Clear Errors ! }
PInst^.Errors := NO_ERROR;
Exit;
end;
PInst^.Errors := PInst^.Errors or Error;
if RaiseExceptionOnError then
begin
if (Error > 0) and (Error < Length(InstErrorsStr)) then
ErrStr := InstErrorsStr[Error]
else
ErrStr := UnknownErrorStr;
raise InstException.Create(Format('Error %d : %s.', [Error, ErrStr]));
end;
end;
function GetModRm_Mod(const Value: Byte): Byte;
begin
Result := Value shr 6;
end;
function GetModRm_Reg(const Value: Byte): Byte;
begin
Result := (Value and $38) shr $03;
end;
function GetModRm_Rm(const Value: Byte): Byte;
begin
Result := Value and 7;
end;
function GetSib_Base(const Value: Byte): Byte;
begin
Result := Value and 7;
end;
function GetSib_Index(const Value: Byte): Byte;
begin
Result := (Value and $38) shr $03;
end;
function GetSib_Scale(const Value: Byte): Byte;
begin
Result := (1 shl (Value shr 6));
end;
function IsSibBaseRegValid(PInst: PInstruction): Boolean;
begin
Result := True;
if PInst^.Sib.Flags and sfUsed <> 0 then
Result := not((PInst^.ModRm.iMod = 0) and (PInst^.Sib.Base = 5));
end;
procedure SetOpCode(PInst: PInstruction); {$IFDEF MustInline}inline; {$ENDIF}
begin
PInst^.OpCode := PInst^.NextInst^;
Inc(PInst^.NextInst);
end;
procedure SetGroup(PInst: PInstruction); {$IFDEF MustInline}inline; {$ENDIF}
begin
PInst^.OpKind := kGrp;
end;
procedure ForceOpSize(PInst: PInstruction); {$IFDEF MustInline}inline; {$ENDIF}
begin
if PInst^.Archi = CPUX32 then
Exit;
PInst^.LID.vOpSize := ops64bits;
end;
procedure DecodeSib(PInst: PInstruction); {$IFDEF MustInline}inline; {$ENDIF}
var
PSib: LPSib;
begin
PSib := @PInst^.Sib;
PSib.Flags := sfUsed;
PSib.Value := PInst^.NextInst^;
PSib.Base := GetSib_Base(PSib.Value);
PSib.Index := GetSib_Index(PSib.Value);
PSib.Scale := GetSib_Scale(PSib.Value);
Inc(PInst^.NextInst); // Skip SIB !
end;
procedure DecodeDisp(PInst: PInstruction);
var
Disp: Int64;
Size: Byte;
DispOnly: Boolean;
begin
Disp := $00;
Size := PInst^.Disp.Size;
PInst^.Disp.Flags := dfUsed;
DispOnly := (PInst^.ModRm.iMod = $00) and (PInst^.ModRm.Rm = $05);
case Size of
ops8bits:
Disp := (PInt8(PInst^.NextInst)^); // and $FF;
ops16bits:
Disp := (PInt16(PInst^.NextInst)^); // and $FFFF;
ops32bits:
begin
Disp := (PInt32(PInst^.NextInst)^); // and $FFFFFFFF;
if (PInst^.Archi = CPUX64) and DispOnly then
{ RIP disp ! }
PInst^.Disp.Flags := PInst^.Disp.Flags or dfRip;
end;
else
SetInstError(PInst, ERROR_DISP_SIZE);
end;
if DispOnly then
PInst^.Disp.Flags := PInst^.Disp.Flags or dfDispOnly
else
PInst^.Disp.Flags := PInst^.Disp.Flags or dfSigned;
PInst^.Disp.Value := Disp;
Inc(PInst^.NextInst, Size) // Skip Disp !
end;
procedure Decode_ModRm(PInst: PInstruction);
var
PModRM: LPModRM;
SibUsed: Boolean;
const
{ Get Disp Size from ModRm . }
ModRMFlagsToDispSize: array [0 .. 4] of Byte = (0, ops8bits, ops16bits, 0, ops32bits);
begin
PModRM := @PInst^.ModRm;
PModRM.Value := PInst^.NextInst^;
PModRM.iMod := GetModRm_Mod(PModRM.Value);
PModRM.Reg := GetModRm_Reg(PModRM.Value);
PModRM.Rm := GetModRm_Rm(PModRM.Value);
PModRM.Flags := ModRMFlags[PInst^.AddrMode][PModRM.Value];
PInst^.Disp.Size := ModRMFlagsToDispSize[(PModRM.Flags shr 1) and 7];
Inc(PInst^.NextInst); // Skip ModRM !
SibUsed := (PModRM.Flags and $10 > 0); { SibUsed ! }
if SibUsed then
begin
DecodeSib(PInst);
{ if the base is not valid ==> there is a disp32 .
But the disp can be 8bit ==> we need to check first
if the disp does not exist !
}
if (PInst^.Disp.Size = 0) and (not IsSibBaseRegValid(PInst)) then
PInst^.Disp.Size := ops32bits;
end;
if PInst^.Disp.Size > 0 then
DecodeDisp(PInst);
{ ModRm Exists ! }
PModRM.Flags := PModRM.Flags or mfUsed;
end;
procedure Decode_Imm(PInst: PInstruction; immSize: Byte);
var
Imm: Int64;
PImm: PImmediat;
begin
Imm := $00;
case immSize of
ops8bits:
Imm := (PInt8(PInst^.NextInst)^);
ops16bits:
Imm := (PInt16(PInst^.NextInst)^);
ops32bits:
Imm := (PInt32(PInst^.NextInst)^);
ops64bits:
Imm := (PInt64(PInst^.NextInst)^);
else
SetInstError(PInst, ERROR_IMM_SIZE);
end;
{
If Imm field already used => get the extra Imm
}
if PInst^.Imm.Flags and imfUsed <> $00 then
PImm := @PInst^.ImmEx
else
PImm := @PInst^.Imm;
PImm.Flags := imfUsed;
PImm.Value := Imm;
PImm.Size := immSize;
Inc(PInst^.NextInst, immSize); // Skip Immediat !
end;
procedure Decode_J(PInst: PInstruction; Size: Byte);
var
Value: Int64;
VA: PByte;
begin
Value := $00;
case Size of
ops8bits:
Value := (PInt8(PInst^.NextInst)^);
ops16bits:
Value := (PInt16(PInst^.NextInst)^);
ops32bits:
Value := (PInt32(PInst^.NextInst)^);
ops64bits:
Value := (PInt64(PInst^.NextInst)^);
end;
Inc(PInst^.NextInst, Size);
if PInst^.OpType = otNone then
PInst^.OpType := otJ;
if PInst^.OpCode in [$70 .. $8F] then
PInst^.OpType := otJ or otJcc;
if Assigned(PInst^.VirtualAddr) then
VA := PByte(NativeInt(PInst^.VirtualAddr) + NativeInt(NativeInt(PInst^.NextInst) - NativeInt(PInst^.Addr)))
else
VA := PInst^.NextInst;
PInst^.Branch.Size := Size;
PInst^.Branch.Falgs := bfUsed or bfRel;
PInst^.Branch.Value := Value;
PInst^.Branch.Target := PByte(NativeInt(VA) + Value);
end;
procedure Decode_Branch_ModRm(PInst: PInstruction);
var
P: PByte;
VA: PByte;
begin
SetOpCode(PInst);
Decode_ModRm(PInst);
PInst^.Branch.Value := PInst^.Disp.Value;
PInst^.Branch.Size := PInst^.Disp.Size;
PInst^.Branch.Falgs := bfUsed or bfIndirect or bfAbs;
if Assigned(PInst^.VirtualAddr) then
VA := PByte(NativeInt(PInst^.VirtualAddr) + (NativeInt(PInst^.NextInst) - NativeInt(PInst^.Addr)))
else
VA := PInst^.NextInst;
if (PInst^.ModRm.iMod = $00) and (PInst^.ModRm.Rm = $05) then
begin
{ Memory = Displacement }
if PInst^.Archi = CPUX64 then
begin
if PInst^.Prefixes and Prf_AddrSize <> 0 then
{ Displacement = EIP + Offset }
VA := PByte(UInt64(VA) and $FFFFFFFF);
{ Displacement = RIP + Offset }
PInst^.Branch.Falgs := PInst^.Branch.Falgs or bfRip;
P := PByte(NativeInt(VA) + NativeInt(PInst^.Disp.Value));
{ Memory 64-bits }
PInst^.Branch.Target := PByte(PUInt64(P)^);
end
else
begin
{ No RIP }
P := PByte(UInt32(PInst^.Disp.Value));
if PInst^.Prefixes and Prf_OpSize <> 0 then
{ Memory 16-bits }
PInst^.Branch.Target := PByte(PUInt16(P)^)
else
{ Memory 32-bits }
PInst^.Branch.Target := PByte(PUInt32(P)^);
end;
end
else
begin
{ Memory = Displacement + Register }
PInst^.Branch.Falgs := PInst^.Branch.Falgs or bfReg;
PInst^.Branch.Target := nil;
end;
end;
procedure Decode_Ap(PInst: PInstruction);
begin
SetOpCode(PInst);
PInst^.Branch.Falgs := bfUsed or bfFar;
{ We must clear the upper word ! }
PInst^.Branch.Value := PUInt64(PInst^.NextInst)^ and $FFFFFFFFFFFF;
PInst^.Branch.Size := ops48bits;
PInst^.Branch.Target := nil;
Inc(PInst^.NextInst, ops48bits);
end;
procedure Decode_Mp(PInst: PInstruction);
begin
SetOpCode(PInst);
PInst^.Branch.Falgs := bfUsed or bfFar;
Decode_ModRm(PInst);
PInst^.Branch.Value := PInst^.Disp.Value;
PInst^.Branch.Size := PInst^.Disp.Size;
PInst^.Branch.Target := nil;
end;
procedure Decode_InvalidOpCode(PInst: PInstruction); {$IFDEF MustInline}inline;
{$ENDIF}
begin
SetOpCode(PInst);
end;
procedure Decode_Invalid_Group(PInst: PInstruction); {$IFDEF MustInline}inline;
{$ENDIF}
begin
SetOpCode(PInst);
Inc(PInst^.NextInst);
end;
procedure Decode_Invalid_FPU(PInst: PInstruction); {$IFDEF MustInline}inline;
{$ENDIF}
begin
SetOpCode(PInst);
Inc(PInst^.NextInst);
end;
{ .$ENDREGION }
{ .$REGION 'PREFIXES' }
{ ========================== PREFIXES =============================== }
procedure Decode_ES_Prefix(PInst: PInstruction);
begin
{ ES Segment Override Prefix }
Inc(PInst^.NextInst);
PInst^.Prefixes := PInst^.Prefixes or Prf_Seg_ES;
PInst^.SegReg := Seg_ES;
DecoderProcTable[OneByteTable[PInst^.NextInst^]](PInst);
end;
procedure Decode_CS_Prefix(PInst: PInstruction);
begin
{ CS Segment Override Prefix }
Inc(PInst^.NextInst);
PInst^.Prefixes := PInst^.Prefixes or Prf_Seg_CS;
PInst^.SegReg := Seg_CS;
DecoderProcTable[OneByteTable[PInst^.NextInst^]](PInst);
end;
procedure Decode_SS_Prefix(PInst: PInstruction);
begin
{ SS Segment Override Prefix }
Inc(PInst^.NextInst);
PInst^.Prefixes := PInst^.Prefixes or Prf_Seg_SS;
PInst^.SegReg := Seg_SS;
DecoderProcTable[OneByteTable[PInst^.NextInst^]](PInst);
end;
procedure Decode_DS_Prefix(PInst: PInstruction);
begin
{ DS Segment Override Prefix }
Inc(PInst^.NextInst);
PInst^.Prefixes := PInst^.Prefixes or Prf_Seg_DS;
PInst^.SegReg := Seg_DS;
DecoderProcTable[OneByteTable[PInst^.NextInst^]](PInst);
end;
procedure Decode_REX_Prefix(PInst: PInstruction);
begin
{ REX Prefix valid only on PM64! }
if PInst^.Archi = CPUX32 then
begin
{ INC/DEC REG }
Decode_NA(PInst);
Exit;
end;
PInst^.Prefixes := PInst^.Prefixes or Prf_Rex;
PInst^.Rex.Value := PInst^.NextInst^;
PInst^.Rex.B := (PInst^.Rex.Value and 1 <> 0);
PInst^.Rex.X := (PInst^.Rex.Value and 2 <> 0);
PInst^.Rex.R := (PInst^.Rex.Value and 4 <> 0);
PInst^.Rex.W := (PInst^.Rex.Value and 8 <> 0);
if PInst^.Rex.W then
PInst^.LID.vOpSize := ops64bits;
Inc(PInst^.NextInst); // Skip Rex .
DecoderProcTable[OneByteTable[PInst^.
gitextract_bn3fmd73/
├── .gitignore
├── CHANGELOG
├── Clean.bat
├── Demo/
│ ├── Delphi/
│ │ ├── D7/
│ │ │ ├── D7.dpr
│ │ │ ├── uMain.dfm
│ │ │ └── uMain.pas
│ │ └── Demo1/
│ │ ├── Demo1.dpr
│ │ ├── Demo1.dproj
│ │ ├── uMain.dfm
│ │ └── uMain.pas
│ └── Lazarus/
│ └── Demo1/
│ ├── Demo1.lpi
│ ├── Demo1.lpr
│ ├── Demo1.lps
│ ├── umain.lfm
│ └── umain.pas
├── LICENSE
├── README.md
├── Source/
│ ├── CPUID.pas
│ ├── DDetours.pas
│ ├── DDetoursDefs.inc
│ ├── InstDecode.pas
│ ├── LegacyTypes.pas
│ ├── ModRmFlagsTables.inc
│ ├── OpCodesTables.inc
│ └── TlHelp32.inc
└── Test/
├── Test.dpr
├── Test.dproj
└── uTest.pas
Condensed preview — 28 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (324K chars).
[
{
"path": ".gitignore",
"chars": 1347,
"preview": "# Uncomment these types if you want even more clean repository. But be careful.\n# It can make harm to an existing projec"
},
{
"path": "CHANGELOG",
"chars": 1588,
"preview": "version 2.2(Jun 9, 2020):\n +Added support for older Delphi version: Now the minimal supported Delphi version is D7.\n +"
},
{
"path": "Clean.bat",
"chars": 973,
"preview": "rem *****************************************\nrem * Delphi CleanUp Batch. *\nrem * "
},
{
"path": "Demo/Delphi/D7/D7.dpr",
"chars": 166,
"preview": "program D7;\n\nuses\n Forms,\n uMain in 'uMain.pas' {Main};\n\n{$R *.res}\n\nbegin\n Application.Initialize;\n Application.Cre"
},
{
"path": "Demo/Delphi/D7/uMain.dfm",
"chars": 837,
"preview": "object Main: TMain\n Left = 192\n Top = 125\n Width = 238\n Height = 191\n BorderStyle = bsSizeToolWin\n Caption = 'Main"
},
{
"path": "Demo/Delphi/D7/uMain.pas",
"chars": 1780,
"preview": "unit uMain;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,\n Dialogs, Std"
},
{
"path": "Demo/Delphi/Demo1/Demo1.dpr",
"chars": 402,
"preview": "program Demo1;\n\nuses\n Vcl.Forms,\n uMain in 'uMain.pas' {Main},\n CPUID in '..\\..\\..\\Source\\CPUID.pas',\n DDetours in '"
},
{
"path": "Demo/Delphi/Demo1/Demo1.dproj",
"chars": 40750,
"preview": "<Project xmlns=\"http://schemas.microsoft.com/developer/msbuild/2003\">\n <PropertyGroup>\n <ProjectGuid>{F3F0668"
},
{
"path": "Demo/Delphi/Demo1/uMain.dfm",
"chars": 847,
"preview": "object Main: TMain\n Left = 0\n Top = 0\n BorderStyle = bsToolWindow\n Caption = 'Main'\n ClientHeight = 134\n ClientWid"
},
{
"path": "Demo/Delphi/Demo1/uMain.pas",
"chars": 1845,
"preview": "unit uMain;\n\ninterface\n\nuses\n Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Gr"
},
{
"path": "Demo/Lazarus/Demo1/Demo1.lpi",
"chars": 2040,
"preview": "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<CONFIG>\n <ProjectOptions>\n <Version Value=\"11\"/>\n <PathDelim Value=\"\\\"/>\n"
},
{
"path": "Demo/Lazarus/Demo1/Demo1.lpr",
"chars": 382,
"preview": "program Demo1;\n\n{$mode objfpc}{$H+}\n\nuses\n {$IFDEF UNIX}{$IFDEF UseCThreads}\n cthreads,\n {$ENDIF}{$ENDIF}\n Interface"
},
{
"path": "Demo/Lazarus/Demo1/Demo1.lps",
"chars": 4186,
"preview": "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<CONFIG>\n <ProjectSession>\n <PathDelim Value=\"\\\"/>\n <Version Value=\"11\"/>\n"
},
{
"path": "Demo/Lazarus/Demo1/umain.lfm",
"chars": 699,
"preview": "object Main: TMain\n Left = 256\n Height = 137\n Top = 145\n Width = 242\n BorderStyle = bsToolWindow\n Caption = 'Main'"
},
{
"path": "Demo/Lazarus/Demo1/umain.pas",
"chars": 1792,
"preview": "unit uMain;\n\n{$mode Delphi}{$H+}\n\n\ninterface\n\nuses\n Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,\n "
},
{
"path": "LICENSE",
"chars": 16725,
"preview": "Mozilla Public License Version 2.0\n==================================\n\n1. Definitions\n--------------\n\n1.1. \"Contributor\""
},
{
"path": "README.md",
"chars": 2072,
"preview": "\n![License](https://img.shields.io/github/license/MahdiS"
},
{
"path": "Source/CPUID.pas",
"chars": 5585,
"preview": "// **************************************************************************************************\n// CPUID for Delph"
},
{
"path": "Source/DDetours.pas",
"chars": 77927,
"preview": "// **************************************************************************************************\n// Delphi Detours "
},
{
"path": "Source/DDetoursDefs.inc",
"chars": 769,
"preview": "{.$DEFINE HOOK_INTERNAL_FUNCTIONS} // hook internal functions.\n\n{$IFDEF FPC}\n {$ASMMODE INTEL}\n{$ELSE !FPC}\n\n{$T-}\n\n{"
},
{
"path": "Source/InstDecode.pas",
"chars": 65433,
"preview": "// **************************************************************************************************\n// x86 Instruction"
},
{
"path": "Source/LegacyTypes.pas",
"chars": 873,
"preview": "// **************************************************************************************************\n//\n// https://gith"
},
{
"path": "Source/ModRmFlagsTables.inc",
"chars": 5419,
"preview": "// **************************************************************************************************\n// Part of x86 Ins"
},
{
"path": "Source/OpCodesTables.inc",
"chars": 31505,
"preview": "// **************************************************************************************************\n// Part of x86 Ins"
},
{
"path": "Source/TlHelp32.inc",
"chars": 1045,
"preview": "{ TlHelp32 types for fpc }\n\nconst\n TH32CS_SNAPHEAPLIST = $00000001;\n TH32CS_SNAPPROCESS = $00000002;\n TH32CS_SNAPTHR"
},
{
"path": "Test/Test.dpr",
"chars": 1575,
"preview": "program Test;\n\n{$IFNDEF TESTINSIGHT}\n{$APPTYPE CONSOLE}\n{$ENDIF}{$STRONGLINKTYPES ON}\nuses\n System.SysUtils,\n {$IFDEF "
},
{
"path": "Test/Test.dproj",
"chars": 40052,
"preview": "<Project xmlns=\"http://schemas.microsoft.com/developer/msbuild/2003\">\n <PropertyGroup>\n <ProjectGuid>{AE7FD8B"
},
{
"path": "Test/uTest.pas",
"chars": 2555,
"preview": "unit uTest;\n\ninterface\n\nuses\n DUnitX.TestFramework, DDetours;\n\ntype\n\n [TestFixture]\n TDDetours = class(TObject)\n pub"
}
]
About this extraction
This page contains the full source code of the MahdiSafsafi/delphi-detours-library GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 28 files (303.9 KB), approximately 92.5k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.