callback вызывается из произвольного потока

[sosed213]

Всем привет.
После длительного перерыва, снова сел за VB6. Появилось желание доделать старый проект.

Существует библиотека WIMGAPI.DLL для работы с wim-файлами. (создание и развертывание образа ОС Windows)

Чтобы применить(развернуть, распаковать) wim-образ, нужно вызвать функцию WIMApplyImage. Процесс применения может длится несколько минут, и чтобы программа не зависла при выполнении этой функции, предварительно нужно зарегистрировать CallBack, в котором можно вызвать DoEvents, посмотреть прогресс, и другие данные.

Проблема в том что callback вызывается (по видимому) из другого потока, и в IDE происходит крах. В скомпилированном виде почти всегда работает работает без падения программы.
Если не использовать CallBack, то функция WIMApplyImage всегда выполняется нормально, но при этом проект зависает до тех пор пока функция выполнится.

К сожалению моих знаний пока не хватает чтобы придумать как правильно вызвать функцию WIMApplyImage, чтобы проект не зависал, и CallBack корректно (без падений IDE) отрабатывал.

Пока есть только одна идея: каким то образом запускать WIMApplyImage и CallBack в отдельном потоке (возможно не корректно выразился). Про создание потоков уже достаточно много почитал на разных ресурсах, и пока в голове нет четкого представления как это реализовать.

Вот собственно я и обращаюсь за помощью.

Код который составил согласно официальной документации.

Код: Выделить всё

Option Explicit

Public Const WIM_MSG_SUCCESS        As Long = &H0
Public Const WIM_MSG_PROGRESS       As Long = 38008
Public Const WIM_MSG_ABORT_IMAGE    As Long = &HFFFFFFFF

Public Const WIM_GENERIC_READ       As Long = &H80000000
Public Const WIM_OPEN_EXISTING      As Long = &H3

Public Const WIM_COMPRESS_NONE      As Byte = 0

Public Const WIM_FLAG_NO_RP_FIX     As Long = &H100
Public Const WIM_FLAG_VERIFY        As Long = &H2

Public Declare Function WIMCloseHandle Lib "WIMGAPI.DLL" (ByVal hObject As Long) As Boolean

Public Declare Function WIMCreateFile Lib "WIMGAPI.DLL" ( _
    ByVal lpszWimPath As Long, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal dwCompressionType As Long, _
    ByRef CreationResult As Long) As Long
   
Public Declare Function WIMGetImageInformation Lib "WIMGAPI.DLL" ( _
    ByVal hImage As Long, _
    ByRef ppvImageInfo As Long, _
    ByRef pcbImageInfo As Long) As Long

Public Declare Function WIMSetTemporaryPath Lib "WIMGAPI.DLL" ( _
    ByVal hWim As Long, _
    ByVal lpszPath As Long) As Boolean

Public Declare Function WIMLoadImage Lib "WIMGAPI.DLL" ( _
    ByVal hWim As Long, _
    ByVal dwImageIndex As Long) As Long

Public Declare Function WIMApplyImage Lib "WIMGAPI.DLL" ( _
    ByVal hImage As Long, _
    ByVal lpszPath As Long, _
    ByVal dzApplyFlags As Long) As Boolean

Public Declare Function WIMRegisterMessageCallback Lib "WIMGAPI.DLL" ( _
    ByVal hWim As Long, _
    ByVal fpMessageProc As Long, _
    ByVal pvUserData As Long) As Long
   
Public Declare Function WIMUnregisterMessageCallback Lib "WIMGAPI.DLL" ( _
    ByVal hWim As Long, _
    ByVal fpMessageProc As Long) As Boolean



    Public hWim As Long
    Public hImage As Long
    Public AplyCancel As Boolean
    Public bIsInIDE    As Boolean
    Public nTime As Long


Public Sub TestWIMGAPI2()
    Dim wimFilePath As String
    wimFilePath = "D:\test\install.wim"
   
    Dim wimFileTMPPath As String
    wimFileTMPPath = "D:\test\tmp"
   
    Dim strApplyPath As String
    strApplyPath = "D:\test\OS"


    Dim status As Boolean
    Dim MyStr As String
    Dim LInfo As Long
    Dim PInfo As Long
    Dim retCreate As Long
    Dim nRet As Long

    hWim = WIMCreateFile( _
        ByVal StrPtr(wimFilePath), _
        WIM_GENERIC_READ, _
        WIM_OPEN_EXISTING, _
        0, _
        WIM_COMPRESS_NONE, _
        ByVal VarPtr(retCreate))
   
   
    nRet = 0
    nRet = WIMGetImageInformation(ByVal hWim, ByVal VarPtr(PInfo), ByVal VarPtr(LInfo))
    Debug.Print "WIMGetImageInformation: " & nRet
   
    nRet = 0
    nRet = WIMSetTemporaryPath(hWim, ByVal StrPtr(wimFileTMPPath))
    Debug.Print "WIMSetTemporaryPath: " & nRet
   
    hImage = WIMLoadImage(hWim, 1)
   
   
   
    nRet = 0
    nRet = WIMRegisterMessageCallback(hWim, AddressOf WIMMessageCallback, 0)
    Debug.Print "RegisterMessageCallback: " & nRet

   
    AplyCancel = False

    Dim nFlag As Long
    nFlag = 0
   
   nFlag = WIM_FLAG_VERIFY Or WIM_FLAG_NO_RP_FIX
   

   Debug.Print "ApplyImage: " & WIMApplyImage(hImage, ByVal StrPtr(strApplyPath), nFlag)



    nRet = 0
    nRet = WIMUnregisterMessageCallback(hWim, AddressOf WIMMessageCallback)
    Debug.Print "WIMUnregisterMessageCallback: " & nRet

    WIMCloseHandle (hImage)
    WIMCloseHandle (hWim)
