从 DLL 中调用 DLL 函数的调用方

Question

是否可以调用在Delphi中编写的DLL中调用函数的函数？加载 DLL 的调用程序只能访问我的 DLL 的导出函数，不能导出它自己的函数（它是 Easylanguge 编程语言，没有导出命令或传递指针的能力）。我从DLL调用时不需要传递任何参数，只需在return地址点后再次执行代码即可。那么如果Easylanguage中的一个函数调用了DLL中的一个函数，是否可以在DLL中使用Easylanguage函数中的return地址，以便稍后在return地址处调用Easylanguage函数？即使是黑客也可以。在我尝试将它应用到实际的 DLL 和 Easylanguage 平台之前，我想让我编写的这个概念代码正常工作。我有时会遇到访问冲突。

Delphi模拟DLL与Easylanguage交互的demo:

type   
    Tra_func = function: Integer;

var
  Form9: TForm9;
  ra: pointer;
  ra_func: Tra_func;

implementation

{$R *.dfm}

function dll_func: integer;
begin
  ra := System.ReturnAddress;
  Form9.ListBox1.Items.Add(Format('RA to "easylanguage_func": %p', [ra]));
  Form9.ListBox1.Items.Add('END of "dll" function');
  result := 1;
end;

function easylanguage_func: integer; // temp stand-in function for Easylanguage
begin
  Form9.ListBox1.Items.Add('Call "dll" to get return address...');
  dll_func();
  Form9.ListBox1.Items.Add('END of "easylanguage_func" function');
  result := 1;
end;

procedure TForm9.Button1Click(Sender: TObject);
begin
  
  easylanguage_func; // * this call would be from Easylanguage to the DLL 
  ListBox1.Items.Add('Calling RA address of "easylanguage_func"');
  ra_func := Tra_func(ra);
  ra_func; // * this call would be located in the DLL
end;

end.

调用 DLL 函数的 Easylanguage 例程可能如下所示：

external: "ra_test_dll.dll", INT, "GetRAFunction";

method void ReturnFunction() // * can not export this *
begin 
    Print("GetRAFunction");
    GetRAFunction(); // calls function in DLL
    // *** returns here, start execution here when call from the DLL later 
    Print("*RA - next line*");
end;

作为参数传递的字符串和 return 双向..

易语言：

external: "ts_dll_str_test.dll", String, "StringTest", String; //  Delphi DLL function def
    
method void StrFunction(String ss) 
variables: 
   String ss2;
begin 
    ss2 = StringTest(ss+"abc");
    Print(ss2); // Output = ABCD5FGHIJKLM
end;

Call: StrFunction("0123456789")

Delphi DLL:

var
  ss: AnsiString;
  myCharPtr: PAnsiChar;

function StringTest(StrIn: PAnsiChar): PAnsiChar; stdcall;  // called by EL
begin
  ss  := 'ABCDEFGHIJKLM';
  myCharPtr := @ss[1];
  myCharPtr[4] := StrIn[5];
  result := myCharPtr;
end;

exports StringTest;

谢谢。

Answer 1

我设计了一个在调用应用程序和 DLL 中都使用 Delphi 的演示。您必须在 EasyLanguage 编程中应用相同的“技巧”。

这个想法是，当 DLL 需要调用可执行文件中的函数时 - 无论如何都不会导出的函数 - 它只是 return 带有一个特殊值，可以传输调用任何 EasyLanguage 所需的所有信息（此处Delphi）函数。

这意味着在调用者和 DLL 中，函数都是循环。 EXE 调用 DLL 传递初始参数，DLL 获取它和 return 描述它需要的函数调用的特殊值。 EXE 认识到，在他的代码中调用所需的函数，然后再次调用 DLL 中的相同函数，这次传递函数调用的结果。并且该过程循环一秒、三秒，依此类推。最后，DLL 能够生成最终结果，并且 return 它没有指示函数调用的标记。

因为 EasyLaguage 不支持指针，所以一切都使用 AnsiString 处理。

下面的代码已最大限度地简化，以使其更具可读性。在实际应用程序中，最好验证许多事情以避免意外行为。

这是可执行代码：

unit CallingCallerDemoMain;

interface

uses
    Winapi.Windows, Winapi.Messages,
    System.SysUtils, System.Variants, System.Classes,
    Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
    ParamParsing;

