Delphi Inline ASM GetProcAddress Api Replacement

posted 2 Sep 2010, 13:47 by Delphi Basics
This code can be used as a replacement for the GetProcAddress Api call 

Tested and working Windows XP, Vista, 7; x86, x64 

Author: NicoDE 
Compiled: Delphi 2007 

program GetProcAddress;

uses
  Windows;

const
  MAX_API_STRING_LENGTH = 150;

type
  PSEHStruct = ^TSEHStruct;
  TSEHStruct = record
    saveEsp: Cardinal;
    saveEbp: Cardinal;
    gotoEip: Cardinal;
  end;

var
  SEH: TSEHStruct;

function SEHHandler(p1, p2, p3, p4: Pointer): Cardinal; cdecl;
begin
  with PContext(p3)^ do
  begin
    Esp := SEH.saveEsp;
    Ebp := SEH.saveEbp;
    Eip := SEH.gotoEip;
  end;
  Result := 0;  // ExceptionContinueExecution
end;

function ASMGetProcAddress(DllBase: LongWord; ApiName: PChar): Pointer; pascal;
{ directive "pascal" to force stack frame }
asm
        { save used registers }
        PUSH    ESI
        PUSH    EDI
        PUSH    ECX
        PUSH    EBX
        PUSH    EDX
        { using [EDX] saves some space over [0] }
        XOR     EDX, EDX
        { set up SEH frame }
        PUSH    OFFSET SEHHandler
        PUSH    DWORD PTR FS:[EDX]
        MOV     SEH.saveEsp, ESP
        MOV     SEH.saveEbp, EBP
        MOV     SEH.gotoEip, OFFSET @@NotFound
        MOV     FS:[EDX], ESP
        { string length the target api }
        MOV     EDI, ApiName
        MOV     ECX, MAX_API_STRING_LENGTH
        XOR     AL, AL
        REPNZ   SCASB
        MOV     ECX, EDI
        SUB     ECX, ApiName
        { get and check PE file header }
        MOV     EDX, DllBase
        CMP     [EDX].TImageDosHeader.e_magic, IMAGE_DOS_SIGNATURE
        JNZ     @@NotFound
        ADD     EDX, [EDX].TImageDosHeader._lfanew
        CMP     [EDX].TImageNtHeaders.Signature, IMAGE_NT_SIGNATURE
        JNZ     @@NotFound
        { get and check export directory }
        MOV     EDX, [EDX].TImageNtHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].TImageDataDirectory.VirtualAddress
        OR      EDX, EDX
        JZ      @@NotFound
        ADD     EDX, DllBase
        { scan names }
        MOV     EBX, [EDX].TImageExportDirectory.AddressOfNames
        ADD     EBX, DllBase
        XOR     EAX, EAX
@@Loop:
        MOV     EDI, [EBX]
        ADD     EDI, DllBase
        MOV     ESI, ApiName
        PUSH    ECX
        REPZ    CMPSB
        POP     ECX
        JE      @@Found
        ADD     EBX, 4
        INC     EAX
        CMP     EAX, [EDX].TImageExportDirectory.NumberOfNames
        JB      @@Loop
        JMP     @@NotFound
@@Found:
        { name -> ordinal }
        SHL     EAX, 1
        ADD     EAX, [EDX].TImageExportDirectory.AddressOfNameOrdinals
        ADD     EAX, DllBase
        MOV     AX, [EAX]
        AND     EAX, $0000FFFF
        { ordinal -> function }
        SHL     EAX, 2
        ADD     EAX, [EDX].TImageExportDirectory.AddressOfFunctions
        ADD     EAX, DllBase
        MOV     EAX, [EAX]
        ADD     EAX, DllBase
        JMP     @@Exit
@@NotFound:
        { return 0 on error }
        XOR     EAX, EAX
@@Exit:
        { clean up SEH frame }
        XOR     EDX, EDX
        POP     DWORD PTR FS:[EDX]
        ADD     ESP, 4
        { restore used registers }
        POP     EDX
        POP     EBX
        POP     ECX
        POP     EDI
        POP     ESI
end;

var
  xMessageBoxA : function(hWnd: HWND; lpText, lpCaption: PAnsiChar; uType: UINT): Integer; stdcall;

begin
  xMessageBoxA := ASMGetProcAddress(LoadLibrary('user32.dll'),'MessageBoxA');
  if Assigned(xMessageBoxA) then
    xMessageBoxA(0,'Assigned!','',0);
end.
Comments