Дорогие друзья, эта статья написана не для того, чтобы дать Вам очередной способ взлома программных продуктов, а чтобы научить Вас самостоятельно создавать и эффективно использовать серьезные защитные алгоритмы в своих собственных разработках.

Введение

На этот раз я представляю Вам сугубо теоретическое исследование, и все рассматриваемые программы написал сам. Кроме них нам понадобятся Delphi и исходный код VCL (я использовал Delphi 4.0 Client/Server Edition), а также дизассемблер IDA Pro (я пользуюсь v3.8b). Полагаю Вы понимаете Ассемблер и имеете опыт в написании программ на Delphi с применением VCL.

Delphi генерирует огромное количество мёртвого и практически одинакового кода для любого приложения, использующего VCL. Тем не менее множество приложений относительно успешно создаются на Delphi, как же бедным исследователям отделять зёрна от плевел?

Вопрос этот совершенно не нов, первым (из известных мне) трудом подобного рода был материал LaZaRuS'а "Нахождение стандартных функций в программах на Delphi/C++ Builder" (http://www.phase-one.com.au/fravia/laza_s11.htm) на Fravia летом этого года. Для тех, кто не знаком с английским, краткий конспект шедевра LaZaRuSа: он сделал тоже, что и я (трудно в наше время быть оригинальным...) - написал тестовое приложение (правда, он использовал Borland C++ Builder), а потом дизассемблировав его W32Dasm'ом, попытался выяснить, как выглядят типичные действия по заполнению окна регистрации на Ассемблере.

Получилось у него примерно следующее:

• функция, закрывающая модальный диалог, должна поместить значение, возвращаемое методов ShowModal, помещает это значение по смещению 0144h. Сами значения можно посмотреть в файле Source/Rtl/Win/windows.pas:

    ID_OK=1
    ID_CANCEL=2
    ID_ABORT=3
    ID_RETRY=4
    ID_IGNORE=5
    ID_YES=6
    ID_NO=7
    ID_CLOSE=8
    ID_HELP=9

• для разрешения/запрещения кнопок используется смещение 40h в классе TButton;
• для быстрого поиска функции MessageBox() (скажем, в SoftICE) нужно найти вызов GetActiveWindow(), затем собственно MessageBox() вслед за ним SetActiveWindow() (!);
• функция, записывающая или считывающая текст из элементов управления TEdit, делает это через указатель по смещению 01CCh.

Обнаружение нужных классов

Я набросал в несистематическом порядке несколько элементов управления (TEdit, TButton и TBitBtn - именно они чаще всего применяются в диалогах регистрации), и написал примерно такой непритязательный код:

Чтобы мне было легко идентифицировать мой же собственный код, я поместил в каждой функции вызов MessageDlg(). Также здесь не все обработчики назначаются во время проектирования - функция MyClickHandler() назначается обработчиком динамически при показе формы (в методе FormShow()). Компилируем, запускаем - безделица, конечно, но работает... Размер EXE-файла 329728 байт! И это буквально за пять минут! Да я - серьезный программист!

Далее неплохо было бы дизассемблировать полученный файл.

Общее замечание: строки в Delphi в бинарном виде выглядят не как во всех прочих языках - т.е. не оканчиваются нулевым символом, отчего IDA Pro не опознаёт их как строки. Вначале идёт один байт - длина, а далее - сама строка, причём её конец никак более не обозначен. Это верно для так называемых коротких строк, длина которых меньше 256 байт. К несчастью, именно такими строками пользуется механизм поддержки классов.

Надо заметить, что, несмотря на все свои достоинства, IDA Pro не справляется со всеми тонкостями программ, написанных на Delphi - утверждает, что на месте VTBL находится код, не распознаёт строк в стиле Pascal'я и прочие мелочи - так что нас выручит только её интерактивность. И, кстати, не забудьте применить файл сигнатур для VCL 4 - для моего файла IDA Pro опознала аж 2297 библиотечных функций!

Для начала посмотрим, как выглядит стартовая процедура Start() (004444A8h):

 push    ebp
 mov     ebp, esp
 add     esp, 0FFFFFFF4h
 mov     eax, offset dword_0_444398
 call    @@InitExe       ; ::`intcls'::InitExe
 mov     eax, ds:off_0_445CDC
 mov     eax, [eax]
 call    @TApplication@Initialize ; TApplication::Initialize
 mov     ecx, ds:off_0_445DAC
 mov     eax, ds:off_0_445CDC
 mov     eax, [eax]
 mov     edx, ds:off_0_443F30
 call    @TApplication@CreateForm ; TApplication::CreateForm
 mov     eax, ds:off_0_445CDC
 mov     eax, [eax]
 call    @TApplication@Run ; TApplication::Run
 call    @@Halt0         ; ::`intcls'::Halt0

По смещению DWORD от начала структуры RTTI расположен указатель на VTBL. Далее идут 12 нулей (возможно выравнивание по границе, а возможно эти три DWORDа тоже что-нибудь означают). А по смещению 10h в расположен указатель (DWORD) на некую рекурсивную структуру, которую я назвал список наследственности:

Путешествуя по этому списку, можно с лёгкостью выяснить генеалогическое дерево класса TForm1:

• TForm, файл Forms
• TCustomForm, файл Forms
• TScrollingWinControl, файл Forms
• TWinControl, файл Controls
• TControl, файл Controls
• TComponent, файл Classes
• TPersistent, файл Classes
• TObject, файл System

Вернёмся к структуре RTTI класса TForm1. По смещению 14h находится указатель на компоненты, которыми владеет данный класс. Это все элементы списка Components во время разработки. Эта структура имеет довольно простой вид:

Сразу вслед за ней идут CompCount структур, описывающих эти компоненты:

Самым важным здесь являются смещение на компонент во включающем классе и его тип. Запомним их для компонентов в форме TForm1:

Снова вернёмся к структуре RTTI класса TForm1. По смещению 18h находится указатель на одну из самых полезных структур - на массив обработчиков событий (но только тех, которые заданы во время проектирования!). Первым элементом этого массива идёт WORD, определяющий длину этого массива, а его элементы имеют такие поля:

Тип определяет количество и размерность аргументов. Для обработчиков OnClick он равен 13h, для OnShow 0Fh.

Не прошло и получаса, а я уже нашёл свой код. Мы рассмотрим его чуть позже (пока Вы можете назвать найденные функции как в оригинале), а сейчас продолжим рассмотрение структуры RTTI класса. По смещению 24h записывается размер класса (DWORD) - для TForm1 он составляет 02E4h байт. Сравните его с таблицей смещений компонентов. По смещению 28h находится указатель на структуру RTTI класса-предка. У объекта TObject он равен нулю. По смещению 20h находится указатель на Pascal-строку - имя класса. Я повторю всю вышеизложенную информацию в следующей таблице:

По смещению 2Ch идёт таблица методов. Порядок следования методов в ней мне не до конца ясен, однако я уверен, что в ней должны содержаться конструктор и деструктор данного класса.

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

BitBtn1Click

BitBtn1Click    proc near
                push    ebx
                mov     ebx, eax
                push    0
loc_0_444149:
                mov     cx, ds:word_0_444168
                mov     dl, 3
                mov     eax, offset aBitbtn1click
                call    @MessageDlg
loc_0_44415C:
                mov     dword ptr [ebx+22Ch], 1
                pop     ebx
                retn
BitBtn1Click    endp

OnFormShow

OnFormShow      proc near
                push    ebx
                mov     ebx, eax
                push    0
                mov     cx, ds:word_0_4441F4
                mov     dl, 3
                mov     eax, offset aFormshow
                call    @MessageDlg
                mov     eax, [ebx+2DCh]
                mov     [eax+108h], ebx
                mov     dword ptr [eax+104h], offset MyClickHandler
                pop     ebx
                retn
OnFormShow      endp

Button1Click

Button1Click    proc near
var_10          = dword ptr -10h
var_C           = dword ptr -0Ch
var_8           = dword ptr -8
var_4           = dword ptr -4
                push    ebp
                mov     ebp, esp	; фрейм стека для локальных переменных
                xor     ecx, ecx
                push    ecx
                push    ecx
                push    ecx
                push    ecx   ; 4 нуля в стек
                push    ebx
                mov     ebx, eax	; в eax - указатель на экземпляр класса
                xor     eax, eax
                push    ebp
                push    offset loc_0_4442B0
		push 	dword ptr fs:[eax]
                mov     fs:[eax], esp
...
loc_0_4442B0:
		jmp     @@HandleFinally

     lea     edx, [ebp+var_C]
     mov     eax, [ebx+2C8h]	; смещение 02C8h не напоминает Вам о Edit2?
     call    @TControl@GetText ; TControl::GetText
     mov     eax, [ebp+var_C]
     lea     edx, [ebp+var_8]
     call    @Trim
     mov     eax, [ebp+var_8]
     push    eax
     lea     edx, [ebp+var_C]
     mov     eax, [ebx+2C4h]	; а 02C4h - о Edit1?
     call    @TControl@GetText ; TControl::GetText
     mov     eax, [ebp+var_C]
     lea     edx, [ebp+var_10]
     call    @Trim
     mov     edx, [ebp+var_10]
     lea     eax, [ebp+var_4]
     pop     ecx
     call    @@LStrCat3      ; ::'intcls'::LStrCat3
     push    1
     mov     eax, [ebp+var_4]
     call    @@LStrToPChar   ; ::'intcls'::LStrToPChar
     mov     edx, eax
     mov     ecx, offset aButton1click
     mov     eax, ds:off_0_445CDC
     mov     eax, [eax]
     call    @TApplication@MessageBox ; TApplication::MessageBox

                xor     eax, eax
                pop     edx
                pop     ecx
                pop     ecx
                mov     fs:[eax], edx
                push    offset loc_0_4442B7

loc_0_444292:                           ; CODE XREF: CODE:004442B5 j
                lea     eax, [ebp+var_10]
                call    @@LStrClr       ; ::`intcls'::LStrClr
                lea     eax, [ebp+var_C]
                call    @@LStrClr       ; ::`intcls'::LStrClr
                lea     eax, [ebp+var_8]
                mov     edx, 2
                call    @@LStrArrayClr  ; ::`intcls'::LStrArrayClr
                retn
...
offset loc_0_4442B7:
                pop     ebx
                mov     esp, ebp
                pop     ebp
                retn

• FS:[0]
• указатель на finally-функцию
• EBP - прежнее значение стека
• EBX
• ECX = 0
• ECX = 0
• ECX = 0
• ECX = 0
• оригинальное значение EBP
• адрес возврата из функции

Итак, сначала извлекается предыдущее значение FS:[0], указатель на finally-функцию и прежнее значение стека, и восстанавливается значение FS:[0]. Дальше в стек помещается адрес процедуры очистки стека. После инструкции retn стек будет выглядеть так:

• EBX
• ECX = 0
• ECX = 0
• ECX = 0
• ECX = 0
• оригинальное значение EBP
• адрес возврата из функции

• оригинальное значение EBP
• адрес возврата функции

Button2Click

Button2Click    proc near
                push    ebx
                push    esi
                mov     ebx, eax ; в eax - указатель на экземпляр класса
                push    0
                mov     cx, ds:word_0_44431C
                mov     dl, 3
                mov     eax, offset aButton2click_0
                call    @MessageDlg
                mov     esi, [ebx+2C4h] ; смещение на Edit1
                mov     eax, esi
                mov     edx, [eax]
                call    dword ptr [edx+50h] ; вызов TEdit::GetEnabled
                mov     edx, eax	; результат в eax
                xor     dl, 1		; xor boolean с 1 - его же not
                mov     eax, esi
                mov     ecx, [eax]
                call    dword ptr [ecx+60h] ; вызов TEdit::SetEnabled
                mov     esi, [ebx+2D4h] ; смещение на Button3
                mov     eax, esi
                mov     edx, [eax]
                call    dword ptr [edx+50h]
                mov     edx, eax
                xor     dl, 1
                mov     eax, esi
                mov     ecx, [eax]
                call    dword ptr [ecx+60h]
                pop     esi
                pop     ebx
                retn
Button2Click    endp

Доступ к этому свойству осуществляется через методы GetEnabled & SetEnabled, что мы и видим здесь - через индекс в VTBL.

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

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

Не вершина программистского мастерства, конечно, но для наших целей вполне годится. Итак, запустим дизассемблер ( я использовал 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 методов. Структура эта имеет примерно такой вид:

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

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

Давайте рассмотрим самую примечательную функцию в моей программе - 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

Далее мы можем наблюдать вызовы 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 всё-таки отслеживают занятые индексы для динамических методов.

Приложение 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

Часть 3. Интерфейсы и published свойства

Итак, мы уже знаем, как найти VTBL. Но в каком порядке хранятся в ней методы ? Ответ можно получить, посмотрев на ассемблерный листинг и сравнив его с исходным кодом VCL. И выяснится, что новые методы дописыватся в конец VTBL, по мере произведения новых классов. Я проследил генеалогию классов до TWinControl и вот что у меня получилось (цифра означает смещение в VTBL):

• TObject
  Виртуальные методы этого класса расположены в VTBL по отрицательным индексам. Смотрите моё описание RTTI в предыдущей статье
• TPersistent
  • 0x00 AssignTo
  • 0x01 DefineProperties
  • 0x02 Assign
• TComponent
  В нём, помимо всего прочего, реализуется также интерфейсы IUnknown & IDispatch, поэтому объекты-производные от него могут быть серверами OLE-Automation
  
  • 0x03 Loaded
  • 0x04 Notification
  • 0x05 ReadState
  • 0x06 SetName
  • 0x07 UpdateRegistry
  • 0x08 ValidateRename
  • 0x09 WriteState
  • 0x0A QueryInterface
  • 0x0B Create(AOwner: TComponent)
• TControl
  Его производные классы могут быть помещены на форму во время проектрирования и умеют отображать себя ( так называемые "видимые" компоненты )
  
  • 0x0C UpdateLastResize
  • 0x0D CanResize
  • 0x0E CanAutoResize
  • 0x0F ConstrainedResize
  • 0x10 GetClientOrigin
  • 0x11 GetClientRect
  • 0x12 GetDeviceContext
  • 0x13 GetDragImages
  • 0x14 GetEnabled
  • 0x15 GetFloating
  • 0x16 GetFloatingDockSiteClass
  • 0x17 SetDragMode
  • 0x18 SetEnabled - полезный метод, особенно для всяких кнопок в диалогах регистрации серийных номеров...
  • 0x19 SetParent
  • 0x1A SetParentBiDiMode
  • 0x1B SetBiDiMode
  • 0x1C WndProc - адрес оконной процедуры. Если она не находит обработчика у себя, вызывается метод TObject::Dispatch. И уже последний метод вызывает dynamic функцию по индексу, равному номеру сообщения Windows.
  • 0x1D InitiateAction
  • 0x1E Invalidate
  • 0x1F Repaint - адрес функции отрисовки компонента
  • 0x20 SetBounds
  • 0x21 Update
• TWinControl
  Его производные классы имеют собственное окно
  • 0x22 AdjustClientRect
  • 0x23 AlignControls
  • 0x24 CreateHandle
  • 0x25 CreateParams
  • 0x26 CreateWindowHandle
  • 0x27 CreateWnd
  • 0x28 DestroyWindowHandle
  • 0x29 DestroyWnd
  • 0x2A GetControlExtents
  • 0x2B PaintWindow
  • 0x2C ShowControl
  • 0x2D SetFocus

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

Unit1.pas - главная форма приложения.

Unit2.pas - объект - сервер OLE-Automation

Projcet1_TLB.pas - файл, автоматически сгенерированный Delphi для классов, являющихся серверами OLE-Automation

Меня всегда интересовало, как же это так Delphi позволят иметь код, запускаемый при инициализации и деинициализации модуля ? Просмотрев исходный код в файле Rtl/Sys/System.pas ( я рекомендую иметь исходные тексты, поставляемые вместе с Delphi при исследовании написанных на ней программ ) и сравнив его с ассемблерным листингом, выясняется, что это легко и непринуждённо. Итак, существуют несколько довольно простых структур:

При startupе указатель на PackageInfoTable передаётся единственным аргументом функции InitExe:

start        proc near
             push    ebp
             mov     ebp, esp
             add     esp, 0FFFFFFF4h
             mov     eax, offset dword_0_445424
             call    @@InitExe       ; ::`intcls'::InitExe

