function RunDllFun(var Pro:Pointer):Boolean;stdcall;export;
begin
Form1:=TForm1.Create(nil);
Form1.Show;
Pro:=Form1.MethodAddress('TestFun');
Result:=true;
end;
其中TestFun是你要調(diào)用的函數(shù)！
////////////////////////////////////////////////////
unit RunDll; //MyRunDLL(s, FunInfo,false); interface uses Windows,SysUtils,Myfunc; type TArg = record ArgType: Integer; S: String; I: Integer; D: Double; end; TWords = array of String; TFunInfo = record DllName: String; FunName: String; LoadAddress: integer; Params: array of TArg; Ret: Integer; end; function ParseArg(S: String): TArg; function ParseFun(S: String): TFunInfo; function MyRunDLL(S: String; var fun:TFunInfo; AutoFree:boolean=false):integer; function RunDllFun(var fun: TFunInfo;AutoFree:boolean=false): Integer; procedure FreeDll(LoadAddress:integer); implementation function SplitWithSpace(const S: String; QuoteChar: Char): TWords; var i, m, n: Integer; Len: Integer; ct: Integer; InQuote: Boolean; begin Len := Length(S); i := 1; ct := 0; InQuote := False; while i <= Len do begin //跳過一到多個空格 while (i <= Len) and (S[i] = ' ') do i := i + 1; m := i; while (i <= Len) and ((S[i] <> ' ') or InQuote) do begin if S[i] = QuoteChar then InQuote := not InQuote; i := i + 1; end; n := i; if n > m then begin SetLength(Result, ((ct + 10) div 10) * 10); Result[ct] := Copy(S, m, n - m); ct := ct + 1; end; end; SetLength(Result, ct); end; function UnQuoteString(const S: String): String; var m, n: Integer; begin if Length(s) = 0 then Exit; m := 1; if S[1] = '"' then m := 2; n := Length(S); if S[n] = '"' then n := n - 1; Result := Copy(S, m, n - m + 1); end; function ParseArg(S: String): TArg; var m: Integer; t1, t2: String; c: Char; begin Result.ArgType := 0; Result.S := ''; Result.I := 0; Result.D := 0.0; m := Pos(':', S); if m > 0 then begin t1 := UpperCase(Copy(S, 1, m - 1)); t2 := Copy(S, m + 1, Length(S)); end; if Length(t1) = 1 then begin c := t1[1]; case c of 'S': //String begin Result.ArgType := 1; Result.S := UnQuoteString(Trim(t2)); end; 'I': //Integer begin Result.ArgType := 2; Result.I := StrToIntDef(t2, 0); end; 'D', 'F': //Double begin Result.ArgType := 3; Result.D := StrToFloatDef(t2, 0.0); end; end; end else begin if (t1 = 'INT') or (t1 = 'INTEGER') then begin Result.ArgType := 1; Result.S := UnQuoteString(Trim(t2)); end else if (t1 = 'STR') or (t1 = 'STRING') then begin Result.ArgType := 2; Result.I := StrToIntDef(t2, 0); end else if (t1 = 'FLOAT') or (t1 = 'DOUBLE') then begin Result.ArgType := 3; Result.D := StrToFloatDef(t2, 0.0); end else if (t1 = 'VI') or (t1 = 'VINTEGER') then begin Result.ArgType := 12; Result.I := StrToIntDef(t2, 0); end; end; end; function ParseFun(S: String): TFunInfo; var m: Integer; v: TWords; i: Integer; begin Result.DllName := ''; Result.FunName := ''; Result.Ret := 0; v := SplitWithSpace(S, '"'); if Length(v) > 0 then begin m := Pos('::', v[0]); if m > 0 then begin Result.DllName := Copy(v[0], 1, m - 1); Result.DllName := UnQuoteString(Result.DllName); Result.FunName := Copy(v[0], m + 2, Length(v[0])); end; end; if Result.DllName <> '' then begin SetLength(Result.Params, Length(v) - 1); for i := 1 to Length(v) - 1 do begin Result.Params[i - 1] := ParseArg(v[i]); end; end; end; function RunDllFun(var fun: TFunInfo;AutoFree:Boolean): Integer; var i, r, t: Integer; d: Double; pd: PIntegerArray; t1, t2: Integer; dll: Integer; f: Pointer; p: PChar; begin Result := 0; dll := LoadLibrary(PChar(fun.DllName)); fun.LoadAddress:=dll; try //finally try //except if dll <> 0 then //load ok begin f := GetProcAddress(dll, PChar(fun.FunName)); if Assigned(f) then begin for i := Length(fun.Params) - 1 downto 0 do begin case fun.Params[i].ArgType of 0: begin asm push 0 end; end; 1: begin SetLength(fun.Params[i].S, 500); p := PChar(fun.Params[i].S); asm push p end; end; 2: begin t := fun.Params[i].I; asm push t end; end; 3: begin d := fun.Params[i].D; pd := @d; t1 := pd[0]; t2 := pd[1]; asm push t2 push t1 end; end; 12: //整數(shù)變參 begin t := Integer(@(fun.Params[i].I)); asm push t end; end; end; end; // call the function asm call f; mov r, eax end; fun.Ret := r; end else begin Result := -3; end; end else begin Result := -4; end; except Result := -2; end; finally if autoFree then FreeDll(dll); end; end; procedure FreeDll(LoadAddress:integer); begin if LoadAddress<>0 then FreeLibrary(LoadAddress); end; function MyRunDLL(S: String;var fun:TFunInfo; AutoFree:boolean=false):integer; begin Result := -1; Fun := ParseFun(S); if Fun.DllName <> '' then begin Result := RunDllFun(Fun,AutoFree); if Result<0 then Log('MyRunDll發(fā)生了調(diào)用異常'+Fun.DllName,1); end else Log('MyRunDll解析失敗，可能是格式不正確'+S,1); end; end.