End Sub



Public Function WIMMessageCallback(ByVal dwMessageId As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal pvUserData As Long) As Long
    Select Case dwMessageId
    Case WIM_MSG_PROGRESS
        Debug.Print "WIM_MSG_PROGRESS: " & wParam & " / " & lParam
    Case Else
        Debug.Print dwMessageId & " / " & wParam & " / " & lParam
    End Select
   
    WIMMessageCallback = WIM_MSG_SUCCESS
   
    If AplyCancel = True Then WIMMessageCallback = WIM_MSG_ABORT_IMAGE
   
    DoEvents
   
End Function


[The trick]

viewtopic.php?f=99&t=56444

Там как раз есть примеры обработки вызовов из разных потоков. Работает в IDE.

[sosed213]

Да, я видел ваш проект, и даже пробовал использовать. Но с первого подхода у меня ничего не получилось.

[The trick]

Я не телепат, поэтому не могу сказать в чем дело. Показывай свои попытки.

[sosed213]

"Попытки" заключались в том, чтобы разобраться в коде и выделить скелет. За основу взял пример InternetStatusCalback.

[The trick]

Ну скинь код который не работает, который ты пытался реализовать с помощью моего модуля.

[sosed213]

Прикладываю архив с проектом.
Что я изменил в исходном проекте: Отключил компонент comctl32, убрал массив очередей, отключил таймер, попытался внедрить свой код.
При нажатии кнопки ApplyImage, образ применяется но нет обратного вызова.
В скомпилированном виде, всплывает окно с ошибкой:
Run-time error '91':
Object variable or With block variable not set

[The trick]

Не могу проверить работоспособность кода в данный момент, но вижу несколько ошибок.
Во-первых,

Код: Выделить всё

   Dim bIsInIDE As Boolean
   
   Debug.Assert MakeTrue(bIsInIDE)
   
    ' // Setup callback
    If bIsInIDE Then
        m_pfnPrevCallback = WIMRegisterMessageCallback(hWim, InitCurrentThreadAndCallFunctionIDEProc( _
                                                                  AddressOf WIMMessageCallback, 16), 0)
    Else
        m_pfnPrevCallback = WIMRegisterMessageCallback(hWim, AddressOf WIMMessageCallbackEXE, 0)
    End If

У тебя 4 DWORD переменные, что соответствует 16 байтам, также для IDE нужно вызывать через InitCurrentThreadAndCallFunctionIDEProc (у тебя пропущен Debug.Assert...).

Во-вторых, функция WIMMessageCallback должна выглядеть так:

Код: Выделить всё

Public Type tWIMMessageCallbackParams
    dwMessageId As Long
    wParam As Long
    lParam As Long
    pvUserData As Long
End Type

...

Function WIMMessageCallback(ByRef tParam as tWIMMessageCallbackParams) As Long

...

Также ты нарушаешь одно из правил COM - маршалинг. Нельзя в процедуре обращаться к объектам из других апартментов без маршалинга. Ты обращаетшься к m_cRequestsQueue.hWndAsync.

[sosed213]

Да, такой вариант я тоже пробовал, но результат пока один и тот же.

Прикрепляю архив. То на чем остановился.
При распаковывании образа, проект зависает (процесс развертывания прекращается). Можно ли в CallBack вставлять DoEvents?

Для проверки кода нужно задать 3 переменных:
wimFilePath = "r:\install.wim" ' Файл образ
wimFileTMPPath = "r:\tmp\" ' Путь к временной папке
strApplyPath = "w:\" ' Путь, куда распаковать образ

[The trick]

Так делать неверно. Если у тебя функция блокирует поток, то нужно ее вызывать в другом потоке, которой не обслуживает GUI. Колбеки соответственно в 3-м потоке будут. В IDE это будет в любом случае с блокировкой работать, поскольку все вызовы перенаправляются в главный поток. Так делай в IDE - блокирующий режим, в EXE все по потокам распределяй. У меня нет wim файла чтобы протестировать, никогда не работал с ними, поэтому рабочего семпла не могу предоставить.

[Хакер]

Есть целый ряд направлений решения этой проблемы. Разберём некоторые:

• Не можешь освоить многопоточность (а в VB это та ещё задача) — обуздай многопроцессность. Т.е. можно вызов блокирующей функции (WIMApplyImage) вынести в отдельный процесс и запускать его. Не обязательно для этого носить рядом второй exe-файл, достаточно запускать самого себя с каким-нибдуь ключом.
  
  
• Можно обернуть обернуть работу с той библиотекой в ActiveX EXE-сервер. По сути это развитие предыдущего варианта, но бонус в том, что появится объектно-ориентированная обёртка, которая обеспечивает асинхронность вызова WIMApplyImage. Иными словами, будет объект с методом StartApplying и событием ApplyingFinished.
  
• Можно просто обернуть работу с той DLL в виде COM-сервера (написать его придётся на С++). Тот же внешний вид, что и в предыдущем пункте, но вместо EXE имеем DLL.
  
• Не плохо бы связаться с разработчиками той DLL и спросить, является ли библиотека потоко-безопасной и можно ли хендл, созданный в одном потоке, потом использовать для вызова каких-то других функций из другого потока. Если возможности связаться нет, можно выяснить это, пореверсив библиотеку. Если запрета на такой способ работы нет, то можно чисто WIMApplyImage вызывать через микро-обёрточку прямо через CreateThread. От callback-ов придётся отказаться.
  
• Развитие предыдущего пункта: не отказываться от механихма callback-ов, а в качестве ф-ции callback-а указывать микро-переходничек, транслирующий входящий вызов в отправку оконного сообщения главного потока. Причём тут есть два варианта: чисто уведомительный порядок работы, при котором обработчик события в главном потоке не сможет передать исходному потоку своё решение относительно продолжения работы, или полноценная пердеча сигнала о событии и сигнала о реакции на событие (в две стороны). Во втором случае надо озаботиться о возможности возникновения дедлоков. Если главный поток заснёт в ожижании какого-то монопольного ресурса, занятого дочерним потоком, а дочершний поток решить уведомить главный и дождаться ответа, то всё это зависнет навечно.

[sosed213]

Идея в том чтобы в работе был всего один exe-файл. Идея с запуском самого себя но с другими параметрами мне понравилась, и оставлю её на крайний случай.

Как сказал The trick "нужно ее (функцию WIMApplyImage) вызывать в другом потоке, которой не обслуживает GUI. Колбеки соответственно в 3-м потоке будут", примерно так я себе это и представлял. Но не хватает конкретного примера. Callback-важен для информативности прогресса, от него нельзя избавиться. Блокирование в IDE, принципе не критично, лишь бы не зависало навсегда.

Если не сложно скачать 500мб то выкладываю тестовый wim-образ, (это среда установки win10, хотя для теста сойдет любой wim-образ).

Идея "обернуть работу с той DLL в виде COM-сервера (написать его придётся на С++)", мне тоже понравилась, особенно если потом эту dll, поместить в ресурсы, и работать с ней из памяти. Или хотя бы таскать рядом с exe. Но писать на С++ я не умею, к сожалению.

C ActiveX EXE, я пока не работал, и не знаю на что он способен. Будет ли он работать/запускаться как обычный exe-проект, но с дополнительными возможностями в виде объектов и методов, или он все-же как пассивная dll-ка?

Еще один вариант мне понравился: "чисто WIMApplyImage вызывать через микро-обёрточку прямо через CreateThread, а в качестве ф-ции callback-а указывать микро-переходничек, транслирующий входящий вызов в отправку оконного сообщения главного потока, с полноценной передачей сигнала о событии и сигнала о реакции на событие (в две стороны)". Звучит круто, но пока нет представления как это реализовать.

[The trick]

Сделал небольшой проект, в котором объект для работы с образом создается в другом потоке, а колбеки принимаются в разных потоках:
Класс CWIMImage:

Код: Выделить всё

Option Explicit

Private m_sFilePath         As String
Private m_sTempPath         As String
Private m_bTempChanged      As Boolean
Private m_sApplyPath        As String
Private m_hWimFile          As OLE_HANDLE
Private m_hCurImage         As OLE_HANDLE
Private m_pAbortFlagAddr    As Long

Public Property Let AbortFlagAddress( _
                    ByVal pValue As Long)
    m_pAbortFlagAddr = pValue
End Property
Public Property Get AbortFlagAddress() As Long
    AbortFlagAddress = m_pAbortFlagAddr
End Property

Public Property Get FilePath() As String
    FilePath = m_sFilePath
End Property

Public Property Let TempPath( _
                    ByRef sValue As String)
   
    If m_hWimFile Then
   
        If WIMSetTemporaryPath(m_hWimFile, StrPtr(sValue)) = 0 Then
            PutLog "WIMSetTemporaryPath failed " & Err.LastDllError
            Err.Raise 7
        End If
       
        m_bTempChanged = False
       
    Else
        m_bTempChanged = True
    End If
   
    m_sTempPath = sValue
   
End Property
Public Property Get TempPath() As String
    TempPath = m_sTempPath
End Property

Public Property Let ApplyPath( _
                    ByRef sValue As String)
    m_sApplyPath = sValue
End Property
Public Property Get ApplyPath() As String
    ApplyPath = m_sApplyPath
End Property

Public Property Get Information() As String
    Dim pImageInfo      As Long
    Dim lImageInfoSize  As Long
   
    If m_hWimFile = 0 Then
        Err.Raise 5
    End If
   
    If WIMGetImageInformation(m_hWimFile, pImageInfo, lImageInfoSize) Then
   
        If pImageInfo <> 0 And lImageInfoSize > 0 Then
           
            PutMem4 ByVal VarPtr(Information), SysAllocStringByteLen(ByVal pImageInfo, lImageInfoSize)
           
        End If
       
        LocalFree pImageInfo
       
    Else
        Err.Raise 7
    End If
   
End Property

Public Sub LoadFile( _
           ByRef sPath As String)
                   
    CloseAll
                   
    m_hWimFile = WIMCreateFile(StrPtr(sPath), WIM_GENERIC_READ, WIM_OPEN_EXISTING, 0, WIM_COMPRESS_NONE, 0)
   
    If m_hWimFile = 0 Then
        PutLog "WIMCreateFile failed " & Err.LastDllError
        Err.Raise 7
    End If
               
    m_sFilePath = sPath
               
End Sub

Public Sub LoadImage( _
           ByVal lOneBaseImgIndex As Long)
    Dim hImage  As OLE_HANDLE
   
    If m_hWimFile = 0 Then
        Err.Raise 5
    End If
   
    If m_bTempChanged Then
   
        If WIMSetTemporaryPath(m_hWimFile, StrPtr(m_sTempPath)) = 0 Then
            PutLog "WIMSetTemporaryPath failed " & Err.LastDllError
            Err.Raise 7
        End If
       
        m_bTempChanged = False
       
    End If
   
    hImage = WIMLoadImage(m_hWimFile, lOneBaseImgIndex)
   
    If hImage = 0 Then
        PutLog "WIMLoadImage failed " & Err.LastDllError
        Err.Raise 7
    End If
           
    If m_hCurImage Then
        WIMCloseHandle m_hCurImage
    End If
           
    m_hCurImage = hImage
   
End Sub

Public Sub Apply()
    Dim bIsInIDE    As Boolean
    Dim pfnCallback As Long
   
    Debug.Assert PutMem2(bIsInIDE, -1) = 0
   
    If m_hWimFile = 0 Or m_hCurImage = 0 Then
        Err.Raise 5
    End If
   
    If Len(m_sApplyPath) = 0 Or Len(m_sTempPath) = 0 Then
        Err.Raise 5
    End If
   
    PutLog "Start"
   
    If Not bIsInIDE Then
        If WIMRegisterMessageCallback(m_hWimFile, AddressOf WIMMessageCallback, m_pAbortFlagAddr) = INVALID_CALLBACK_VALUE Then
            PutLog "WIMRegisterMessageCallback failed " & Err.LastDllError
            Err.Raise 7
        End If
    End If
   
    If WIMApplyImage(m_hCurImage, StrPtr(m_sApplyPath), WIM_FLAG_VERIFY Or WIM_FLAG_NO_RP_FIX) = 0 Then
        PutLog "WIMApplyImage failed " & Err.LastDllError
        Err.Raise 7
    End If
   
    If Not bIsInIDE Then
        WIMUnregisterMessageCallback m_hWimFile, AddressOf WIMMessageCallback
    End If
   
    PutLog "Finish"
   
End Sub

Private Sub CloseAll()
   
    If m_hCurImage Then
        WIMCloseHandle m_hCurImage
        m_hCurImage = 0
    End If
   
    If m_hWimFile Then
        WIMCloseHandle m_hWimFile
        m_hWimFile = 0
    End If
   
End Sub

Private Sub Class_Terminate()
    CloseAll
End Sub


В IDE этот класс отрабатывает в главном потоке и без колбеков, так что вызов в IDE блокирующий и без лога. В скомпилированном варианте объект создается в новом потоке:

Код: Выделить всё

. . .

        ' // Create object in new thread
        Set m_cWimImage = CreatePrivateObjectByNameInNewThread("CWIMImage", , m_lAsyncID)
       
        m_cWimImage.TempPath = txtTempPath.Text
        m_cWimImage.ApplyPath = txtApplyPath.Text
        m_cWimImage.AbortFlagAddress = VarPtr(m_bAbort)
        m_cWimImage.LoadFile txtPath.Text
        m_cWimImage.LoadImage 1
       
        txtImageinfo.Text = m_cWimImage.Information
       
        m_bIsInProgress = True
       
        cmdApply.Caption = "Abort"
       
        ' // Async call
        AsynchDispMethodCall m_lAsyncID, "Apply", VbMethod, Me, "Applied"

. . .


Через AsynchDispMethodCall асинхронно вызывается метод Apply, и в случае отработки без ошибок вызывается метод Applied формы.
В колбеке просто происходит запись лога в перменную, которая периодически по таймеру в основном потоке считывается:

Код: Выделить всё

Public Function WIMMessageCallback( _
                ByVal dwMessageId As Long, _
                ByVal wParam As Long, _
                ByVal lParam As Long, _
                ByVal pvUserData As Long) As Long
    InitCurrentThreadAndCallFunction AddressOf WIMMessageCallback2, VarPtr(dwMessageId), WIMMessageCallback
End Function

' // This function is called from different threads with the initialized runtime
Public Function WIMMessageCallback2( _
                ByRef tParams As tWIMMessageCallbackParams) As Long
    Dim bAbort  As Boolean
    Dim sText   As String
   
    Select Case tParams.dwMessageId
    Case WIM_MSG_PROCESS
        PutMem4 ByVal VarPtr(sText), SysAllocString(ByVal tParams.wParam)
        PutLog "WIM_MSG_PROCESS: " & sText
    Case WIM_MSG_ERROR
        PutMem4 ByVal VarPtr(sText), SysAllocString(ByVal tParams.wParam)
        PutLog "WIM_MSG_ERROR: " & tParams.lParam & "; " & sText
    Case WIM_MSG_PROGRESS
        PutLog "WIM_MSG_PROGRESS: " & tParams.wParam & " / " & tParams.lParam
    Case WIM_MSG_STEPIT
        PutLog "WIM_MSG_STEPIT"
    Case WIM_MSG_SETPOS
        PutLog "WIM_MSG_STEPIT: Count: " & tParams.lParam
    Case Else
        PutLog tParams.dwMessageId & " / " & tParams.wParam & " / " & tParams.lParam
    End Select
   
    ' // Check for abort
    ' // pvUserData contains address of bollean variable we can contol from the main thread
    GetMem4 ByVal tParams.pvUserData, bAbort
   
    If bAbort Then
        WIMMessageCallback2 = WIM_MSG_ABORT_IMAGE
    Else
        WIMMessageCallback2 = WIM_MSG_SUCCESS
    End If
   
End Function

Можно было бы сделать через посылки оконного сообщения главному потоку (как писал Хакер), но я изначально так реализовал и получилось что частота колбеков настолько большая что очередь сообщение перегружается и перестает отвечать на пользовательский ввод. Из-за этого я решил сделать запись и чтение лога в общую переменную доступ к которой разграничивается через критическую секуцию:

Код: Выделить всё

' // Initialize Log
Public Sub InitLog()
    InitializeCriticalSection m_tLogLock
End Sub

' // Uninitialize Log
Public Sub UninitLog()
    DeleteCriticalSection m_tLogLock
End Sub

' // Add log entry
Public Sub PutLog( _
           ByVal sText As String)
    EnterCriticalSection m_tLogLock
    m_sLogBuffer = m_sLogBuffer & Now & ": " & sText & vbNewLine
    LeaveCriticalSection m_tLogLock
End Sub

' // Extract log buffer and free it
Public Function ExtractLog() As String
    EnterCriticalSection m_tLogLock
    ExtractLog = m_sLogBuffer
    m_sLogBuffer = vbNullString
    LeaveCriticalSection m_tLogLock
End Function

В архиве весь код. Модуль для потоков нужно брать отсюда.

[sosed213]

The trick, спасибо тебе большое. Я даже не ожидал на столько развернутый пример.

Код работает как надо.

Теперь несколько вопросов.

На сколько опасно в WIMMessageCallback2 в Case WIM_MSG_PROGRESS вставлять код (обновление полосы прогресса или изменение надписи в Label)? С кейсом WIM_MSG_PROGRESS вроде частота колбеков будет не большой. Не очень хотелось бы использовать таймер для этого.

Есть совет как лучше, или как правильнее вести отладку в IDE режиме?

Антивирус (Касперский) съедает modMultiThreading2.bas, видимо не нравится такое сочетание кода

[Mikle]

Антивирус (Касперский) съедает modMultiThreading2.bas

Считает vbs вирусом? Чем дальше, тем сильнее антивирусный беспредел.

[sosed213]

Trojan-Downloader.Script.Generic

[The trick]

На сколько опасно в WIMMessageCallback2 в Case WIM_MSG_PROGRESS вставлять код (обновление полосы прогресса или изменение надписи в Label)? С кейсом WIM_MSG_PROGRESS вроде частота колбеков будет не большой. Не очень хотелось бы использовать таймер для этого.

Нужно делать маршалинг. Проблема в том что колбек может вызываться из произвольных потоков, поэтому нужно будет добавлять проверку, если объект "отмаршален" в текущем потоке. Дополнительно это снизит производительность поскольку начнутся накладные расходы на переключение потоков. А так смотри функции Marshal2, Unmarshal, FreeMarshalData.
Принцип действия следующий:

• Создаешь информацию для маршалинга через Marshal2, и передаешь ее в колбек;
• В колбеке проверяешь, если объект был уже "отмаршален" в текущем потоке. Для этого идеально подойдет TLS слот;
• Если объект "неотмаршален", получаешь ссылку на интерфейс через Unmarshal, и сохраняешь состояние в TLS;
• Теперь можно безболезненно вызывать методы через "отмаршаленную" сслыку.

За примером - CallbackTest. Там происходит вызов к методам формы из разных потоков.

Есть совет как лучше, или как правильнее вести отладку в IDE режиме?

Для этого нужно будет писать внешний код, который будет выполнять методы CWIMImage в новом потоке/процессе. Т.е. если хочешь создавать потоки в IDE - нужно использовать скомпилированный файл, будь то EXE или DLL. В IDE нельзя выполнять код из разных потоков, только в главном потоке (как к примеру в ActiveX EXE). Есть RC5 фреймворк, так вот он позволяет создавать объекты из ActiveX DLL и вызывать их методы в отдельном потоке. Либо написать простую DLL которая основана на функции CreateActiveXObjectInNewThread2, которая будет делать тоже самое.

Антивирус (Касперский) съедает modMultiThreading2.bas, видимо не нравится такое сочетание кода

Нужно отправлять репорты им чтобы убрали детекты.

[sosed213]

Используя пример CallbackTest, сделал по аналогии. Работает, но не все понятно.

CallBack работает только если эту секцию добавить в конец функции CallBack,a.

Код: Выделить всё

    Dim cObj    As Object
    Set cObj = UnMarshal(gpMarshalData, , False)
    cObj.clock


Среда IDE крашется при вызове FreeMarshalData gpMarshalData, или так и должно быть, а в exe-файле уже будет нормально?

Вот этот пунк не очень понятен:

В колбеке проверяешь, если объект был уже "отмаршален" в текущем потоке. Для этого идеально подойдет TLS слот;

Не понял как именно проверять, для этого надо куда то записать значение, а потом его считывать?
TLS слот? Это я правильно понимаю (в данном примере) PutLog и ExtractLog ?

Прикладываю вариант проекта который у меня получился.

[The trick]

Среда IDE крашется при вызове FreeMarshalData gpMarshalData, или так и должно быть, а в exe-файле уже будет нормально?

Нет, ничего не должно падать.

Не понял как именно проверять, для этого надо куда то записать значение, а потом его считывать?
TLS слот? Это я правильно понимаю (в данном примере) PutLog и ExtractLog ?

Я немного ошибся. Нужен не TLS, а FLS, т.к. нам нужно обеспечить уничтожение отмаршаленых объектов. FLS предоставляет механизм для уведомления фибера при его уничтожении, а если фибер связан с текущим потоком, то соответственно колбек будет вызван в контексте завершающегося потока.
При инициализации лога мы вызываем FlsAlloc и передаем указатель на наш колбек:

Код: Выделить всё

Private m_lFlsSlot          As Long

' // Initialize Log
Public Sub InitLog( _
           ByVal cObj As Object)
    g_pLogMarshalData = Marshal2(cObj)
    m_lFlsSlot = FlsAlloc(AddressOf FlsCallback)
End Sub

При колбеке от WIM мы проверяем был ли уже отмаршален объект (который сохранен глобально в FLS слоте), и если не был то отмаршаливаем ссылку и сохраняем ее в FLS слот (не забыв вызвать AddRef). В противном случае просто извлекаем ее из FLS. После того как мы получили отмаршаленый указатель можно вызывать методы объекта:

Код: Выделить всё

' // Add log entry
Public Sub PutLog( _
           ByVal sText As String)
    Dim pObj    As Long
    Dim cObj    As Object

    ' // Check if thread has marshaled reference
    pObj = FlsGetValue(m_lFlsSlot)

    If pObj = 0 Then

        ' // Initialize ref
        Set cObj = UnMarshal(g_pLogMarshalData, , False)
       
        vbaObjSetAddref pObj, ByVal ObjPtr(cObj)
       
        FlsSetValue m_lFlsSlot, ByVal pObj
       
    Else
        vbaObjSetAddref cObj, ByVal pObj
    End If
   
    If Not cObj Is Nothing Then
        cObj.LogEntry Now & ": " & sText
    End If
   
