Форум: "Начинающим";
Текущий архив: 2018.06.10;
Скачать: [xml.tar.bz2];
Вниз
Генерировать функцию во время выполнения Найти похожие ветки
← →
KSergey © (2016-04-12 15:24) [0]Почитал тему рядом и подумал, что наверное и на мой вопрос будут идеи реализации.
Что есть:
В коде есть некие разные функции с единым прототипом.
Есть функция, которая регистрирует их как callback"и.
Что нужно:
Нужна такая функция, которая во внешней системе будет регистрировать на сам переданный ей call-back, а обёртку на call-back"ом, которая уже будет этот call-back вызывать.
Сама обёртка каждый раз совершенно идентичная:
код до
вызов оригинального callback
код после
Передать через параметры какой call-back вызывать - возможности нет. Т.е. call-back-функции различаются только адресами получается.
Тогда нужно регистрировать каждый раз регистрировать новый адрес обёртки, а где его взять.
Есть ли возможность лепить такие обёртки в run-time?
← →
sniknik © (2016-04-12 15:29) [1]там же, рядом, уже предлагали встраиваемые скриптовые языки, нет?
← →
Sha © (2016-04-12 15:34) [2]> KSergey
Было проще понять проблему, если бы был код, что есть и что хочешь.
← →
Sha © (2016-04-12 15:48) [3]> KSergey
Если правильно понял, тебе достаточно одной процедуры с сотней входов.
Регистрируешь все входы.
Потом по адресу входа определяешь, что надо вызвать.
← →
DVM © (2016-04-12 15:50) [4]
> Есть ли возможность лепить такие обёртки в run-time?
Их бесконечное множество что ли? Может заранее слепить все варианты, не?
← →
KSergey © (2016-04-13 08:57) [5]> DVM © (12.04.16 15:50) [4]
> Их бесконечное множество что ли? Может заранее слепить все варианты, не?
Да, это понятный вариант.
Но как-то не спортивно )
← →
KSergey © (2016-04-13 08:58) [6]> Sha © (12.04.16 15:48) [3]
> Потом по адресу входа определяешь, что надо вызвать.
Да, вот это и надо как бы, но вопрос: в памяти по "адресу входа" должен лежать какой-то разумный код. И так для каждого адреса.
← →
KSergey © (2016-04-13 09:09) [7]Возможно в самом деле не достаточно понятно написано.
Попробую еще раз.
Есть код:function Func1: Integer;
begin
....
end;
....
function Func2: Integer;
begin
....
end;
....
function Func3: Integer;
begin
....
end;
....
....
SetCallbackA(Func1);
SetCallbackB(Func2);
SetCallbackC(Func3);
Хочется получить такое:function Func1: Integer;
begin
....
end;
function Func1Cover: Integer;
begin
try
Result := Func1;
except
.....
end;
end;
....
function Func2: Integer;
begin
....
end;
function Func2Cover: Integer;
begin
try
Result := Func2;
except
.....
end;
end;
....
function Func3: Integer;
begin
....
end;
function Func3Cover: Integer;
begin
try
Result := Func3;
except
.....
end;
end;
....
....
SetCallbackA(Func1Cover);
SetCallbackB(Func2Cover);
SetCallbackC(Func3Cover);
Т.к. функции-обёртки идентичны, кроме самой вызываемой функции - хотелось бы куража ради придумать хитровыпученный способ, когда бы при вызове некоей
SetCallbackA_My(Func1);
волшебно вокруг Func1 подставлялась (генерировалась) "индивидуальная" (в смысле адреса) обёртка, т.к. никаким параметром, увы, параметризировать вызов не удастся, интерфейс установки call-back"ов за зоной моего влияния.
Есть такой способ - хорошо, нет - ну и ладно.
← →
icWasya © (2016-04-13 09:39) [8]И уточни, это всё будет находиться в одном исполняемом файле, в разных (Exe,dll), Какую часть ты можешь модифицировать, какую нет.
Где находится код Func1,FuncX..., где находится код Func1Cover,FuncXCover
← →
KSergey © (2016-04-13 10:15) [9]Func1,FuncX..., - моё (т.е. это мой код, который могу изменить как угодно)
Func1Cover,FuncXCover - моё
Всё это внутри dll, подгружаемой во внешний процесс.
SetCallbackA, SetCallbackB, SetCallbackC - не моё.
Код, который в итоге вызывает зарегистрированные callback"и - не моё, менять ничего в нём не могу.
← →
Sha © (2016-04-13 12:45) [10]Что-то вроде этого, например.
Проверил в D7.
unit CoverForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TMyFunc= function: integer;
function Func1: integer;
begin;
Result:=1;
Form1.Memo1.Lines.Add(IntToStr(Result));
end;
function Func2: integer;
begin;
Result:=2;
Form1.Memo1.Lines.Add(IntToStr(Result));
end;
var
Callback: array[1..8] of TMyFunc= (nil, nil, nil, nil, nil, nil, nil, nil);
procedure SetCallback(No: integer; Func: TMyFunc);
begin;
CallBack[No]:=@Func;
end;
procedure Run;
begin;
if Assigned(Callback[1]) then Callback[1];
if Assigned(Callback[2]) then Callback[2];
end;
procedure TForm1.Button1Click(Sender: TObject);
begin;
SetCallback(1,Func1);
SetCallback(2,Func2);
Run;
end;
var
CoverBase: pAnsiChar= nil;
CoverCallback: array[1..8] of TMyFunc= (nil, nil, nil, nil, nil, nil, nil, nil);
function Cover(Func: TMyFunc): integer;
var
p: PAnsiChar;
i: integer;
begin;
//получить адрес возврата
asm
mov eax,[ebp+4]
mov p, eax
end;
i:=((p-CoverBase)+1) div 6;
Form1.Memo1.Lines.Add("Enter Cover");
try
Result:=CoverCallback[i];
except
Result:=0;
end;
Form1.Memo1.Lines.Add("Leave Cover");
end;
procedure CoveredFunc;
asm
call Cover
ret
call Cover
ret
call Cover
ret
call Cover
ret
call Cover
ret
call Cover
ret
call Cover
ret
call Cover
ret
end;
procedure SetCoverCallback(No: integer; Func: TMyFunc);
begin;
CoverCallBack[No]:=Func;
CoverBase:=@CoveredFunc;
SetCallback(No, TMyFunc(CoverBase+6*(No-1)));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin;
SetCoverCallback(1,Func1);
SetCoverCallback(2,Func2);
Run;
end;
end.
← →
Sha © (2016-04-13 13:05) [11]В коде есть пара опечаток:
1. Объявление функции Cover должно удовлетворять типу TMyFunc,
т.е. ее надо объявить так:function Cover: integer;
2. Где-то в коде собака потерялась. Лучше ее найти. Для строгости.
← →
Leonid Troyanovsky © (2016-06-02 09:16) [12]
> KSergey © (13.04.16 09:09) [7]
> обёртки идентичны, кроме самой вызываемой функции - хотелось
> бы куража ради придумать хитровыпученный способ, когда бы
> при вызове некоейSetCallbackA_My(Func1);волшебно вокруг
> Func1 подставлялась (генерировалась) "индивидуальная" (в
> смысле адреса) обёртка
Проверил в D6.
type
TProc = procedure;
TEProc = procedure(E: Exception);
TModProcs = packed record
proc1: TProc;
proc2: TEProc;
code: PByte;
end;
PModProcs=^TModProcs;
procedure Agregate(p1: TProc; p2: TEProc);
begin
try
p1;
except
on E: Exception do
p2(E);
end;
end;
const
vagr: procedure(p1: TProc; p2: TEProc)= Agregate;
procedure Template(m: PModProcs); register;
begin
with m^ do
vagr(proc1, proc2);
end;
type
TPrecode = packed record
b8: Byte;
m: Pointer;
end;
procedure AddModProc(const p1: TProc; p2: TEProc; var p3: TProc);
var
procsize: Longint;
p0, pt: PByte;
pc: TPrecode;
pmp: PModProcs;
begin
New(pmp);
procsize := Dword(@AddModProc)-Dword(@template)+1;
pc.b8 := $B8;
pc.m := pmp; // mov eax, pmp = B8 00 00 00 00
with pmp^ do
begin
proc1 := p1;
proc2 := p2;
GetMem(code, SizeOf(pc)+ procsize);
pt := code;
Move(pc.b8, pt^, SizeOf(pc));
inc(pt, SizeOf(pc));
p0 := @template;
Move(p0^, pt^, procsize);
p3 := @code^;
end;
end;
procedure a;
begin
ShowMessage("a: "+IntToStr(GetTickCount));
abort;
end;
procedure b(E: Exception);
begin
Application.ShowException(E);
end;
procedure d;
begin
ShowMessage("a: "+IntToStr(GetTickCount));
raise Exception.Create("MyException");
end;
procedure TForm1.Button2Click(Sender: TObject);
var
c, e: TProc;
begin
AddModProc(a, b, c);
AddModProc(d, b, e);
c;
e;
end;
--
Regards, LVT.
← →
KSergey © (2016-06-02 09:56) [13]Ого!
Спасибо, мастера.
Буду изучать.
← →
Плохиш © (2016-06-02 10:32) [14]Хм, и для чего только придумывали интерфейсы?
← →
ВладОшин © (2016-07-04 09:35) [15]как то надо было сделать быстро нечто похожее - сделал тупо:
положил рядом dcc, писал налету dll, компилил ее, подгружал, получал адрес процы, выполнял, выгружал, удалял.
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2018.06.10;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.001 c
