DLL, динамический выхов процедур с переменных числом параметров.

← →
AMPR (2006-01-31 16:20) [0]

Объясняю, есть DLL и к ней описание, в виде отдельного файла, экспортируемых функций и процедур, типа:

function summ (a : real ; b : real) : real ;
procedure TextOut(test : string) ;

В общем я открывая файл с описанием, парсю его и т.д. В общем всё до теперешнего момента получилось. А вот как потом динамически вызвать, например, функцию "summ" и передать ей эти два параметра ???

PS: всю инфу храню в структуре

type TPFRec = record //запись, где содержиться вся информация о функции или процедуре (заполняется парсером (сканнером))
need_return : boolean ; //функция или процедура
Name : string ;//имя процедуры/функции
params : array of variant ; // массив параметров
result_code : variant ;
end;

var
spisok : array of TPFRec ;

← →
Digitman © (2006-01-31 16:26) [1]

Галиматьища.
Кошмарная каша.

Прожуй и изложи как положено - четко, конкретно, терминологически внятно.

← →
AMPR (2006-01-31 16:33) [2]

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

← →
AMPR (2006-01-31 16:34) [3]

идеи есть ?

← →
evvcom © (2006-01-31 17:07) [4]

идеи-то есть.
Поясни еще такой момент. Ну предположим нашел ты способ. Что ты будешь передавать в качестве
> a : real ; b : real
? Какие фактические параметры будешь использовать?

← →
AMPR (2006-01-31 17:21) [5]

а вот в этом и есть вся загвоздка ! я не знаю как их передавать.

← →
Desdechado © (2006-01-31 17:43) [6]

не как передавать, а что они значат
ну кинул я тебе ДЛЛ, которая содержит функцию рисования синусоиды (с параметрами, передаваемыми в функцию) на контексте, передаваемом параметром
что твоя программа будет делать "автоматически подключать DLL к некоторому проекту", нафига ей эта ДЛЛ?

← →
jack128 © (2006-01-31 17:49) [7]

AMPR (31.01.06 16:20)
что то я у тебя не вижу, где в твоей структуре хранится ТИП параметров.

А вообще ИМХО, только через асм. В ручную кидать параметры в стек, в ручную забирать результат. А вот если же ты ограничешь кол-во параметров у функций в dll, ну например тремя, то можно подумать..

Digitman © (31.01.06 16:26) [1]
как я понял, человек хочешь реализовать что то типа вот такой УНИВЕРСАЛЬНОЙ процедуры

procedure ExecDllProc(const DllFileName, FuncName: string; Params: array of const; var FuncResult);

Desdechado © (31.01.06 17:43) [6]
нафига ей эта ДЛЛ?
Если в проге реализован скриптовый движек, то эта dll может быть нужна конечному пользователю программы..

← →
Desdechado © (2006-01-31 17:59) [8]

если конечный пользователь настолько продвинут, что будет разбираться в параметрах внушних неизвестно откуда появившихся ДЛЛ, то это уже программист

← →
AMPR (2006-01-31 17:59) [9]

jack128 >> спасибо, удачно подметил и понял меня в полном смысле.

а на счёт хранения типа переменной я просто забыл указать .... бывает такое.

да мне хоть на асме ... просто проект изначально разрабатывался на Delphi, а на сколько я знаю в Delphi есть возможность вставки asm кода

← →
AMPR (2006-01-31 18:03) [10]

Desdechado >>

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

← →
AMPR (2006-01-31 18:05) [11]

Desdechado >> и вообще, если есть конкретный вопрос ... , нафига спрашивать надо это делать или нет!!! Если бы мне это надо было ,я б спросил по другому! ( сори конечно, но просто обидно - не люблю когда выделываются и загибают пальцы)

← →
Desdechado © (2006-01-31 18:12) [12]

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

← →
Digitman © (2006-02-01 09:44) [13]

