Завершение регистрации - как поймать процесс RegSvr32?

Call Shell("RegSvr32 /s " & Name) 'Регистрация

Dim pid As Long, hProc As Long
pid = Shell(Path)
hProc = OpenProcess(SYNCHRONIZE, False, pid)
WaitForSingleObject hProc, INFINITE
CloseHandle hProc
' Процесс завершился

Option Explicit
'----------------------------------------------------------[ Константы ]
Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000
'----------------------------------------------------------[ События ]
Event ObjectEvent(Info As EventInfo)
'----------------------------------------------------------[ WinApi ]
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'----------------------------------------------------------[ Переменные ]
Dim WithEvents Component As VBControlExtender
 
Public Property Get Obj() As Variant
    'От сюда можно получить доступ к свойствам "Component"
    Set Obj = Component.object
End Property
 
Private Sub UserControl_Initialize()
    'Варианты инициализации
'    Set Component = RegSvr32("Dialogs.ocx", "dlgColor")
'    Set Component = RegSvr32("Dialogs.ocx", "dlgOpenSave")
    Set Component = RegSvr32("Dialogs.ocx", "dlgBrawser")
End Sub
 
Private Function RegSvr32(ByVal Name$, Optional ByVal Class$) As Object
    Const r = "."
    Dim Byt() As Byte, s$, f&, j$()
    Dim pid&, hProc&
    '===================================================
    Name = Trim(Name): Class = Trim(Class) 'Убрать передние и задние пробелы
    j = Split(Name, r, 2): j(1) = LCase(j(1)) 'Тип мелкими буквами
    s = App.Path & "\" & Name 'Создание файлового пути
    On Error Resume Next 'Отключить остановку программы на случай ошибки
    f = GetAttr(s) And Not vbDirectory 'Бит соответствия файлу
    If f > 0 And Len(Class) Then
        GoTo Reg: 'Если файл существует то переход к ссылке на объект
    ElseIf Len(Class) Then
        Byt = LoadResData(Name, j(1))
        f = FreeFile 'Определяем номер свободного файла
        Open s For Binary As #f: Put #f, 1, Byt: Close #f 'Копируем !
Reg:
        For f = 0 To 1 'Две попытки на случай если объект уже зарегестр.
            Select Case j(1) 'Это может быть OCX или DLL
            Case "ocx"
                Licenses.Add j(0) & r & Class
                Set RegSvr32 = Controls.Add(j(0) & r & Class, Class)
            Case "dll": Set RegSvr32 = CreateObject(j(0) & r & Class)
            End Select
            If Err Then 'pid = Shell("RegSvr32 /s /u " & Name) 'Подсказка, отмена регистрации
                pid = Shell("RegSvr32 /s " & Name) 'Регистрация
                hProc = OpenProcess(SYNCHRONIZE, False, pid)
                WaitForSingleObject hProc, INFINITE 'Ждать завершения регистрации
                CloseHandle hProc
                Err.Clear 'Сброс ошибки
            Else: Exit For
            End If
        Next
    End If
End Function
Private Sub Component_ObjectEvent(Info As EventInfo)
 
    If Info.Name = "NewSize" Then UserControl_Resize
    RaiseEvent ObjectEvent(Info) 'передача всех событий
End Sub
 
Private Sub UserControl_Show()
    Component.Visible = True
End Sub
 
 
Private Sub UserControl_Resize()
    Component.Move 0, 0, ScaleWidth
    Height = Component.Height
End Sub

Option Explicit
'----------------------------------------------------------[ Константы ]
Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000
'----------------------------------------------------------[ События ]
Event ObjectEvent(Info As EventInfo)
'----------------------------------------------------------[ WinApi ]
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'----------------------------------------------------------[ Переменные ]
Dim WithEvents Component As VBControlExtender
 
Private Function CommonFolder$()
    'Общая папка для компонентов
    Const FelixMacintosh = "© FelixMacintosh"
    Dim ACN$, f&
    ACN = App.CompanyName
    For f = 1 To Len(ACN)
        If Mid$(ACN, f, 1) Like "[\/:*?""<>|.]" Then Mid$(ACN, f, 1) = "_"
    Next
    On Error Resume Next
    'Если по каким-то причинам App.CompanyName оказалость пустым _
    то названием общей папки будет мой ник по умолчанию
    ACN = Trim(ACN): ACN = IIf(Len(ACN), ACN, FelixMacintosh)
    CommonFolder = Environ("CommonProgramFiles") & "\" & ACN
    If Len(Dir(CommonFolder, vbDirectory)) Then Else MkDir CommonFolder
End Function
 
Private Sub UserControl_Initialize()
    'Варианты инициализации
'    Set Component = RegSvr32("Dialogs.ocx", "dlgColor")
'    Set Component = RegSvr32("Dialogs.ocx", "dlgOpenSave")
    Set Component = RegSvr32("Dialogs.ocx", "dlgBrawser")
End Sub
 
