📄 regunreg.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "RuActiveX 2.0 beta8"
ClientHeight = 5610
ClientLeft = 3750
ClientTop = 4680
ClientWidth = 7995
Icon = "REGUNREG.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5610
ScaleWidth = 7995
Begin 工程1.YFSkin YFSkin1
Left = 1800
Top = 4800
_ExtentX = 1561
_ExtentY = 529
End
Begin VB.Timer Timer2
Interval = 8000
Left = 3360
Top = 8000
End
Begin VB.Timer Timer1
Interval = 1000
Left = 2400
Top = 2280
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3720
Top = 3480
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "全部支持的类型|*.Ocx;*.dll"
End
Begin VB.CommandButton Command3
Caption = "退出"
Height = 375
Left = 6480
TabIndex = 6
Top = 4800
Width = 1215
End
Begin VB.Frame Frame1
Caption = "请选择ActiveX控件，支持拖放操作"
Height = 3855
Left = 2280
TabIndex = 3
Top = 360
Width = 5535
Begin VB.CommandButton Command5
Caption = "系统路径注册"
Enabled = 0 'False
Height = 495
Left = 3480
TabIndex = 9
Top = 3120
Width = 1935
End
Begin VB.CommandButton Command4
Caption = "..."
Height = 255
Left = 4800
TabIndex = 7
Top = 360
Width = 615
End
Begin VB.TextBox Text1
BackColor = &H00C0FFFF&
Height = 270
Left = 840
TabIndex = 5
Top = 360
Width = 3735
End
Begin VB.Label Label2
Caption = $"REGUNREG.frx":08CA
Height = 2535
Left = 120
TabIndex = 8
Top = 840
Width = 5295
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "文件名"
Height = 180
Left = 120
TabIndex = 4
Top = 360
Width = 540
End
End
Begin VB.CommandButton Command2
Caption = "关于..."
Height = 375
Left = 240
TabIndex = 2
Top = 4800
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "注 销 控 件"
Default = -1 'True
Enabled = 0 'False
Height = 375
Index = 1
Left = 4200
TabIndex = 1
Top = 4800
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "注册 控件"
Enabled = 0 'False
Height = 375
Index = 0
Left = 2760
TabIndex = 0
Top = 4800
Width = 1335
End
Begin VB.Image Image1
Height = 3870
Left = 120
Picture = "REGUNREG.frx":09E0
Top = 360
Width = 1815
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 Const MAX_PATH = 260
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Sub Form_Initialize()
Association
If App.PrevInstance Then End '避免重复运行程序
YFSkin1.SkinInit Me
YFSkin1.Caption = "ActiveX 2.0 beta8"
End Sub
Private Sub Form_Load()
DragAcceptFiles Me.hwnd, 1& '窗体所有控件支持拖放
procOld = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WindowProc)
If GetSystemMetrics(0) = 1024 Then Me.Left = 3705: Me.Top = 4245 '根据屏幕分辨率设定启动位置
If GetSystemMetrics(0) = 800 Then Me.Top = 1710: Left = 2385
If Command <> "" Then Text1 = Command
End Sub
Private Sub Command1_Click(index As Integer)
Select Case index
Case 0 '注册按钮
RegisterOcx '注册控件
Case 1 '注销按钮
UnRegisterOcx '注销控件
End Select
End Sub
Private Sub Command2_Click()
Me.Hide '先隐藏主窗体
ShellAbout Me.hwnd, "RuActiveX 2.0 Build 12.10.06", "Created by Mr.David", ByVal 0& '调用系统关于对话框
Me.Show '看完关于对话框后在显示主界面
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command4_Click()
CommonDialog1.FileName = "" '打开对话框先清除以前打开的文件名
CommonDialog1.ShowOpen '打开选择对话框
Text1 = CommonDialog1.FileName '将文件名赋值给文本框
End Sub
Private Sub Command5_Click()
Dim lFileOp As Long
Dim lresult As Long
Dim lFlags As Long
Dim SHFileOp As SHFILEOPSTRUCT
Dim A As Long
Dim B As String * 1
Dim C As Long
Dim D As String
Dim i As Long
A = Len(Text1) '首先获取选择文件字符串长度
For i = 1 To A '从路径中的"\"字符分离出ActiveX控件名，不含路径
B = Mid$(Text1, A, 1) '从最后一位字符开始取一位字符
If B = "\" Then D = Right$(Text1, C): GoTo 1 '如果找到最后的"\"字符，则退出循环并保存ActiveX控件名
C = C + 1 '计数器加1
A = A - 1 '字符总数减一，继续判断下一位
Next i
1
D = MyGetSystemDirectory & "\" & D '得出系统路径控件名
lFileOp = FO_MOVE '移动文件
With SHFileOp
.wFunc = lFileOp
.pFrom = Text1 & vbNullChar & vbNullChar
.pTo = D & vbNullChar & vbNullChar
.fFlags = lFlags
End With
lresult = SHFileOperation(SHFileOp)
If lresult <> 0 Or SHFileOp.fAborted Then Exit Sub
Text1 = D
RegisterOcx '注册控件
End Sub
Private Sub Timer1_Timer() '实时检测输入的文件是否是为空或ActiveX控件
Dim A As String * 3
If Text1 = "" Then
Command1(0).Enabled = False
Command1(1).Enabled = False
Command1(1).Enabled = False
Command5.Enabled = False
Else
Command1(0).Enabled = True
Command1(1).Enabled = True
Command1(1).Enabled = True
Command5.Enabled = True
A = UCase$(Right$(Text1, 3)) '取文本框文件名右边3位然后大写化
If A = "OCX" Or A = "DLL" Then
Else
MsgBox "你选择文件不是ActiveX控件！", vbExclamation
Text1 = ""
End If
End If
End Sub
Public Sub DropFiles(ByVal hDrop&) '不能私有过程
Dim sFileName$, nCharsCopied&
sFileName = String$(MAX_PATH, vbNullChar)
nCharsCopied = DragQueryFile(hDrop, 0&, sFileName, MAX_PATH)
DragFinish hDrop
If nCharsCopied Then
sFileName = Left$(sFileName, nCharsCopied)
Text1 = sFileName
End If
End Sub
Private Sub RegisterOcx() '注册控件
menum = RegisterComponent(Trim$(Text1), DllRegisterServer)
If menum = [File Could Not Be Loaded Into Memory Space] Then
MsgBox "文件不能打开！", vbExclamation
ElseIf menum = [Not A Valid ActiveX Component] Then
MsgBox "这不是一个合法的ActiveX控件！", vbExclamation
ElseIf menum = [ActiveX Component Registration Failed] Then
MsgBox "ActiveX控件注册失败！", vbExclamation
ElseIf menum = [ActiveX Component Registered Successfully] Then
MsgBox "ActiveX控件注册成功!", vbExclamation
End If
End Sub
Private Sub UnRegisterOcx() '注销控件
menum = RegisterComponent(Trim$(Text1), DllUnRegisterServer)
If menum = [File Could Not Be Loaded Into Memory Space] Then
MsgBox "文件不能打开！", vbExclamation
ElseIf menum = [Not A Valid ActiveX Component] Then
MsgBox "这不是一个合法的ActiveX控件！", vbExclamation
ElseIf menum = [ActiveX Component Registration Failed] Then
MsgBox "ActiveX控件注销失败！", vbExclamation
ElseIf menum = [ActiveX Component UnRegistered Successfully] Then
MsgBox "ActiveX控件注销成功！", vbExclamation
End If
End Sub
Private Function MyGetSystemDirectory() As String '获取Windows系统路径
Dim sSave As String, Ret As Long
sSave = Space$(255) '建立一个缓冲区
Ret = GetSystemDirectory(sSave, 255) 'Api函数获取系统路径存入sSave,Ret返回路径长度
MyGetSystemDirectory = Left$(sSave, Ret) '清除路径中所有多余的Chr(0)字符
'MsgBox "Windows System directory: " + sSave '调试用输出信息框
End Function
Private Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, procOld)
Set Form1 = Nothing
End Sub
Private Sub Timer2_Timer()
SetProcessWorkingSetSize GetCurrentProcess(), -1&, -1& '内存压缩
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -