Показать сообщение отдельно
  #43  
Старый 25.10.2012, 02:03
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Цитата:
Сообщение от Freeman
Кстати, гм. Эта функциональность очень похожа на rundll32 и прочие inf и advapi32.

Тогда нужно уметь работать всего лишь с двумя типами значений -- строкой и числом (DWORD). LONGBOOL -- тоже DWORD. В синтаксисе inf-файлов строки обычно заключаются в кавычки, а числа передаются просто так. Можно еще 16-ричные числа обрабатывать, которые заданы как 0x########, но это уже на любителя.
можно подробнее) или пример)

реализовал функцию, всё кроме конст работает) вары возвращает)

всё работает прекрассно)
вот сама функция:

Код:
function SetFunction(dll, adress, param: String;out res2:string;l:integer): LongWord;
type
  TPoint=record
    x:Int64;
    y:byte;
  end;
  Tp=record
    s:string;
    c:Char;
  end;
var
  hdll: HMODULE;
  proc: Pointer;
  Params: array of LongWord;
  _par:array of TPoint;//0 1 2 3
  Strings: array of String;
  PrmCount, StrCount, p,i: Integer;
  pp:array[0..2]of Tp;
  //param =var integer:const 8;boolean:1;out pchar:reqyz; integer:8; ...//например
begin
  hdll := LoadLibrary(Pointer(dll));
  if hdll = 0 then
    exit;

  try
    proc := GetProcAddress(hdll, Pointer(adress));
    if not Assigned(proc) then
      exit;
    PrmCount := 0;
    StrCount := 0;
    setlength(_par,l);
    setlength(Params,l);
    pp[0].c:=' ';
    pp[1].c:=':';
    pp[2].c:=';';
    while param <> '' do
    begin
      for i:=0 to 2 do
      begin
        p := Pos(pp[i].c, param);
        pp[i].s := Copy(param, 1, p - 1);
        Delete(param, 1, p);
      end;

      if(pp[1].s = 'boolean')or(pp[1].s = 'integer')then
        Params[PrmCount] := StrToInt(pp[2].s)
      else
      if pp[1].s = 'pchar' then
      begin // Здесь строки нигде не сохранялись, поэтому указатели на них теряли актуальность
        if Length(Strings) = StrCount then
          SetLength(Strings, StrCount + 10);
        Strings[StrCount] := pp[2].s;
        Params[PrmCount] := longWORD(Strings[StrCount]);
        Inc(StrCount);
      end;

      if(pp[0].s = 'var')then
      begin
        _par[PrmCount].y:=1;
        _par[PrmCount].x:=Params[PrmCount];
        Params[PrmCount]:=integer(@_par[PrmCount].x);
      end
      else
      if(pp[0].s = 'const')then
        _par[PrmCount].y:=2
      else
      if(pp[0].s = 'out')then
      begin
        _par[PrmCount].y:=3;
        _par[PrmCount].x:=Params[PrmCount];
        Params[PrmCount]:=integer(@_par[PrmCount].x);
      end
      else
      if(pp[0].s = '')then
        _par[PrmCount].y:=0;


      Inc(PrmCount);
    end;
    asm
      PUSH ESI
      PUSH EDI
      MOV  ESI, Params
      MOV  ECX, PrmCount
      NEG  ECX
      LEA  ESP, [ESP + ECX * 4] // Здесь была ошибочная инструкция lea esp, [esp - ecx * 4]
      NEG  ECX
      MOV  EDI, ESP
      CLD
      REP  MOVSD
      MOV  EAX, proc
      CALL EAX
      MOV  Result, EAX // Сохраняем результат работы вызванной функции
      POP  EDI
      POP  ESI
    end;
    res2:='';
    for p:=0 to length(_par)-1 do
      if(_par[p].y=1)or(_par[p].y=3)
        then
          res2:=res2+inttostr(p)+':'+inttostr(_par[p].x)+';';
  finally
    FreeLibrary(hdll);
  end;
end;

но есть странные особенности при использовании констант

Код:
//например так функция работает:
Function func(const a,b:longword):LongWord;stdcall
begin
 if(a<>b)then
end;//часть в длл-ке

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetFunction('project2.dll','func','const integer:5;const integer:4;',s,2);
end;//использование


//так функция тоже работает:
type
  req=record
    a,b:longword;
  end;
Function func(z:req):LongWord;stdcall
begin
 if(z.a<>z.b)then
end;//часть в длл-ке

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetFunction('project2.dll','func',' integer:5; integer:4;',s,2);
end;//использование

//а так функция не работает:
type
  req=record
    a,b:longword;
  end;
Function func(const z:req):LongWord;stdcall
begin
 if(z.a<>z.b)then
end;//часть в длл-ке

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetFunction('project2.dll','func','const integer:5;const integer:4;',s,2);
end;//использование

я не понимаю почему(
кто нибудь знает?
я предполагаю, что в последнем случае функция ожидает указатель, я прав?
да, как оказалось, я прав, в случае, когда константой является несколько одновременно параметров, то нужно передавать один указатель на них
Ответить с цитированием