Форум программистов, компьютерный форум, киберфорум
Наши страницы
The trick
Войти
Регистрация
Восстановить пароль
Рейтинг: 5.00. Голосов: 1.

Многопоточность в VB6 часть 4 - многопоточность в Standart EXE.

Запись от The trick размещена 17.02.2015 в 01:07
Обновил(-а) The trick 01.06.2015 в 10:04


Всем привет. Сейчас у меня мало времени, поэтому я уже не так часто уделяю внимание бейсику и реже появляюсь на форумах. Сегодня я опять буду говорить о многопоточности, на этот раз в Standart EXE. Сразу скажу что все о чем я пишу является моим личным исследованием и может в чем-то не соответствовать действительности; также из-за моего недостатка времени я буду дополнять этот пост по мере дальнейшего прогресса в исследовании данного вопроса. Итак начнем.
Как я говорил до этого для того чтобы многопоточность работала нужно инициализировать рантайм. Без инициализации мы можем работать очень ограниченно, в том смысле что COM не будет работать, т.е. грубо говоря вся мощь бейсика будет недоступна. Можно работать с API, объявленными в tlb, некоторыми функциями, также убирая проверку __vbaSetSystemError, можно использовать Declared-функции. Все предыдущие публикации показывали работу в отдельных DLL, и мы легко могли инициализировать рантайм используя VBDllGetClassObject функцию для этого. Сегодня мы попытаемся инициализировать рантайм в обычном EXE, т.е. не используя внешние зависимости. Не для кого не секрет что любое приложение написанное в VB6 состоит из хидера проекта, в котором содержится очень много информации о проекте которую рантайм использует для работы:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Type VbHeader
    szVbMagic               As String * 4
    wRuntimeBuild           As Integer
    szLangDll               As String * 14
    szSecLangDll            As String * 14
    wRuntimeRevision        As Integer
    dwLCID                  As Long
    dwSecLCID               As Long
    lpSubMain               As Long
    lpProjectInfo           As Long
    fMdlIntCtls             As Long
    fMdlIntCtls2            As Long
    dwThreadFlags           As Long
    dwThreadCount           As Long
    wFormCount              As Integer
    wExternalCount          As Integer
    dwThunkCount            As Long
    lpGuiTable              As Long
    lpExternalCompTable     As Long
    lpComRegisterData       As Long
    bszProjectDescription   As Long
    bszProjectExeName       As Long
    bszProjectHelpFile      As Long
    bszProjectName          As Long
End Type
В этой структуре большое количество полей описывать все я не буду, отмечу только что эта структура ссылается на множество других структур. Некоторые из них нам понадобятся в дальнейшем, например поле lpSubMain, в котором содержится адрес процедуры Main, если она определена, иначе там 0.
Подавляющее большинство EXE файлов начинаются со следующего кода:
Assembler
1
2
PUSH xxxxxxxx
CALL MSVBVM60.ThunRTMain
Как раз xxxxxxxx указывает на структуру VBHeader. Эта особенность позволит найти эту структуру внутри EXE для инициализации рантайма. В одной из предыдущих частей я описывал как достать из ActiveX DLL эту структуру - для этого нужно было считать данные в одной из экспортируемых функций (к примеру DllGetClassObject). Для получения из EXE - мы также воспользуемся тем-же методом. Для начала нужно найти точку входа (entry point), т.е. адрес с которого начинается выполнение EXE. Этот адрес можно получить из структуры IMAGE_OPTIONAL_HEADER - поле AddressOfEntryPoint. Сама структура IMAGE_OPTIONAL_HEADER расположена в PE заголовке, а PE заголовок находится по смещению заданному в поле e_lfanew структуры IMAGE_DOS_HEADER, ну а структура IMAGE_DOS_HEADER расположена по адресу App.hInstance (или GetModuleHandle). Указатель на VbHeader будет лежать по смещению AddressOfEntryPoint + 1, т.к. опкод команды push в данном случае 0x68h. Итак, собирая все вместе, получим функцию для получения хидера:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
' // Get VBHeader structure
Private Function GetVBHeader() As Long
    Dim ptr     As Long
    ' Get e_lfanew
    GetMem4 ByVal hModule + &H3C, ptr
    ' Get AddressOfEntryPoint
    GetMem4 ByVal ptr + &H28 + hModule, ptr
    ' Get VBHeader
    GetMem4 ByVal ptr + hModule + 1, GetVBHeader
    
End Function
Теперь если передать эту структуру функции VBDllGetClassObject в новом потоке, то, грубо говоря, эта функция запустит наш проект на выполнение согласно переданной структуре. Конечно смысла в этом мало - это тоже самое что начать выполнение приложения заново в новом потоке. Например если была задана функция Main, то и выполнение начнется опять с нее, а если была форма, то с нее. Нужно как-то сделать так, чтобы проект выполнялся с другой, нужной нам, функции. Для этого можно изменить поле lpSubMain структуры vbHeader. Я тоже сначала сделал так, но это ничего не дало. Как выяснилось, внутри рантайма есть один глобальный объект, который хранит ссылки на проекты и связанные с ними объекты и если передать тот же самый хидер в VBDllGetClassObject, то рантайм проверит, не загружался ли такой проект, и если загружался, то просто запустит новую копию без разбора структуры vbHeader, на основании предыдущего разбора. Поэтому я решил поступить так - можно скопировать структуру vbHeader в другое место и использовать ее. Сразу замечу, что в этой структуре последние 4 поля - это смещения относительно начала структуры, поэтому при копировании струкутуры их нужно будет скорректировать. Если теперь попробовать передать эту структуру в VBDllGetClassObject, то все будет отлично если в качестве стартапа установлена Sub Main, если же форма, то будет запущена и форма и после нее Main. Для исключения такого поведения нужно поправить кое-какие данные на которые ссылается хидер. Я пока точно не знаю что это за данные, т.к. не разбирался в этом, но "поковырявшись" внутри рантайма я нашел их место положение. Поле lpGuiTable структуры vbHeader ссылается на список структур tGuiTable, которые описывают формы в проекте. Структуры идут последовательно, число структур соответствует полю wFormCount структуры vbHeader. В сети я так и не нашел нормальное описание структуры tGuiTable, вот что есть:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Type tGuiTable
    lStructSize          As Long
    uuidObjectGUI        As uuid
    Unknown1             As Long
    Unknown2             As Long
    Unknown3             As Long
    Unknown4             As Long
    lObjectID            As Long
    Unknown5             As Long
    fOLEMisc             As Long
    uuidObject           As uuid
    Unknown6             As Long
    Unknown7             As Long
    aFormPointer         As Long
    Unknown8             As Long