type
    TCallingCallerForm = class(TForm)
        Button1: TButton;
        Memo1: TMemo;
        procedure Button1Click(Sender: TObject);
    public
        function CallDll(Value: Integer): String;
        function DemoSquare(Arg1: Integer): Integer;
        function DemoSum(Arg1: Integer): Integer;
    end;

// Declaration for function in DLL
// In this demo, the function takes one integer argument and return a string
// looking like "Value=4  Square=16  Sum=8". The value is the argument, the
// square and the sum are computed by THIS executable: the DLL somehow call
// this executable.
// The use of AnsiChar is required for this demo because it is normally not
// written in Delphi but in EasyLanguage which has only ANSI strings.
function DllFunc(
    StrIn : PAnsiChar
    ) : PAnsiChar; stdcall; external 'CallingCallerDemoDll.dll';

var
  CallingCallerForm: TCallingCallerForm;

implementation

{$R *.dfm}

function TCallingCallerForm.DemoSquare(Arg1 : Integer) : Integer;
begin
    Result := Arg1 * Arg1;
    Memo1.Lines.Add('DemoSquare called');
end;

function TCallingCallerForm.DemoSum(Arg1 : Integer) : Integer;
begin
    Result := Arg1 + Arg1;
    Memo1.Lines.Add('DemoSum called');
end;

function TCallingCallerForm.CallDll(Value : Integer) : String;
var
    S         : String;
    DllFctPrm : AnsiString;
    Params    : String;
    FctName   : String;
    Arg1      : Integer;
    Status    : Boolean;
    State     : String;
    Value1    : Integer;
    Value2    : Integer;
begin
    DllFctPrm := '4';
    while TRUE do begin
        S := String(DllFunc(PAnsiChar(DllFctPrm)));
        if not ((S <> '') and (S[1] = '[') and (S[Length(S)] = ']')) then begin
            Result := S;
            Exit;
        end
        else begin
            Params  := Trim(Copy(S, 2, Length(S) - 2));
            FctName := ParamByNameAsString(Params, 'FctName', Status, '');
            State   := ParamByNameAsString(Params, 'State',   Status, '');
            Memo1.Lines.Add('Callback="' + Params + '"');
            if SameText(FctName, 'DemoSquare') then begin
                Arg1    := ParamByNameAsInteger(Params, 'Arg1', Status, 0);
                Value1  := DemoSquare(Arg1);
                DllFctPrm := AnsiString('[' +
                                         'State=' + State +';' +
                                         'Value=' + IntToStr(Value1) +
                                        ']');
                continue;
            end
            else if SameText(FctName, 'DemoSum') then begin
                Arg1    := ParamByNameAsInteger(Params, 'Arg1', Status, 0);
                Value2  := DemoSum(Arg1);
                DllFctPrm := AnsiString('[' +
                                         'State=' + State +';' +
                                         'Value=' + IntToStr(Value2) +
                                        ']');
                continue;
            end
            else
                raise Exception.Create('Unexpected function name');
        end;
    end;
end;

procedure TCallingCallerForm.Button1Click(Sender: TObject);
begin
    Memo1.Lines.Add('Result: ' + CallDll(4));
end;

end.

这是 DLL 的代码：

library CallingCallerDemoDll;

uses
  System.SysUtils,
  System.Classes,
  ParamParsing in '..\DirectCompute\Mandel\Delphi\ParamParsing.pas';

{$R *.res}

var
    GBuffer : AnsiString;
    Value  : Integer;
    Value1 : Integer;
    Value2 : Integer;

function DllFunc(StrIn : PAnsiChar) : PAnsiChar; stdcall;
var
    S      : String;
    Params : String;
    State  : Integer;
    Status : Boolean;
