На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
! Правила раздела Visual Basic: Общие вопросы
Здесь обсуждаются вопросы по языку Visual Basic 1-6 (а так же по схожим языкам, как, например, PowerBASIC).
Вопросы по Visual Basic .NET (это который входит в состав Visual Studio 2002/2003/2005/2008+, для тех, кто не в курсе) обсуждаются в разделе .NET.

Обратите внимание:
1. Прежде чем начать новую тему или отправить сообщение, убедитесь, что Вы не нарушаете правил форума!
2. Обязательно воспользуйтесь поиском. Возможно, Ваш вопрос уже обсуждали. Полезные ссылки приведены ниже.
3. Темы с просьбой выполнить какую-либо работу за автора в этом разделе не обсуждаются. Студенты, вам сюда: ПОМОЩЬ СТУДЕНТАМ!
4. Используйте теги [ code=vba ] ...текст программы... [ /code ] для выделения текста программы подсветкой.
5. Помните, здесь телепатов нет. Формулируйте свой вопрос максимально грамотно и чётко: Как правильно задавать вопросы
6. Запрещено отвечать в темы месячной (и более) давности, без веских на то причин.

Полезные ссылки:
user posted image FAQ Сайта user posted image FAQ Раздела user posted image Кладовка user posted image Наши Исходники user posted image API-Guide user posted image Поиск по Разделу user posted image MSDN Library Online user posted image Google
Ваше мнение о модераторах: user posted image SCINER, user posted image B.V.
Модераторы: SCINER, B.V.
Ссылки по теме:
  
> Многопоточность в VB6 часть 1 , Создание объекта в другом потоке и подписка на события.
TheTrik
Сообщ. #1 ,
    Full Member
    ***
    Профиль · PM
    Поощрения: 10 Dgm
    Рейтинг (т): 29
    Всем привет. Сегодня я расскажу о многопоточности в 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 с помощью которой можно скачать файл из сети, которая имеет несколько методов и генерирует события.
    ExpandedWrap disabled
      ' Класс 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 для гарантированного запуска приложения.
    Код клиентского приложения:
    Форма -
    ExpandedWrap disabled
      ' 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

    Модуль -
    ExpandedWrap disabled
      ' 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). Здесь, если не нужна обработка ошибок, то можно использовать
    ExpandedWrap disabled
      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).
    Помимо асинхронных вызовов у нас также остается возможность синхронного вызова, т.е. в коде формы вполне законно можем написать
    ExpandedWrap disabled
      Downloader.Download URL, FileName
    . Можно сравнить преимущества и недостатки асинхронноги и синхронного вызовов.
    Пример не требует регистрации ActiveX DLL, достаточно положить ее в ту же папку благодаря манифесту. В итоге имеем многопоточное приложение которое работает на любой машине без запроса админских прав.
    user posted image

    _____________________________________________

    Многопоточность на VB6 реальна, и практически реализуема. В этой части я описал метод создания объекта в отдельном потоке и подписку на его события. Если нам не нужно иметь связи с объектом в разных потоках, то код многократно укорачивается (убирается цикл обработки, маршалинг и т.п.); можно даже создать объект в ассемблерной вставке - что позволит ограничено отлаживать такой код в IDE. Но все эти приемы я опишу как-нибудь в другой раз. Всем удачи!
    Прикреплённый файлПрикреплённый файлTrickMTDownloader.rar (43,47 Кбайт, скачиваний: 117)
    Сообщение отредактировано: TheTrik -
    1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)
    0 пользователей:


    Рейтинг@Mail.ru
    [ Script execution time: 0,0905 ]   [ 16 queries used ]   [ Generated: 14.07.25, 03:56 GMT ]  
    Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.