Многопоточность в VB6 часть 1

Автор обещает много интересных штучек.

Модератор: The trick

The trick
Постоялец
Постоялец
 
Сообщения: 774
Зарегистрирован: 26.06.2010 (Сб) 23:08

Многопоточность в VB6 часть 1

Сообщение The trick » 11.11.2014 (Вт) 12:17

Всем привет. Сегодня я расскажу о многопоточности в VB6. Писать многопоточные программы на VB6 вполне реально, но существуют ограничения, которые так или иначе можно обойти. Рассмотрим более правильный (с точки зрения программирования на VB6) метод многопоточности с использованием объектов. В данном методе нет никаких ограничений, в отличии от многопоточности в Standart EXE, а также есть все плюсы ООП. Также хочу сразу заметить что IDE не предназначена для отладки многопоточных программ, поэтому отлаживать такие программы в IDE не получится. Для отладки я использую другой отладчик. Также можно отдельно отлаживать потоки, а потом уже собирать EXE.
Используя несколько потоков, у нас появляется возможность вызывать методы асинхронно, с сохранением синхронности; т.е. мы сможем вызывать методы как и в отдельном потоке, так и в своем. Например методы требующие большой вычислительной загрузки стоит вызывать асинхронно и получать, при окончании, уведомление в виде события. Такие методы (свойства) которые работают быстро, можно вызывать синхронно.
Одна из проблем создания потока на VB6 в Standart EXE, является невозможность использования вызовов WinAPI функций через Declare. В отличии от функций задекларированных в библиотеки типов и попадающих в импорт, Declared-функции после каждого вызова устанавливают свойство объектной переменной Err.LastDllError. Делается это посредством вызова функции __vbaSetSystemError из MSVBVM. Объект Err, является потокозависимым, а ссылка на него находится в локальном хранилище потока (TLS). Для каждого потока должен создаваться свой объект Err, иначе при вызове функции __vbaSetSystemError, рантайм запросит ссылку из хранилища, а у нас ее там нет (точнее там 0) и произойдет чтение по неправильному адресу, как следствие вылет.
Чтобы предотвратить такое поведение, можно декларировать функции в tlb, тогда не будет вызываться функция __vbaSetSystemError. Также можно инициализировать Err объект, например создать объект из DLL в новом потоке, тогда рантайм инициализирует этот объект сам. Но для создания нового объекта, нужно сначала инициализировать поток для работы с COM, для этого нужно вызвать CoInitialize(Ex), но мы не можем вызывать функции. Можно ее задекларировать в tlb (только ее одну), тогда все честно; также можно ее вызвать из ассемблерного переходника к примеру или любым другим способом. Я всегда иду по другому. Зачем мне LastDllError? Я могу просто напросто сам вызвать GetLastError когда мне надо. Поэтому я просто нахожу адрес функции __vbaSetSystemError и пишу первой инструкцией выход из процедуры (ret). Это конечно не так красиво, но зато надежно и быстро. Можно сделать так только для одной функции CoInitialize, а потом восстановить __vbaSetSystemError.
Теперь мы можем вызывать Declared функции в новом потоке, что дает нам безграничные возможности. После создания объекта (CreateObject), мы можем вызывать его методы, свойства, получать от него события и т.д., но просто так ссылку между потоками нельзя передавать, т.к. могут возникнуть ошибки из-за одновременного доступа к данным и т.п. Для передачи ссылки между потоками существует маршалинг. Мы будем использовать универсальный маршаллер, т.к. у нас ActiveX DLL имеет в себе библиотеку типов. Принцип работы я подробно расписывать не буду, для этого есть в сети много статей. Общий смысл в том, что вместо прямого вызова метода объекта, используется RPC запрос в другой компьютер/процесс/поток. Для обработки запросов нужно использовать цикл обработки сообщений, и раз так вышло, то и связь между потоками сделаем через сообщения.
Для теста я написал простейшую ActiveX DLL с помощью которой можно скачать файл из сети, которая имеет несколько методов и генерирует события.
Код: Выделить всё
' Класс 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

Код в принципе простой, если прочитать описание API функций. При вызове метода Download, начинает выполнятся загрузка, периодически (зависит от размера буфера) генерируется событие Progress. При ошибке генерируется событие Error, и при окончании Complete. BufferSize - задает размер буфера, при заполнении которого генерируется событие. Код демонстрационный и содержит недочеты.
Класс я назвал MultithreadDownloader, а библиотеку MTDownloader, соответственно ProgID этого объекта MTDownloader.MultithreadDownloader. После компиляции получаем описание интерфейсов через OleView, PEExplorer и т.п. В моем примере CLSID = {20FAEF52-0D1D-444B-BBAE-21240219905B}, IID = {DF3BDB52-3380-4B78-B691-4138300DD304}. Также я поставил галочку RemoteServerFiles чтобы получить на выходе библиотеку типов для нашей DLL, и будем подключать ее вместо DLL для гарантированного запуска приложения.
Код клиентского приложения:
Форма -
Код: Выделить всё
' 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

Модуль -
Код: Выделить всё
' 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

Разберем подробно код. При загрузке формы (Form_Load), мы пропатчиваем рантайм для исключения ошибки использования Declared функций в неинициализированном потоке (RemoveLastDllError). Принцип я описал выше. Если мы создаем объект в другом потоке, то нам нужно как-то проверить в основном потоке, создался ли объект. Для этого я использовал простейший синхронизирующий объект - событие с ручным сбросом. Иницииализируем его в сброшенном состоянии. Далее создаем поток в функции ThreadProc, в качестве параметра передаем структуру из синхронизирующего события и ссылки на объект потока (Stream), который нужен для маршалинга. В этом объекте веренется ссылка на отмаршаленый указатель на объект. При успехе ждем срабатывания события (WaitForSingleObject). На этом основной поток приостанавливает свое выполнение пока мы не установим событие hEvent. В новом потоке сначала инициализируем COM (CoInitialize), переводим CLSID и IID в двоичную форму, создаем объект (CoCreateInstance). Здесь, если не нужна обработка ошибок, то можно использовать CreateObject("MTDownloader.MultithreadDownloader"). В данном коде для создания объекта я использовал CoCreateInstance, т.к. до создания первого объекта мы не можем включить обработку ошибок (причина описана выше), после создания первого объекта далее можно создавать через VB-шный CreateObject. Если обработка ошибок не нужна, то можно сразу использовать CreateObject. При успехе выполняем маршалинг, для этого вызываем функцию CoMarshalInterThreadInterfaceInStream, которая записывает в Stream (поток) информацию для создания прокси-объекта в другом потоке. Устанавливаем событие, этим самым говорим основному потоку что инициализация прошла. При неудаче также выставляем событие и деинициализируем COM в данном потоке, выходим (поток завершен). Признаком успешной инициализации становится ссылка IStream. Далее в этом потоке переходим к стандартному циклу обработки сообщений. Т.к. мы установили событие, основной поток просыпается и мы проверяем, успешно ли прошла инициализация. Если в IStream записана ссылка, значит все хорошо, иначе ошибка.
Далее получаем указатель на прокси объект из потока вызовом CoGetInterfaceAndReleaseStream, тем самым также освобождаем объект Stream. Присваиваем нашей объектной переменной, подписанной на события, указатель на прокси-объект. Всеми этими манипуляциями теперь мы можем обращаться к объекту в другом потоке и получать от него события. Проверяем корректно ли инициализировался сам объект (hInternet<>0), и устанавливаем размер буфера в 64 кб, информация будет обновляться при очередной порции закаченных данных в 64 кБ. На этом инициализация закончена.
Для того, чтобы нельзя было выполнить несколько запросов на закачку, мы будем синхронизировать запросы по созданному событию. Иначе просто если несколько раз щелкнуть на кнопке Download, то данные будут закачиваться последовательно, если ошибочно нажать 2 раза, то файл скачается 2 раза и перезапишется, ошибок не будет. При нажатии мы проверяем статус события, если оно установлено то закачки в данной момент нет. Для передачи данных в другой поток, выполним транспортировку (маршалинг) параметров в другой поток (MT_DOWNLOAD_packParam). Для этого выделим память в куче и скопируем данные (в нашем случае URL и FileName) в нее, а ссылку передадим в созданный поток. Сохранять я решил самым простым способом - 2 unicode-строки последовательно с завершающими нуль-терминалами. Передаем ссылку на параметры в очередь потока через PostThreadMessage, в качестве номера сообщения используем первый незанятый идентификатор WM_APP, который я назвал WM_MT_DOWNLOAD. В другом потоке в цикле, при получении сообщения WM_MT_DOWNLOAD, вытаскиваем параметры из кучи и вызываем метод Download, предварительно сбросив событие hEvent. Все. Пока выполняется метод мы не сможем вызвать его опять, а благодаря маршалингу мы получаем уведомления от объекта в виде событий в основном потоке. Обработчики событий элементарные и в пояснениях не нуждаются. Единственное что хочу добавить, что для размера файла я выбрал Currency, т.к. 64-битных целых чисел нет, а Currency это почти тоже самое, только деленное на 10000(10).
Помимо асинхронных вызовов у нас также остается возможность синхронного вызова, т.е. в коде формы вполне законно можем написать Downloader.Download URL, FileName. Можно сравнить преимущества и недостатки асинхронноги и синхронного вызовов.
Пример не требует регистрации ActiveX DLL, достаточно положить ее в ту же папку благодаря манифесту. В итоге имеем многопоточное приложение которое работает на любой машине без запроса админских прав.
Изображение
_____________________________________________

Многопоточность на VB6 реальна, и практически реализуема. В этой части я описал метод создания объекта в отдельном потоке и подписку на его события. Если нам не нужно иметь связи с объектом в разных потоках, то код многократно укорачивается (убирается цикл обработки, маршалинг и т.п.); можно даже создать объект в ассемблерной вставке - что позволит ограничено отлаживать такой код в IDE. Но все эти приемы я опишу как-нибудь в другой раз. Всем удачи!
Вложения
TrickMTDownloader.zip
(48.06 Кб) Скачиваний: 183
UA6527P

Вернуться в The trick

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 4

    TopList