End Sub

Для того чтобы освободить ссылки на объект лога из разных потоков используем FLS колбек который вызывается при завершении потока:

Код: Выделить всё

Private Sub FlsCallback( _
            ByVal lFlsData As Long)
   
    ' // IUnknown::Release
    If lFlsData Then
        vbaObjSetAddref lFlsData, ByVal 0&
    End If
   
End Sub

Остальной код уже не нужен. Пример прикладываю здесь (без проверок ошибок). Кстати в модуле был недочет который я исправил, так что нужно будет обновить его, по той же ссылке.

[sosed213]

The trick, спасибо что помогаешь разобраться.

Сейчас еще раз проверил, все таки в процедуре UninitLog на строке FreeMarshalData g_pLogMarshalData происходит падение IDE. Я его пока закоментировал.

[The trick]

The trick, спасибо что помогаешь разобраться.

Сейчас еще раз проверил, все таки в процедуре UninitLog на строке FreeMarshalData g_pLogMarshalData происходит падение IDE. Я его пока закоментировал.

Пройдись пошагово, где конкретно падает?
Все, понял. Это ошибка в модуле, сейчас исправлю.

[sosed213]

Ой, извини, надо было сразу эту строку написать.
Крах происходит на
EnterCriticalSection tLockMarshal.tWinApiSection

И похоже что то пошло не так. Теперь CallBack может зависнуть до окончания применения образа (в скомпилированном виде).

[The trick]

Обнови модуль.

[sosed213]

IDE перестала падать при закрытии формы.

Но зависание CallBack'a пока еще есть.
Проверку веду только на кейсе WIM_MSG_PROGRESS (остальные пока не нужны, отключаю).

[The trick]

IDE перестала падать при закрытии формы.

Но зависание CallBack'a пока еще есть.
Проверку веду только на кейсе WIM_MSG_PROGRESS (остальные пока не нужны, отключаю).

С чего взял что зависает? Она у меня несколько раз только вызывается. Для проверки зависает/нет используй WIM_MSG_PROCESS которая вызывается достаточно часто.

[sosed213]

Вот что самое интересное, на WIM_MSG_PROCESS, работает. Может это из-за частых калбеков, или ещё чего.

Событие WIM_MSG_PROGRESS, должно появляться равномерно, а не так что завис на 7%, и отвис сразу на 100%.
wParam - проценты, lParam-примерно оставшееся время.
В предыдущем примере так и было.

[The trick]

Я понял в чем дело. Это из-за инициализации COM. В модуле идет следующая цепочка вызовов Колбек->Инициализация COM->Вызов пользовательской функции->Деинициализация COM. Из-за деинициализации COM и происходит ошибка. Для предотвращения ошибки можно дополнительно вызывать инициализацию COM (чтобы увеличить счетчик ссылок) при маршалинге ссылки:

Код: Выделить всё

' // Add log entry
Public Sub PutLog( _
           ByVal sText As String)
    Dim pObj    As Long
    Dim cObj    As Object

    ' // Check if thread has marshaled reference
    pObj = FlsGetValue(m_lFlsSlot)

    If pObj = 0 Then
       
        CoInitialize ByVal 0&
       
        ' // Initialize ref
        Set cObj = UnMarshal(g_pLogMarshalData, , False)
       
        vbaObjSetAddref pObj, ByVal ObjPtr(cObj)
       
        FlsSetValue m_lFlsSlot, ByVal pObj
       
    Else
        vbaObjSetAddref cObj, ByVal pObj
    End If
   
    If Not cObj Is Nothing Then
        cObj.LogEntry Now & ": " & sText
    End If
   
End Sub

В данном подходе, при выходе из пользовательской функции никакой деинициализации COM не происходит, т.к. у нас было 2 вызова и просто уменьшается счетчик ссылок. Для деинициализаци COM необходимо сбалансировать количество вызовов CoInitialize/CoUninitialize, что можно сделать в FLS колбеке:

Код: Выделить всё

Private Sub FlsCallback( _
            ByVal lFlsData As Long)
   
    ' // IUnknown::Release
    If lFlsData Then
        vbaObjSetAddref lFlsData, ByVal 0&
        CoUninitialize
    End If
   
End Sub

По-хорошему нужно прямо в колбеке чекать была ли проведена инициализация COM, а не когда мы маршалим ссылку (дабы избежать постоянной инициализации/деинициализации COM), но как демонстрационный пример сойдет. В релизе я бы отдельно инициализировал COM и сохранял в FLS статус, но тут не делал, т.к. на скорость почти не влияет. Код в аттаче.

[sosed213]

Работает. Стабильно.

[sosed213]

The trick, прошу пояснить несколько моментов.
В твоём примере сколько всего должно создаваться потоков помимо главного?

У меня получается 3 потока. 1 поток на CWIMImage, и один поток, по идее, должен выделяться на WIMMessageCallback2.
А по факту получается что на WIMMessageCallback2 выделяется всегда 2 потока. Событие WIM_MSG_PROGRESS приходит от разных потоков. Это так решает сама библиотека WIMGAPI.DLL? Если да, то говорит ли это о том что библиотека эффективно использует процессор, развертывая образ в 2 потока?

И второй момент по поводу

По-хорошему нужно прямо в колбеке чекать была ли проведена инициализация COM, а не когда мы маршалим ссылку (дабы избежать постоянной инициализации/деинициализации COM)

По факту ведь инициализация происходит один раз для каждого потока перед развертывание образа, и деинициализации при завершении развертывания образа или при нажатии кнопки Abort.
Также, из-за того что PutLog вызывается из CWIMImage, то и в этот момент также нужно "чекать" была ли проведена инициализация COM, а не только в "колбеке"? Ведь так?
(возможно, сказанное мной не совсем корректно, в силу моей непрофессиональности)


И есть небольшая проблема. После применения образа, если закрыть программу, то процесс остается висеть в памяти. А если во время применения образы, нажать Abort, и закрыть программу, то процесс завершается. (так происходит не всегда)

[The trick]

The trick, прошу пояснить несколько моментов.
В твоём примере сколько всего должно создаваться потоков помимо главного?

В моем примере создается только один дополнительный поток (STA-апартмент) в котором живет экземпляр CWIMImage. Получается основной поток + дополнительный поток.

У меня получается 3 потока. 1 поток на CWIMImage, и один поток, по идее, должен выделяться на WIMMessageCallback2.
А по факту получается что на WIMMessageCallback2 выделяется всегда 2 потока. Событие WIM_MSG_PROGRESS приходит от разных потоков. Это так решает сама библиотека WIMGAPI.DLL? Если да, то говорит ли это о том что библиотека эффективно использует процессор, развертывая образ в 2 потока?

Колбек вызывается из разных потоков, это уже зависит от реализации WIMGAPI.DLL - мы на это не влияем.

И второй момент по поводу

По-хорошему нужно прямо в колбеке чекать была ли проведена инициализация COM, а не когда мы маршалим ссылку (дабы избежать постоянной инициализации/деинициализации COM)

По факту ведь инициализация происходит один раз для каждого потока перед развертывание образа, и деинициализации при завершении развертывания образа или при нажатии кнопки Abort.

Нет. Мы должны инициализировать COM (CoInitialize) для работы VB кода. Библиотека WIMGAPI.DLL его не инициализирует. Мой модуль при получении колбека инициализирует COM, а затем вызывает твою колбек функцию, после выхода из функции происходит деинициализация COM. Далее если в этом же потоке опять происходит вызов колбека то все те же действия происходят опять. Если к примеру у тебя есть отмаршаленая ссылка то после деинициализации COM при первом вызове ты не сможешь использовать уже эту ссылку поскольку COM был деинициализирован и инициализирован заново - все старые данные изменились. Не деинициализировать COM модуль не может поскольку он не понятия не имеет когда тогда производить деинициализацию. Поэтому я сделал так, при вызове колбека модуль инициализирует COM, затем мы уже в колбеке инициализируем модуль еще раз - счетчик ссылок увеличивается и становится равен 2. При выходе из колбека модуль деинициализирует COM, yj поскольку счетчик сслок был 2, то он уменьшается и деинициализации не происходит. Дальнейшие вызовы колбека в этом потоке просто увеличивают/уменьшают счетчик ссылок не изменяя ничего другого - поэтому мы можем работать с отмаршаленой ссылкой. При завершении потока вызывается FLS колбек в котором мы уже деинициализируем COM и счетчик становится равен 0 и происходит деинициализации COM.
Проблема тут в том что в моем коде инициализация COM внутри колбека происходит только при выводе лога, а у тебя в коде логируются только 2 типа сообщений. Поэтому при каждом вызове колбека в модуле происходит постоянная инициализация/деинициализация COM, которая ни на что не влияет кроме как на производительность. Данное поведение будет пока не будет вызван вывод в лог. При первом выводе мы увеличиваем счетчике ссылок инициализации COM и теперь вызовы инициализации и деинициализации в модуле только изменяют счетчик ссылок.

И есть небольшая проблема. После применения образа, если закрыть программу, то процесс остается висеть в памяти. А если во время применения образы, нажать Abort, и закрыть программу, то процесс завершается. (так происходит не всегда)

Где происходит зависание? Просто у себя не наблюдаю подобного. В какой функции? FLS колбеки вызываются?