универсальная загрузка dll

poli-smen · #16 23.10.2012, 12:02

Цитата:

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

в каком месте я её использую о_О, или как и зачем её использовать?

BORLNDMM.DLL используется когда ты в своей dll-ке хочешь обмениваться строками с вызывающим приложением. Но теперь я вижу, что BORLNDMM.DLL тут не причём.
Ошибка у тебя скорее всего вот здесь:

Цитата:

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

Код:

        if(p1='PChar')then
          Params[count-1]:=integer(PChar(p2));

Попробуй вместо этого выделить память через GetMem, скопировать в эту память строку и передать указатель на эту память, а не указатель на строку p2.

reqyz · #17 23.10.2012, 12:15

у меня в примере незакомментированном даже не используется возможность с чар, не в этом дело(

poli-smen · #18 23.10.2012, 12:28

Цитата:

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

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

Используется:

Цитата:

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

Код:

  SetFunction('Project2.dll','func','Boolean:1;Integer:10;PChar:rgtrhtyh;');

(только не чар, а PChar).

Цитата:

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

не в этом дело(

И всё же попробуй.

Есть правда вариант, что в ассемблерном куске ошибка. Например навскидку из справки по Delphi по поводу директивы asm:

Цитата:

An asm statement must preserve the EDI, ESI, ESP, EBP, and EBX registers, but can freely modify the EAX, ECX, and EDX registers.

angvelem · #19 23.10.2012, 13:50

Цитата:

Сообщение от poli-smen

An asm statement must preserve the EDI, ESI, ESP, EBP, and EBX registers, but can freely modify the EAX, ECX, and EDX registers

Это общее правило по использованию ассемблера.

Bargest · #20 23.10.2012, 21:00

Цитата:

Есть правда вариант, что в ассемблерном куске ошибка. Например навскидку из справки по Delphi по поводу директивы asm:

Возможно, но врядли. Не думаю, что делфи настолько тупая. Обычно компилеры читают асм-кусок кода и сами сохраняют и загружают нужные им регистры, если они используются внутри.
ТС: в крайнем случае в начале можно сделать push используемых регистров, а в конце - pop.

Цитата:

Ошибка у тебя скорее всего вот здесь:
if(p1='PChar')then
Params[count-1]:=integer(PChar(p2));

+1.

poli-smen · #21 24.10.2012, 06:00

Хоть практическая польза от этой "волшебной" функции довольно сомнительна, но интерес меня всё же пересилил.

Ошибки были и в том месте что я указывал выше, и в ассемблерной вставке, и даже в вызывающей строке. Кроме того я привёл эту функцию к более приличному виду, в результате получилось так:

Код:

procedure RaiseErrorFmt(const Msg: String; const Args: array of const);
begin
  raise Exception.CreateFmt(Msg, Args);
end;

function SetFunction(dll, adress, param: String): DWORD;
var
  hdll: HMODULE;
  LastError: DWORD;
  proc: Pointer;
  Params: array of DWORD;
  Strings: array of String;
  PrmCount, StrCount, p: Integer;
  p1, p2: String;
  //param = integer:8;boolean:true; ...
begin
  hdll := LoadLibrary(Pointer(dll));
  if hdll = 0 then
  begin
    LastError := GetLastError;
    RaiseErrorFmt('При загрузке библиотеки "%s" возникла ошибка №%d: "%s"',
      [dll, LastError, SysErrorMessage(LastError)]);
  end;

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

    PrmCount := 0;
    StrCount := 0;

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

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

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

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

// Пример вызова (в исходном варианте здесь была ошибка):
procedure TForm1.Button1Click(Sender: TObject);
begin
  SetFunction('shell32.dll', 'ShellExecuteA', 'Integer:0;PChar:;PChar:calc.exe;PChar:;PChar:;Integer:0;');
end;

reqyz · #22 24.10.2012, 08:07

потестю) уверен в 100% что всё правильно) примного благодарен)

reqyz · #23 24.10.2012, 10:06

уважаемый poli-smen важный вопрос, уже не удобно о чём либо просить, но всё же, а возможно как либо указывать такие параметры переменных как вар конст и аут?)

poli-smen · #24 24.10.2012, 10:54

Цитата:

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

уважаемый poli-smen важный вопрос, уже не удобно о чём либо просить, но всё же, а возможно как либо указывать такие параметры переменных как вар конст и аут?)

Теоретически конечно можно, но будет посложнее. Например out (а также часто и var) означает, что эта функция может возвращать результат через эти параметры, а значит в функции SetFunction нужно как-то предусмотреть возможность получения дополнительных результатов от вызываемой функции.

reqyz · #25 24.10.2012, 11:56

Цитата:

Сообщение от poli-smen

Теоретически конечно можно, но будет посложнее. Например out (а также часто и var) означает, что эта функция может возвращать результат через эти параметры, а значит в функции SetFunction нужно как-то предусмотреть возможность получения дополнительных результатов от вызываемой функции.

я представляю как в этой функции получать результаты, но я не знаю совсем ассемблер и не знаю что писать там.

как я представляю:

Код:

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

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

    PrmCount := 0;
    StrCount := 0;

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

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

      p := Pos(';', param);
      if p = 0 then RaiseErrorFmt('Ожидался символ ";" в строке "%s"', [param]);
      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(p0 = 'var')then
        _par[PrmCount]:=1
      else
      if(p0 = 'const')then
        _par[PrmCount]:=2
      else
      if(p0 = 'out')then
        _par[PrmCount]:=3
      else
      if(p0 = '')then
        _par[PrmCount]:=0
      else
        RaiseErrorFmt('Неподдерживаемый тип "%s"', [p0]);

      if p1 = 'integer' then
        Params[PrmCount] := StrToInt(p2)
      else
      if p1 = 'boolean' then
        Params[PrmCount] := StrToInt(p2)
      else
      if p1 = 'pchar' then
      begin // Здесь строки нигде не сохранялись, поэтому указатели на них теряли актуальность
        if Length(Strings) = StrCount then
          SetLength(Strings, StrCount + 10);
        Strings[StrCount] := p2;
        Params[PrmCount] := DWORD(Strings[StrCount]);
        Inc(StrCount);
      end else
      begin
        RaiseErrorFmt('Неподдерживаемый тип "%s"', [p1]);
      end;
      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]=1)or(_par[p]=3)
        then
          res2:=res2+inttostr(p)+':'+inttostr(Params[p])+';';
  finally
    FreeLibrary(hdll);
  end;
end;

нарыл вот это

Передача параметров по значению говорится о const?

Процедуре передается собственно значение параметра. При этом фактически значение параметра копируется, и процедура использует его копию, так что модификация исходного параметра оказывается невозможной. Этот механизм применяется для передачи небольших параметров, таких как байты или слова.

Например, если параметры передаются в регистрах:

Код:

        mov        ax,word ptr value   ; сделать копию значения
        call       procedure           ; вызвать процедуру

Передача параметров по ссылке напоминает out

Процедуре передается не значение переменной, а ее адрес, по которому процедура должна сама прочитать значение параметра. Этот механизм удобен для передачи больших массивов данных и для тех случаев, когда процедура должна модифицировать параметры, хотя он и медленнее из-за того, что процедура будет выполнять дополнительные действия для получения значений параметров.

Код:

        mov        ax,offset value
        call       procedure

Передача параметров по возвращаемому значению//похоже на var

Этот механизм объединяет передачу по значению и по ссылке. Процедуре передают адрес переменной, а процедура делает локальную копию параметра, затем работает с ней, а в конце записывает локальную копию обратно по переданному адресу. Этот метод эффективнее обычной передачи параметров по ссылке в тех случаях, когда процедура должна обращаться к параметру достаточно большое число раз, например, если используется передача параметров в глобальной переменной:

Код:

        mov        global_variable,offset value
        call       procedure
        [...]
procedure proc near
        mov        dx,global_variable
        mov        ax,word ptr [dx]
       (команды,  работающие с АХ в цикле десятки тысяч раз)
        mov        word ptr [dx],ax
procedure endp