Delphi помещает список реализуемых классом интерфейсов в отдельную структуру, указатель на которую помещает в RTTI по смещению 0x4. Сама эта структура описана во всё том же Rtl/Sys/System.pas:

Указатель на 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	; вызов функции в классе

Самый же значимый резльтат всех этий ковыряний в коде - мне удалось обнаружить в RTTI полное описание всех published свойств ! Из системы помощи Delphi: ( файл del4op.hlp, перевод мой ):

Published члены имеют такую же видимость, как public члены. Разница заключается
в том, что для published членов генерируется информация о типе времени исполнения
(RTTI). RTTI позволяет приложению динамически обращаться к полям и свойствам
объектов и отыскивать их методы. Delphi использует RTTI для доступа к значениям
свойств при сохранении и загрузке файлов форм (.DFM), для показа свойств в
Object Inspector и для присваивания некоторых методов (называемых обработчиками
событий) определённым свойствам (называемых событиями)

Published свойства ограничены по типу данных. Они могут иметь типы Ordinal, 
string, класса, интерфейса и указателя на метод класса. Также могут быть
использованы наборы (set), если верхний и нижний пределы их базового типа
имеют порядковые значения между 0 и 31 (другими словами, набор должен помещаться
в байте, слове или двойном слове ). Также можно иметь published свойство любого
вещественного типа (за исключением Real48). Свойство-массив не может быть 
published. Все методы могут быть published, но класс не может иметь два или
более перегруженных метода с одинаковыми именами. Члены класса могут быть
published, только если они являются классом или интерфейсом.

Класс не может содержать published свойств, если он не скомпилирован с ключом {$M+}
или является производным от класса, скомпилированного с этим ключом. Подавляющее
большинство классов с published свойствами являются производными от класса
TPersistent, который уже скомпилирован с ключом {$M+}, так что Вам редко
потребуется использовать эту директиву.

