Обработка исключений и сообщений

Delphi , Синтаксис , Ошибки и Исключения

Обработка исключений и сообщений

У кнопки Reset есть один недостаток: маленькая очень, кулаком попасть сложно.

На сей раз я наваял приложение, использующее несколько более продвинутые технологии, предоставляемые Delphi - exceptions handling ( перехват исключений ), virtual & dynamic функции, обработку формой сообщений Windows, производные классы и загрузку строковых ресурсов из реестра. Исходный код моей программы мог бы выглядеть как-нибудь так:

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TRPEnum = ( RP_One, RP_Two, RP_Tree );
  TRPEnumSet = set of TRPEnum;

  TRPException = class(Exception)
  private
   RP_Array: array[7..9] of string;
   Code: TRPEnumSet;
  public
   Procedure Old_one_virtual; virtual;
   Procedure Old_one_dynamic; dynamic;
   Constructor Create;
   Destructor Destroy; override;
  end;

  TRPExceptionChild = class(TRPException)
   Procedure Old_one_virtual; override;
   Procedure Old_one_dynamic; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FDesignedWidth, FDesignedHeight: Integer;
    procedure BuggyOne;
    Procedure WMSizing( var Message: TMessage ); message WM_SIZING;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

resourcestring
 BuggyOneCaption = 'BuggyOne';
 MalformedException = 'Malformed exception';

(* TRPException *)
Constructor TRPException.Create;
begin
 Application.MessageBox('Create', 'TRPException', ID_OK);
 inherited Create('BuggyOne object');
end;

Destructor TRPException.Destroy;
begin
 Application.MessageBox('Destroy', 'TRPException', ID_OK);
 Inherited;
end;

Procedure TRPException.Old_one_virtual;
begin
 Application.MessageBox('Old_one_virtual','TRPException', ID_OK);
end;

Procedure TRPException.Old_one_dynamic;
begin
 Application.MessageBox('Old_one_dynamic','TRPException', ID_OK);
end;

(* TRPExceptionChild *)
Procedure TRPExceptionChild.Old_one_virtual;
begin
 Application.MessageBox('Old_one_virtual','TRPExceptionChild', ID_OK);
end;

Procedure TRPExceptionChild.Old_one_dynamic;
begin
 Application.MessageBox('Old_one_dynamic','TRPExceptionChild', ID_OK);
end;

(* TForm1 *)
procedure TForm1.BuggyOne;
var
 RP_E: TRPExceptionChild;
 N: Integer;
begin
 MessageDlg(BuggyOneCaption,mtConfirmation,[mbOk],0);
try
 RP_E := TRPExceptionChild.Create;
 RP_E.Code := [RP_One];
 RP_E.RP_Array[7] := 'Seven';
 N := 9;
 RP_E.RP_Array[8] := 'Eight';
 RP_E.RP_Array[N] := 'Nine inch nails';
 RP_E.Code := RP_E.Code + [RP_Two];
 Raise RP_E;
 MessageDlg('Not will showed at the end',mtConfirmation,[mbOk],0);
finally
 MessageDlg('In finally part',mtConfirmation,[mbOk],0);
end;
 MessageDlg('Not will showed at the end',mtConfirmation,[mbOk],0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 MessageDlg('Button1Click',mtConfirmation,[mbOk],0);
 try
  BuggyOne;
 except
  on E:TRPException do
   begin
    MessageDlg('Button1Click in exception block',mtConfirmation,[mbOk],0);
    E.Old_one_virtual;
    E.Old_one_dynamic;
   end;
  on E:TRPExceptionChild do
   begin
    MessageDlg(MalformedException,mtConfirmation,[mbOk],0);
   end;
 end;
 MessageDlg('Button1Click at the end',mtConfirmation,[mbOk],0);
end;

Procedure TForm1.WMSizing( var Message: TMessage );
var
 PRect : ^TRect;
Begin
  PRect := Pointer (Message . LParam );
  if PRect^. Right - PRect^. Left < FDesignedWidth then
  begin
    if Message.WParam in [ WMSZ_BOTTOMLEFT, WMSZ_LEFT, WMSZ_TOPLEFT ]
    then
     PRect^.Left := PRect^ . Right - FDesignedWidth
    else
     PRect^.Right := PRect^ . Left + FDesignedWidth;
  end;
  if PRect^ . Bottom - Prect^.Top < FDesignedHeight then
  begin
    if Message . WParam in [ WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT ]
    then
     PRect^.Top := PRect^ . Bottom - FDesignedHeight
    else
     PRect^. Bottom := PRect^ . Top + FDesignedHeight;
  end;
End;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FDesignedWidth := Width;
 FDesignedHeight := Height;
 MessageDlg('FormCreate',mtConfirmation,[mbOk],0);
end;

Не вершина программистского мастерства, конечно, но для наших целей вполне годится. Итак, запустим дизассемблер ( я использовал IDA 3.8b ) и не забудьте применить файл сигнатур для библиотеки VCL версии 4 ( d4vcl ) - в моём случае IDA опознала 2172 функции.

А пока IDA делает грязную работу за нас, можно предаться чтению документации ( весьма рекомендую заниматься этим время от времени - можно узнать столько интересного :-). Итак, что мы можем узнать из официальной документации по Delphi о тонкой разнице между динамическими (dynamic) и виртуальными (virtual) методами ?

Virtual методы расположены в таблице виртуальных методах, по традиции называемой VTBL, которая дублируется для каждого производного класса. Если в производном классе переопределяется новый метод, указатель на него будет в этой таблице под тем же индексом, что и в VTBL класса-предка - но указывать он будет на перегруженный метод. За счёт этого достигается наилучшая скорость - вызов функции по указателю через смещение в VTBL. С другой стороны, для каждого нового класса полностью дублируется вся VTBL ! Короче, классический случай ножниц "скорость против размера".

Dynamic методы имеют несколько другой способ хранения. Им назначается некоторый индекс - но не в таблице, а в hash-структуре. Также эта структура не дублируется для каждого производного класса - если переопределяется dynamic метод, он переопределяется для данного класса - и всё. Но вызов dynamic методов имеет больше накладных расходов - при вызове Delphi просматривает все классы-предки данного класса в поисках метода с нужным индексом.

Посмотрим, как всё вышесказанное выглядит на Ассемблере:

Я надеюсь, Вы ещё помните, насколько полезна бывает RTTI ? RTTI класса нашей единственной формы расположена по адресу 0x44016C. На сей раз она содержит по смещению 1Ch ненулевое значение, а указатель на hash-массив dynamic методов. Структура эта имеет примерно такой вид:

Смещение	Тип	Описание
0	WORD	Размер N hashа
2	WORD	N слов - индексов dynamic методов
N * 2 + 2	DWORD	N указателей на функции

Что ещё более интересно, в нашём случае индекс единственной функции - WMSizing 0x214. Если Вы посмотрите в файле заголовков messages.pas, 0x214 ( eq 532 ) есть значение сообщения WM_SIZING. В Borlandе, видимо, простые парни работают...

Итак, сейчас у нас есть более полное описание RTTI, я позволю себе повторить его здесь полностью:

Смещение	Тип	Описание
0	DWORD	указатель на VTBL
4	DWORD	значение не выяснено (vmtIntfTable)
8	DWORD	значение не выяснено (vmtAutoTable)
Ch	DWORD	значение не выяснено (vmtInitTable)
10h	DWORD	указатель на список наследований
14h	DWORD	указатель на компоненты, которыми владеет данный класс
18h	DWORD	указатель на массив обработчиков событий
1Ch	DWORD	указатель на hash dynamic методов
20h	DWORD	указатель на Pascal-строку - имя класса
24h	DWORD	размер класса
28h	DWORD	указатель на структуру RTTI класса-предка данного класса
2Ch	DWORD	указатель на метод SafeCallException
30h	DWORD	указатель на метод AfterConstruction
34h	DWORD	указатель на метод BeforeDestruction
38h	DWORD	указатель на метод Dispatch
3Ch	DWORD	указатель на метод DefaultHandler
40h	DWORD	указатель на метод NewInstance
44h	DWORD	указатель на метод FreeInstance
48h	DWORD	указатель на метод Destroy
4Ch	DWORDs	начало VTBL

Давайте рассмотрим самую примечательную функцию в моей программе - TForm1.Button1Click. Примечательна она исключительно тем, что вызывает функцию BuggyOne, выбрасывающую исключение, которое затем сама же и ловит двумя руками.

BuggyOne        proc near

var_4           = dword ptr -4

                push    ebp
                mov     ebp, esp
                push    0	; инициализация в 0 var_4
                push    ebx	; сохранить ebx
                push    esi	; и esi
                xor     eax, eax
                push    ebp     ; и ещё ebp
                push    offset loc_0_44064F	; поместим в стек адрес
						; finally кода
                push    dword ptr fs:[eax]      ; и прежнее значение стека
						; обработки исключений
                mov     fs:[eax], esp		; в стек обработки исключений
			     ; помещается указатель на текущее значение стека
                push    0
                lea     edx, [ebp+var_4]	; загрузим в var_4 строку из
                mov     eax, offset off_0_440368	; ресурсов
                call    @LoadResString
...
loc_0_440646:
                lea     eax, [ebp+var_4]	; очистить строку в var_4
                call    @@LStrClr       ; ::`intcls'::LStrClr
                retn
loc_0_44064F:
                jmp     @@HandleFinally ; ::`intcls'::HandleFinally
                jmp     short loc_0_440646

Обратите внимание на две вещи:

1) инициализация стека исключений. В стек помещается указатель 0x44064f, далее значение стека заносится с fs:[0]. По адресу 0x44064f нет ничего примечательного - просто переход на одинаковый для всех кусок кода HandleFinally. Но вот сразу за ним идёт код, который, казалось бы, никогда не достигается - переход на 0x440646. Но вот этот-то код как раз и есть finally часть в обработке исключений. В данном случае - это освобождение строки var_4.

HandleFinally:

@@HandleFinally:
         mov     eax, [esp+4]
         mov     edx, [esp+8]
         test    dword ptr [eax+4], 6
         jz      short loc_0_403294
         mov     ecx, [edx+4]	 ; адрес перехода на HandleFinally
         mov     dword ptr [edx+4], offset loc_0_403294
         push    ebx
         push    esi
         push    edi
         push    ebp
         mov     ebp, [edx+8]
         add     ecx, 5          ; добавим к нему 5
         call    @System@_16583  ; System::_16583
         call    ecx		 ; и вызовем как функцию
         pop     ebp
         pop     edi
         pop     esi
         pop     ebx
loc_0_403294:
         mov     eax, 1
         retn

На момент вылета на этот код в fs:[0] и eax содержится указатель стека, в котором находятся ранее занесённые в него ( смотрите начало процедуры BuggyOne; также я привык изображать вершину стека сверху, а не как оно есть на самом деле ):

[eax + 4] прежнее значение стека в fs:[0]
[eax + 8] указатель на инструкцию перехода к HandleFinally
[eax + 0xC] ebp

Т.е. происходит следующее - инструкция следом за переходом на HandleFinally является процедурой обработки finally-части ( так как размер инструкции "jmp HandleFinally" равен ровно 5 байт )

2) Загрузка строки из ресурса. Строка BuggyOneCaption описана как resourcestring - это значит, что Delphi помесила её в строковую таблицу. Прототип функции LoadResString ( из Sys/System.pas ):

type
  PResStringRec = ^TResStringRec;
  TResStringRec = record
    Module: ^Longint;
    Identifier: Integer;
  end;

function LoadResString(ResStringRec: PResStringRec): string;

Module - handler загруженного модуля, содержащего в себе ресурс. Для нашей программы это hInstance самого приложения ( поскольку главная форма находится в том же модуле, что и объект TApplication ).

Identifier - целое число, меньшее 65536, или указатель на LPSZ строку - имя ресурса. По адресу 0x440368 содержится:

off_0_440368    dd offset dword_0_4424D8 ; hModule приложения
                dd 0FF5Dh		 ; Identifier

Число 0xFF5D = 65373 < 65536, так что наша строка идентифицируется по числовому значению. Посмотрим ресурсы моей программы в редакторе ресурсов Restorator ( кстати, весьма рекомендую эту программу для исследований приложений на Delphi - она умеет показывать описание Delphi-форм ! ). Наша строка нашлась в секции string tables под номером секции 4086, смещение -3. Как это соотносится с ранее найденным значением идентификатора ? Очень просто:

65373 = 4086 * 16 - 3;

Всё гениальное просто ( однако не всё простое гениально ).

xor     eax, eax
      push    ebp
      push    offset loc_0_44061D  ; новый finally handler
      push    dword ptr fs:[eax]
      mov     fs:[eax], esp
      mov     dl, 1
      mov     eax, ds:off_0_44016C ; ptr to TRPExceptionChild RTTI
      call    sub_0_440378         ; TRPExceptionChild::Create
      mov     ebx, eax
      mov     al, ds:byte_0_440660 ; db 1 eq RP_One из TRPEnum
      mov     [ebx+18h], al
      lea     eax, [ebx+0Ch]
      mov     edx, offset aSeven   ; "Seven"
      call    @@LStrAsg       ; ::`intcls'::LStrAsg
      mov     esi, 9
      lea     eax, [ebx+10h]
      mov     edx, offset aEight   ; "Eight"
      call    @@LStrAsg       ; ::`intcls'::LStrAsg
      lea     eax, [ebx+esi*4-10h]
      mov     edx, offset aNineInchNails	; "Nine inch nails"
      call    @@LStrAsg       ; ::`intcls'::LStrAsg
      mov     al, [ebx+18h]
      or      al, ds:byte_0_44069C ; db 2 eq RP_Two из TRPEnum
      mov     [ebx+18h], al
      mov     eax, ebx
      call    @@RaiseExcept   ; ::`intcls'::RaiseExcept
...
loc_0_44061D:
      jmp     @@HandleFinally

      jmp     short loc_0_440607
...
loc_0_440607:
      push    0
      mov     cx, ds:word_0_44065C
      mov     dl, 3
      mov     eax, offset aInFinallyPart
      call    @MessageDlg
      retn

Дальше совсем просто. Инициализируется новый обработчик finally части, при этом указатель на старое значение стека также помещается в стек. Далее вызывается конструктор TRPExceptionChild::Create - первым аргументом ему передаётся указатель на RTTI класса TRPExceptionChild, а вторым ( в регистре dl, я не знаю для чего ) 1 - указатель на созданный экземпляр класса возвращается в регистре eax, и затем пересылается в ebx, который используется в дальнейшем как базовый регистр. Члену Code присваивается значение RP_One ( eq 1 ) из набора TRPEnum. Можно заметить, что Code расположена в классе TRPException по смещению 0x18h. Затем идёт присваивание значений массиву строк - массив начинается по смещению 0xC. Довольно непонятно выглядит присваивание последнему ( 9ому элементу массива ): он должен быть расположен по смещению 0xC + (3 - 1) * 4 = 0x14; 9 * 4 - 0x10 даёт то же самое 0x14, но какова логика ! Затем к нашему набору Code добавляется RP_Two ( eq 2 ). Потом вызывается процедура RaiseExcept с единственным аргументом в eax - адресом нашего класса.

Пожалуй, в BuggyOne больше нет ничего интересного.

Button1Click

...
        push    offset loc_0_440728
        push    dword ptr fs:[edx]
        mov     fs:[edx], esp
        mov     eax, ebx
        call    BuggyOne	; процедура, генерирующая исключение
        xor     eax, eax
        pop     edx
        pop     ecx
        pop     ecx
        mov     fs:[eax], edx
        jmp     short loc_0_440790

