...eine DLL-Funktion mit Laufzeit Parameter dynamisch aufrufen?

(*
--- 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;

printed from
www.swissdelphicenter.ch
developers knowledge base