Mega Code Archive
Call a dll function with variable rt-parameter dynamically
<![CDATA[
(*
--- 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: String; const 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;
]]>