loc_0_440728:
        jmp     @@HandleOnException ; ::`intcls'::HandleOnExceptions

        dd 2	; размер фильтров исключений
        dd offset off_0_4400F4  ; адрес RTTI TRPException
        dd offset loc_0_440741  ; адрес код для TRPException
        dd offset off_0_44016C  ; TRPExceptionChild
        dd offset loc_0_44076B  ; On TRPExceptionChild

loc_0_440741:
        mov     ebx, eax
        push    0
        mov     cx, ds:word_0_4407C8
        mov     dl, 3
        mov     eax, offset aButton1clickIn
		; строка "Button1Click in exception block"
        call    @MessageDlg
        mov     eax, ebx
        mov     edx, [eax]	; вызов TRPExceptionChild::Old_one_virtual
        call    dword ptr [edx]
        mov     eax, ebx
        mov     bx, 0FFFFh	; вызов TRPExceptionChild::Old_one_dynamic
				; имеет индекс 0xFFFF
        call    @@CallDynaInst  ; ::`intcls'::CallDynaInst
        jmp     short loc_0_44078B

Здесь можно увидеть в действии механизм фильтрации и обработки исключений. Опять в fs:[0] помещается указатель на стек, но на сей раз в него помещён адрес инструкции перехода к процедуре обработке исключений HandleOnExceptions. Следом за ней расположен массив фильтров исключений. Он имеет весьма незатейливую структуру:

Смещение	Тип	Описание
0	DWORD	Размер N массива фильтров исключений
4	DWORD	Указатель на RTTI класса - объекта исключение
8	DWORD	Указатель на код, вызываемый при исключении этого класса
4 + M * 4	DWORD	Указатель на M-ную RTTI класса - объекта исключение
8 + M * 4	DWORD	Указатель на код, вызываемый при исключении M-ного класса

Далее мы можем наблюдать вызовы virtual & dynamic функций - соответственно, TRPExceptionChild::Old_one_virtual & TRPExceptionChild::Old_one_dynamic.

1) Вызов TRPExceptionChild::Old_one_virtual Простой и понятный вызов функции по указателю. Первым членом любого класса идёт указатель на VTBL - по смещению 0x0; метод Old_one_virtual является единственным в VTBL класса TRPExceptionChild - соответственно, он расположен под индексом 0. Под тем же самым индексом в VTBL класса TRPException расположен виртуальный метод TRPException::Old_one_virtual

2) Вызов TRPExceptionChild::Old_one_dynamic В hash dynamic методов класса TRPException метод TRPException::Old_one_dynamic прописан под индексом 0xFFFF. Сложно сказать, что будет, если, имея dynamic метод с индексом 0xFFFF, Вы попробуете обработать событие Windows с номеров 0xFFFF ( можете попробовать сделать это самостоятельно ). Остаётся надеятся, что Delphi всё-таки отслеживают занятые индексы для динамических методов. Как видите, для вызова динамических методов используется вызов функции CallDynaInst с передаваемым в регистре bx индексом метода.

Приложение A

Поскольку я человек ленивый ( лень - двигатель прогресса ) и мне совершенно не хотелось вручную сообщать IDA Pro, что это не просто нечто бесформенное, а самая что ни наесть структура RTTI ( при этом ещё мучительно вспоминая, чего там идёт под каким смещением ), я написал небольшой script на IDC, который позволяет мне иметь немного свободного времени для прямых обязанностей сисадмина, а именно - для чтения newsов и взлома программ...

//
// This script deal with Delphi RTTI structures
//
// 	Red Plait, 23-VIII-1999
//

#include 

// makes dword and offset to data
static MakeOffset(adr)
{
  auto ref_adr;

  MakeUnkn(adr,0);
  MakeUnkn(adr+1,0);
  MakeUnkn(adr+2,0);
  MakeUnkn(adr+3,0);
  MakeDword(adr);
  ref_adr = Dword(adr);
  if ( ref_adr != 0 )
   add_dref(adr, ref_adr, 0);
}

