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

Узнай цену своей работы

Формулировка задачи:

Возможно ли зарегистрировать OCX в Windows 7 x32 под учетной записью пользователя (не админ).. Либо каким то образом использовать OCX в написанной программе из папки с программой ?

Решение задачи: «Возможно ли зарегистрировать OCX в Windows 7 x32 под учетной записью пользователя»

textual
Листинг программы 
  1. '::: Модуль Setup.bas
  2.  
  3. Public Type FILETIME
  4.        dwLowDateTime    As Long
  5.        dwHighDateTime   As Long
  6. End Type
  7.  
  8. Public Type SECURITY_ATTRIBUTES
  9.        nLength                  As Long
  10.        lpSecurityDescriptor     As Long
  11.        bInheritHandle           As Boolean
  12. End Type
  13.  
  14. 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
  15. Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  16. 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
  17. 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
  18. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  19.  
  20. Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  21. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
  22.  
  23. Sub Main()
  24.  
  25. Dim tpfl          As FILETIME
  26.  
  27. Dim CIDs(1 To 10) As String
  28. Dim IIDs(1 To 10) As String
  29. Dim SRVs(1 To 10) As String
  30. Dim FLGs(1 To 10) As Integer
  31.     HKEY_CLASSES_ROOT& = &H80000000
  32.     KEY_ALL_ACCESS& = &HF003F
  33.     '::: Сначала проверка прав...
  34.     lp& = 0
  35.     ret_1& = RegCreateKey(HKEY_CLASSES_ROOT&, "Имя_приложения", lp&)
  36.     ret_2& = RegDeleteKey(HKEY_CLASSES_ROOT&, "Имя_приложения")
  37.     If (ret_1& <> 0) Or (ret_2& <> 0) Then
  38.        show_Err "Для инсталляции Имя_приложения нужны административные права и доступ к реестру Windows.", _
  39.                 "Необходимо войти в систему администратором или запустить инсталлятор от имени администратора!"
  40.        Exit Sub
  41.     End If
  42.     CIDs(1) = ""
  43.     IIDs(1) = "{3B7C8863-D78F-101B-B9B5-04021C009402}"
  44.     SRVs(1) = "RICHTX32.OCX"
  45.     CIDs(2) = ""
  46.     IIDs(2) = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}"
  47.     SRVs(2) = "MSCOMCTL.OCX"
  48.     CIDs(3) = ""
  49.     IIDs(3) = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}"
  50.     SRVs(3) = "COMDLG32.OCX"
  51.     CIDs(4) = ""
  52.     IIDs(4) = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}"
  53.     SRVs(4) = "MSFLXGRD.OCX"
  54.     CIDs(5) = ""
  55.     IIDs(5) = "{E316DE6E-F751-11DB-82AA-87E48000BA41}"
  56.     SRVs(5) = "cntAssoList.ocx"
  57.     CIDs(6) = ""
  58.     IIDs(6) = "{F3B998CF-F751-11DB-82AA-87E48000BA41}"
  59.     SRVs(6) = "cntObjList.ocx"
  60.     CIDs(7) = ""
  61.     IIDs(7) = "{D160BB24-9543-454D-892A-797F5E690438}"
  62.     SRVs(7) = "extCombo.ocx"
  63.     CIDs(8) = ""
  64.     IIDs(8) = "{0884D707-5473-4EA5-96B9-2348B928025D}"
  65.     SRVs(8) = "tpw.dll"
  66.     CIDs(9) = ""
  67.     IIDs(9) = "{D2624A77-1438-11D7-8D53-00B0D0D7CD78}"
  68.     SRVs(9) = "xcoder.dll"
  69.     CIDs(10) = ""
  70.     IIDs(10) = "{4D740E1D-016A-4FA2-8700-2D45023902D4}"
  71.     SRVs(10) = "Fuploadn.dll"
  72.     num_comp% = 10
  73.     HomeDir$ = App.Path
  74.     ComDir$ = HomeDir$ + "\Com"
  75.     If Dir$(ComDir$, vbDirectory) = "" Then
  76.        show_Err "Почему-то нет директории \Com", _
  77.                 "Возможно, были ошибки при распаковке..."
  78.        Exit Sub
  79.     End If
  80.     '::: Этап-1 Сканирование реестра
  81.     Res1& = RegOpenKeyEx(HKEY_CLASSES_ROOT&, "CLSID", 0&, KEY_ALL_ACCESS&, hSubkey&)
  82.     If Res1& <> 0 Then
  83.        show_Err "Не могу открыть ветвь реестра HKEY_CLASSES_ROOT", _
  84.                 ""
  85.        Exit Sub
  86.     Else
  87.        With frmMain
  88.             .Label2.Visible = True
  89.             .Picture1.Visible = False
  90.             .Show
  91.             DoEvents
  92.        End With
  93.        Do
  94.           Buf$ = String$(255, Chr$(0))
  95.           Lb& = 255
  96.           classBuf$ = String$(255, Chr$(0))
  97.           Lcb& = 255
  98.           Res_3& = RegEnumKeyEx(hSubkey&, cEnum&, Buf$, Lb&, 0&, classBuf$, Lcb&, tpfl)
  99.           '::: Достигнут конец ветви...
  100.           If Res_3& <> 0 Then Exit Do
  101.           '::: Извлекли GUID очередного класса
  102.           curr_CLSID$ = Left$(Buf$, Lb&)
  103.           frmMain.Label2.Caption = curr_CLSID$
  104.           DoEvents
  105.           '::: Достанем его InprocServer32
  106.           Prog_Id$ = String$(255, Chr$(0))
  107.           lll& = 255
  108.           CCC$ = "CLSID\" + curr_CLSID$ + "\InprocServer32"
  109.           Res_6& = RegOpenKeyEx(HKEY_CLASSES_ROOT&, CCC$, 0&, KEY_ALL_ACCESS&, hSubkey_1&)
  110.           If Res_6& = 0 Then
  111.              Res_5& = RegQueryValueEx(hSubkey_1&, "", 0&, 1&, ByVal Prog_Id$, lll&)
  112.              If (Res_5& = 0) And (lll& > 1) Then
  113.                 SrvNam$ = Left$(Prog_Id$, lll& - 1)
  114.              Else
  115.                 SrvNam$ = ""
  116.              End If
  117.              If (Len(SrvNam$) <> 0) Then
  118.                 '::: Проверим CLSID
  119.                 For i% = 1 To num_comp%
  120.                     If (curr_CLSID$ = CIDs(i%)) And (FLGs(i%) = 0) Then
  121.                        FLGs(i%) = -1
  122.                        GoTo NEXT_COM
  123.                        Exit For
  124.                     End If
  125.                 Next i%
  126.                 '::: Достанем TypeLib
  127.                 CCC$ = "CLSID\" + curr_CLSID$ + "\TypeLib"
  128.                 Res_7& = RegOpenKeyEx(HKEY_CLASSES_ROOT&, CCC$, 0&, KEY_ALL_ACCESS&, hSubkey_1&)
  129.                 If Res_7& = 0 Then
  130.                    TpLB$ = String$(255, Chr$(0))
  131.                    lll& = 255
  132.                    Res_8& = RegQueryValueEx(hSubkey_1&, "", 0&, 1&, ByVal TpLB$, lll&)
  133.                    If (Res_8& = 0) And (lll& > 1) Then
  134.                       TpLB$ = Left$(TpLB$, lll& - 1)
  135.                    Else
  136.                       TpLB$ = ""
  137.                    End If
  138.                    Res_2& = RegCloseKey(hSubkey_1&)
  139.                    If Len(TpLB$) <> 0 Then
  140.                       '::: Проверим IID
  141.                       For i% = 1 To num_comp%
  142.                           If (TpLB$ = IIDs(i%)) And (FLGs(i%) = 0) Then
  143.                              If Dir$(SrvNam$, vbNormal) <> "" Then
  144.                                 FLGs(i%) = -1
  145.                                 Exit For
  146.                              End If
  147.                           End If
  148.                       Next i%
  149.                    End If
  150.                 End If
  151.              End If
  152. NEXT_COM:
  153.           End If
  154.           cEnum& = cEnum& + 1
  155.        Loop
  156.     End If
  157.     Res_2& = RegCloseKey(hSubkey&)
  158.     '::: Проверим, сколько компонентов нужно регистрировать
  159.     kk% = 0
  160.     For i% = 1 To num_comp%
  161.         If FLGs(i%) = 0 Then
  162.            kk% = kk% + 1
  163.         Else
  164.            If Dir$(ComDir$ + "\" + SRVs(i%), vbNormal) <> "" Then Kill ComDir$ + "\" + SRVs(i%)
  165.         End If
  166.     Next i%
  167.     fo% = FreeFile
  168.     Open HomeDir$ + "\setup.log" For Output As #fo%
  169.     If (kk% > 0) Then
  170.        frmMain.Label2.Visible = False
  171.        frmMain.Picture1.Visible = True
  172.        frmMain.Label1.Caption = "Регистрирую компоненты..."
  173.        WW# = frmMain.Picture1.Width
  174.        HH# = frmMain.Picture1.Height
  175.        DW# = WW# / num_comp%
  176.        For i% = 1 To num_comp%
  177.            x# = DW# * i%
  178.            frmMain.Picture1.Line (0, 0)-(x#, HH#), QBColor(9), BF
  179.            DoEvents
  180.            If FLGs(i%) = 0 Then
  181.               ExecPrg "regsvr32.exe", "/s " + ComDir$ + "\" + SRVs(i%), RC%, 0
  182.               If RC% = 0 Then
  183.                  Tmp$ = SRVs(i%)
  184.                  l% = Len(Tmp$)
  185.                  If l% < 30 Then Tmp$ = Space$(30 - l%) + Tmp$
  186.                  Print #fo%, Date$; " "; Time$; " "; Tmp$; " "; IIDs(i%)
  187.               Else
  188.                  MsgBox "Ошибка при регистрации компонента " + SRVs(i%) + " RC=" + Str$(RC%)
  189.               End If
  190.            End If
  191.        Next i%
  192.     End If
  193.     Close #fo%
  194.     frmMain.Hide
  195. End Sub
  196.  
  197. Sub show_Err(Txt1 As String, Txt2 As String)
  198.     frmErr.lbl1.Caption = Txt1
  199.     frmErr.lbl2.Caption = Txt2
  200.     frmErr.Show 1
  201.     End
  202. End Sub

ИИ поможет Вам:

  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

13   голосов , оценка 4.231 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы