Results 1 to 36 of 36

Thread: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    [VB6] - Multithreading in VB6 part 4 - multithreading in a Standart EXE.


    This one is obsolete. The stable solution without any dependencies you can get here.

    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
    In this structure, a lot of fields to describe all I will not, I will note only that this structure refers to a variety of other structures. Some of them will be needed in the future, such as a field lpSubMain, which contains the address of the procedure Main, if it is defined, otherwise there is 0. The vast majority of EXE files begin with the following code:
    Code:
    PUSH xxxxxxxx
    CALL MSVBVM60.ThunRTMain
    Just xxxxxxxx points to structure VBHeader. This feature will allow to find the structure inside the EXE for initializing runtime. In a previous article, I described how to get from the ActiveX DLL that structure - for this it was necessary to read the data in one of the exported functions (eg DllGetClassObject). To get from EXE - we also make use of the same method. First you need to find an entry point (entry point), ie address that starts the EXE. This address can be obtained from the structure IMAGE_OPTIONAL_HEADER - field AddressOfEntryPoint. This structure (IMAGE_OPTIONAL_HEADER) is located in the PE header, and the PE header is located at offset specified in the field e_lfanew from structure IMAGE_DOS_HEADER, well, IMAGE_DOS_HEADER structure located in the address specified in App.hInstance (or GetModuleHandle). Pointer to VbHeader is located at offset AddressOfEntryPoint + 1, because push-opcode in this case equal 0x68h. So, gathering all together, we get the function to get the Header:
    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
    Now, if you pass this structure VBDllGetClassObject function in a new thread, then, roughly speaking, this function will start our project for execution according to this structure. Of course in this sense is not enough - it is the same as re-start the application in the new thread. For example, if the function has been set Main, and then start again with the execution of it, and if the form has, then this form. Must somehow make the project was carried out on the other, do we need in the function. To do this, you can change the field "lpSubMain" in the structure vbHeader. I also did so at first, but it has given nothing. As it turned out, in runtime, there is one global object that stores a reference to projects and related objects, and if you pass the same header at VBDllGetClassObject, then the runtime checks are not loaded if such a project, and if loaded, simply launch a new copy without parse structure vbHeader, based on the previous analysis. So I decided to do so - you can copy the structure vbHeader to another location and use it. Immediately, I note that in this structure the last 4 fields - is offset with respect to the structure, so when copying the structure they need to be adjusted. If we now try to pass this structure to VBDllGetClassObject, then everything will be fine if installed as a startup Sub Main, if the form, it will be launched and the shape and after the Main. To exclude such behavior need to fix some data referenced by the title. I do not know exactly what kind of data, as did not understand this, but "dig deeper" inside the runtime I found their place position. Field "lpGuiTable" in the structure "vbHeader" refers to a list of structures tGuiTable, which describe froms in the project. Structures are sequentially the number of structures has a field "wFormCount" in the structure "vbHeader". In the network, I have not found the normal description of the structure tGuiTable, that's what is:
    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
    As it turned out there inside the runtime code that checks the field "Unknown5" in each structure:

    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
    Now, if you try to run this procedure before sending the header at VBDllGetClassObject, it will run the procedure defined by us. However multithreading have will work, but it is not convenient because there is no mechanism to pass a parameter to the thread as it is implemented in the CreateThread. In order to make a complete analog CreateThread I decided to create a similar function that will perform all initialization and then execute the call is transferred to the thread function with parameter. In order to be able to pass a parameter to the Sub Main, I used a thread local storage (TLS). We distinguish index for TLS. After allocation of the index, we can set the value of this index, specific for each thread. In general, the idea is, create a new thread where the starting function is a special feature ThreadProc, a parameter which transmits the structure of two fields - addresses the user function and address parameter. In this procedure, we will initialize the runtime for the new thread and stored in TLS parameter passed. As the procedure Main create a binary code that will get data from TLS, forming a stack and jump to a user function. The result had such a module:

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 - multithreading in Standart EXE.

    modMultiThreading.bas:
    Code:
    ' 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
    All API declaration I made in a separate type library - EXEInitialize.tlb. Yet found one drawback - not working private control if'll take care of the reason - fixed. Works only in the compiled version. The archive contains a few tests.
    1st: to create a form in a new thread, lockable entry through the long cycle.
    2nd: event processing from the object whose method is called by another thread. I should say so, and you can not do incorrect because transmit a link between the threads without the marshalling dangerous and can lead to glitches, besides event processing is performed in another thread. The example I have left as a demonstration of multi-threading, and not for use in everyday tasks.
    3rd: demonstration of the shared variable values change in one thread and read it from the other.

    Good luck to everyone!

    Download.

  3. #3

  4. #4

  5. #5
    Lively Member vbgamer45's Avatar
    Join Date
    Sep 2004
    Posts
    67

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Very nice great work! I enjoy seeing people dig deep into the internals of vb programs.
    Semi VB Decompiler 0.07 Getting better everyday
    http://www.visualbasiczone.com/produ...ivbdecompiler/
    VisualBasicZone
    http://www.visualbasiczone.com
    EasyPHPBB.com
    Free PHPBB forums the quick and easy way!

  6. #6
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    @The trick: In `ThreadProc` you use `lpVBHeader` as a parameter to `CopyMemory` and expect this global variable to be initialized from the calling thread. How is this supposed to work provided that appartment globals in VB6 are TLS based? Why is not `lpVBHeader` "reset" to NULL on the new thread in `ThreadProc`? I'm simply trying to figure out why is this working at all?

    cheers,
    </wqw>

  7. #7

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by wqweto View Post
    @The trick: In `ThreadProc` you use `lpVBHeader` as a parameter to `CopyMemory` and expect this global variable to be initialized from the calling thread.
    What do you mean "global variable to be initialized from the calling thread"?
    Quote Originally Posted by wqweto View Post
    How is this supposed to work provided that appartment globals in VB6 are TLS based?
    As far as i know TLS is used only for objects. Each TLS cell belongs to thread therefore each thread have own copy of TLS values.
    Quote Originally Posted by wqweto View Post
    Why is not `lpVBHeader` "reset" to NULL on the new thread in `ThreadProc`?
    What do you mean 'reset'?
    Quote Originally Posted by wqweto View Post
    I'm simply trying to figure out why is this working at all?
    It just reload project in new thread.

  8. #8
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    In vbCreateThread this is executed on main thread
    Code:
    Line 73:         lpVBHeader = GetVBHeader()
    In ThreadProc this happens in the newly created thread
    Code:
    Line 116:    CopyMemory ByVal lpNewHdr, ByVal lpVBHeader, &H6A
    Variable lpVBHeader is declared with global scope in the module. Global variables in VB6 are TLS based. So each appartment has "a copy" of the global state. So lpVBHeader on the main thread is a different variable than lpVBHeader on any other thread. Or am I wrong?

    cheers,
    </wqw>

  9. #9

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by wqweto View Post
    Global variables in VB6 are TLS based.
    What variables do you say about? User variables isn't TLS based, except objects. All variables are shared between all threads, thread-specific variables have local copy based in TLS index if i don't wrong (i research it ago).
    Quote Originally Posted by wqweto View Post
    So each appartment has "a copy" of the global state. So lpVBHeader on the main thread is a different variable than lpVBHeader on any other thread.
    I'm creating copy because inside the runtime MSVBVM checks all loaded project. If EXE-project is already loaded it isn't initialized.

  10. #10
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by The trick View Post
    User variables isn't TLS based, except objects.
    What does this mean? Does it mean that this variable
    Code:
    Line 19: Private lpVBHeader  As Long  ' Pointer to VBHeader structure.
    is shared across threads, and this variable
    Code:
    Line 20: Private g_oObject As Object  ' A reference to an instance.
    is not shared?

    cheers,
    </wqw>

  11. #11

  12. #12
    Junior Member
    Join Date
    Mar 2016
    Posts
    16

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Seems like code we was working on few years back on one chinese forum.

  13. #13

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by wqweto View Post
    What does this mean? Does it mean that this variable
    Code:
    Line 19: Private lpVBHeader  As Long  ' Pointer to VBHeader structure.
    is shared across threads, and this variable
    Code:
    Line 20: Private g_oObject As Object  ' A reference to an instance.
    is not shared?

    cheers,
    </wqw>
    Both of variables will be shared. I mean some object variables like Err are not shared.
    Quote Originally Posted by izero76 View Post
    Seems like code we was working on few years back on one chinese forum.
    That's interesting. Can you show this code?

  14. #14
    Junior Member
    Join Date
    Mar 2016
    Posts
    16

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by The trick View Post
    That's interesting. Can you show this code?
    There is it, there is a thread about multithreaded exe, we also uses vbheader to initialize thread, stable from 2010.

    http://www.vbgood.com/thread-93124-1-1.html

    There is some modified version:

    http://www.dotnetzone.gr/cs/forums/thread/59912.aspx

  15. #15
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by izero76 View Post
    There is it, there is a thread about multithreaded exe, we also uses vbheader to initialize thread, stable from 2010.

    http://www.vbgood.com/thread-93124-1-1.html

    There is some modified version:

    http://www.dotnetzone.gr/cs/forums/thread/59912.aspx
    I am not a fan of MT.
    I download the file and remove the exe and attach the Zip file.
    Attached Files Attached Files

  16. #16

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by izero76 View Post
    There is it, there is a thread about multithreaded exe, we also uses vbheader to initialize thread, stable from 2010.
    It is the interesting method. My solution uses other way.
    You do use the CreateIExprSrvObj function for initialize some internal structures.
    I actually emulate a new project by copying the VBHeader and changing some data.
    BTW, do you release IExprSrv object after termination of a thread? I've seen an application in the debugger and i've figured out CreateIExprSrvObj returns COM object. I'll investigate your method.
    ADDED:
    I'm testing your application and found a bug that i had encountered when i was developing the method in this article. When you call VBDllGetClassObject with VBHeader runtime launches new copy of project with the its startup object. If you add MsgBox to the Form_Initialize event it'll appear this MsgBox. In order to bypass this behavior you should change the startup object in the header, but there is a problem - the runtime does not load a changed header because there is a collection of loaded project inside runtime. When you try to load a project the runtime searches this project in the collection by the pointer of VBHeader. Due to the behavior, i did the copy of header and passed this changed copy to VBDllGetClassObject.
    Combining your method with mine it is possible to create a nice multithreading without TLB i think. It is also needed to do releasing of IExprSrv object in order to release its memory.
    Name:  ??????????.jpg
Views: 10633
Size:  34.7 KB

  17. #17
    Junior Member
    Join Date
    Mar 2016
    Posts
    16

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Yes, it's long time. I was working on idea (vbheader etc) and some starting code, it's not finished. We also found problem with startup object, but I am not sure if somebody fixed it, I leaved project soon because I worked on another project Use it for your inspiration, I like your MT code.

  18. #18

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by izero76 View Post
    Yes, it's long time. I was working on idea (vbheader etc) and some starting code, it's not finished. We also found problem with startup object, but I am not sure if somebody fixed it, I leaved project soon because I worked on another project Use it for your inspiration, I like your MT code.
    I can combine both methods (your and mine) if you don't mind. My method does not cause problems with startup objects, for example - stable multithreading.

  19. #19
    Junior Member
    Join Date
    Mar 2016
    Posts
    16

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by The trick View Post
    I can combine both methods (your and mine) if you don't mind. My method does not cause problems with startup objects
    Yep, do it

  20. #20
    Junior Member
    Join Date
    Mar 2016
    Posts
    16

    Re: [VB6] - Multithreading in VB6 - multithreading in Standart EXE.

    Trick, could you publish tlb source? I am interested in GetMem and I don't want to decompile your tlb Thanks.

  21. #21

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 - multithreading in Standart EXE.

    Quote Originally Posted by izero76 View Post
    Trick, could you publish tlb source? I am interested in GetMem and I don't want to decompile your tlb Thanks.
    Yes, of course.
    Code:
    [uuid(0000000E-0000-0000-0300-000000003AAB),
     helpstring("API declarations for support multithreading in Visual Basic 6.0 by the trick"),
     version(2.00)]
    
    library EXEInitialize
    
    {
        [dllname("msvbvm60.dll")]
        module msvbvm60
        {
            [entry("VBDllGetClassObject")]int VBDllGetClassObject([in] int lpHinstDLL,
                                                                  [in] int Reserved,
                                                                  [in] int lpVBHeader,
                                                                  [in] void* CLSID,
                                                                  [in] void* IID,
                                                                  [out] void* ppObj);
    
            [entry("GetMem1")]int GetMem1([in] void* Src,
                                          [out] void* Dst);
    
            [entry("GetMem2")]int GetMem2([in] void* Src,
                                          [out] void* Dst);
    
            [entry("GetMem4")]int GetMem4([in] void* Src,
                                          [out] void* Dst);
    
            [entry("GetMem8")]int GetMem8([in] void* Src,
                                          [out] void* Dst);
    
        }
        [dllname("ole32.dll")]
    
        module ole32
        {
                [entry("CoInitialize")]int vbCoInitialize([in] void* pvReserved);
    
                [entry("CoUninitialize")] void vbCoUninitialize(void);
    
        }
    
        [dllname("oleaut32.dll")]
    
        module oleaut32
        {
            const int CC_STDCALL                = 4;
    
                [entry("DispCallFunc")]int DispCallFunc([in] void* pvInstance,
                                                        [in] int oVft,
                                                        [in] short cc,
                                                        [in] short vtReturn,
                                                        [in] int cActuals,
                                                        [in] void* prgvt,
                                                        [in] void* prgpvarg,
                                                        [in] void* pvargResult);
    
        }
    
        [dllname("kernel32.dll")]
        module kernel32
        {
    
            const int PAGE_EXECUTE              = 0x10;
            const int PAGE_EXECUTE_READ         = 0x20;
            const int PAGE_EXECUTE_READWRITE    = 0x40;
            const int PAGE_EXECUTE_WRITECOPY    = 0x80;
            const int PAGE_NOACCESS             = 0x1;
            const int PAGE_READONLY             = 0x2;
            const int PAGE_READWRITE            = 0x4;
            const int PAGE_WRITECOPY            = 0x8;
    
            const int MEM_COMMIT                = 0x1000;
            const int MEM_RESERVE               = 0x2000;
    
            [entry("RtlMoveMemory")]void CopyMemory([out] void* Dst,
                                                    [in] void* Src,
                                                    [in] int Length);
    
            [entry("CreateThread")] int CreateThread([in] void* lpThreadAttributes,
                                                     [in] int dwStackSize,
                                                     [in] int lpStartAddress,
                                                     [in] void* lpParameter,
                                                     [in] int dwCreationFlags,
                                                     [out] int* lpThreadId);
    
            [entry("CloseHandle")]int CloseHandle([in] int hObject);
    
            [entry("HeapAlloc")] int HeapAlloc([in] int hHeap,
                                               [in] int dwFlags,
                                               [in] int dwBytes);
    
            [entry("HeapFree")] int HeapFree([in] int hHeap,
                                             [in] int dwFlags,
                                             [in] void* lpMem);
    
            [entry("GetProcessHeap")]int GetProcessHeap();
    
            [entry("VirtualProtect")] int VirtualProtect([in] void* lpAddress,
                                                         [in] int dwSize,
                                                         [in] int flNewProtect,
                                                         [in] int* lpflOldProtect);
    
            [entry("VirtualAlloc")]int VirtualAlloc([in] void* lpAddress,
                                                    [in] int dwSize,
                                                    [in] int flAllocationType,
                                                    [in] int flProtect);
    
            [entry("TlsAlloc")]int TlsAlloc();
    
            [entry("TlsSetValue")]int TlsSetValue([in] int dwTlsIndex,
                                                  [in] void* lpTlsValue);
    
            [entry("TlsGetValue")]int TlsGetValue([in] int dwTlsIndex);
    
            [entry("TlsFree")]int TlsFree([in] int dwTlsIndex);
    
            [entry("GetModuleHandleW")]int GetModuleHandle([in] void* lpModuleName);
    
            [entry("GetProcAddress")]int GetProcAddress([in] int hModule,
                                                        [in] lpStr lpProcName);
    
        }
    }
    Attached Files Attached Files

  22. #22
    New Member
    Join Date
    Mar 2016
    Posts
    6

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Thanks for your great VB6 multi-threading solution. I tested your solution and it seems that it works well. I would like to have full source code of project which generates TrickMultithreading.dll . Thanks a lot.

  23. #23

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by cuongch1980 View Post
    Thanks for your great VB6 multi-threading solution. I tested your solution and it seems that it works well. I would like to have full source code of project which generates TrickMultithreading.dll . Thanks a lot.
    I glad that you find it useful. I attach the source of DLL:
    Code:
    ' modMultiThreadingDll.bas - The DLL-Wrapper of module provides support for multi-threading.
    ' © Krivous Anatolii Anatolevich (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.
    
    Public Sub Main()
    End Sub
    
    ' // Dll entry point
    Public Function DllMain(ByVal hInstDll As Long, ByVal fdwReason As Long, ByVal lpvReserved As Long) As Long
        DllMain = 1
    End Function
    
    ' // 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
        
        InIDE = GetModuleHandle(ByVal StrPtr("vb6.exe"))
        
        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 = CallByPointer(lpStartAddress, lpParameter)
                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
    
    ' // Call function in same thread
    Private Function CallByPointer(ByVal lpStartAddress As Long, ByVal lpParameter As Long) As Long
        CallByPointer = DispCallFunc(ByVal 0&, lpStartAddress, CC_STDCALL, vbEmpty, 1, vbLong, VarPtr(CVar(lpParameter)), CVar(0))
    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
    Attached Files Attached Files

  24. #24
    New Member
    Join Date
    Mar 2016
    Posts
    6

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Thanks. I appreciate your help.

  25. #25
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    @Trick Are you going to post the combined method here, or another thread? Regards,

  26. #26

  27. #27
    New Member
    Join Date
    Mar 2016
    Posts
    6

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    @Trick We would like to pass parameters between threads. I want to pass parameter to Test4 function. How can we do it? Thanks

    Public Function ThreadProc(ByVal frm As form1) As Long
    Test4
    End Function

  28. #28

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by cuongch1980 View Post
    @Trick We would like to pass parameters between threads. I want to pass parameter to Test4 function. How can we do it? Thanks

    Public Function ThreadProc(ByVal frm As form1) As Long
    Test4
    End Function
    You should not pass an object variable between thread without marshaling. Please read this thread.
    If you want to pass a variable excepting an object you should ensure sharing of variables.

  29. #29
    New Member
    Join Date
    Mar 2016
    Posts
    6

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    @Trick I tried to use your multi-thread approach in the separate testing project and it works well. Unfortunately, when I tried to apply to my company project, it runs well in the first call of ThreadProc function . For second call, the program crashed before calling ThreadProc function. I would like to hear your advice on this issue. Thanks in advance.

  30. #30

  31. #31
    New Member
    Join Date
    Mar 2016
    Posts
    6

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by The trick View Post
    Hi, cuongch1980. Can you send me an EXE file, or a crash-dump of an EXE file that causes crash? This module has a bug you should replace the GetModuleHandle function to App.hInstance. I've not fixed it yet.
    I will try to replace the function. Our project is quite big. I will try to break down code and send you the executable file later. Thanks.

  32. #32
    New Member
    Join Date
    May 2018
    Posts
    2

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Hi Guys,

    I need to solve a problem in VB6 project using .Net C# Library. The application works successfully in VB6 IDE, But the EXE doesn't work when getting data and update the form controls.

    We can use invoke method in .Net or Synchronize method in Delphi for thread safe. But I can't find any solution for VB6. Do you have any solution for this issue? Thanks

  33. #33

  34. #34
    New Member
    Join Date
    May 2018
    Posts
    2

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Quote Originally Posted by The trick View Post
    Hi metin.

    Show an example.

    Code:
        OptionOption Explicit
    
       Explicit Public foo As FOOClient.foo
      Public comWrapper As FOOClient.comWrapper
    
      Sub Start()
          Set foo = New FOOClient.foo
          Set comWrapper = New FOOClient.comWrapper
    
          Set foo = comWrapper.SpiInit()
          comWrapper.Main foo, AddressOf TxFlowStateChanged, AddressOf PairingFlowStateChanged
          foo.Start
    
          PrintStatusAndActions
      End Sub
    
      Private Sub TxFlowStateChanged(ByVal e As FOOClient.TransactionFlowState)
          frmActions.Show
    
          PrintFlowInfo e
    
          PrintStatusAndActions
      End Sub
    
      Private Sub PairingFlowStateChanged(ByVal e As FOOClient.PairingFlowState)
          frmActions.Show
    
          frmActions.listFlow.Clear
          frmActions.lblFlowMessage.Caption = e.Message
    
          If e.ConfirmationCode <> "" Then
              frmActions.listFlow.AddItem "# Confirmation Code: " + e.ConfirmationCode
          End If
    
          PrintStatusAndActions
      End Sub
    Foo is .Net Assembly

  35. #35

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    TxFlowStateChanged is called from the other thread? Each call is in the different thread or the same one?
    If so, you need to initialize the thread before work with it, you should call ThreadProc from your callback function. You also can't call the methods of the VB6 controls from the different thread without marshaling. You need to pass the queries to the main thread using the messages queue, APC, etc. If you can change the sources of the .Net assembly it's simpler to ensure marshaling from that assembly using a callback interface and the typelib-marshaller.

  36. #36
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6] - Multithreading in VB6 part 4 - multithreading in Standart EXE.

    Code:
    Public Function UninitializeRuntimeForProject( _
                    ByVal hInstance As Long) As Boolean
        Dim pNewHeader  As Long
        
        ' // Check if the module is initialized
        pNewHeader = VBDll.TlsGetValue(mlTlsSlot)
        If pNewHeader = 0 Then Exit Function
    
        VBDll.CoUninitialize
        
        UninitializeRuntimeForProject = True
        
    End Function
    hInstance ,Can this parameter be deleted?


    Code:
    sub UninitializeRuntimeForProject( _
                    ByVal hInstance As Long) 
        Dim pNewHeader  As Long
        
        ' // Check if the module is initialized
        pNewHeader = VBDll.TlsGetValue(mlTlsSlot)
        If pNewHeader = 0 Then Exit Function
    
        VBDll.CoUninitialize    
    End sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width