Calling a caller to a DLL function from within the DLL

Question

Is it possible to call a function that called a function in a DLL that is written in Delphi? The calling program that loads the DLL just has access to my DLL's exported functions and can not export it's own functions (it's Easylanguge programming language and does not have a command to export or the ability to pass pointers). I do not need to pass any parameters when I call the from the DLL, just execute the code again after the return address point. So if a function in Easylanguage calls a function from the DLL, can the return address from the Easylanguage function be used in the DLL to later call the Easylanguage function at the point of the return address? Even a hack will do. I want to get this concept code I wrote working correctly before I try to apply it to the actual DLL & Easylanguage platform. I sometimes get access violations.

Delphi demo that simulates the interaction of the DLL & Easylanguage:

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.

What an Easylanguage routine that calls a DLL function could look like:

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;

String passing as parameters and returns in both directions..

Easylanguage:

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;

Thanks.

Answer 1

I designed a demo with Delphi used in both the calling application and the DLL. You'll have to apply the same "trick" in your EasyLanguage programming.

The idea is that when the DLL need to call a function in the executable - function which is not exported in anyway - it simply returns with a special value transporting all the information required to call whatever EasyLanguage (here Delphi) function.

This means that at both the caller and the DLL, the function are loops. The EXE calls the DLL passing the initial argument, the DLL get it and return a special value describing the function call it needs. The EXE recognize that, call the required function in his code and then call again the same function in the DLL, this time passing the result of the function call. And the process loops for a second, thirds and so on. Finally the DLL is able to produce the final result and return it without the mark indicating a function call.

Everything is handled using AnsiString since EasyLaguage do not support pointers.

The code below has been simplified at maximum so that it is more readable. In a real application it is much better to validate many things to avoid unexpected behaviour.

Here is the code for executable:

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.

Here is the code for the 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.

And finally a support unit to parse values:

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.

Everything tested OK with Delphi 10.4.2 (Should work with any other recent Delphi).