// makes dword and offset to a function
static MakeFOffset(adr,string)
{
  auto ref_adr, func_name;
  MakeUnkn(adr,0);
  MakeUnkn(adr+1,0);
  MakeUnkn(adr+2,0);
  MakeUnkn(adr+3,0);
  MakeDword(adr);
  ref_adr = Dword(adr);
  if ( ref_adr != 0 )
  {
    MakeFunction(ref_adr, BADADDR);
    MakeName(ref_adr,string);
    add_dref(adr,ref_adr,0);
  }
}

// makes simple string
static do_Str(adr,len)
{
 auto count;
 for ( count = 0; count < len; count++ )
  MakeUnkn(adr + count,0);
 MakeStr(adr, adr+len);
}

// makes Pascal-style string
static makePStr(adr)
{
 auto len;
 MakeUnkn(adr,0);
 MakeByte(adr);
 len = Byte(adr);
 do_Str(adr+1,len);
 return len + 1;
}

// extract pascal-style string
static getPStr(adr)
{
 auto len, res, c;

 len = Byte(adr++);
 res = "";
 for ( ; len; len-- )
 {
   c = Byte(adr++);
   res = res + c;
 }
 return res;
}

// returns name of class of this RTTI
static getRTTIName(adr)
{
  auto ptr;
  ptr = Dword(adr+0x20);
  if ( ptr != 0 )
   return getPStr(ptr);
  else
   return "";
}

// processing owned components list
static processOwned(adr)
{
 auto count, str_len, comp_count, rtti_base;

 MakeUnkn(adr,0);
 MakeUnkn(adr+1,0);
 MakeWord(adr);
 comp_count = Word(adr); /* count of RTTI array */
 adr = adr + 2;
 MakeOffset(adr);
 rtti_base = Dword(adr); /* offset to array of RTTI */
 adr = adr + 4;
 /* process RTTI array */
 MakeUnkn(rtti_base,0);
 MakeUnkn(rtti_base+1,0);
 MakeWord(rtti_base);    /* size of array */
 count = Word(rtti_base);
 rtti_base = rtti_base + 2;
 for ( str_len = 0; str_len < count; str_len++ )
 {
   MakeOffset(rtti_base + str_len * 4);
 }
 /* process each of owned to form components */
 for ( count = 0; count < comp_count; count++ )
 {
  // offset in owners class
   MakeUnkn(adr,0);
   MakeUnkn(adr+1,0);
   MakeWord(adr);
   str_len = Word(adr);
   MakeComm(adr, "Offset 0x" + ltoa(str_len,0x10) );
   adr = adr + 2;
  // unknow word
   MakeUnkn(adr,0);
   MakeUnkn(adr+1,0);
   MakeWord(adr);
   adr = adr + 2;
  // index in RTTI array
   MakeUnkn(adr,0);
   MakeUnkn(adr+1,0);
   MakeWord(adr);
   str_len = Word(adr);
   MakeComm(adr, "Type: " + getRTTIName(Dword(rtti_base + str_len*4)) );
   adr = adr + 2;
  // pascal string - name of component
   MakeUnkn(adr,0);
   str_len = Byte(adr);
   adr = adr + 1;
   do_Str(adr,str_len);
   adr = adr + str_len;
 }
}

// process events handlers list
static processHandlers(adr)
{
 auto count, str_len, f_addr;

 MakeUnkn(adr,0);
 MakeUnkn(adr+1,0);
 MakeWord(adr);
 MakeComm(adr,"Handlers count");
 count = Word(adr);
 adr = adr + 2;
 for ( ; count; count-- )
 {
 // unknown dword
  MakeUnkn(adr,0);
  MakeUnkn(adr+1,0);
  MakeWord(adr);
  adr = adr + 2;
 // offset to function - handler
  f_addr = Dword(adr);
  MakeOffset(adr);
  adr = adr + 4;
 // Name of handler
  if ( f_addr != 0 )
  {
    MakeCode(f_addr);
    MakeFunction(f_addr, BADADDR);
    MakeName(f_addr, getPStr(adr));
  }
  adr = adr + makePStr(adr);
 }
}