End Type
Как выяснилось внутри рантайма есть код, который проверяет поле Unknown5 каждой структуры:
Нажмите на изображение для увеличения
Название: 1.png
Просмотров: 432
Размер:	10.0 Кб
ID:	3039
Я проставил комментарии; из них видно что Unknown5 содержит флаги и если установлен 5-й бит, то происходит запись ссылки на какой-то объект, заданный регистром EAX, в поле со смещением 0x30 объекта заданного регистром EDX. Что за объекты - я не знаю, возможно позже разберусь с этим, нам важен сам факт записи какого-то значения в поле со смещением 0x30. Теперь, если дальше начать исследовать код то можно наткнутся на такой фрагмент:
Нажмите на изображение для увеличения
Название: 2.png
Просмотров: 430
Размер:	17.9 Кб
ID:	3040
Скажу что объект на который указывает ESI, тот же самый объект что в предыдущей рассматриваемой процедуре (регистр EDX). Видно что тестируется значение этого поля на -1 и на 0, и если там любое из этих чисел то запускается процедура Main (если она задана); иначе запускается первая форма.
Итак, теперь чтобы гарантированно запускать только Sub Main, мы изменяем флаг lpGuiTable.Unknown5, сбрасывая пятый бит. Для установки новой Sub Main и модификации флага я создал отдельную процедуру:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
' // Modify VBHeader to replace Sub Main
Private Sub ModifyVBHeader(ByVal newAddress As Long)
    Dim ptr     As Long
    Dim old     As Long
    Dim flag    As Long
    Dim count   As Long
    Dim size    As Long
    
    ptr = lpVBHeader + &H2C
    ' Are allowed to write in the page
    VirtualProtect ByVal ptr, 4, PAGE_READWRITE, old
    ' Set a new address of Sub Main
    GetMem4 newAddress, ByVal ptr
    VirtualProtect ByVal ptr, 4, old, 0
    
    ' Remove startup form
    GetMem4 ByVal lpVBHeader + &H4C, ptr
    ' Get forms count
    GetMem4 ByVal lpVBHeader + &H44, count
    
    Do While count > 0
        ' Get structure size
        GetMem4 ByVal ptr, size
        ' Get flag (unknown5) from current form
        GetMem4 ByVal ptr + &H28, flag
        ' When set, bit 5,
        If flag And &H10 Then
            ' Unset bit 5
            flag = flag And &HFFFFFFEF
            ' Are allowed to write in the page
            VirtualProtect ByVal ptr, 4, PAGE_READWRITE, old
            ' Write changet flag
            GetMem4 flag, ByVal ptr + &H28
            ' Restoring the memory attributes
            VirtualProtect ByVal ptr, 4, old, 0
            
        End If
        count = count - 1
        ptr = ptr + size
        
    Loop
    
End Sub
Теперь, если попробовать запустить эту процедуру перед передачей хидера в VBDllGetClassObject, то будет запускаться процедура, определенная нами. Впрочем многопоточность уже будет работать, но это не удобно, т.к. отсутствует механизм передачи параметра в поток как это реализовано в CreateThread. Для того чтобы сделать полный аналог CreateThread я решил создать аналогичную функцию, которая будет проводить все инициализации и после выполнять вызов переданной функции потока вместе с параметром. Для того чтобы была возможность передать параметр в Sub Main, я использовал локальное хранилище потока (TLS). Мы выделяем индекс для TLS. После выделения индекса мы сможем задавать значение этого индекса, специфичное для каждого потока. В общем идея такова, создаем новый поток, где стартовой функцией будет специальная функция ThreadProc, в параметр которой передаем структуру из двух полей - адреса пользовательской функции и адреса параметра. В этой процедуре мы будем инициализировать рантайм для нового потока и сохранять в TLS переданный параметр. В качестве процедуры Main создадим бинарный код, который будет доставать данные из TLS, формировать стек и прыгать на пользовательскую функцию. В итоге получился такой модуль:
modMultiThreading.bas
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
' modMultiThreading.bas - The module provides support for multi-threading.
' © Кривоус Анатолий Анатольевич (The trick), 2015
 
Option Explicit
 
Private Type uuid
    data1       As Long
    data2       As Integer
    data3       As Integer
    data4(7)    As Byte
End Type
 
Private Type threadData
    lpParameter As Long
    lpAddress   As Long
End Type
 
Private tlsIndex    As Long  ' Index of the item in the TLS. There will be data specific to the thread.
Private lpVBHeader  As Long  ' Pointer to VBHeader structure.
Private hModule     As Long  ' Base address.
Private lpAsm       As Long  ' Pointer to a binary code.
 
' // Create a new thread
Public Function vbCreateThread(ByVal lpThreadAttributes As Long, _
                               ByVal dwStackSize As Long, _
                               ByVal lpStartAddress As Long, _
                               ByVal lpParameter As Long, _
                               ByVal dwCreationFlags As Long, _
                               lpThreadId As Long) As Long
    Dim InIDE   As Boolean
    
    Debug.Assert MakeTrue(InIDE)
    
    If InIDE Then
        Dim ret As Long
        
        ret = MsgBox("Multithreading not working in IDE." & vbNewLine & "Run it in the same thread?", vbQuestion Or vbYesNo)
        If ret = vbYes Then
            ' Run function in main thread
            ret = DispCallFunc(ByVal 0&, lpStartAddress, CC_STDCALL, vbEmpty, 1, vbLong, VarPtr(CVar(lpParameter)), CVar(0))
            If ret Then
                Err.Raise ret
            End If
        End If
        
        Exit Function
    End If
    
    ' Alloc new index from thread local storage
    If tlsIndex = 0 Then
        
        tlsIndex = TlsAlloc()
        
        If tlsIndex = 0 Then Exit Function
        
    End If
    ' Get module handle
    If hModule = 0 Then
        
        hModule = GetModuleHandle(ByVal 0&)
        
    End If
    ' Create assembler code
    If lpAsm = 0 Then
        
        lpAsm = CreateAsm()
        If lpAsm = 0 Then Exit Function
        
    End If
    ' Get pointer to VBHeader and modify
    If lpVBHeader = 0 Then
    
        lpVBHeader = GetVBHeader()
        If lpVBHeader = 0 Then Exit Function
        
        ModifyVBHeader lpAsm
        
    End If
    
    Dim lpThreadData    As Long
    Dim tmpData         As threadData
    ' Alloc thread-specific memory for threadData structure
    lpThreadData = HeapAlloc(GetProcessHeap(), 0, Len(tmpData))
    
    If lpThreadData = 0 Then Exit Function
    ' Set parameters
    tmpData.lpAddress = lpStartAddress
    tmpData.lpParameter = lpParameter
    ' Copy parameters to thread-specific memory
    GetMem8 tmpData, ByVal lpThreadData
    ' Create thread
    vbCreateThread = CreateThread(ByVal lpThreadAttributes, _
                                  dwStackSize, _
                                  AddressOf ThreadProc, _
                                  ByVal lpThreadData, _
                                  dwCreationFlags, _
                                  lpThreadId)
    
End Function
 
' // Initialize runtime for new thread and run procedure
Private Function ThreadProc(lpParameter As threadData) As Long
    Dim iid         As uuid
    Dim clsid       As uuid
    Dim lpNewHdr    As Long
    Dim hHeap       As Long
    ' Initialize COM
    vbCoInitialize ByVal 0&
    ' IID_IUnknown
    iid.data4(0) = &HC0: iid.data4(7) = &H46
    ' Store parameter to thread local storage
    TlsSetValue tlsIndex, lpParameter
    ' Create the copy of VBHeader
    hHeap = GetProcessHeap()
    lpNewHdr = HeapAlloc(hHeap, 0, &H6A)
    CopyMemory ByVal lpNewHdr, ByVal lpVBHeader, &H6A
    ' Adjust offsets
    Dim names()     As Long
    Dim diff        As Long
    Dim Index       As Long
    
    ReDim names(3)
    diff = lpNewHdr - lpVBHeader
    CopyMemory names(0), ByVal lpVBHeader + &H58, &H10
    
    For Index = 0 To 3
        names(Index) = names(Index) - diff
    Next
    
    CopyMemory ByVal lpNewHdr + &H58, names(0), &H10
    ' This line calls the binary code that runs the asm function.
    VBDllGetClassObject VarPtr(hModule), 0, lpNewHdr, clsid, iid, 0
    ' Free memeory
    HeapFree hHeap, 0, ByVal lpNewHdr
    HeapFree hHeap, 0, lpParameter
    
End Function
 
' // Get VBHeader structure
Private Function GetVBHeader() As Long
    Dim ptr     As Long
   
    ' Get e_lfanew
    GetMem4 ByVal hModule + &H3C, ptr
    ' Get AddressOfEntryPoint
    GetMem4 ByVal ptr + &H28 + hModule, ptr
    ' Get VBHeader
    GetMem4 ByVal ptr + hModule + 1, GetVBHeader
    
End Function
 
