... call a DLL function with variable RT-parameter dynamically?

Author: Thomas Weidenmueller
Homepage: http://www.w3seek.us

Category: System

(*
--- english -------------------------------------------------------------------
These two functions allow to dynamically call DLL functions with dynamically
customizable parameters.
Also allow a programm to call a function with at design time unknown parameters
(you'll have to implement the dynamicall filling of the array of pointer).
--- german --------------------------------------------------------------------
Mit diesen Funktionen können Sie dynamische Aufrufe von DLL-Funktionen
realisieren.
Sie legen zur Laufzeit den Namen der Funktion und bestimmen ebenso welche
Parameter übergeben werden sollen und von welchem Typ diese sind (zu
Letzteres kann eine entsprechende Prozedur geschrieben werden).
*)

// Calls a function from a library.
// if it's not loaded yet, it will call LoadLibrary() to load it.
function DynamicDllCallName(Dll: Stringconst Name: String; HasResult: Boolean; var Returned: Cardinal; const Parameters: array of Pointer): Boolean;
var
  
prc: Pointer;
  x, n: Integer;
  p: Pointer;
  dllh: THandle;
begin
  
dllh := GetModuleHandle(PChar(Dll));
  if dllh = 0 then begin
    
dllh := LoadLibrary(PChar(Dll));
  end;
  if dllh <> 0 then begin
    
prc := GetProcAddress(dllh, PChar(Name));
    if Assigned(prc) then begin
      
n := High(Parameters);
      if n > -1 then begin
        
x := n;
        repeat
          
p := Parameters[x];
          asm
            
PUSH p
          end;
          Dec(x);
        until x = -1;
      end;
      asm
        
CALL prc
      end;
      if HasResult then begin
        asm
          
MOV p, EAX
        end;
        Returned := Cardinal(p);
      end else begin
        
Returned := 0;
      end;
    end else begin
      
Returned := 0;
    end;
    Result := Assigned(prc);
  end else begin
    
Result := false;
  end;
end;

// Calls a function from a loaded library
function DynamicDllCall(hDll: THandle; const Name: String; HasResult: Boolean; var Returned: Cardinal; const Parameters: array of Pointer): Boolean;
var
  
prc: Pointer;
  x, n: Integer;
  p: Pointer;
begin
  
prc := GetProcAddress(hDll, PChar(Name));
  if Assigned(prc) then begin
    
n := High(Parameters);
    if n > -1 then begin
      
x := n;
      repeat
        
p := Parameters[x];
        asm
          
PUSH p
        end;
        Dec(x);
      until x = -1;
    end;
    asm
      
CALL prc
    end;
    if HasResult then begin
      asm
        
MOV p, EAX
      end;
      Returned := Cardinal(p);
    end else begin
      
Returned := 0;
    end;
  end else begin
    
Returned := 0;
  end;
  Result := Assigned(prc);
end;


(* --------- Sample (GetSystemDirectory) --------- *)

var
  
parameters: array of Pointer;
  returned: Cardinal;
  Dir: String;
begin
  
SetLength(parameters, 2);
  SetLength(Dir, MAX_PATH); // Set Buffer size
  
parameters[0] := Pointer(@Dir[1]); // 1st parameter, buffer for path string
  
parameters[1] := Pointer(MAX_PATH); // 2nd parameter, length of buffer
  
if not DynamicDllCallName(kernel32, 'GetSystemDirectoryA', true, returned, parameters) then begin
    
ShowMessage('Function could not be found!');
  end else begin
    
SetLength(Dir, returned); // Cut String
    
ShowMessage('GetSystemDirectoryA:'#13#10'Path: ' + Dir + #13#10'Length: ' + IntToStr(returned));
  end;
end;


(* --------- Sample (TextOut) --------- *)

const
  
SampleText = 'test';
var
  
parameters: array of Pointer;
  returned: Cardinal;
begin
  
SetLength(parameters, 5);
  parameters[0] := Pointer(Canvas.Handle); // 1st parameter, handle to the form's canvas
  
parameters[1] := Pointer(10); // 2nd parameter, left margin
  
parameters[2] := Pointer(30); // 3rd parameter, top margin
  
parameters[3] := @SampleText[1]; // 4th parameter, pointer to the sample string
  
parameters[4] := Pointer(Length(SampleText)); // 5th parameter, length of the sample string
  
if not DynamicDllCallName(gdi32, 'TextOutA', true, returned, parameters) then begin
    
ShowMessage('Function could not be found!');
  end else begin
    if not 
BOOL(returned) then begin // function's result = false
      
ShowMessage('TextOut() failed!');
    end;
  end;
end;


(* --------- Sample (LockWorkStation) --------- *)

var
  
parameters: array of Pointer;
  returned: Cardinal;
begin
  
// We don't have parameters, so we don't touch parameters
  
if not DynamicDllCallName(user32, 'LockWorkStation', true, returned, parameters) then begin
    
ShowMessage('Function could not be found!');
  end else begin
    if not 
BOOL(returned) then begin
      
ShowMessage('LockWorkStation() failed!');
    end;
  end;
end;

 

printed from
www.swissdelphicenter.ch
developers knowledge base