из этой статьи

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

Bargest · #26 24.10.2012, 16:49

Цитата:

Теоретически конечно можно, но будет посложнее. Например out (а также часто и var) означает, что эта функция может возвращать результат через эти параметры

Все просто. Если обычная передача параметров - это push значения, то Var - это push адреса переменной. Таким образом можно для тех параметров, которые var, сделать массив указателей, и в params сохранить эти указатели.
Следовательно, можно сделать "префикс" типа VAR, который будет означать, что программа выделит память, скопирует туда значение и передаст в функцию адрес переменной. Соответственно если составить отдельно массив записей о таких параметрах (например в формате <адрес><тип>), то и вывести их потом не составит труда.
А вот то, что lea не дает идти в минус я забыл.

reqyz · #27 24.10.2012, 17:14

можете подравить мой пример под вар?) и насчёт конст и оут неужели невозможно, та статья не правильная?)

Bargest · #28 24.10.2012, 17:20

Конст - это фактически просто директива для компилятора, которая проверит твой код за тебя, чтобы ты случайно не мог изменить параметр. После компиляции const и обычный параметр не будут отличаться.
С аут та же история.
Ну а подправить код - надо ему еще объявить префикс var. То есть он будет искать как сейчас до :, а потом будет смотреть, нету ли в типе пробела. Если есть пробел - то выдирает то, что до него и сравнивает с var. Если равно var - выделяет место для значения, сохраняет его адрес в массиве записей и в Params, затем сохраняет тип для дальнейшей обработки. Записи можно сделать вида <addr><typeID>, как я уже говорил. После вызова вывод всех параметров из этого массива.

reqyz · #29 24.10.2012, 17:24

Цитата:

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

Конст - это фактически просто директива для компилятора, которая проверит твой код за тебя, чтобы ты случайно не мог изменить параметр. После компиляции const и обычный параметр не будут отличаться.
С аут та же история.
Ну а подправить код - надо ему еще объявить префикс var. То есть он будет искать как сейчас до :, а потом будет смотреть, нету ли в типе пробела. Если есть пробел - то выдирает то, что до него и сравнивает с var. Если равно var - выделяет место для значения, сохраняет его адрес в массиве записей и в Params, затем сохраняет тип для дальнейшей обработки. Записи можно сделать вида <addr><typeID>, как я уже говорил. После вызова вывод всех параметров из этого массива.

да в функции я это сделал, я не знаю как правильно в ассем это добавить

и на счёт конст, если в функции, например

Код:

function SHFileOperation(const lpFileOp: _SHFILEOPSTRUCTA): Integer; stdcall; external shell32 name 'SHFileOperationA';

не указать, то вылезет ошибка использования функции

Bargest · #30 24.10.2012, 17:42

Смотря как использовать.

Код:

function Func1(const p: PAnsiChar): Integer; stdcall;
begin
 MessageBoxA(0,p,0,0);
end;

function Func2(p: PAnsiChar): Integer; stdcall;
begin
 MessageBoxA(0,p,0,0);
end;

; ---------------------------------------------------------
Project1.dpr.13: begin
00418F0C 55               push ebp
00418F0D 8BEC             mov ebp,esp
00418F0F 51               push ecx
Project1.dpr.14: MessageBoxA(0,p,0,0);
00418F10 6A00             push $00
00418F12 6A00             push $00
00418F14 8B4508           mov eax,[ebp+$08]
00418F17 50               push eax
00418F18 6A00             push $00
00418F1A E875F8FEFF       call MessageBoxA
Project1.dpr.15: end;
00418F1F 8B45FC           mov eax,[ebp-$04]
00418F22 59               pop ecx
00418F23 5D               pop ebp
00418F24 C20400           ret $0004
; --------------------------------------------------------
Project1.dpr.17: begin
00418F28 55               push ebp
00418F29 8BEC             mov ebp,esp
00418F2B 51               push ecx
Project1.dpr.18: MessageBoxA(0,p,0,0);
00418F2C 6A00             push $00
00418F2E 6A00             push $00
00418F30 8B4508           mov eax,[ebp+$08]
00418F33 50               push eax
00418F34 6A00             push $00
00418F36 E859F8FEFF       call MessageBoxA
Project1.dpr.19: end;
00418F3B 8B45FC           mov eax,[ebp-$04]
00418F3E 59               pop ecx
00418F3F 5D               pop ebp
00418F40 C20400           ret $0004

