MahdiSafsafi
commented
4 years ago Hello there, I don't really have much time but I managed to make a very tiny Profiler using DDetours.
- It works only on 32-bit.
- Lacks of optimization.
- Doesn't handle exceptions.
I believe it would be helpful for you. Start by studying it and try to improve it. A minimal assembly skills is required.
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,
System.Diagnostics;
type
TMain = class(TForm)
BtnMsgBox: TButton;
Memo1: TMemo;
procedure BtnMsgBoxClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Main: TMain;
implementation
{$R *.dfm}
procedure TMain.BtnMsgBoxClick(Sender: TObject);
begin
MessageBox(0, 'text', 'caption', 0);
end;
type
TProfileStruct = record
Stopwatch: TStopwatch;
Name: string;
Proc: Pointer;
Trampoline: Pointer;
ReturnAddress: Pointer;
end;
PProfileStruct = ^TProfileStruct;
threadvar ProfileStruct: PProfileStruct;
var
GProfileStructList: TList;
function GetCurrentProfileStruct(): PProfileStruct;
begin
Result := ProfileStruct;
end;
procedure ProfileStart(Struct: PProfileStruct);
begin
Struct.Stopwatch.Reset();
Struct.Stopwatch.Start();
end;
procedure ProfileEnd(Struct: PProfileStruct);
begin
Struct.Stopwatch.Stop();
Main.Memo1.Lines.Add(Format('function "%s" took %s', [Struct.Name, Struct.Stopwatch.Elapsed.ToString]));
end;
procedure DoProfile;
asm
pushad // save registers
call GetCurrentProfileStruct // eax = GetCurrentProfileStruct()
push eax
call ProfileStart // ProfileStart(Struct)
pop eax
mov ecx, [esp + (8 * 4)] // current return address
mov TProfileStruct.[eax].ReturnAddress, ecx // save current return address
mov [esp + (8 * 4)], offset @NewReturnAddress // new return address.
mov ecx, TProfileStruct.[eax].Trampoline // ecx = Trampoline
push ecx // push Trampoline
pop ecx // dummy pop
popad // restore registers
jmp [esp - (9*4)] // jmp to original method.
// after original method returns, it returns here:
@NewReturnAddress:
push eax
call GetCurrentProfileStruct
push eax
call ProfileEnd // ProfileEnd(Struct)
pop eax
mov eax, TProfileStruct.[eax].ReturnAddress // original return address
push eax // push return address
pop eax // pop return address
pop eax // pop register
push [esp - (2 * 4)] // push xxx + ret = jmp xxx
ret // jmp to original return address.
end;
procedure SaveStruct(AStruct: PProfileStruct); stdcall;
begin
ProfileStruct := AStruct;
{ stdcall = clean stack }
end;
procedure CreateProfile(Proc: Pointer; const Name: string);
var
P: Pointer;
Trampoline: Pointer;
Struct: PProfileStruct;
begin
P := VirtualAlloc(nil, 1024, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE);
GProfileStructList.Add(P);
Struct := P;
Inc(PByte(P), sizeof(TProfileStruct));
Trampoline := InterceptCreate(Proc, P);
Struct^.Name := Name;
Struct^.Proc := Proc;
Struct^.Trampoline := Trampoline;
// pushad
PByte(P)^ := $60;
Inc(PByte(P));
// push struct
PByte(P)^ := $68;
Inc(PByte(P));
PDword(P)^ := DWORD(Struct);
Inc(PDword(P));
// call SaveStruct
PByte(P)^ := $E8;
Inc(PByte(P));
PInteger(P)^ := Integer(@SaveStruct) - Integer(P) - 4;
Inc(PDword(P));
// popad
PByte(P)^ := $61;
Inc(PByte(P));
// jmp DoProfile
PByte(P)^ := $E9;
Inc(PByte(P));
PInteger(P)^ := Integer(@DoProfile) - Integer(P) - 4;
Inc(PDword(P));
end;
var
i: Integer;
initialization
GProfileStructList := TList.Create();
CreateProfile(@MessageBox, 'MessageBox');
finalization
for i := 0 to GProfileStructList.Count - 1 do
VirtualFree(Pointer(GProfileStructList.Items[i]), 1024, MEM_RELEASE);
GProfileStructList.Free();
end.Have a nice day, Mahdi.
ASM Profiler uses the tricks of DDetours and produces fantastic results however it has fallen out of being maintained and errors sometimes when profiling probably due to new features in Delphi.
The actual Intercepting part is relatively small but if could be handled by DDetours it would replace ASM Profiler.
I get the bit of getting a list of procs from the map file but the two key parts which although there is little asm are beyond me.
Having InterceptCreate call a proc without the same signature and the calling registers pushed onto stack before and popped after so although the interceptor doesnt get the params they are passed on correctly to the original proc.
Having a post intercepted proc interceptor such as PreOriginalProc OriginalProc PostOriginalProc
I post this in the hope someone finds the idea of having a DDetours profiler as enticing as I but has more experience with the inner workings of asm.
I have pasted below the main part of the code below in case interested.
Many thanks