Hello everyone. Now I have a little time, so I have not often been programming BASIC and less likely to appear on the forum. Today again I will be talking about multi-threading, this time in the Standart EXE. I must say that all of what I write is my personal study, and may in some way does not correspond to reality; also due to my lack of time I will complement this post with further progress in the study of this issue. So here we go.
As I said before, to multithreading worked need to initialize the runtime. Without initialization we can work very limited in the sense that the COM will not work, ie roughly all the power of BASIC is not available. You can work with the API, declared in tlb, some functions, also removing the check __vbaSetSystemError, you can use Declared-function. All previous publications showing work in separate DLL, and we could easily initialize runtime using VBDllGetClassObject function for this. Today we will try to initialize the runtime in the usual EXE, ie without using external dependencies. It's no secret that any application written in VB6 has a project header, which contains a lot of information about the project that the runtime uses to work:
Code:
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
Code:
PUSH xxxxxxxx
CALL MSVBVM60.ThunRTMain
Code:
' // 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
Code:
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

I've added comments; They show that "Unknown5" contains flags and if you have installed the 5th bit, the recording is a reference to some object defined register EAX, in the field at offset 0x30 within the object specified register EDX. What kind of objects - I do not know, maybe later will deal with this, we have the important fact of the recording of a value in the field at offset 0x30. Now, if you start to explore more code you can stumble on such a fragment:

I will say that the object pointed to by ESI, the same object in the previous procedure under consideration (register EDX). It can be seen that the value of this field is tested for 0 and -1, and if there is any of the numbers that starts the procedure Main (unless specified); otherwise runs the first form. So, now that is guaranteed to run only Sub Main, we change the flag lpGuiTable.Unknown5, resetting the fifth bit. To install a new Sub Main and modification flag I created a separate procedure:
Code:
' // 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