// process inherited list first element ( may be recursive ? )
// returns pointer to next parent`s struct
static processParent(adr)
{
  auto str_len;
  auto res;

  res = 0;
 // 1st byte - unknown
  MakeUnkn(adr,0);
  MakeByte(adr);
  adr = adr + 1;
 // next - Pascal string - name of class
  adr = adr + makePStr(adr);
 // VTBL pointer
  MakeOffset(adr);
  adr = adr + 4;
 // next - pointer to pointer to next this struct :-)
  MakeOffset(adr);
  str_len = Dword(adr);
  if ( str_len != 0 )
  {
   MakeOffset(str_len);
   res = Dword(str_len);
  }
  adr = adr + 4;
 // WORD - unknown
  MakeUnkn(adr,0);
  MakeUnkn(adr+1,0);
  MakeWord(adr);
  adr = adr + 2;
 // next - name of Unit name
  makePStr(adr);
  return res;
}

// process dynamic methods table
static processDynamic(adr)
{
  auto count, base, i, old_comm;

  MakeUnkn(adr,0);
  MakeUnkn(adr+1,0);
  MakeWord(adr);
  count = Word(adr);
  MakeComm(adr,"Count of dynamic methods " + ltoa(count,10) );
  adr = adr + 2;
  base = adr + 2 * count;
  for ( i = 0; i < count; i++ )
  {
    MakeUnkn(adr,0);
    MakeUnkn(adr+1,0);
    MakeWord(adr);
    MakeOffset(base + 4 * i);
    old_comm = Comment(base + 4 * i);
    if ( old_comm != "" )
     MakeComm(base + 4 * i, "Dynamic 0x" + ltoa(Word(adr),0x10) + ", " + old_comm );
    else
     MakeComm(base + 4 * i, "Dynamic 0x" + ltoa(Word(adr),0x10) );
    adr = adr + 2;
  }
  return count;
}

// makes tricky VTBL entries
static makeF2Offset(adr,name)
{
 auto comm,ref_adr;

 MakeOffset(adr);
 ref_adr = Dword(adr);
 if ( ref_adr != 0 )
    add_dref(adr,ref_adr,0);
 comm = Comment(adr);
 if ( comm != "" )
  MakeComm(adr, comm + ", " + name);
 else
  MakeComm(adr, name);
}

// main function - process RTTI structure
static processRTTI(adr)
{
 auto count;
 auto res;
 auto my_name;

 my_name = "";
 // first DWORD - VTBL pointer
 MakeOffset(adr);
 // three next DWORD is unknown
 MakeOffset(adr+4);
 MakeOffset(adr+8);
 MakeOffset(adr+0xc);
 // list of parents
 MakeOffset(adr+0x10);
 count = Dword(adr+0x10);
 if ( count != 0 )       // also process first parent for this class
  processParent(count);
 // 0x14 DWORD - owned components
 MakeOffset(adr+0x14);
 count = Dword(adr+0x14);
 if ( count != 0 )
  processOwned(count);
 // 0x18 DWORD - event handlers list
 MakeOffset(adr+0x18);
 count = Dword(adr+0x18);
 if ( count != 0 )
  processHandlers(count);
 // 0x1c DWORD - pointer to dynamic functions list
 MakeOffset(adr+0x1c);
 count = Dword(adr+0x1c);
 if ( count != 0 )
 {
  count = processDynamic(count);
  MakeComm(adr+0x1c, ltoa(count,10) + " dynamic method(s)");
 }
 // 0x20 DWORD - pointer to class name
 MakeOffset(adr+0x20);
 count = Dword(adr+0x20);
 if ( count != 0 )
 {
   makePStr(count);
   my_name = getPStr(count);
   MakeComm(adr+0x20, "Name: " + my_name );
 }
 // 0x24 DWORD - size of class
 MakeUnkn(adr+0x24,0);
 MakeUnkn(adr+0x25,0);
 MakeUnkn(adr+0x26,0);
 MakeUnkn(adr+0x27,0);
 MakeDword(adr+0x24);
 MakeComm(adr+0x24,"Size of class");
 // 0x28 - pointer to parent`s RTTI struct
 MakeOffset(adr+0x28);
 res = Dword(adr+0x28);
 MakeComm(adr+0x28,"Parent`s class");
 // 0x2c SafeCallException
 makeF2Offset(adr+0x2c,my_name + "::SafeCallException");
 // 0x30 AfterConstruction
 makeF2Offset(adr+0x30,my_name + "::AfterConstruction");
 // 0x34 BeforeConstruction
 makeF2Offset(adr+0x34,my_name + "::BeforeConstruction");
 // 0x38 Dispatch
 makeF2Offset(adr+0x38,my_name + "::Dispatch");
 // 0x3C DefaultHandler
 makeF2Offset(adr+0x3c,my_name + "::DefaultHandler");
 // 0x40 NewInstance
 makeF2Offset(adr+0x40,my_name + "::NewInstance");
 // 0x44 FreeInstance
 makeF2Offset(adr+0x44,my_name + "::FreeInstance");
 // 0x48 Destroy
 makeF2Offset(adr+0x48,my_name + "::Destroy");
 return res;
}