Одна из главных структур, применяющихся для идентификации published свойств - TPropInfo

После структуры наследования ( по смещению 10h в RTTI ) расположен WORD - количество расположенных следом за ним структур TPropInfo, по одной на каждое published свойство. В этой структуре поля имеют следующие значения:

• PropType - указатель на структуру, описывающую тип данного свойства. Структуры, содержащиеся в TypeInfo, довольно сложные, так что я не буду объяснять, как именно они работают, Вам достаточно знать, что мой IDC script потрошит её в 99 % случаев. Они описаны в файле vcl/typeinfo.pas.
• GetProc,SetProc,StoredProc - поля, указывающие на методы Get ( извлечение свойства ), Set ( изменение свойства ) и Stored ( признак сохранения значения свойства ). Для всех них есть недокументрированные правила:
  • Если старший байт этих полей равен 0xFF, то в остальных байтах находится смещение в экземпляре класса, по которому находятся данные, представляющие данное свойство. В таком случае все манипуляции со свойством производятся напрямую.
  • Если старший байт равен 0xFE, то в остальных байтах содержится смещение в VTBL класса, т.е. все манипуляции со свойством производятся через виртуальную функцию.
  • Если значение поля равно 0x80000000 - метод не определён ( скажем, метод Set для read-only published свойств )
  • Значение 1 для поля StoredProc означает обязательное сохранение значения свойства.
  • Все остальные значения полей рассматриваются как ссылка на метод класса.
• Index - значение не выяснено. Есть подозрение, что это поле связано со свойствами типа массив и подчиняется тем же правилам, что и предыдущие три поля. Во время тестирования мне не встретилось ни одного поля Index со значением, отличным от 0x80000000
• Default - значение свойства по умолчанию
• NameIndex - порядковый номер published свойства в данном классе, отсчёт ведётся почему-то с 2.
• Name - Имя свойства, pascal-style строка

Я изменил свой IDC script для анализа RTTI классов Delphi 4, чтобы он поддерживал все обнаруженные структуры. Cам script приведен в конце данной статьи.

IDC script для анализа RTTI Delphi 4

Текущая версия 0.2.
Тестировалась на трёх отладочных приложениях и одном реальном ( размером порядка 3 Mb ). Во время тестирования не были проверены published-свойства в виде интерфейсов.

Описание функций

Перечислены в том же порядке, в котором они следуют в файле d4rtti.idc.

• setComment(adr,set_to,is_before)
  Вставляет строку set_to комментария по адресу adr. Поскольку функции этого scriptа могут прогоняться несколько раз над одним и тем же адресом, производится проверка, был ли уже вставлен данный комментарий. Параметр is_before определяет, как нужно поместить вновь вставляемый комментарий - до уже имеющегося или после.
• ReMakeByte(adr)
  Помечает данные по адресу adr как байт и возвращает его значение.
• ReMakeInt(adr)
  Помечает данные по адресу adr как двойное слово и возвращает его значение.
• ReMakeWord(adr)
  Помечает данные по адресу adr как слово и возвращает его значение.
• ReMakeQword(adr)
  Помечает данные по адресу adr как QWORD и возвращает его значение.
• MakeOffset(adr)
  Помечает данные по адресу adr как смещение и возвращает его значение.
• ReMakeFunc(adr)
  Пытается преобразовать данные по адресу adr в функцию. Не гарантирует правильного опознавания всего кода функции.
• MakeFOffset(adr)
  Помечает данные по адресу adr как смещение на функцию и пытается преобразовать данные по этому смещению в функцию. Замечания аналогично предыдущей функции.
• MakeNameFOffset(adr,name)
  Помечает данные по адресу adr как смещение на функцию и пытается преобразовать данные по этому смещению в функцию, которую переименует в name. Замечания аналогичны ReMakeFunc
• ReMakeStr(adr,len)
  Помечает данные по адресу adr длиной len как строку.
• makePStr(adr)
  Помечает данные по адресу adr как pascal-style строку. Возвращает длину этой строки.
• getPStr(adr)
  Возвращает pascal-style строку по адресу adr.
• getRTTIName(adr)
  Возвращает имя класса, чья RTTI содержится по адресу adr.
• getOwnedCount(adr)
  Возвращает количество структур RTTI для списка субкомпонентов, расположенного по адресу adr.