begin
    S := String(StrIn);
    if not ((S <> '') and (S[1] = '[') and (S[Length(S)] = ']')) then begin
        // Normal call
        State  := 1;
        Value  := StrToInt(S);
        Value1 := 0;
        Value2 := 0;
    end;
    while TRUE do begin
        if not ((S <> '') and (S[1] = '[') and (S[Length(S)] = ']')) then begin
            // Call caller
            {$WARN USE_BEFORE_DEF OFF}
            case State of
            1: GBuffer := '[FctName=' + '"DemoSquare";' +
                           'Arg1='    + AnsiString(IntToStr(Value)) + ';' +
                           'State='   + AnsiString(IntToStr(State)) + ']';
            2: GBuffer := '[FctName=' + '"DemoSum";' +
                           'Arg1='    + AnsiString(IntToStr(Value)) + ';' +
                           'State='   + AnsiString(IntToStr(State)) + ']';
            end;
            Result := PAnsiChar(GBuffer);
            Exit;
        end
        else begin
            // Return from function
            Params := Trim(Copy(S, 2, Length(S) - 2));
            State  := StrToInt(ParamByNameAsString(Params, 'State', Status, ''));
            case State of
            1:  begin
                    Value1 := ParamByNameAsInteger(Params, 'Value', Status, 0);
                    State  := 2;
                    S   := '';
                    continue;
                end;
            2:  begin
                    Value2 := ParamByNameAsInteger(Params, 'Value', Status, 0);
                    GBuffer := AnsiString(Format('Value=%d Square=%d  Sum=%d',
                                                 [Value, Value1, Value2]));
                    Result := PAnsiChar(GBuffer);
                    Exit;
                end;
            end;
        end;
    end;
end;

exports
    DllFunc;
begin
end.

最后是解析值的支持单元：

unit ParamParsing;

interface

uses
    SysUtils;

function ParamByNameAsString(
    const Params     : String;
    const ParamName  : String;
    var   Status     : Boolean;
    const DefValue   : String) : String;
function ParamByNameAsInteger(
    const Params     : String;
    const ParamName  : String;
    var   Status     : Boolean;
    const DefValue   : Integer) : Integer;

implementation

// Parameters format = 'name1="value";name2="value2";....;nameN="valueN"
function ParamByNameAsString(
    const Params     : String;
    const ParamName  : String;
    var   Status     : Boolean;
    const DefValue   : String) : String;
var
    I, J  : Integer;
    Ch    : Char;
begin
    Status := FALSE;
    I := 1;
    while I <= Length(Params) do begin
        J := I;
        while (I <= Length(Params)) and (Params[I] <> '=')  do
            Inc(I);
        if I > Length(Params) then begin
            Result := DefValue;
            Exit;                  // Not found
        end;
        if SameText(ParamName, Trim(Copy(Params, J, I - J))) then begin
            // Found parameter name, extract value
            Inc(I); // Skip '='
            // Skip spaces
            J := I;
            while (J < Length(Params)) and (Params[J] = ' ') do
                Inc(J);
            if (J <= Length(Params)) and (Params[J] = '"') then begin
                // Value is between double quotes
                // Embedded double quotes and backslashes are prefixed
                // by backslash
                I      := J;
                Status := TRUE;
                Result := '';
                Inc(I);        // Skip starting delimiter
                while I <= Length(Params) do begin
                    Ch := Params[I];
                    if Ch = '\' then begin
                        Inc(I);          // Skip escape character
                        if I > Length(Params) then
                            break;
                        Ch := Params[I];
                    end
                    else if Ch = '"' then
                        break;
                    Result := Result + Ch;
                    Inc(I);
                end;
            end
            else begin
                // Value is up to semicolon or end of string
                J := I;
                while (I <= Length(Params)) and (Params[I] <> ';') do
                    Inc(I);
                Result := Trim(Copy(Params, J, I - J));
                Status := TRUE;
            end;
            Exit;
        end;
        // Not good parameter name, skip to next
        Inc(I); // Skip '='
        if (I <= Length(Params)) and (Params[I] = '"') then begin
            Inc(I);        // Skip starting delimiter
            while I <= Length(Params) do begin
                Ch := Params[I];
                if Ch = '\' then begin
                    Inc(I);          // Skip escape character
                    if I > Length(Params) then
                        break;
                end
                else if Ch = '"' then
                    break;
                Inc(I);
            end;
            Inc(I);        // Skip ending delimiter
        end;
        // Param ends with ';'
        while (I <= Length(Params)) and (Params[I] <> ';')  do
            Inc(I);
        Inc(I);  // Skip semicolon
    end;
    Result := DefValue;
end;

function ParamByNameAsInteger(
    const Params     : String;
    const ParamName  : String;
    var   Status     : Boolean;
    const DefValue   : Integer) : Integer;
begin
    Result := StrToInt(ParamByNameAsString(Params, ParamName, Status, IntToStr(DefValue)));
end;

end.

使用 Delphi 10.4.2 测试一切正常（应该适用于任何其他最近的 Delphi）。

从 DLL 中调用 DLL 函数的调用方

Calling a caller to a DLL function from within the DLL

delphi

dll

function