> AMPR (31.01.06 18:05) [11]

Ты занялся изобретением велосипеда.

Есть OLE/COM-технология, есть технология библиотек типов OLE/COM-объектов - этого вполне достаточно для решения задачи.

Сделай свою DLL COM-сервером автоматизации, дополни ее содержимое библиотекой типов с минимально необходимыми комментариями, дай пользователю инструмент для просмотра библ-ки типов - и все ! И не надо ничего изобретать ! Все уже готово ...

← →
AMPR (2006-02-01 09:51) [14]

Digitman >> наверно так и придётся ... спасибо

← →
Игорь Шевченко © (2006-02-01 10:36) [15]

> как я понял, человек хочешь реализовать что то типа вот
> такой УНИВЕРСАЛЬНОЙ процедуры
>
> procedure ExecDllProc(const DllFileName, FuncName: string;
> Params: array of const; var FuncResult);

И в чем проблема реализации ?

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

Или я что-то здорово не понимаю ?

← →
Digitman © (2006-02-01 10:43) [16]

> Игорь Шевченко © (01.02.06 10:36) [15]

Думаю, автору не дает покоя идея "интерпретируемого" вызова произвольной эксп.ф-ции из произвольной DLL.

Если так, то на первый план выдвигаются соглашения о вызове, кои автор почему-то напрочь игнорирует ... А ведь от этого в первую очередь как раз и зависит решение задачи с передачей параметров и результата ... Ну и баланса стека, конечно же ..

← →
Игорь Шевченко © (2006-02-01 11:16) [17]

Digitman © (01.02.06 10:43) [16]

Если ограничиться соглашением stdcall, что, в общем-то для функций из DLL вполне естественно, то почему бы и нет ? Мы вроде подобные задачи (вызов функций с произвольным количеством аргументов) регулярно решали с перехватчиками API, как ты, так и я.

← →
Digitman © (2006-02-01 11:59) [18]

> Игорь Шевченко © (01.02.06 11:16) [17]

> Если ограничиться соглашением stdcall

А вот это у автора нужно спросить.

Хотя судя по упомянутой TPFRec соглашения его никак не заботят, будто их, соглашений этих, в природе не существует ...

← →
AMPR (2006-02-01 12:01) [19]

Digitman >>то на первый план выдвигаются соглашения о вызове >>

это я прекрасно понимаю .... чтож пока рассмаривается stdcall ...