• processOwned(adr)
  Обрабатывает список субкомпонентов, расположенный по адресу adr. Возвращает адрес массива структур RTTI для этих субкомпонентов. Поскольку я не смог вызвать на IDC функцию, описанную позже, чем её вызов, рекурсивная обработка RTTI здесь не используется. Вместо этого эти структуры RTTI обрабатываются позже в _processRTTI.
• processHandlers(adr,class_name)
  Обрабатывает таблицу обработчиков событий по адресу adr для класса с именем class_name. Для всех функций-обработчиков в качестве префикса добавляется имя class_name ( для обеспечения уникальности этих имён ).
• get_type_name(adr)
  Возвращает имя типа для структуры TypeInfo по адресу adr.
• TypeOrdComm(Ord)
  Возвращает строковое название размера простого типа данных Ord.
• TypeOrdKind(Ord)
  Возвращает строковое название типа данных Ord.
• TypeOrdFloat(Ord)
  Возвращает строковое название размера для типов данных с плавающей точкой Ord.
• doParamFlag(Set)
  Возвращает в виде строки представление набора атрибутов Set параметра функций и процедур.
• doIntfFlag(Set)
  Возвращает в виде строки представление набора атрибутов Set интерфейса.
• TypeOrdMethod(Ord)
  Возвращает строковое название типа метода Ord.
• processTypeInfo(adr)
  Обрабатывает структуру TypeInfo по адресу adr.
  Предупреждения относительно этой функции:
  1. Не производится рекурсивная обработка поля BaseType для типа tkEnumeration. Причиной это служит зацикливание (если тип tkEnumeration не наследует ни от какого набора, это полу указывает на свою же структуру TypeData).
  2. Для типа tkClass не производится рекурсивной обработки структуры RTTI ClassType. Это сделано для предотвращения зацикливаний ( если, скажем, свойством некоторого класса будет указатель на тот же самый класс ), также см. примечание к функции processOwned.
  3. По вышеназванным причинам не производится обработка структуры ParentInfo (указатель на TypeInfo предка) и PropData (рекурсивная структура TypeInfo) для типа tkClass.
  4. Поскольку у меня не было published-свойств - интерфейсов, обработка типа tkInterface не производится.
• separatePointer(base_adr, adr, kind)
  Возвращает строковое описание метода в атрибутах published-свойств. Адрес RTTI класса передаётся в base_adr, адрес атрибута в adr, строка с описанием класса атрибута в kind.
• doPublished(adr, base_adr)
  Обрабатывает published-свойства класса по адресу adr, RTTI класса находится по адресу base_adr. См. также предупреждения относительно функции processTypeInfo.
• processDynamic(adr)
  Обрабатывает таблицу динамических методов по адресу adr. Динамические функции никак не называются.
• makeF2Offset(adr,name)
  Помечает данные по адресу adr как указатель на функцию и вставляет комментарий name.
• make_TGUID(adr)
  Помечает данные по адресу adr как GUID.
• padZeros(str,desired_len)
  Увеличивает длину строки str до длины desired_len, дополняя её слева символов "0".
• getTGUIDstr(adr)
  Возвращает строковое представление GUID по адресу adr.
• processIntf(adr)
  Обрабатывает таблицу интерфейсов по адресу adr.
• get_dyncount(adr)
  Возвращает число динамических методов для структуры RTTI по адресу adr.
• _processRTTI(adr, is_recursive)
  Обрабатывает RTTI структуру по адресу adr. Флаг is_recursive предназначен для рекурсивной обработки всех связанных структур RTTI.
• askRTTI(adr)
  Выдаёт приглашение на обработку структуры RTTI по адресу adr. В случае успеха возвращает 1.
• processRTTI(adr)
  Обрабатывает RTTI структуру по адресу adr.
• allRTTI(adr)
  Рекурсивно обрабатывает структуру RTTI по адресу adr.

В IDA Pro загрузить этот script ( нажатием F2 ). Далее, поместив курсор на адрес начала структуры RTTI, выполнить команду IDC:

 processRTTI(ScreenEA());

• Поддержка published-свойств интрефейсного типа.
• Поддержка сохранения информации о RTTI в текстовый файл (IMHO, значительно приятнее иметь подобного рода информацию для дальнейшего дизассемблирования в IDA Pro распечатанной на бумаге, нежели постоянно рыскать по структуре RTTI)
• Функции для поддержки exceptions & system initialization
• Здесь могут быть и Ваши предложения. Напишите автору по адресу redplait@usa.net

/*
 * This script deal with Delphi RTTI structures
 *
 * Created by Red Plait ( redplait@usa.net ), 23-VIII-1999
 * History:
 * 28-08-1999	RP	Added support for dynamic methods
 * 01-09-1999	RP	Added support for interfaces & eight methods in VTBL
 *			with negative indexes
 * 06-09-1999	RP	TypeInfo of published properties (rip some code from 
 *			Santucco)
 */
