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 
    //跳過(guò)一到多個(gè)空格 
    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.