Private Function RegSvr32(ByVal Name$, Optional ByVal Class$) As Object
    Const r = "."
    Dim Byt() As Byte, s$, f&, j$()
    Dim pid&, hProc&
    '===================================================
    Name = Trim(Name): Class = Trim(Class) 'Убрать передние и задние пробелы
    j = Split(Name, r, 2): j(1) = LCase(j(1)) 'Тип мелкими буквами
    s = CommonFolder & "\" & Name 'Создание файлового пути
    On Error Resume Next 'Отключить остановку программы на случай ошибки
    f = GetAttr(s) And Not vbDirectory 'Бит соответствия файлу
    If f > 0 And Len(Class) Then
        GoTo RegFile: 'Если файл существует то переход к ссылке на объект
    ElseIf Len(Class) Then
        Byt = LoadResData(Name, j(1)) 'Загрузка указанного ресурса в байтовый массив
        f = FreeFile 'Определяем номер свободного файла
        Open s For Binary As #f: Put #f, 1, Byt: Close #f 'Копируем !
RegFile:
        For f = 0 To 1 'Две попытки, на случай если объект уже зарегестр.
            Select Case j(1) 'Это может быть OCX или DLL
            Case "ocx"
                Licenses.Add j(0) & r & Class
                Set RegSvr32 = Controls.Add(j(0) & r & Class, Class)
            Case "dll": Set RegSvr32 = CreateObject(j(0) & r & Class)
            End Select
            If Err Then 'pid = Shell("RegSvr32 /s /u " & Name) 'так будет отмена регистрации !
                pid = Shell("RegSvr32 /s " & Name) 'Регистрация
                hProc = OpenProcess(SYNCHRONIZE, False, pid)
                WaitForSingleObject hProc, INFINITE 'Ждать завершения регистрации
                CloseHandle hProc
                Err.Clear 'Сброс ошибки
            Else: Exit For
            End If
        Next
    End If
End Function
 
Public Property Get Obj() As Variant
    'От сюда можно получить доступ к свойствам "Component"
    Set Obj = Component.object
End Property
 
Private Sub Component_ObjectEvent(Info As EventInfo)
    If Info.Name = "NewSize" Then UserControl_Resize
    RaiseEvent ObjectEvent(Info) 'передача всех событий
End Sub
 
Private Sub UserControl_Show()
    Component.Visible = True
End Sub
 
Private Sub UserControl_Resize()
    Component.Move 0, 0, ScaleWidth
    Height = Component.Height
End Sub

Private Function WriteBytes(FileName$, Bytes() As Byte, Optional ByRef Start&, _
Optional Overwrite As Boolean)
    'Запись байт в файл
    'Арг: Путь // Массив байт // Старт // Флаг перезаписи
    'Возврат: Следующая позиция записи (при успешном выполнении)
    Dim n, f: On Error Resume Next
    If Start Then Else Start = 1
    f = FreeFile 'Определяем номер свободного файла
    If Overwrite Then Kill FileName
    Open FileName$ For Binary As #f: Put #f, Start, Bytes: Close #f 'Копируем !
    If Err = 0 Then WriteBytes = Start + UBound(Bytes) + 1
End Function
 
Private Function RegSvr32(ByVal Name$, Optional ByVal Class$, Optional LicenseKey$) As Object
    Const Start = 2 ^ 17 + 1, dln = 2 ^ 16 'Старт и длина для чтения версии
    Dim Byt() As Byte, Byt1() As Byte, f&, j$()
    '===================================================
    Name = Trim(Name): Class = Trim(Class) 'Убрать передние и задние пробелы
    j = Split(Name, r, 2): j(1) = LCase(j(1)) 'Тип мелкими буквами
    On Error Resume Next 'Отключить остановку программы на случай ошибки
    mCD = CurDir$ 'Запоминаем текущую папку
    ChDir CommonFolder 'Устанавливаем общую папку
    '----------------------
    '''Call WaitShell("RegSvr32 /s /u " & Name)
    '''Kill Name  'Пример отмены регистрации и удаления файла
    '----------------
    Byt = LoadResData(Name, j(1)) 'Загрузка указанного ресурса в байтовый массив
 
    If GetVersion(Byt).Summ <= GetVersion(ReadBytes(Name, Start, dln)).Summ Then
        'Если файл существует и версия совпадает или младше то переход к ссылке на объект
        GoTo RegFile:
    ElseIf Len(Class) Then
        Licenses.Remove j(0) & r & Class 'Удаление лицензии
        Call WaitShell("RegSvr32 /s /u " & Name) 'Отмена регистрации старой версии
        Call WriteBytes(Name, Byt, , True) 'Перезапись
RegFile:
        For f = 0 To 1 'Две попытки, на случай если объект уже зарегестр.
            Err.Clear 'Сброс ошибки
            Select Case j(1) 'Это может быть OCX или DLL
            Case "ocx"
                Licenses.Add j(0) & r & Class, LicenseKey 'Добавление лицнзии
                Set RegSvr32 = Controls.Add(j(0) & r & Class, Class)
            Case "dll": Set RegSvr32 = CreateObject(j(0))
            End Select
            If Err Then 'Если возникли ошибки, то зарегестрироваться
                Call WaitShell("RegSvr32 /s " & Name)
            Else: Exit For
            End If
        Next
    End If
    ChDir mCD 'Установка текущей папки
End Function