|
|
|
|
Исследование кода, генерируемого Delphi 3Delphi , Программа и Интерфейс , Исследование программИсследование кода, генерируемого Delphi 3
Оформил: DeeCo
Unit1.pas - главная форма приложения.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Project1_TLB;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
Unit2;
procedure TForm1.Button1Click(Sender: TObject);
var
My_Object: TRP_Server;
My_Interface: IRP_Server;
begin
My_Object := nil;
My_Interface := nil;
try
My_Object := TRP_Server.Create;
My_Interface := My_Object;
My_Interface.RP_Prop := PChar('??????');
MessageDlg(Format('My Method1: %d, string is %s, refcount is %d',
[My_Interface.Method1(1), My_Interface.RP_Prop, My_Object.RefCount]),
mtConfirmation, [mbOk], 0);
finally
if My_Interface <> nil then
My_Interface := nil;
(* ??? ?? ????????? - My_Object ??? ?? ?????????? ????? *)
MessageDlg(Format('refcount is %d', [My_Object.RefCount]),
mtConfirmation, [mbOk], 0);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
RP_IO: IRP_Server;
begin
try
RP_IO := CoRP_Server.Create;
RP_IO.RP_Prop := 'Yet one string';
MessageDlg(Format('String is %s, Method1 return %d',
[RP_IO.RP_Prop, RP_IO.Method1(123)]), mtConfirmation, [mbOk], 0);
except
on e: Exception do
MessageDlg(Format('Exception occured: %s, reason %s',
[e.ClassName, e.Message]), mtError, [mbOk], 0);
end;
end;Projcet1_TLB.pas - файл, автоматически сгенерированный Delphi для классов,
являющихся серверами OLE-Automation
unit Project1_TLB;
...
interface
uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used: //
// Type Libraries : LIBID_xxxx //
// CoClasses : CLASS_xxxx //
// DISPInterfaces : DIID_xxxx //
// Non-DISP interfaces: IID_xxxx //
// *********************************************************************//
const
LIBID_Project1: TGUID = '{198C3180-6073-11D3-908D-00104BB6F968}';
IID_IRP_Server: TGUID = '{198C3181-6073-11D3-908D-00104BB6F968}';
CLASS_RP_Server: TGUID = '{198C3183-6073-11D3-908D-00104BB6F968}';
type
// *********************************************************************//
// Forward declaration of interfaces defined in Type Library //
// *********************************************************************//
IRP_Server = interface;
IRP_ServerDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library //
// (NOTE: Here we map each CoClass to its Default Interface) //
// *********************************************************************//
RP_Server = IRP_Server;
// *********************************************************************//
// Interface: IRP_Server
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {198C3181-6073-11D3-908D-00104BB6F968}
// *********************************************************************//
IRP_Server = interface(IDispatch)
['{198C3181-6073-11D3-908D-00104BB6F968}']
function Method1(a: Integer): Integer; safecall;
function Get_RP_Prop: PChar; safecall;
procedure Set_RP_Prop(Value: PChar); safecall;
property RP_Prop: PChar read Get_RP_Prop write Set_RP_Prop;
end;
// *********************************************************************//
// DispIntf: IRP_ServerDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {198C3181-6073-11D3-908D-00104BB6F968}
// *********************************************************************//
IRP_ServerDisp = dispinterface
['{198C3181-6073-11D3-908D-00104BB6F968}']
function Method1(a: Integer): Integer; dispid 1;
property RP_Prop: {??PChar} OleVariant dispid 2;
end;
CoRP_Server = class
class function Create: IRP_Server;
class function CreateRemote(const MachineName: string): IRP_Server;
end;
implementation
uses ComObj;
class function CoRP_Server.Create: IRP_Server;
begin
Result := CreateComObject(CLASS_RP_Server) as IRP_Server;
end;
class function CoRP_Server.CreateRemote(const MachineName: string): IRP_Server;
begin
Result := CreateRemoteComObject(MachineName, CLASS_RP_Server) as IRP_Server;
end; Меня всегда интересовало, как же это так Delphi позволят иметь код, запускаемый
при инициализации и деинициализации модуля ? Просмотрев исходный код в файле
Rtl/Sys/System.pas ( я рекомендую иметь исходные тексты, поставляемые вместе
с Delphi при исследовании написанных на ней программ ) и сравнив его с
ассемблерным листингом, выясняется, что это легко и непринуждённо.
Итак, существуют несколько довольно простых структур:
PackageUnitEntry = record
Init, FInit: procedure;
end;
{ Compiler generated table to be processed sequentially to init & finit all package units }
{ Init: 0..Max-1; Final: Last Initialized..0 }
UnitEntryTable = array[0..9999999] of PackageUnitEntry;
PUnitEntryTable = ^UnitEntryTable;
PackageInfoTable = record
UnitCount: Integer; { number of entries in UnitInfo array; always > 0 }
UnitInfo: PUnitEntryTable;
end;
PackageInfo = ^PackageInfoTable;
При startupе указатель на PackageInfoTable передаётся единственным аргументом
функции InitExe:
start proc near
push ebp
mov ebp, esp
add esp, 0FFFFFFF4h
mov eax, offset dword_0_445424
call @@InitExe ; ::`intcls'::InitExe
По адресу 0x445424 хранится DWORD 0x29 и указатель на таблицу структур
PackageUnitEntry, где, в частности, на предпоследнем месте содержатся и
адреса моих процедур инициализации и деинициализации.
Delphi помещает список реализуемых классом интерфейсов в отдельную структуру, указатель на которую помещает в RTTI по смещению 0x4. Сама эта структура описана во всё том же Rtl/Sys/System.pas: PGUID = ^TGUID; TGUID = record D1: LongWord; D2: Word; D3: Word; D4: array[0..7] of Byte; end; PInterfaceEntry = ^TInterfaceEntry; TInterfaceEntry = record IID: TGUID; VTable: Pointer; IOffset: Integer; ImplGetter: Integer; end; PInterfaceTable = ^TInterfaceTable; TInterfaceTable = record EntryCount: Integer; Entries: array[0..9999] of TInterfaceEntry; end;Указатель на TInterfaceTable и помещается в RTTI по смещению 0x4 ( если класс реализует какие-либо интерфейсы ). TGUID - это обычная структура UID, используемая в OLE, VTable - указатель на VTBL интерфейса, IOffset - смещение в данном классе на экземпляр, содержащий данные данного интерфейса. Когда вызывается метод интерфейса, он вызывается обычно от указателя на интерфейс, а не на класс, реализующий этот интерфейс. Мы же пишем методы нашего класса, которые ожидают видеть в качестве нулевого аргумента указатель на экземпляр нашего класса. Поэтому Delphi автоматически генерирует для VTable код, настраивающий свой нулевой аргумент соответствующим образом. Например, для моего класса TRP_Server значение поля IOffset составляет 0x34. Функции же, содержащиеся в VTable, выглядят так:
loc_0_444B39: ; функция, вызываемая по интерфейсу
add dword ptr [esp+4], 0FFFFFFCCh
jmp MyMethod1 ; вызов функции в классе
Напомню, что все методы интерфейсов должны объявляться как safecall -
параметры передаются как в C, справо налево, но очистку стека производит
вызываемая процедура. Поэтому в [esp+4] содержится нулевой параметр функции -
указатель на экземпляр интерфейса - класса IRP_Server. Затем вызывается
метод класса TRP_Server, которому должен нулевым параметром передаваться
указатель на экземпляр TRP_Server - поэтому происходит настройка этого
параметра, 0x0FFFFFFCC = -0x34.
Самый же значимый резльтат всех этий ковыряний в коде - мне удалось обнаружить
в RTTI полное описание всех published свойств ! Из системы помощи
Delphi: ( файл del4op.hlp, перевод мой ): TPropInfo = packed record PropType: PPTypeInfo; GetProc: Pointer; SetProc: Pointer; StoredProc: Pointer; Index: Integer; Default: Longint; NameIndex: SmallInt; Name: ShortString; end;После структуры наследования ( по смещению 10h в RTTI ) расположен WORD - количество расположенных следом за ним структур TPropInfo, по одной на каждое published свойство. В этой структуре поля имеют следующие значения:
Как видите, можно узнать о published-свойствах практически всё, включая
адрес, на который нужно ставить точку останова.
Исследование кода, генерируемого Delphi 3: интерфейсы и published свойства. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш :: Главная :: Исследование программ ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 | ||||
Telegram-канал