кстати, на счёт COM - не так уж универсально получается!
(пусть COM - будущее, но ...

такое не устраивает тем, что основной программный продукт потеряет клиента только из-за того, что в нём используются достаточно сложные технологии реализации импортируемых модулей!!!! тем более COM не все любят и многие не знают!

← →
AMPR (2006-02-01 12:04) [20]

и не обращайте сильно внимания на то что было приведено выше в качетво примера .... это была всего-лишь мысль ... которую можно менять как хочешь ..

Развлекался я в своё время такой идеей.

Принцип прост: по известным типам аргументов и их значениям
в ран-тайме собирается код помещения аргументов в стек и
вызова процедуры.

Код достаночно сырой и грубый,
так как это всего всего лишь проверка принципа.
Работает только для stcall.

Вот так, собственно, выглядит вызов:

var f: TFunctionCaller;
i1, i2: TArgTreater;
begin
// Создаётся объект-вызыватель,
// и ему передаётся указатель на процедуру.
f := TFunctionCaller.Create(@Test2);

// Следующие шаги должен делать парсировщик: по сигнатуре процедуры
// определить, сколько и какие аргументы eсть у процедуры,
// создать соответствующие объекты TArgTreater по именам типов
// и добавить их в Caller. Но пока всё это делается вручную,
// поскольку эта задача для меня интереса не представляла.

try
i1 := TIntArgTreater.Create("Integer"); // CreateArgTreater("Integer");
i2 := TIntArgTreater.Create("Integer");

i1.SetValue("1");
i2.SetValue("2");

f.AddArgument(i1);
f.AddArgument(i2);

f.WriteCode; // Caller собирает код вызова

f.Call; // производит вызов
finally
f.Free;
end;
end;

{********************* FuncCall.pas *************************}
unit FuncCall;

interface

uses
Classes, Contnrs;

type

TArgTreater = class
protected
FBuffer: array of Byte;
public
constructor Create(const ATypeName: string); virtual;
destructor Destroy; override;

procedure SetValue(const Value: string); virtual; abstract;
procedure WriteCode(ACode: TStream; ArgNo: Integer); virtual; abstract;
// function GetDataSize: Integer; virtual; abstract;
end;

TFunctionCaller = class // stdcall only
private
// VMT // 0
FRetAddr: Integer; // 4
FCode: Pointer; // 8
FFunc: Integer; //Pointer; // c
FArgs: TObjectList;

FRetPlace, FRetMove: Integer;
protected
procedure WriteInitialCode(ACode: TStream);
procedure WriteFinalCode(ACode: TStream);
public
constructor Create(AFunc: Pointer);
destructor Destroy; override;

procedure AddArgument(Arg: TArgTreater);
procedure WriteCode;
procedure Call;
end;

implementation

{ TArgTreater }

constructor TArgTreater.Create(const ATypeName: string);
begin
inherited Create;
//GetMem(FData, GetDataSize);
end;

destructor TArgTreater.Destroy;
begin
//FreeMem(FData, GetDataSize);
inherited;
end;

{ TFunctionCaller }

constructor TFunctionCaller.Create(AFunc: Pointer);
begin
inherited Create;
GetMem(FCode, 4096); // VirtualAlloc + PAGE_EXECUTE_READWRITE
FFunc := Integer(AFunc);
FArgs := TObjectList.Create(True);
end;

destructor TFunctionCaller.Destroy;
begin
FreeMem(FCode, 4096);
FArgs.Free;
inherited;
end;

procedure TFunctionCaller.Call;
asm
// self in EAX

PUSH EAX
PUSH EBX
PUSH ECX
PUSH EDX

MOV EBX,EAX
// self in EBX

CALL Self.FCode

POP EDX
POP ECX
POP EBX
POP EAX
end;

type THackMemStream = class(TCustomMemoryStream);

procedure TFunctionCaller.WriteCode;
var i: Integer;
Stream: TMemoryStream;
begin
Stream := TMemoryStream.Create();
THackMemStream(Stream).SetPointer(FCode, 4096);
try
WriteInitialCode(Stream);
for i := 0 to FArgs.Count-1 do TArgTreater(FArgs[i]).WriteCode(Stream, i);
WriteFinalCode(Stream);

finally
Stream.Free;
end;
end;

var
POP_EDX: Byte = $5A;
//MOV_RETADDR: array[0..2] of Byte = ($89, $53, $00{offset FRetAddr}); // MOVE [ebx + $00] , edx
MOV_RETADDR: array[0..5] of Byte = ($89, $15, $00, $00, $00, $00);

procedure TFunctionCaller.WriteInitialCode(ACode: TStream);
begin
ACode.WriteBuffer(POP_EDX, 1);

//MOV_RETADDR[2] := Integer(@Self.FRetAddr) - Integer(Self);

FRetMove := ACode.Position + 2;
ACode.WriteBuffer(MOV_RETADDR, 6);
end;

var
PUSH_RETADDR: array[0..4]of Byte = ($68, $00, $00, $00, $00);
//JMP_FUNC: array[0..5]of Byte = ($FF, $25, $00, $00, $00, $00);
JMP_FUNC: array[0..2]of Byte = ($FF, $63, $00);
JMP_EBX: array[0..1]of Byte = ($FF, $E3);

//MOV_FUNC: array[0..2]of Byte = ($8B, $60, $0c); // mov edx, dword ptr[eax + $0c]
//MOV_FUNC: array[0..2]of Byte = ($8B, $58, $0c); // mov ebx, dword ptr[eax + $0c]
MOV_FUNC: array[0..2]of Byte = ($8B, $5B, $0c); // mov ebx, dword ptr[ebx + $0c]

procedure TFunctionCaller.WriteFinalCode(ACode: TStream);
var pos: Integer;
begin

PUSH_RETADDR[1] := FRetAddr and $FF; // Here RetAddr = nil
PUSH_RETADDR[2] := (FRetAddr shr 8) and $FF;
PUSH_RETADDR[3] := (FRetAddr shr 16) and $FF;
PUSH_RETADDR[4] := (FRetAddr shr 24) and $FF;

PUSH_RETADDR[1] := FFunc and $FF;
PUSH_RETADDR[2] := (FFunc shr 8) and $FF;
PUSH_RETADDR[3] := (FFunc shr 16) and $FF;
PUSH_RETADDR[4] := (FFunc shr 24) and $FF;

pos := ACode.Position;
FRetPlace := pos + 1 + Integer(THackMemStream(ACode).Memory);

ACode.WriteBuffer(PUSH_RETADDR, 5);

{
JMP_FUNC[2] := FFunc and $FF;
JMP_FUNC[3] := (FFunc shr 8) and $FF;
JMP_FUNC[4] := (FFunc shr 16) and $FF;
JMP_FUNC[5] := (FFunc shr 24) and $FF;
}
MOV_FUNC[2] := Integer(@Self.FFunc) - Integer(Self);
ACode.WriteBuffer(MOV_FUNC, 3); // test

ACode.WriteBuffer(JMP_EBX, 2);

JMP_FUNC[2] := Integer(@Self.FFunc) - Integer(Self);
ACode.WriteBuffer(JMP_FUNC, 3);

//JMP_FUNC[2]

ACode.Position := FRetMove;
ACode.WriteBuffer(FRetPlace, 4);
end;

procedure TFunctionCaller.AddArgument(Arg: TArgTreater);
begin
FArgs.Add(Arg);
end;

end.

{************************** Args.pas *************************}

unit Args;

interface

uses
Classes,
TypId, DoubleFn, IntegerFn,
FuncCall;

type
TIntArgTreater = class(TArgTreater)
private
FTypeId: TNumericTypeId;
public
constructor Create(const ATypeName: string); override;
procedure SetValue(const Value: string); override;
procedure WriteCode(ACode: TStream; ArgNo: Integer); override;
end;

TInt64ArgTreater = class(TArgTreater)
public
constructor Create(const ATypeName: string); override;
procedure SetValue(const Value: string); override;
procedure WriteCode(ACode: TStream; ArgNo: Integer); override;
end;

TFloatArgTreater = class(TArgTreater)
private
FTypeId: TFloatTypeId;
public
constructor Create(const ATypeName: string); override;
procedure SetValue(const Value: string); override;
procedure WriteCode(ACode: TStream; ArgNo: Integer); override;
end;

implementation

uses
SysUtils;

{----------------------------- TIntArgTreater ---------------------------------}

constructor TIntArgTreater.Create(const ATypeName: string);
begin
inherited;
FTypeId := GetTypeId(ATypeName);
if FTypeId = tpInt64 then raise Exception.Create("");
SetLength(FBuffer, GetTypeSize(tpInteger));
end;

procedure TIntArgTreater.SetValue(const Value: string);
var put: procedure(p: Pointer; I: Integer; const V: Integer);
begin
put := IntegerFn.SetProc(FTypeId);
put(@FBuffer[0], 0, StrToInt(Value));
end;

const
PUSH4: Byte = $68;
MOV_ECX = $B9;
MOV_EDX = $BA;
MOV_EAX = $B8;

MOV_REG: array[0..2]of Byte = (MOV_EAX, MOV_EDX, MOV_ECX);

procedure TIntArgTreater.WriteCode(ACode: TStream; ArgNo: Integer);
begin
if ArgNo > 2 then
ACode.WriteBuffer(PUSH4, 1) else
ACode.WriteBuffer(MOV_REG[ArgNo], 1);

ACode.WriteBuffer(FBuffer[0], 4);
end;

{----------------------------- TInt64ArgTreater -------------------------------}

constructor TInt64ArgTreater.Create(const ATypeName: string);
begin
inherited;
SetLength(FBuffer, SizeOf(Int64));
end;

procedure TInt64ArgTreater.SetValue(const Value: string);
var v: Int64;
er: Integer;
begin
Val(Value, v, er);
PInt64(@FBuffer[0])^ := v;
end;

procedure TInt64ArgTreater.WriteCode(ACode: TStream; ArgNo: Integer);
begin
ACode.WriteBuffer(PUSH4, 1);
ACode.WriteBuffer(FBuffer[0], 4);
ACode.WriteBuffer(PUSH4, 1);
ACode.WriteBuffer(FBuffer[4], 4);
end;

{--------------------------- TFloatArgTreater ---------------------------------}

constructor TFloatArgTreater.Create(const ATypeName: string);
begin
inherited;
FTypeId := GetTypeId(ATypeName);
SetLength(FBuffer, GetTypeSize(FTypeId));
end;

procedure TFloatArgTreater.SetValue(const Value: string);
var
v: Double;
er: Integer;
put: procedure(p: Pointer; I: Integer; const V: Double);
begin
Val(Value, v, er);
put := DoubleFn.SetProc(FTypeId);
put(@FBuffer[0], 0, v);
end;

const
ZERO: Integer = 0;

procedure TFloatArgTreater.WriteCode(ACode: TStream; ArgNo: Integer);
begin
case GetTypeSize(FTypeId) of
4: {};
6: begin
ACode.WriteBuffer(PUSH4, 1);
ACode.WriteBuffer(FBuffer[4], 2);
ACode.WriteBuffer(ZERO, 2);
end;
8: begin
ACode.WriteBuffer(PUSH4, 1);
ACode.WriteBuffer(FBuffer[4], 4);
end;
10: begin
ACode.WriteBuffer(PUSH4, 1);
ACode.WriteBuffer(FBuffer[8], 2);
ACode.WriteBuffer(ZERO, 2);

ACode.WriteBuffer(PUSH4, 1);
ACode.WriteBuffer(FBuffer[4], 4);
end;
end;
ACode.WriteBuffer(PUSH4, 1);
ACode.WriteBuffer(FBuffer[0], 4);

end;

end.
{******************************************************}

← →
AMPR (2006-02-01 14:18) [23]

Спасибо, пошёл разбираться ...

Пардон, это я ошибся.
Данная реализация рассчитана не на stdcall, а на register.

Но stdcall из неё сделать несложно -
пустить аргументы в обратном порядке

//for i := 0 to FArgs.Count-1 do TArgTreater(FArgs[i]).WriteCode(Stream, i);
for i := FArgs.Count-1 downto 0 do TArgTreater(FArgs[i]).WriteCode(Stream, i);

и вместо
if ArgNo > 2 then
ACode.WriteBuffer(PUSH4, 1) else
ACode.WriteBuffer(MOV_REG[ArgNo], 1);

для целочисленных типов написать просто

ACode.WriteBuffer(PUSH4, 1);

Вроде и всё.

← →
AMPR (2006-02-01 15:24) [25]

сори вот только загвоздка с некоторыми юнитами вышла:

TypId, DoubleFn, IntegerFn,

.... не понял где они есть и что в них должно быть ...

соответственно некоторые типы не катят ...

Они тут лежат:
http://kladovka.net.ru/index.cgi?pid=list&rid=257

DLL, динамический выхов процедур с переменных числом параметров. Найти похожие ветки