' // Modify VBHeader to replace Sub Main
Private Sub ModifyVBHeader(ByVal newAddress As Long)
    Dim ptr     As Long
    Dim old     As Long
    Dim flag    As Long
    Dim count   As Long
    Dim size    As Long
    
    ptr = lpVBHeader + &H2C
    ' Are allowed to write in the page
    VirtualProtect ByVal ptr, 4, PAGE_READWRITE, old
    ' Set a new address of Sub Main
    GetMem4 newAddress, ByVal ptr
    VirtualProtect ByVal ptr, 4, old, 0
    
    ' Remove startup form
    GetMem4 ByVal lpVBHeader + &H4C, ptr
    ' Get forms count
    GetMem2 ByVal lpVBHeader + &H44, count
    
    Do While count > 0
        ' Get structure size
        GetMem4 ByVal ptr, size
        ' Get flag (unknown5) from current form
        GetMem4 ByVal ptr + &H28, flag
        ' When set, bit 5,
        If flag And &H10 Then
            ' Unset bit 5
            flag = flag And &HFFFFFFEF
            ' Are allowed to write in the page
            VirtualProtect ByVal ptr, 4, PAGE_READWRITE, old
            ' Write changet flag
            GetMem4 flag, ByVal ptr + &H28
            ' Restoring the memory attributes
            VirtualProtect ByVal ptr, 4, old, 0
            
        End If
        
        count = count - 1
        ptr = ptr + size
        
    Loop
    
End Sub
 
' // Create binary code.
Private Function CreateAsm() As Long
    Dim hMod    As Long
    Dim lpProc  As Long
    Dim ptr     As Long
    
    hMod = GetModuleHandle(ByVal StrPtr("kernel32"))
    lpProc = GetProcAddress(hMod, "TlsGetValue")
    
    If lpProc = 0 Then Exit Function
    
    ptr = VirtualAlloc(ByVal 0&, &HF, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    
    If ptr = 0 Then Exit Function
    
    ' push  tlsIndex
    ' call  TLSGetValue
    ' pop   ecx
    ' push  DWORD [eax]
    ' push  ecx
    ' jmp   DWORD [eax + 4]
    
    GetMem4 &H68, ByVal ptr + &H0:          GetMem4 &HE800, ByVal ptr + &H4
    GetMem4 &HFF590000, ByVal ptr + &H8:    GetMem4 &H60FF5130, ByVal ptr + &HC
    GetMem4 &H4, ByVal ptr + &H10:          GetMem4 tlsIndex, ByVal ptr + 1
    GetMem4 lpProc - ptr - 10, ByVal ptr + 6
    
    CreateAsm = ptr
    
End Function
 
Private Function MakeTrue(value As Boolean) As Boolean
    MakeTrue = True: value = True
End Function
Все API декларации я сделал в отдельной библиотеке типов - EXEInitialize.tlb. Пока найден один недостаток - не работают формы с приватными контролами, если разберусь в чем причина - исправлю. Работает только в скомпилированном варианте.
В архиве содержится несколько тестов.
1-й: создание формы в новом потоке, с возможностью блокировки ввода посредством длинного цикла.
2-й: обработка событий от объекта, метод которого вызван в другом потоке. Сразу скажу так делать нельзя и неправильно, т.к. передавать между потоками ссылку без маршаллинга опасно и может привести к глюкам, к тому же обработка события выполняется в другом потоке. Этот пример я оставил в качестве демонстрации работы многопоточности, а не для использования в повседневных задачах.
3-й: демонстрация изменения значения общей переменной в одном потоке и считывание его из другого.

Update: 27.05.2015
В IDE запуск осуществляется в главном потоке по желанию.
Добавлен 4-й тест - получение списка простых чисел в отдельном потоке.

Update: 01.06.2015
Добавлена нативная DLL которая экспортирует vbCreateThread.
Внесены изменения в код чтобы поддерживать эту возможность.

Скачать материалы.
Всем удачи!
Размещено в Без категории
Просмотров 1483 Комментарии 0
Всего комментариев 0
Комментарии
 
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.