Видно, что в коде функций нет совершенно никакой разницы, хотя объявлена одна с Const, другая без. Ошибки тут могут быть только из-за проверок компилятора.

А вот пример номер два:

Код:

function Func1(var p: AnsiString): Integer; stdcall;
begin
 MessageBoxA(0,PAnsiChar(p),0,0);
end;
function Func2(p: AnsiString): Integer; stdcall;
begin
 MessageBoxA(0,PAnsiChar(p),0,0);
end;

; ----------------------------------------------------------

Project1.dpr.13: begin
00418F1C 55               push ebp
00418F1D 8BEC             mov ebp,esp
00418F1F 51               push ecx
Project1.dpr.14: MessageBoxA(0,PAnsiChar(p),0,0);
00418F20 6A00             push $00
00418F22 6A00             push $00
00418F24 8B4508           mov eax,[ebp+$08]                 // Берем параметр
00418F27 8B00             mov eax,[eax]                         // <------- Вот оно!
00418F29 E872CAFEFF       call @LStrToPChar
00418F2E 50               push eax
00418F2F 6A00             push $00
00418F31 E86EF8FEFF       call MessageBoxA
Project1.dpr.15: end;
00418F36 8B45FC           mov eax,[ebp-$04]
00418F39 59               pop ecx
00418F3A 5D               pop ebp
00418F3B C20400           ret $0004
00418F3E 8BC0             mov eax,eax
; ----------------------------------------------------------
Project1.dpr.17: begin
00418F40 55               push ebp
00418F41 8BEC             mov ebp,esp
00418F43 51               push ecx
00418F44 8B4508           mov eax,[ebp+$08]                  // берем параметр
00418F47 E890C6FEFF       call @LStrAddRef               // не обращаем внимания, это inc количества текущих ссылок на строку, делается для защиты многопоточности
00418F4C 33C0             xor eax,eax
00418F4E 55               push ebp
00418F4F 68848F4100       push $00418f84
00418F54 64FF30           push dword ptr fs:[eax]        // Для хендла исключений
00418F57 648920           mov fs:[eax],esp
Project1.dpr.18: MessageBoxA(0,PAnsiChar(p),0,0);
00418F5A 6A00             push $00
00418F5C 6A00             push $00
00418F5E 8B4508           mov eax,[ebp+$08]              // снова берем параметр
00418F61 E83ACAFEFF       call @LStrToPChar             // перевод в PChar (фактически return eax)
00418F66 50               push eax
00418F67 6A00             push $00
00418F69 E836F8FEFF       call MessageBoxA
Project1.dpr.19: end;
00418F6E 33C0             xor eax,eax
00418F70 5A               pop edx
00418F71 59               pop ecx
00418F72 59               pop ecx
00418F73 648910           mov fs:[eax],edx                 // Восстанавливаем все
00418F76 688B8F4100       push $00418f8b
00418F7B 8D4508           lea eax,[ebp+$08]
00418F7E E889C5FEFF       call @LStrClr                   // снимаем ссылку на строку
00418F83 C3               ret 
00418F84 E977BCFEFF       jmp @HandleFinally
00418F89 EBF0             jmp $00418f7b
00418F8B 8B45FC           mov eax,[ebp-$04]
00418F8E 59               pop ecx
00418F8F 5D               pop ebp
00418F90 C20400           ret $0004

Видно, что первая делает mov eax, [eax]. Что означает взять значение по указателю. То есть ей передался указатель на строку s (скорее даже "указатель на указатель на строку"

).

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты

Этот пользователь сказал Спасибо poli-smen за это полезное сообщение:
reqyz (24.10.2012)

Этот пользователь сказал Спасибо Bargest за это полезное сообщение:
reqyz (24.10.2012)