#include 

// consts for TypeInfo
#define tkUnknown       0
#define tkInteger       1
#define tkChar          2
#define tkEnumeration   3
#define tkFloat		4
#define tkString 	5
#define tkSet 		6
#define tkClass 	7
#define tkMethod	8
#define tkWChar		9
#define tkLString 	10
#define tkWString	11
#define tkVariant	12
#define tkArray		13
#define tkRecord	14
#define tkInterface	15
#define tkInt64		16
#define tkDynArray	17

// consts for OrdType
#define otSByte         0
#define otUByte         1
#define otSWord         2
#define otUWord         3
#define otSLong         4

// consts for FloatType
#define ftSingle        0
#define ftDouble        1
#define ftExtended      2
#define ftComp          3
#define ftCurr          4

// consts for MethodKind
#define mkProcedure	0
#define mkFunction	1
#define mkConstructor	2
#define mkDestructor	3
#define mkClassProcedure	4
#define mkClassFunction	5
#define mkSafeProcedure	6
#define mkSafeFunction	7

// consts for ParamFlag - set
#define pfVar		0
#define pfConst		1
#define pfArray		2
#define pfAddress	3
#define pfReference	4
#define pfOut		5

// consts for IntfFlag - set
#define ifHasGuid	0
#define ifDispInterface	1
#define ifDispatch	2

// do reenterable comments :-)
// Params:
//  adr		- address to comment
//  set_to	- comment to set
//  is_before	- place new comment before old
static setComment(adr,set_to,is_before)
{
 auto old_comm;

 if ( ! strlen(set_to) )
  return; // no comments
 old_comm = Comment(adr);
 if ( ! strlen(old_comm) )
 {
   MakeComm(adr, set_to);
   return;
 }
 if ( -1 != strstr(old_comm,set_to) )
  return;
 if ( is_before )
  MakeComm(adr,set_to + "," + old_comm);
 else
  MakeComm(adr,old_comm + "," + set_to);
}

// makes Byte
static ReMakeByte(adr)
{
  MakeUnkn(adr,0);
  MakeByte(adr);
  return Byte(adr);
}

// makes dword
static ReMakeInt(adr)
{
  MakeUnkn(adr,0);
  MakeUnkn(adr+1,0);
  MakeUnkn(adr+2,0);
  MakeUnkn(adr+3,0);
  MakeDword(adr);
  return Dword(adr);
}

// makes word
static ReMakeWord(adr)
{
  MakeUnkn(adr,0);
  MakeUnkn(adr+1,0);
  MakeWord(adr);
  return Word(adr);
}

// makes qword
static ReMakeQword(adr)
{
 auto count;
 for ( count = 0; count < 8; count++ )
  MakeUnkn(adr + count, 0);
 MakeQword(adr);
 return Qword(adr);
}

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

  ref_adr = ReMakeInt(adr);
  if ( ref_adr != 0 )
   add_dref(adr, ref_adr, 0);
  return ref_adr;
}

static ReMakeFunc(adr)
{
  if ( adr != 0 )
  {
    MakeUnkn(adr,1);
    MakeCode(adr);
    MakeFunction(adr, BADADDR);
  }
}

// makes dword and offset to a function
static MakeFOffset(adr)
{
  auto ref_adr;
  ref_adr = MakeOffset(adr);
  ReMakeFunc(ref_adr);
  return ref_adr;
}

// make offset to function and name it
static MakeNameFOffset(adr,name)
{
 auto ref_adr;

 ref_adr = MakeFOffset(adr);
 if ( ref_adr )
  MakeName(ref_adr,name);
}

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

// makes Pascal-style string
// Returns lenght of pascal string (including byte for lenght)
static makePStr(adr)
{
 auto len;
 MakeUnkn(adr,0);
 len = ReMakeByte(adr);
 ReMakeStr(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 "";
}

static getOwnedCount(adr)
{
  return Word(Dword(adr+2)); // wow!
}

// processing owned components list
// Returns ptr to RTTI array (cauze I don`t know how to make forward declaration
//  of _processRTTI
static processOwned(adr)
{
 auto count, str_len, comp_count, rtti_base;
 
 comp_count = ReMakeWord(adr);  /* count of RTTI array */
 adr = adr + 2;
 rtti_base = MakeOffset(adr);	/* offset to array of RTTI */
 adr = adr + 4;
 /* process RTTI array */
 count = ReMakeWord(rtti_base);	/* size of array */
 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
   str_len = ReMakeWord(adr);
   setComment(adr, "Offset 0x" + ltoa(str_len,0x10), 1);
   adr = adr + 2;
  // unknow word
   ReMakeWord(adr);
   adr = adr + 2;
  // index in RTTI array
   str_len = ReMakeWord(adr);
   setComment(adr, "Type: " + getRTTIName(Dword(rtti_base + str_len*4)), 1 );
   adr = adr + 2;
  // pascal string - name of component
   str_len = ReMakeByte(adr);
   adr = adr + 1;
   ReMakeStr(adr,str_len);
   adr = adr + str_len;
 }
  return rtti_base;
}

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

 count = ReMakeWord(adr);
 setComment(adr,"Handlers count", 1);
 adr = adr + 2;
 for ( ; count; count-- )
 {
 // unknown dword
  ReMakeWord(adr);
  adr = adr + 2;
 // offset to function - handler
  MakeNameFOffset(adr, class_name + "." + getPStr(adr+4) );
  adr = adr + 4;
 // Name of handler
  adr = adr + makePStr(adr);
 }
}

// returns name of type published property
static get_type_name(adr)
{
 auto deref;

 deref = Dword(adr);
 if ( deref )
  return getPStr(deref + 1);
 else
  return "";
}

#define encodeKind(c, name)	if ( Ord == c ) return name;

static TypeOrdComm(Ord)
{
  encodeKind(otSByte, "signed byte" );
  encodeKind(otUByte, "unsigned byte" );
  encodeKind(otSWord, "signed word");
  encodeKind(otUWord, "unsigned word");
  encodeKind(otSLong, "signed long");

  return "";
}

static TypeOrdKind(Ord)
{
  encodeKind(tkUnknown, "unknown");
  encodeKind(tkInteger, "integer");
  encodeKind(tkChar, "char");
  encodeKind(tkEnumeration, "enum");
  encodeKind(tkFloat, "float");
  encodeKind(tkString, "string");
  encodeKind(tkSet, "set");
  encodeKind(tkClass, "class");
  encodeKind(tkMethod, "method");
  encodeKind(tkWChar, "WChar");
  encodeKind(tkLString, "LString");
  encodeKind(tkWString, "WString");
  encodeKind(tkVariant, "variant");
  encodeKind(tkArray, "array");
  encodeKind(tkRecord, "record");
  encodeKind(tkInterface,"interface");
  encodeKind(tkInt64,"int64");
  encodeKind(tkDynArray, "DynArray");

  return "";
}

static TypeOrdFloat(Ord)
{
  encodeKind(ftSingle, "single");
  encodeKind(ftDouble, "double");
  encodeKind(ftExtended, "extended");
  encodeKind(ftComp, "comp");
  encodeKind(ftCurr, "currency");
  return "";
}

#define encodeSet(c,name)	if ( (1<= vtbl_adr )
    {
      if ( ! vtbl_end )
        vtbl_end = my_name;
      else
       if ( vtbl_end > my_name )
         vtbl_end = my_name;
    }
  }
/* for debug only: Message("end of VTBL is " + ltoa(vtbl_end, 0x10) );   */
  for ( count = vtbl_end - vtbl_adr ; count > 0; count = count - 4 )
  {
    MakeFOffset(vtbl_adr);
    vtbl_adr = vtbl_adr + 4;
  }
 }
 if ( is_recursive && res)
  _processRTTI(res, is_recursive);
 return res;
}

// pre-check RTTI and ask about it
static askRTTI(adr)
{
 auto name, dyn_count, what_say;
 name = getRTTIName(adr);
 dyn_count = get_dyncount(adr);
 what_say = "Do you want to process RTTI of class \"" + name + "\"";
 if ( dyn_count )
  what_say = what_say + " with " + ltoa(dyn_count, 10) + " dynamic methods";
 what_say = what_say + "?";
 return AskYN(1, what_say);
}

// main function - process RTTI with small pre-checking
static processRTTI(adr)
{
 if ( 1 == askRTTI(adr) )
  _processRTTI(adr,0);
}

// process all RTTI from this (recursive)
static allRTTI(adr)
{
  if ( 1 == askRTTI(adr) )
    _processRTTI(adr,1);
}

static UnitEntries(adr)
{
  auto count, i;

  count = ReMakeInt(adr);
  adr = MakeOffset(adr + 4);
  if ( !adr || ! count )
    return;
  for ( i = 0; i < count; i++ )
  {
    MakeFOffset(adr);
    setComment(adr,ltoa(i+1,10) + " Initialize",1);
    adr = adr + 4;
    MakeFOffset(adr);
    setComment(adr,"Finalize",1);
    adr = adr + 4;
  }
}

Den is Com [000859]