Results 1 to 4 of 4

Thread: [VB6] - Multithreading in VB6 part 1

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    [VB6] - Multithreading in VB6 part 1

    The most recent solution.

    Hello everyone! Many people wonder multithreaded programs written in VB6. Write multithreaded programs in VB6 quite real, I have many examples that I also published in my blog, but there are restrictions, one way or another can be circumvented. I consider this question in this post will not, and will consider more correct (in terms of programming in VB6) method of of multithreading - using objects. In this method, there are no restrictions, unlike threading Standart EXE, and has all the advantages of OOP. Also, I hasten to note that the IDE is not intended for debugging multithreaded programs, so to debug such programs in the IDE will not work. For debugging I use another debugger. You can also debug streams separately, and then collect the EXE.
    Using multiple threads, we have the ability to call methods asynchronously while maintaining synchronicity; ie we can call methods as well as in a separate thread, and in his. For example methods require large computational load should cause asynchronously and receive, at the end of the notice in the form of events. Such methods (properties) that work fast, you can call synchronously.
    One of the problems create a thread on VB6 in Standart EXE, is the inability to use WinAPI calls functions through Declare. Unlike the functions declared in a type library and entering the import, Declared-function after each call to set the properties of the object variable Err.LastDllError. This is done by calling the function __vbaSetSystemError of MSVBVM. Object Err, is thread-dependent, and the reference to it is in the thread local storage (TLS). For each thread must create its own object Err, otherwise the function call __vbaSetSystemError, runtime inquiry link from the storage, and we have it is not there (or rather there is 0) and will read the wrong address, as a consequence of crash.
    To prevent this behavior, you can declare a function in tlb, then the function will not be called __vbaSetSystemError. You can also initialize the Err object, create an object instance of the DLL in the new thread, then the runtime initializes the object itself. But to create a new object, you must first initialize the thread to work with COM, it needs to call CoInitialize (Ex), but we can not call functions. It is possible to declare a tlb (it only one), then all is fair; it can also be called from assembler code or in any other way. I always go to another. Why do I LastDllError? I can just simply call GetLastError himself when I need to. So I just find the address of the function __vbaSetSystemError and write the first instruction output from the procedure (ret). This is certainly not so nice, but reliably and quickly. You can have only one function CoInitialize, and then restore __vbaSetSystemError.
    Now we can call Declared-function in a new thread, which gives us endless possibilities. After creating the object (CreateObject), we can call its methods, properties, events receive from him, etc., but just a link between streams can not be passed because errors can occur because of concurrent access to data, etc. To send a link exists between threads marshaling. We will use the universal marshaller, because we ActiveX DLL has a type library. The principle of work, I will not describe in detail, it has a lot of articles online. The general sense is that instead of a direct call to the object, the RPC request to another computer / process / thread. For processing queries need to use the message loop, and once it happened, then the communication between threads is done through the posts.
    To test, I wrote a simple ActiveX DLL that lets you download a file from a network that has several methods and generates events.
    Code:
    ' Класс MultithreadDownloader - класс загрузчика
    ' © Кривоус Анатолий Анатольевич (The trick), 2014
     
    Option Explicit
     
    Public Enum ErrorCodes
        OK
        NOT_INITIALIZE
        ERROR_CREATING_DST_FILE
    End Enum
     
    Private Declare Function InternetCloseHandle Lib "wininet" (ByRef hInternet As Long) As Boolean
    Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenW" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxy As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
    Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlW" (ByVal hInternet As Long, ByVal lpszUrl As Long, ByVal lpszHeaders As Long, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByRef dwContext As Long) As Long
    Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, lpBuffer As Any, ByVal dwNumberOfBytesToRead As Long, ByRef lpdwNumberOfBytesRead As Long) As Integer
    Private Declare Function HttpQueryInfo Lib "wininet" Alias "HttpQueryInfoW" (ByVal hRequest As Long, ByVal dwInfoLevel As Long, lpBuffer As Any, ByRef lpdwBufferLength As Long, ByRef lpdwIndex As Long) As Long
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
     
    Private Const INTERNET_OPEN_TYPE_PRECONFIG  As Long = 0
    Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000
    Private Const HTTP_QUERY_CONTENT_LENGTH     As Long = 5
    Private Const HTTP_QUERY_FLAG_NUMBER        As Long = &H20000000
    Private Const CREATE_ALWAYS                 As Long = 2
    Private Const FILE_ATTRIBUTE_NORMAL         As Long = &H80
    Private Const INVALID_HANDLE_VALUE          As Long = -1
    Private Const GENERIC_WRITE                 As Long = &H40000000
     
    Public Event Complete()
    Public Event Error(ByVal Code As Long)
    Public Event Progress(ByVal Size As Currency, ByVal TotalSize As Currency, cancel As Boolean)
     
    Private mBufferSize As Long
    Private mError      As ErrorCodes
     
    Dim hInternet   As Long
     
    Public Property Get ErrorCode() As ErrorCodes
        ErrorCode = mError
    End Property
     
    Public Property Get BufferSize() As Long
        BufferSize = mBufferSize
    End Property
    Public Property Let BufferSize(ByVal Value As Long)
        If Value > &H1000000 Or Value < &H400 Then Err.Raise vbObjectError, "MultithreadDownloader", "Wrong buffer size": Exit Property
        mBufferSize = Value
    End Property
     
    Public Sub Download(URL As String, Filename As String)
        Dim hFile   As Long
        Dim hDst    As Long
        Dim fSize   As Currency
        Dim total   As Long
        Dim prgSize As Currency
        Dim cancel  As Boolean
        Dim buf()   As Byte
        
        If hInternet = 0 Then mError = NOT_INITIALIZE: RaiseEvent Error(mError): Exit Sub
        hFile = InternetOpenUrl(hInternet, StrPtr(URL), 0, 0, INTERNET_FLAG_RELOAD, 0)
        
        If hFile = 0 Then mError = Err.LastDllError: RaiseEvent Error(mError): Exit Sub
        
        If HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, fSize, 8, 0) Then
            hDst = CreateFile(StrPtr(Filename), GENERIC_WRITE, 0, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
            If hDst = INVALID_HANDLE_VALUE Then mError = ERROR_CREATING_DST_FILE: RaiseEvent Error(mError): Exit Sub
            ReDim buf(mBufferSize - 1)
            Do
                If InternetReadFile(hFile, buf(0), mBufferSize, total) = 0 Then
                    mError = Err.LastDllError
                    RaiseEvent Error(mError)
                    InternetCloseHandle hFile
                    Exit Sub
                End If
                WriteFile hDst, buf(0), total, 0, ByVal 0&
                prgSize = prgSize + CCur(total) / 10000@
                RaiseEvent Progress(prgSize, fSize, cancel)
            Loop While (total = mBufferSize) And Not cancel
            CloseHandle hDst
            RaiseEvent Complete
        Else
            mError = Err.LastDllError
            RaiseEvent Error(mError)
        End If
        InternetCloseHandle hFile
        mError = OK
    End Sub
     
    Private Sub Class_Initialize()
        ' Инициализация WinInet
        hInternet = InternetOpen(StrPtr(App.ProductName), INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0)
        mBufferSize = &H10000
    End Sub
     
    Private Sub Class_Terminate()
        ' Деинициализация
        If hInternet Then InternetCloseHandle hInternet
    End Sub
    The code basically simple, if you read the description of the API functions. When calling the method "Download", starts will download from time to time (depending on the size of the buffer) event is generated Progress. If an error occurs, an event "Error", and at the end of the "Complete". "BufferSize" - sets the size of the buffer, which is generated when filling event. Demo code and contains bugs.*
    Class I named "MultithreadDownloader", and the library "MTDownloader", respectively ProgID of the object - "MTDownloader.MultithreadDownloader". After compiling obtain a description of the interfaces through OleView, PEExplorer etc. In my example, CLSID = {20FAEF52-0D1D-444B-BBAE-21240219905B}, IID = {DF3BDB52-3380-4B78-B691-4138300DD304}. I also put a check "RemoteServerFiles" to get the output type library for our DLL, and will connect it instead of DLL for guaranteed start of the application.
    Last edited by The trick; May 4th, 2019 at 05:18 AM.

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Multithreading in VB6 Part 1

    Client application code:
    Form:
    Code:
    ' frmDownloader.frm - форма загрузчика
    ' © Кривоус Анатолий Анатольевич (The trick), 2014
     
    Option Explicit
     
    ' Объявляем объектную переменную с подпиской на события
    Dim WithEvents Downloader As MTDownloader.MultithreadDownloader
     
    Dim param   As ThreadData   ' Данные потока
    Dim tid     As Long         ' ИД потока
    Dim hThread As Long         ' Описатель потока
    Dim mCancel As Boolean      ' Если отмена закачки
    Dim mActive As Boolean      ' Если активна закачка
     
    ' // Отмена
    Private Sub cmdCancel_Click()
        mCancel = True
    End Sub
     
    ' // Скачать файл
    Private Sub cmdDownload_Click()
        Dim ptr As Long
        ' Проверяем, идет ли уже вызов
        If WaitForSingleObject(param.hEvent, 0) = WAIT_OBJECT_0 Then
            ' Упаковываем параметры
            ptr = MT_DOWNLOAD_packParam(txtURL.Text, txtPath.Text)
            If ptr Then
                mCancel = False
                mActive = True
                ' Очистка прогрессбара
                picProgress.Cls
                ' Отправляем запрос на асинхронный вызов метода в другом потоке
                PostThreadMessage tid, WM_MT_DOWNLOAD, 0, ptr
            Else
                MsgBox "Не удалось упаковать параметры", vbCritical
            End If
        Else
            MsgBox "Скачивание еще идет", vbInformation
        End If
    End Sub
     
    ' // Окончание загрузки
    Private Sub Downloader_Complete()
        mActive = False
        MsgBox "Загрузка завершена"
    End Sub
     
    ' // Ошибка загрузки
    Private Sub Downloader_Error(ByVal Code As Long)
        mActive = False
        MsgBox "Ошибка"
    End Sub
     
    ' // Прогресс
    Private Sub Downloader_Progress(ByVal Size As Currency, ByVal TotalSize As Currency, cancel As Boolean)
        Dim sVal    As String
        Dim wTxt    As Single
        
        cancel = mCancel
        picProgress.Cls
        picProgress.Line (0, 0)-(Size / TotalSize, 1), vbRed, BF
        
        sVal = Format(Size / TotalSize, "##0%")
        wTxt = picProgress.TextWidth(sVal)
        picProgress.CurrentX = (1 - wTxt) / 2
        picProgress.CurrentY = 0
        picProgress.Print sVal
        picProgress.Refresh
        
    End Sub
     
    Private Sub Form_Initialize()
        InitCommonControlsEx 3435973.8623@
    End Sub
     
    Private Sub Form_Load()
        Dim iid As UUID
        Dim obj As MTDownloader.MultithreadDownloader
        ' Удаляем вылет Declared функций
        RemoveLastDllError
        ' Создаем синхронизирующий объект
        param.hEvent = CreateEvent(ByVal 0&, 1, 0, 0)
        ' Создаем поток
        hThread = CreateThread(ByVal 0&, 0, AddressOf ThreadProc, ByVal VarPtr(param), 0, tid)
        If hThread = 0 Then
            MsgBox "Не удалось создать поток", vbCritical
            End
        End If
        ' Ждем инициализацию объекта
        WaitForSingleObject param.hEvent, INFINITE
        ' Если успешно
        If param.IStream Then
            ' Преобразуем интерфейс в бинарную форму
            IIDFromString StrPtr(IID_MultithreadDownloader), iid
            ' Получаем отмаршаленный указатель на объект
            CoGetInterfaceAndReleaseStream param.IStream, iid, obj
            Set Downloader = obj
        Else
            MsgBox "Не удалось создать объект", vbCritical
            End
        End If
        ' Проверяем корректность инициализации объекта
        If Downloader.ErrorCode = NOT_INITIALIZE Then
            MsgBox "Объект не инициализирован", vbCritical
            End
        End If
        ' Задаем размер буфера в 100 кб
        Downloader.BufferSize = &H10000
    End Sub
     
    Private Sub Form_Unload(cancel As Integer)
        If mActive Then
            MsgBox "Идет загрузка"
            cancel = True
            Exit Sub
        End If
        If tid Then
            ' Освобождаем объект
            Set Downloader = Nothing
            ' Отправляем запрос на завершение потока
            PostThreadMessage tid, WM_QUIT, 0, 0
            ' Ждем завершение, т.к. поток ссылается на param
            WaitForSingleObject hThread, INFINITE
            ' Закрываем описатели
            CloseHandle hThread
            CloseHandle param.hEvent
        End If
    End Sub
    Standart module:
    Code:
    ' modMain.bas - главный модуль загрузчика
    ' © Кривоус Анатолий Анатольевич (The trick), 2014
     
    Option Explicit
     
    Public Type POINTAPI
        x   As Long
        y   As Long
    End Type
    Public Type msg
        hwnd    As Long
        message As Long
        wParam  As Long
        lParam  As Long
        time    As Long
        pt      As POINTAPI
    End Type
    Public Type UUID
        Data1           As Long
        Data2           As Integer
        Data3           As Integer
        Data4(0 To 7)   As Byte
    End Type
     
    Public Declare Function GetMessage Lib "user32" Alias "GetMessageW" (lpMsg As msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
    Public Declare Function TranslateMessage Lib "user32" (lpMsg As msg) As Long
    Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageW" (lpMsg As msg) As Long
    Public Declare Function PostThreadMessage Lib "user32" Alias "PostThreadMessageW" (ByVal idThread As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Public Declare Function GetMem1 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
    Public Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
    Public Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long
    Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
    Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
    Public Declare Function CoInitialize Lib "ole32" (pvReserved As Any) As Long
    Public Declare Function CoUninitialize Lib "ole32" () As Long
    Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Long, pclsid As UUID) As Long
    Public Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, lpiid As UUID) As Long
    Public Declare Function CoCreateInstance Lib "ole32" (rclsid As UUID, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, riid As UUID, ppv As Any) As Long
    Public Declare Function CoMarshalInterThreadInterfaceInStream Lib "ole32.dll" (riid As UUID, ByVal pUnk As IUnknown, ppStm As Long) As Long
    Public Declare Function CoGetInterfaceAndReleaseStream Lib "ole32.dll" (ByVal pStm As Long, riid As UUID, pUnk As Any) As Long
    Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
    Public Declare Function SetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
    Public Declare Function ResetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
    Public Declare Function CreateEvent Lib "kernel32" Alias "CreateEventW" (lpEventAttributes As Any, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As Long) As Long
    Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (lpString1 As Any, lpString2 As Any) As Long
    Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (lpString As Any) As Long
    Public Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
    Public Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
    Public Declare Function GetProcessHeap Lib "kernel32" () As Long
    Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Public Declare Function InitCommonControlsEx Lib "comctl32" (icc As Any) As Long
     
    Public Const CLSCTX_INPROC_SERVER           As Long = 1
    Public Const PAGE_EXECUTE_READWRITE         As Long = &H40&
    Public Const CLSID_MultithreadDownloader    As String = "{20FAEF52-0D1D-444B-BBAE-21240219905B}"
    Public Const IID_MultithreadDownloader      As String = "{DF3BDB52-3380-4B78-B691-4138300DD304}"
    Public Const WM_APP                         As Long = &H8000&
    Public Const WM_QUIT                        As Long = &H12
    Public Const WM_MT_DOWNLOAD                 As Long = WM_APP    ' Сообщение потоку чтобы вызвать метод
    Public Const INFINITE                       As Long = -1&
    Public Const WAIT_OBJECT_0                  As Long = 0
     
    Public Type ThreadData
        hEvent  As Long     ' Объект синхронизации
        IStream As Long     ' Объект потока, получающий ссылку на отмаршалленый объект MultithreadDownloader
    End Type
     
    ' // Удаляем вылеты Declare функций, жертвуя Err.LastDllError
    ' // Если использовать tlb, то не нужна.
    Public Sub RemoveLastDllError()
        Dim hMod    As Long
        Dim lpProc  As Long
        ' Получаем адрес функции __vbaSetSystemError
        hMod = GetModuleHandle(StrPtr("msvbvm60"))
        lpProc = GetProcAddress(hMod, "__vbaSetSystemError")
        ' Делаем ret
        VirtualProtect lpProc, 1, PAGE_EXECUTE_READWRITE, 0
        GetMem1 &HC3, ByVal lpProc
    End Sub
     
    ' // Функция потока
    Public Function ThreadProc(value As ThreadData) As Long
        Dim clsid   As UUID
        Dim iid     As UUID
        Dim obj     As MTDownloader.MultithreadDownloader
     
        ' Инициализируем COM
        CoInitialize ByVal 0&
        ' Инициализируем CLSID и IID для создания и управления объектом
        IIDFromString StrPtr(IID_MultithreadDownloader), iid
        CLSIDFromString StrPtr(CLSID_MultithreadDownloader), clsid
        ' Создаем объект MTDownloader.MultithreadDownloader
        If CoCreateInstance(clsid, 0, CLSCTX_INPROC_SERVER, iid, obj) = 0 Then
            ' Маршаллинг для отлова событий в другом потоке
            CoMarshalInterThreadInterfaceInStream iid, obj, value.IStream
            ' Объект инициализирован
            SetEvent value.hEvent
        Else
            ' Объект не инициализирован
            SetEvent value.hEvent
            ' Деинициализация
            CoUninitialize
            ' Выход
            Exit Function
        End If
        
        Dim msg As msg
        Dim ret As Long
        Dim URL As String
        Dim fle As String
        
        ' Цикл обработки сообщений в новом потоке
        Do
            ret = GetMessage(msg, 0, 0, 0)
            If ret = -1 Or ret = 0 Then Exit Do
            ' Проверяем сообщения
            Select Case msg.message
            Case WM_MT_DOWNLOAD
                ' Получаем запакованные параметры, они лежат последовательно
                ret = lstrlen(ByVal msg.lParam)
                URL = Space(ret)
                lstrcpy ByVal StrPtr(URL), ByVal msg.lParam
                ret = lstrlen(ByVal msg.lParam + (ret + 1) * 2)
                fle = Space(ret)
                lstrcpy ByVal StrPtr(fle), ByVal msg.lParam + LenB(URL) + 2
                ' Сбрасываем событие, чтобы нельзя было вызвать метод еще раз пока не отработает предыдущий вызов
                ResetEvent value.hEvent
                ' Вызываем метод
                obj.Download URL, fle
                ' Устанавливаем событие - объект свободен
                SetEvent value.hEvent
                ' Очищаем параметры
                HeapFree GetProcessHeap(), 0, ByVal msg.lParam
            Case Else
                TranslateMessage msg
                DispatchMessage msg
            End Select
        Loop
        
        ' Удаляем объекты
        Set obj = Nothing
        ' Деинициализация
        CoUninitialize
        
    End Function
     
    ' // Упаковка параметров последовательно
    Public Function MT_DOWNLOAD_packParam(URL As String, fileName As String) As Long
        MT_DOWNLOAD_packParam = HeapAlloc(GetProcessHeap(), 0, LenB(URL) + LenB(fileName) + 4)
        If MT_DOWNLOAD_packParam Then
            lstrcpy ByVal MT_DOWNLOAD_packParam, ByVal StrPtr(URL)
            lstrcpy ByVal MT_DOWNLOAD_packParam + LenB(URL) + 2, ByVal StrPtr(fileName)
        End If
    End Function

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Multithreading in VB6 Part 1

    We examine in detail the code. When loading forms (Form_Load), we patch the runtime error to exclude the use Declared functions in an uninitialized flow (RemoveLastDllError). The principle I described above. If we create an object in another thread, we need to somehow check in the main thread, whether to create the object. For this, I use a simple synchronization objects - an event with manual reset. Initialize it in a reset state. Then create a stream function ThreadProc, as a parameter to pass the structure of sync events and links to the stream object (Stream), which need to be marshaled. This object returns a reference to marshal a pointer to the object. If successful, forward trigger events (WaitForSingleObject). On this main thread suspends execution until we establish event hEvent. In a new thread first initialize COM (CoInitialize), translate the CLSID and IID in binary form, create an object (CoCreateInstance). Here, if you do not need error handling, you can use:
    Code:
    CreateObject("MTDownloader.MultithreadDownloader")
    In this code to create an object I used CoCreateInstance, as before the creation of the first object we can not include error handling (the reason described above), after the creation of the first object can be further create objects through "CreateObject". If the error handling is not necessary, you can immediately use CreateObject. If successful, marshals for this call the "CoMarshalInterThreadInterfaceInStream", which writes the Stream (stream) information to create a proxy object in another thread. Set the event, thereby indicate the main flow of the initialization was successful. On failure, and set the event and perform deinitialization "COM" in the stream output (flow completed). A sign of a successful initialization becomes a pointer to the IStream. Further, in this stream to enter the standard loop. Because we have established event, the main flow and wakes up, we check whether successfully passed the initialization. If "IStream" contains a pointer, then all is well, otherwise an error. Then get a pointer to a proxy object from the stream by calling "CoGetInterfaceAndReleaseStream", thus also release the object "Stream". Assign our object variable, subscribe to the event, a pointer to a proxy object. All these manipulations we can now access the object in another thread and receive events from it. Check whether correctly initialized object itself (hInternet <> 0), and set the buffer size to 64 KB, the information will be updated when the next batch of uploaded data in 64 KB. The initialization is completed. To it was impossible to perform several queries on the download, we will synchronize requests to create an event. Otherwise, if just a few clicks on the button Download, the data will be downloaded sequentially, if mistakenly press 2 times, then the file will be downloaded 2 times and overwritten, the error will not. When pressed we check the status of the event, if it is established that download in the moment. To transfer data to another stream, perform transportation (marshalling) parameters in the other thread (MT_DOWNLOAD_packParam). To do this, allocate memory on the heap and copy the data (in this case the URL and FileName) into it, and give a link to the newly created thread. I decided to save the easiest way - 2 unicode-strings series with a trailing null terminals. A reference to the parameters in turn flow through PostThreadMessage, as the number of the message using the first free identifier WM_APP, which I called WM_MT_DOWNLOAD. In another thread in the cycle, when receiving a message WM_MT_DOWNLOAD, take out the parameters of the heap and invokes the Download, pre-reset event hEvent. All. While a method we can not call him again, and thanks marshaled we receive notification from the object as the events in the main stream. Event handlers elementary and self-explanatory. The only thing that I want to add that the file size I selected Currency, as 64-bit integers no, but it's almost Currency same, only divided by 1000010.
    In addition to the asynchronous calls have also remains the possibility of a synchronous call, that is, in the form code can legitimately write "Downloader.Download URL, FileName". You can compare the advantages and disadvantages of synchronous and asynchronous calls.* Example does not require registration of ActiveX DLL, enough to put it in the same folder thanks to the manifesto. As a result, we have a multi-threaded application that runs on any machine without prompting the admin rights.
    _____________________________________________
    Multithreading on VB6 real and feasibility. In this article, I described a method of creating an object in a separate thread and subscribe to its events. If we do not need to have a connection with different object streams, the code is repeatedly shortened (retracted cycle, marshaling, etc.); You can even create an object in inline assembly - that will limit the debug this code in the IDE. But all these methods I describe it some other time. Good luck to everyone!

    TrickMTDownloader.zip

  4. #4
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,468

    Re: [VB6] - Multithreading in VB6 part 1

    I had previously asked the question of how to tell if threads use different CPU cores when available. To answer that question, I modified TrickMTDownloader to service 2 separate threads. I then started a download of a 180 MB jpeg, and quickly started a simple page file, with the following results.
    Start 1 31833.39
    Start 2 31833.82
    End 2 31833.85
    End 1 31833.9
    Download 1 is a 180 KB file - elapsed time 510 ms
    Download 2 is a 1 KB file - elapsed time 30 ms
    I am assuming that this means the second download runs on a different CPU core.

    I then compiled the program and ran the test again. The results were pretty much the same, indicating that network speed was the limiting factor. I have only included the test program in the attached download. To run this program you will need the registered ActiveX DLL program from the trick download.

    I used arrays for most of the download variables, but I had difficulty with the Downloader object. I left most of the translated comments in place.

    J.A. Coutts
    Attached Files Attached Files

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