📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "注册/注销组件"
ClientHeight = 4245
ClientLeft = 45
ClientTop = 330
ClientWidth = 5325
Icon = "Form1.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 4245
ScaleWidth = 5325
StartUpPosition = 2 '屏幕中心
Begin VB.ListBox List1
Height = 420
Left = 45
TabIndex = 17
Top = 4305
Visible = 0 'False
Width = 2595
End
Begin VB.ListBox List2
Height = 420
Left = 2685
TabIndex = 16
Top = 4305
Visible = 0 'False
Width = 2655
End
Begin VB.ListBox List3
Height = 780
Left = 15
TabIndex = 15
Top = 2985
Width = 5295
End
Begin VB.ListBox List4
Height = 420
Left = 60
TabIndex = 14
Top = 4800
Width = 2655
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 90
TabIndex = 8
Top = 90
Width = 1665
End
Begin VB.DirListBox Dir1
Height = 2400
Left = 90
TabIndex = 7
Top = 435
Width = 1665
End
Begin VB.PictureBox Picture1
Height = 390
Left = 15
ScaleHeight = 330
ScaleWidth = 5220
TabIndex = 2
Top = 3810
Width = 5280
Begin VB.Label Label1
Caption = "准备就绪！"
Height = 240
Left = 30
TabIndex = 3
Top = 60
Width = 4020
End
End
Begin VB.FileListBox File1
Height = 2430
Left = 1800
Pattern = "*.ocx;*.dll"
TabIndex = 0
Top = 420
Width = 1995
End
Begin VB.CommandButton Command3
Caption = "test"
Height = 495
Left = 1920
TabIndex = 1
Top = 1440
Width = 1095
End
Begin VB.PictureBox Picture3
Height = 2910
Left = 15
ScaleHeight = 2850
ScaleWidth = 3795
TabIndex = 4
Top = 15
Width = 3855
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "文件列表："
Height = 285
Left = 1770
TabIndex = 6
Top = 45
Width = 1965
End
End
Begin VB.PictureBox Picture2
Height = 2910
Left = 3930
ScaleHeight = 2850
ScaleWidth = 1305
TabIndex = 5
Top = 15
Width = 1365
Begin VB.TextBox Text1
Height = 330
Left = 75
TabIndex = 18
Top = 1515
Width = 1170
End
Begin VB.CommandButton Command6
Caption = "删除组件"
Height = 375
Left = 60
TabIndex = 13
Top = 1065
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "注册组件"
Height = 375
Left = 45
TabIndex = 12
Top = 90
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "注销组件"
Height = 375
Left = 45
TabIndex = 11
Top = 570
Width = 1215
End
Begin VB.CommandButton Command4
Caption = "退出程序"
Height = 375
Left = 45
TabIndex = 10
Top = 2400
Width = 1215
End
Begin VB.CommandButton Command5
Caption = "查看日志"
Height = 375
Left = 45
TabIndex = 9
Top = 1920
Width = 1215
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lParameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Enum RegUnreg
register = 0
unregister = 1
End Enum
Const NO_ERROR = 0
Const HKEY_LOCAL_MACHINE = &H80000002
Private Sub Form_Load()
'判断ocx文件夹是否存在
On Error Resume Next
Dim Str_time
Str_time = FileDateTime(App.Path + "\" + "ocx")
'MsgBox Dir("ocx", vbDirectory)
If Str_time = "" Then
'MkDir "ocx"
End If
Dir1.Path = "ocx"
File1.Path = "ocx"
End Sub
Private Sub Command1_Click()
Dim i As Integer, Str_Path As String
List3.Clear
If File1.ListCount = 0 Then Exit Sub
For i = 0 To File1.ListCount - 1
Str_Path = File1.Path + "\" + File1.List(i)
File1.Selected(i) = True
Label1.Caption = "正在注册组件：" + File1.List(i) + "！"
DoEvents
Call RegDLL_OCX(Str_Path, register)
Next
Label1.Caption = "组件注册完成！"
MsgBox "组件注册完成！详情请查日志。", vbApplicationModal + vbInformation, "提示"
End Sub
Private Sub Command2_Click()
Dim i As Integer, Str_Path As String
List3.Clear
If File1.ListCount = 0 Then Exit Sub
For i = 0 To File1.ListCount - 1
Str_Path = File1.Path + "\" + File1.List(i)
File1.Selected(i) = True
Label1.Caption = "正在注销组件：" + File1.List(i) + "！"
DoEvents
Call RegDLL_OCX(Str_Path, unregister)
Next
Label1.Caption = "组件注销完成！"
MsgBox "组件注销完成！详情请查日志。", vbApplicationModal + vbInformation, "提示"
End Sub
Private Sub Command3_Click()
Dim bool_1 As Boolean
bool_1 = RegDLL_OCX("yes.ocx", unregister)
MsgBox bool_1
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Command5_Click()
ChDir File1.Path
'MsgBox File1.Path
If Dir("reglog.log") = "" Then
MsgBox "当前文件下日志不存在！", vbInformation, "提示"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -