MiTec/Common/MiTeC_ImageHlp.pas

{*******************************************************}
{                      MiTeC                            }
{              ImageHlp declarations                     }
{                                                       }
{         Copyright (c) 2006-2021 Michal Mutl           }
{                                                       }
{*******************************************************}

{$INCLUDE Compilers.inc}

unit MiTeC_ImageHlp;

interface

uses {$IFDEF RAD9PLUS}
     WinAPI.Windows, System.SysUtils, WinApi.ImageHlp, System.Classes,
     {$ELSE}
     Windows, SysUtils, ImageHlp, Classes,
     {$ENDIF}
     MiTeC_Windows;

const
  ImageHlpLib = 'IMAGEHLP.DLL';

const
  cBuffSize = $7FF;

type
  {$IFDEF FPC}
  PImagehlpSymbol = ^TImagehlpSymbol;
  _IMAGEHLP_SYMBOL = record
    SizeOfStruct: DWORD;
    Address: NativeUInt;
    Size: DWORD;
    Flags: DWORD;
    MaxNameLength: DWORD;
    Name: packed array[0..0] of Byte;
  end;
  IMAGEHLP_SYMBOL = _IMAGEHLP_SYMBOL;
  TImagehlpSymbol = _IMAGEHLP_SYMBOL;
  {$ENDIF}

  _IMAGEHLP_SYMBOL64 = record
    SizeOfStruct: Cardinal;
    Address: UInt64;
    Size: Cardinal;
    Flags: Cardinal;
    MaxNameLength: Cardinal;
    Name: packed array[0..0] of Byte;
  end;
  TImagehlpSymbol64 = _IMAGEHLP_SYMBOL64;
  PImagehlpSymbol64 = ^TImagehlpSymbol64;

  {$IFDEF FPC}
  TSymEnumSymbolsCallback = TSYM_ENUMSYMBOLS_CALLBACK;
  {$ENDIF}

  {$IFDEF WIN64}
  function SymGetSymFromAddr(hProcess: THandle; dwAddr: ULONG_PTR; pdwDisplacement: PDWORD64; Symbol: PImagehlpSymbol64): Bool; stdcall;
    external ImageHlpLib name 'SymGetSymFromAddr64';
  function SymLoadModule(hProcess: THandle; hFile: THandle; ImageName, ModuleName: LPSTR; BaseOfDll: ULONG_PTR; SizeOfDll: DWORD): DWORD; stdcall;
    external ImageHlpLib name 'SymLoadModule64';
  function SymUnloadModule(hProcess: THandle; BaseOfDll: ULONG_PTR): Bool; stdcall;
    external ImageHlpLib name 'SymUnloadModule64';
  function SymEnumerateSymbols(hProcess: THandle; BaseOfDll: ULONG_PTR; EnumSymbolsCallback: TSymEnumSymbolsCallback; UserContext: Pointer): Bool; stdcall;
    external ImageHlpLib name 'SymEnumerateSymbols64';
  {$ELSE}
  function SymGetSymFromAddr(hProcess: THandle; dwAddr: ULONG_PTR; pdwDisplacement: PDWORD; Symbol: PImagehlpSymbol): Bool; stdcall;
    external ImageHlpLib;
  function SymLoadModule(hProcess: THandle; hFile: THandle; ImageName, ModuleName: LPSTR; BaseOfDll: ULONG_PTR; SizeOfDll: DWORD): DWORD; stdcall;
    external ImageHlpLib;
  function SymUnloadModule(hProcess: THandle; BaseOfDll: ULONG_PTR): Bool; stdcall;
    external ImageHlpLib;
  function SymEnumerateSymbols(hProcess: THandle; BaseOfDll: ULONG_PTR; EnumSymbolsCallback: TSymEnumSymbolsCallback; UserContext: Pointer): Bool; stdcall;
    external ImageHlpLib;
  {$ENDIF}

function GetDescriptionAtAddr(AProcessHandle: THandle; AAddress, ABaseAddress: NativeUINt; const AModuleName: string): string;
function GetDescriptionAtAddr2(AProcessHandle: THandle; AAddress,ABaseAddress: NativeUInt; const AModuleName: string): string;
procedure GetExportFuncList(AProcessHandle: THandle; const AModuleName: string; ABaseAddress: NativeUInt; ALIst: TStringList);

implementation

function GetDescriptionAtAddr(AProcessHandle: THandle; AAddress, ABaseAddress: NativeUINt; const AModuleName: string): string;
const
{$IFDEF WIN64}
  cStructSize = SizeOf(TImagehlpSymbol64);
  cMaxNameLength = cBuffSize-cStructSize;
var
  Symbol: PImagehlpSymbol64;
{$ELSE}
  cStructSize = SizeOf(TImagehlpSymbol);
  cMaxNameLength = cBuffSize-cStructSize;
var
  Symbol: PImagehlpSymbol;
{$ENDIF}
  Displacement: NativeUInt;
  ph: THandle;
begin
  Result:='';
  SymSetOptions(SYMOPT_UNDNAME or SYMOPT_DEFERRED_LOADS);
  ph:=AProcessHandle;
  if ph=0 then
    ph:=GetCurrentProcess;

  if not SymInitialize(ph,nil,True) then
    Exit;
  Symbol:=AllocMem(cBuffSize);
  try
    Symbol^.SizeOfStruct:=cStructSize;
    Symbol^.MaxNameLength:=cMaxNameLength;
    Symbol^.Size:=0;
    SymLoadModule(ph,0,PAnsiChar(AnsiString(AModuleName)),nil,ABaseAddress,0);
    try
      if SymGetSymFromAddr(ph,AAddress,@Displacement,Symbol) then begin
        if Displacement=0 then
          Result:=string(PAnsiChar(@(Symbol^).Name[0]))
        else
          Result:=string(PAnsiChar(@(Symbol^).Name[0]))+'+ 0x'+IntToHex(Displacement,4);
      end else begin
        SymLoadModule(ph,0,PAnsiChar(AnsiString(AModuleName)),nil,ABaseAddress,0);
        if SymGetSymFromAddr(ph,AAddress,@Displacement,Symbol) then begin
          if Displacement=0 then
            Result:=string(PAnsiChar(@(Symbol^).Name[0]))
          else
            Result:=string(PAnsiChar(@(Symbol^).Name[0]))+'+ 0x'+IntToHex(Displacement,4);
        end;
      end;
    finally
      SymUnloadModule(ph,ABaseAddress);
    end;
  finally
    FreeMem(Symbol);
    SymCleanup(ph);
  end;
  if Result='' then
    Result:=ExtractFileName(AModuleName)+' + 0x'+IntToHex(AAddress-ABaseAddress,1)
  else
    Result:=ExtractFileName(AModuleName)+'!'+Result;
end;

function GetDescriptionAtAddr2(AProcessHandle: THandle; AAddress,ABaseAddress: NativeUInt; const AModuleName: string): string;
const
{$IFDEF WIN64}
  cStructSize = SizeOf(TImagehlpSymbol64);
  cMaxNameLength = cBuffSize-cStructSize;
var
  Symbol: PImagehlpSymbol64;
{$ELSE}
  cStructSize = SizeOf(TImagehlpSymbol);
  cMaxNameLength = cBuffSize-cStructSize;
var
  Symbol: PImagehlpSymbol;
{$ENDIF}
  Displacement: NativeUInt;
  ph: THandle;
begin
  Result:='';
  SymSetOptions(SYMOPT_UNDNAME or SYMOPT_DEFERRED_LOADS);
  ph:=AProcessHandle;
  if ph=0 then
    ph:=GetCurrentProcess;
  if not SymInitialize(ph,nil,True) then
    Exit;
  Symbol:=AllocMem(cBuffSize);
  try
    Symbol^.SizeOfStruct:=cStructSize;
    Symbol^.MaxNameLength:=cMaxNameLength;
    Symbol^.Size:=0;
    SymLoadModule(ph,0,PAnsiChar(AnsiString(AModuleName)),nil,ABaseAddress,0);
    try
      if SymGetSymFromAddr(ph,AAddress,@Displacement,Symbol) then begin
        if Displacement=0 then
          Result:=string(PAnsiChar(@(Symbol^).Name[0]));
      end else begin
        SymLoadModule(ph,0,PAnsiChar(AnsiString(AModuleName)),nil,ABaseAddress,0);
        if SymGetSymFromAddr(ph,AAddress,@Displacement,Symbol) then
          if Displacement=0 then
            Result:=string(PAnsiChar(@(Symbol^).Name[0]));
      end;
    finally
      SymUnloadModule(ph,ABaseAddress);
    end;
  finally
    FreeMem(Symbol);
    SymCleanup(ph);
  end;
  if Result<>'' then
    Result:=ExtractFileName(AModuleName)+'!'+Result;
end;

function SymEnumsymbolsCallback(ASymbolName: PAnsiChar; ASymbolAddress: NativeUInt; ASymbolSize: Cardinal; AUserContext: Pointer): Bool; stdcall;
var
  List: TStringList;
begin
  List:=AUserContext;
  List.Add('0x'+IntToHex(ASymbolAddress,sizeof(NativeUInt))+'='+string(ASymbolName));
  Result:=True;
end;

procedure GetExportFuncList(AProcessHandle: THandle; const AModuleName: string; ABaseAddress: NativeUInt; ALIst: TStringList);
var
  ph: THandle;
begin
  AList.Clear;
  SymSetOptions(SYMOPT_UNDNAME or SYMOPT_DEFERRED_LOADS);
  ph:=AProcessHandle;
  if ph=0 then
    ph:=GetCurrentProcess;
  if not SymInitialize(ph,nil,True) then
    Exit;
  SymLoadModule(ph,0,PAnsiChar(AnsiString(AModuleName)),nil,ABaseAddress,0);
  try
    if not SymEnumerateSymbols(ph,ABaseAddress,@SymEnumsymbolsCallback,AList) then begin
      SymLoadModule(ph,0,PAnsiChar(AnsiString(AModuleName)),nil,ABaseAddress,0);
      SymEnumerateSymbols(ph,ABaseAddress,@SymEnumsymbolsCallback,AList);
    end;
  finally
    SymUnloadModule(ph,ABaseAddress);
    SymCleanup(ph);
  end;
end;

end.