Возможно ли зарегистрировать OCX в Windows 7 x32 под учетной записью пользователя - VB

'::: Модуль Setup.bas
 
Public Type FILETIME
       dwLowDateTime    As Long
       dwHighDateTime   As Long
End Type
 
Public Type SECURITY_ATTRIBUTES
       nLength                  As Long
       lpSecurityDescriptor     As Long
       bInheritHandle           As Boolean
End Type
 
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
 
Sub Main()
 
Dim tpfl          As FILETIME
 
Dim CIDs(1 To 10) As String
Dim IIDs(1 To 10) As String
Dim SRVs(1 To 10) As String
Dim FLGs(1 To 10) As Integer
    HKEY_CLASSES_ROOT& = &H80000000
    KEY_ALL_ACCESS& = &HF003F
    '::: Сначала проверка прав...
    lp& = 0
    ret_1& = RegCreateKey(HKEY_CLASSES_ROOT&, "Имя_приложения", lp&)
    ret_2& = RegDeleteKey(HKEY_CLASSES_ROOT&, "Имя_приложения")
    If (ret_1& <> 0) Or (ret_2& <> 0) Then
       show_Err "Для инсталляции Имя_приложения нужны административные права и доступ к реестру Windows.", _
                "Необходимо войти в систему администратором или запустить инсталлятор от имени администратора!"
       Exit Sub
    End If
    CIDs(1) = ""
    IIDs(1) = "{3B7C8863-D78F-101B-B9B5-04021C009402}"
    SRVs(1) = "RICHTX32.OCX"
    CIDs(2) = ""
    IIDs(2) = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}"
    SRVs(2) = "MSCOMCTL.OCX"
    CIDs(3) = ""
    IIDs(3) = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}"
    SRVs(3) = "COMDLG32.OCX"
    CIDs(4) = ""
    IIDs(4) = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}"
    SRVs(4) = "MSFLXGRD.OCX"
    CIDs(5) = ""
    IIDs(5) = "{E316DE6E-F751-11DB-82AA-87E48000BA41}"
    SRVs(5) = "cntAssoList.ocx"
    CIDs(6) = ""
    IIDs(6) = "{F3B998CF-F751-11DB-82AA-87E48000BA41}"
    SRVs(6) = "cntObjList.ocx"
    CIDs(7) = ""
    IIDs(7) = "{D160BB24-9543-454D-892A-797F5E690438}"
    SRVs(7) = "extCombo.ocx"
    CIDs(8) = ""
    IIDs(8) = "{0884D707-5473-4EA5-96B9-2348B928025D}"
    SRVs(8) = "tpw.dll"
    CIDs(9) = ""
    IIDs(9) = "{D2624A77-1438-11D7-8D53-00B0D0D7CD78}"
    SRVs(9) = "xcoder.dll"
    CIDs(10) = ""
    IIDs(10) = "{4D740E1D-016A-4FA2-8700-2D45023902D4}"
    SRVs(10) = "Fuploadn.dll"
    num_comp% = 10
    HomeDir$ = App.Path
    ComDir$ = HomeDir$ + "\Com"
    If Dir$(ComDir$, vbDirectory) = "" Then
       show_Err "Почему-то нет директории \Com", _
                "Возможно, были ошибки при распаковке..."
       Exit Sub
    End If
    '::: Этап-1 Сканирование реестра
    Res1& = RegOpenKeyEx(HKEY_CLASSES_ROOT&, "CLSID", 0&, KEY_ALL_ACCESS&, hSubkey&)
    If Res1& <> 0 Then
       show_Err "Не могу открыть ветвь реестра HKEY_CLASSES_ROOT", _
                ""
       Exit Sub
    Else
       With frmMain
            .Label2.Visible = True
            .Picture1.Visible = False
            .Show
            DoEvents
       End With
       Do
          Buf$ = String$(255, Chr$(0))
          Lb& = 255
          classBuf$ = String$(255, Chr$(0))
          Lcb& = 255
          Res_3& = RegEnumKeyEx(hSubkey&, cEnum&, Buf$, Lb&, 0&, classBuf$, Lcb&, tpfl)
          '::: Достигнут конец ветви...
          If Res_3& <> 0 Then Exit Do
          '::: Извлекли GUID очередного класса
          curr_CLSID$ = Left$(Buf$, Lb&)
          frmMain.Label2.Caption = curr_CLSID$
          DoEvents
          '::: Достанем его InprocServer32
          Prog_Id$ = String$(255, Chr$(0))
          lll& = 255
          CCC$ = "CLSID\" + curr_CLSID$ + "\InprocServer32"
          Res_6& = RegOpenKeyEx(HKEY_CLASSES_ROOT&, CCC$, 0&, KEY_ALL_ACCESS&, hSubkey_1&)
          If Res_6& = 0 Then
             Res_5& = RegQueryValueEx(hSubkey_1&, "", 0&, 1&, ByVal Prog_Id$, lll&)
             If (Res_5& = 0) And (lll& > 1) Then
                SrvNam$ = Left$(Prog_Id$, lll& - 1)
             Else
                SrvNam$ = ""
             End If
             If (Len(SrvNam$) <> 0) Then
                '::: Проверим CLSID
                For i% = 1 To num_comp%
                    If (curr_CLSID$ = CIDs(i%)) And (FLGs(i%) = 0) Then
                       FLGs(i%) = -1
                       GoTo NEXT_COM
                       Exit For
                    End If
                Next i%
                '::: Достанем TypeLib
                CCC$ = "CLSID\" + curr_CLSID$ + "\TypeLib"
                Res_7& = RegOpenKeyEx(HKEY_CLASSES_ROOT&, CCC$, 0&, KEY_ALL_ACCESS&, hSubkey_1&)
                If Res_7& = 0 Then
                   TpLB$ = String$(255, Chr$(0))
                   lll& = 255
                   Res_8& = RegQueryValueEx(hSubkey_1&, "", 0&, 1&, ByVal TpLB$, lll&)
                   If (Res_8& = 0) And (lll& > 1) Then
                      TpLB$ = Left$(TpLB$, lll& - 1)
                   Else
                      TpLB$ = ""
                   End If
                   Res_2& = RegCloseKey(hSubkey_1&)
                   If Len(TpLB$) <> 0 Then
                      '::: Проверим IID
                      For i% = 1 To num_comp%
                          If (TpLB$ = IIDs(i%)) And (FLGs(i%) = 0) Then
                             If Dir$(SrvNam$, vbNormal) <> "" Then
                                FLGs(i%) = -1
                                Exit For
                             End If
                          End If
                      Next i%
                   End If
                End If
             End If
NEXT_COM:
          End If
          cEnum& = cEnum& + 1
       Loop
    End If
    Res_2& = RegCloseKey(hSubkey&)
    '::: Проверим, сколько компонентов нужно регистрировать
    kk% = 0
    For i% = 1 To num_comp%
        If FLGs(i%) = 0 Then
           kk% = kk% + 1
        Else
           If Dir$(ComDir$ + "\" + SRVs(i%), vbNormal) <> "" Then Kill ComDir$ + "\" + SRVs(i%)
        End If
    Next i%
    fo% = FreeFile
    Open HomeDir$ + "\setup.log" For Output As #fo%
    If (kk% > 0) Then
       frmMain.Label2.Visible = False
       frmMain.Picture1.Visible = True
       frmMain.Label1.Caption = "Регистрирую компоненты..."
       WW# = frmMain.Picture1.Width
       HH# = frmMain.Picture1.Height
       DW# = WW# / num_comp%
       For i% = 1 To num_comp%
           x# = DW# * i%
           frmMain.Picture1.Line (0, 0)-(x#, HH#), QBColor(9), BF
           DoEvents
           If FLGs(i%) = 0 Then
              ExecPrg "regsvr32.exe", "/s " + ComDir$ + "\" + SRVs(i%), RC%, 0
              If RC% = 0 Then
                 Tmp$ = SRVs(i%)
                 l% = Len(Tmp$)
                 If l% < 30 Then Tmp$ = Space$(30 - l%) + Tmp$
                 Print #fo%, Date$; " "; Time$; " "; Tmp$; " "; IIDs(i%)
              Else
                 MsgBox "Ошибка при регистрации компонента " + SRVs(i%) + " RC=" + Str$(RC%)
              End If
           End If
       Next i%
    End If
    Close #fo%
    frmMain.Hide
End Sub
 
Sub show_Err(Txt1 As String, Txt2 As String)
    frmErr.lbl1.Caption = Txt1
    frmErr.lbl2.Caption = Txt2
    frmErr.Show 1
    End
End Sub