Мне удалось это зделать !
В режиме регистрации
Программа записывает ключи и GUID-ы для каждого класса DLL или OCX
в реестр, в режиме отмены, удаляется все безследно.
идея принадлежит пользователю под ником "Аналитика" (CyberForum.ru)
Так-же можно ввести относительный путь, тоесть только файловое имя DLL-ки
например: wsh.Run "RegLib Min.dll", 0, 1
wsh.Run "RegLib Min.dl /s", 0, 1 'При ошибке сообщения не будет
Команды /S и /U можно вводить в любой очередности
но первый параметр должен быть путь к DLL
Могу продемонстрировать часть кода из RegLib, остальное военная тайна 
Кликните здесь для просмотра всего текста
| Visual Basic | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
| Option Explicit: Option Compare Text
'
'Программа, для регистрации библиотек, без запроса админских прав
'© Антихакер32™ // Матерьялы взяты здесь: [url]https://www.cyberforum.ru/visual-basic/thread649325.html[/url]
'
Const k = "\", r = "/"
Const Promt1 = "Файл не найден", Promt2 = "Файл не является библиотекой Dll // Ocx"
'=================
Const sPATH_BASE As String = "HKEY_CURRENT_USER\Software\Classes\"
Const sCOMPONENTCATEGORIESGUID = "{40FC6ED5-2438-11CF-A3DB-080036F12502}"
Const sPSOAINTERFACE = "{00020424-0000-0000-C000-000000000046}"
Dim mWShell As Object, mTLI As Object, mFSO As Object
Dim j$(), f&
Sub Main()
Dim result&, b(1) As Boolean, Promt$, Ext$, hMod&
On Error Resume Next: DeleteSetting App.EXEName: Err.Clear
j = Split(Command$, r)
For f = 0 To UBound(b): b(f) = 1: Next
For f = 0 To UBound(j): j(f) = Trim(j(f))
If f Then
Select Case UCase(j(f))
Case "S": b(0) = False 'Разрешение показывать сообщения
Case "U": b(1) = False 'Отмена регистрации
End Select
End If: Next
j(0) = getFSO.GetAbsolutePathName(j(0))
If Not getFSO.FileExists(j(0)) Then Promt = Promt1: GoTo 101
Ext = getFSO.GetExtensionName(j(0))
If Not (Ext Like "dll" Or Ext Like "ocx") Then Promt = Promt2: GoTo 101
result = Register(j(0), b(1))
If Err Then
Promt = "Error " & Err.Number & vbCrLf & Err.Description
If b(1) Then Call Register(j(0), 0) 'Удалить созданные ключи
End If
SaveSetting App.EXEName, 0, 0, result
101
If Len(Promt) And b(0) Then MsgBox Promt, vbCritical
SaveSetting App.EXEName, 0, 0, result 'Сохранить в реестр
End Sub |
|
Как пользоваться?!, версия для макроса VBA:
в архиве есть сама прога (RegLib.exe) и тестовая DLL (min.dll)
нужно все закинуть в ту папку где будет ваш лист, документ и тп
и выполнить этот код:
Кликните здесь для просмотра всего текста
| Visual Basic | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| Option Explicit
'
'Программа, для регистрации библиотек, без запроса админских прав
'Первый параметр вызова должен быть путь,
'можно относительный после него, в любой последовательности идут ключи
'/s /u ...где /s - это тихий режим, /u - отмена регистрации
'© Антихакер32™ // Матерьялы взяты здесь: [url]https://www.cyberforum.ru/visual-basic/thread649325.html[/url]
'
Dim wsh As Object
Private Sub Test_Reg()
'Тест регистрации
'
Dim o As Object, path$
Set wsh = CreateObject("WScript.Shell")
ChDir ThisWorkbook.path
wsh.Run "RegLib Min.dll", 0, 1
If GetSetting("RegLib", 0, 0) Then
Set o = CreateObject("Project1.Class1")
o.out "Hello Word!"
End If
wsh.Run "RegLib Min.dll /u/s", 0, 1 'Отменить регистрацию по тихому :)
End Sub |
|
должно будет появится сообщение "Привет мир!"
Кликните здесь для просмотра всего текста
Версия тэста, для VB6
Архив с файлом проекта, необходимыми компонентами, и одной формы,
ниже код этой формы:
Кликните здесь для просмотра всего текста
| Visual Basic | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
| Option Explicit
'
'Регистрация и динамическое подключение тест
'// © Антихакер32™
'
Const cn = "dlg_" 'Component Name
Dim WithEvents dlg As VBControlExtender
'
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal PPV As Long, ByVal oVft As Long, ByVal cc As Long, ByVal rtTYP As VbVarType, ByVal paCNT As Long, paTypes As Any, paValues As Any, ByRef fuReturn As Variant) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryW" (ByVal lpLibFileName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Dim wsh As Object
Private Sub dlg_LostFocus()
If Left$(ActiveControl.Name, Len(cn) + 1) Like cn & "#" Then
Set dlg = ActiveControl
End If
End Sub
Private Sub dlg_ObjectEvent(Info As EventInfo)
'Пример реакции на события этого компонента
Debug.Print Info.Name
Select Case Info.Name
Case "Help" 'Вызов подсказок
Info.EventParameters(1) = "Кнопка " & Info.EventParameters(1)
Info.EventParameters(2) = "Пример вызова подсказки по правой кнопке"
Info.EventParameters(3) = 7 '1,2,3 ,7
Case "SelectPath" 'Выбран путь
MsgBox "Выбран путь" & vbCrLf & dlg.object.Text
End Select
End Sub
Private Sub Form_Load()
'Динамически регестрируем и создаем этот компонент
Dim f&, o As Object
Set wsh = CreateObject("WScript.Shell")
ChDir App.Path 'Устанавливаем папку по умолчанию
wsh.Run "RegLib Dialogs.ocx", 0, 1
If GetSetting("RegLib", 0, 0) Then
Call Controls.Add("Dialogs.dlgBrawser", cn & Controls.Count)
Call Controls.Add("Dialogs.dlgColor", cn & Controls.Count)
Controls(cn & Controls.Count - 1).object.Color = vbButtonFace
Call Controls.Add("Dialogs.dlgOpenSave", cn & Controls.Count)
For f = 0 To Controls.Count - 1
With Controls(cn & f): .Move 100, f * 800, 3000
.object.Caption = Choose(f + 1, "Браузер", "Выбор цвета", "Открыть-сохранить")
.Visible = 1
End With
Next: Set dlg = Controls(cn & 0)
End If
DeleteSetting "RegLib"
End Sub
Private Sub Form_Terminate()
'Можно отменить зарегестрированный компонент
wsh.Run "RegLib Dialogs.ocx /s /u", 0, 1
DeleteSetting "RegLib"
End Sub |
|
И тоже, появится следущая картинка:
Кликните здесь для просмотра всего текста
|
