[reqyz]

Сообщение от Bargest

Что делать? Нормально описать параметры функции, в соответствии с официальными документами. В конкретно этом случае определить тип "указатель на эту структуру".

А где pVar учитывать - надо было внимательнее читать. В pVar нужно сохранять не только номер типа, но и адрес переменной этого типа, которая выделяется динамически. В массив Params класть тоже адрес VAR-овской переменной. А после вызова фунцкии проходить по массиву и выводить параметры в зависимости от типа.

я ничего не понял, поэтому сделал как понял(

Код:

function SetFunction(dll, adress, param: String;out res2:string): LongWord;
type
  TPoint=record
    x:longword;
    y:Pointer;
  end;
var
  hdll: HMODULE;
  LastError: LongWord;
  proc: Pointer;
  Params: array of TPoint;
  _par:array of TPoint;//0 1 2 3
  Strings: array of String;
  PrmCount, StrCount, p: Integer;
  p0, p1, p2: String;
  //param =var integer:const 8;boolean:1;out pchar:reqyz; integer:8; ...//например
begin
  hdll := LoadLibrary(Pointer(dll));
  if hdll = 0 then
  begin
    LastError := GetLastError;
    {RaiseErrorFmt('При загрузке библиотеки "%s" возникла ошибка №%d: "%s"',
      [dll, LastError, SysErrorMessage(LastError)]);}
    exit;
  end;

  try
    proc := GetProcAddress(hdll, Pointer(adress));
    if not Assigned(proc) then
    begin
      //RaiseErrorFmt('В библиотеке "%s" отсутствует процедура "%s"', [dll, adress]);
      exit;
    end;
    PrmCount := 0;
    StrCount := 0;

    while param <> '' do
    begin
      p := Pos(' ', param);
      if p = 0 then
      begin
        //RaiseErrorFmt('Ожидался символ " " в строке "%s"', [param]);
        exit;
      end;
      p0 := Copy(param, 1, p - 1);
      Delete(param, 1, p);

      p := Pos(':', param);
      if p = 0 then
      begin
        //RaiseErrorFmt('Ожидался символ ":" в строке "%s"', [param]);
        exit;
      end;
      p1 := Copy(param, 1, p - 1);
      Delete(param, 1, p);

      p := Pos(';', param);
      if p = 0 then
      begin
        //RaiseErrorFmt('Ожидался символ ";" в строке "%s"', [param]);
        exit;
      end;
      p2 := Copy(param, 1, p - 1);
      Delete(param, 1, p);

      if Length(Params) = PrmCount then
      begin
        SetLength(Params, PrmCount + 10);
        SetLength(_par, PrmCount + 10);
      end;

      if p1 = 'integer' then
        Params[PrmCount].x := StrToInt(p2)
      else
      if p1 = 'boolean' then
        Params[PrmCount].x := StrToInt(p2)
      else
      if p1 = 'pchar' then
      begin // Здесь строки нигде не сохранялись, поэтому указатели на них теряли актуальность
        if Length(Strings) = StrCount then
          SetLength(Strings, StrCount + 10);
        Strings[StrCount] := p2;
        Params[PrmCount].x := longWORD(Strings[StrCount]);
        Inc(StrCount);
      end else
      begin
        //RaiseErrorFmt('Неподдерживаемый тип "%s"', [p1]);

      end;

      _par[PrmCount].y:=addr(Params[PrmCount]);

      if(p0 = 'var')then
        _par[PrmCount].x:=1
      else
      if(p0 = 'const')then
        _par[PrmCount].x:=2
      else
      if(p0 = 'out')then
        _par[PrmCount].x:=3
      else
      if(p0 = '')then
        _par[PrmCount].x:=0
      else
      begin
        //RaiseErrorFmt('Неподдерживаемый тип "%s"', [p0]);
      end;
      param[PrmCount].y:=addr(_par[PrmCount].x);

      Inc(PrmCount);
    end;
//mov        ax,word ptr value
    asm
      PUSH ESI
      PUSH EDI
      MOV  ESI, Params[PrmCount].x//тут теперь не компилит
      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].x=1)or(_par[p].y=3)
        then
          res2:=res2+inttostr(p)+':'+inttostr(Params[p].x)+';';
  finally
    FreeLibrary(hdll);
  end;
end;

где использовать новые параметры я не знаю, и что нужно менять в асеме тоже не знаю, но сейчас там глюк, а уже не понимаю чего делаю