Используя несколько потоков, у нас появляется возможность вызывать методы асинхронно, с сохранением синхронности; т.е. мы сможем вызывать методы как и в отдельном потоке, так и в своем. Например методы требующие большой вычислительной загрузки стоит вызывать асинхронно и получать, при окончании, уведомление в виде события. Такие методы (свойства) которые работают быстро, можно вызывать синхронно.
Одна из проблем создания потока на 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. Но все эти приемы я опишу как-нибудь в другой раз. Всем удачи!
