Текущий архив: 2006.03.05;
Скачать: CL | DM;
Вниз
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]и не обращайте сильно внимания на то что было приведено выше в качетво примера .... это была всего-лишь мысль ... которую можно менять как хочешь ..
← →
reonid © (2006-02-01 14:02) [21]Развлекался я в своё время такой идеей.
Принцип прост: по известным типам аргументов и их значениям
в ран-тайме собирается код помещения аргументов в стек и
вызова процедуры.
Код достаночно сырой и грубый,
так как это всего всего лишь проверка принципа.
Работает только для 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.
← →
reonid © (2006-02-01 14:02) [22]{************************** 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]Спасибо, пошёл разбираться ...
← →
reonid © (2006-02-01 14:38) [24]Пардон, это я ошибся.
Данная реализация рассчитана не на 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,
.... не понял где они есть и что в них должно быть ...
соответственно некоторые типы не катят ...
← →
reonid © (2006-02-01 15:33) [26]Они тут лежат:
http://kladovka.net.ru/index.cgi?pid=list&rid=257
Страницы: 1 вся ветка
Текущий архив: 2006.03.05;
Скачать: CL | DM;
Память: 0.56 MB
Время: 0.049 c