Пояснения по каждой функции:

MakeOffset: - создаёт смещение по указанному адресу adr. Иногда IDA бывает упряма, и настаивает, что по этому адресу вовсе не смещение, а, скажем, data - четырёх вызовов MakeUnkn обычно бывает достаточно, чтобы изменить её мнение
MakeFOffset: - аналогично MakeOffset, но только создаёт смещение на функцию, которую называет string. Warning: не проверяется результат MakeFunction, поэтому функция может быть не совсем правильной. В любом случае, это нужно проверять обычно.
do_Str: - помечает len байт с адреса adr как строку
makePStr: - создаёт pascal-строку по адресу adr. Возвращает её длину, включая сам байт длины.
getPStr: - возвращает значение pascal-строки по адресу adr.
getRTTIName: - возвращает имя класса по его RTTI, расположенной по адресу adr
processOwned: - обрабатывает список компонентов, принадлежащих данному компоненту. Сам список начинается с адреса adr
processHandlers: - обрабатывает список функций-обработчиков событий. Сам список начинается с адреса adr. Warning: так как имеет место попытка назвать функцию так же, как она называлась в этом классе, имя может быть неуникально ( вспомните, сколько раз у Вас были функции с именем Button1Click в разных классах )
processParent: - обрабатывает один элемент в списке наследований по адресу adr. Это рекурсивная структура, но её окончание может быть обозначено по-разному - либо как Nil, либо как две структуры TObject, ссылающиеся друг на друга. На всякий случай возвращается ссылка на следующий элемент.
processDynamic: - обрабатывает hash динамических методов по адресу adr. Warning: несмотря на то, что этот метод пытается сохранить ранее данные комментарии для указателя на каждую dynamic функцию, похоже, что в IDA Pro есть bug, из-за которого нельзя извлечь комментарии для опознанных с помощью сигнатур функций ( который по умолчанию имеют тёмно-коричневый цвет, скажем, TFormCustom::WMPaint ). Вызов Comment на таких комментариях возвращает пустую строку. Возвращается число динамических функций.
makeF2Offset: - вспомогательная функция, служит по пометки служебных функций ( с отрицательным индексом в VTBL ) и добавления к ним комментария. Адрес функции передаётся в adr, строка комментария в name
processRTTI: - собственно, самая главная функция, собирающая все остальные - обрабатывает структуру RTTI по адресу adr

Я даже в кои-то веки раз комментарии кое-где сделал, так что я надеюсь, Вам не составит труда разобраться в моих каракулях.

This is a script written in IDC (IDA Pro's scripting language) to process and analyze Delphi RTTI (Run-Time Type Information) structures. The script is designed to extract various information from the RTTI structure, such as class names, method signatures

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.

:: Главная :: Ошибки и Исключения ::

Время компиляции файла: 2024-12-22 20:14:06
2025-01-28 05:04:32/0.007220983505249/0