📄 regunreg.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Caption = "RuActiveX 2.0 beta7"
ClientHeight = 6255
ClientLeft = 4185
ClientTop = 2880
ClientWidth = 7920
Icon = "REGUNREG.frx":0000
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 417
ScaleMode = 3 'Pixel
ScaleWidth = 528
Begin VB.Timer Timer2
Interval = 8000
Left = 3360
Top = 1.20000e5
End
Begin VB.Timer Timer1
Interval = 1000
Left = 840
Top = 4920
End
Begin 工程1.xp_canvas xp_canvas1
Height = 6255
Left = 0
TabIndex = 0
Top = 0
Width = 7935
_extentx = 13996
_extenty = 11033
caption = "RuActiveX 2.0 beta7"
icon = "REGUNREG.frx":08CA
fixed_single = -1 'True
Begin 工程1.xpgroupbox xpgroupbox1
Height = 3975
Left = 2160
TabIndex = 5
Top = 840
Width = 5415
_extentx = 9551
_extenty = 7011
font = "REGUNREG.frx":11A6
backcolor = -2147483626
caption = "请选择ActiveX控件，支持拖放操作"
Begin 工程1.xpcmdbutton xpcmdbutton6
Height = 495
Left = 3720
TabIndex = 10
Top = 3240
Width = 1575
_extentx = 2778
_extenty = 873
enabled = 0 'False
caption = "系统路径注册"
font = "REGUNREG.frx":11CA
End
Begin 工程1.xpcmdbutton xpcmdbutton5
Height = 255
Left = 4560
TabIndex = 9
Top = 480
Width = 735
_extentx = 1296
_extenty = 450
caption = "..."
font = "REGUNREG.frx":11EE
End
Begin VB.TextBox Text1
BackColor = &H00C0FFFF&
Height = 270
Left = 720
TabIndex = 6
Top = 480
Width = 3735
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = $"REGUNREG.frx":1212
Height = 2655
Left = 360
TabIndex = 8
Top = 1080
Width = 5055
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "文件名"
Height = 180
Left = 120
TabIndex = 7
Top = 480
Width = 540
End
End
Begin 工程1.xptopbuttons xptopbuttons3
Height = 315
Left = 7200
Top = 90
Width = 315
_extentx = 556
_extenty = 556
value = 1
enabled = 0 'False
End
Begin 工程1.xptopbuttons xptopbuttons2
Height = 315
Left = 6840
Top = 90
Width = 315
_extentx = 556
_extenty = 556
value = 2
End
Begin 工程1.xptopbuttons xptopbuttons1
Height = 315
Left = 7550
Top = 90
Width = 315
_extentx = 556
_extenty = 556
End
Begin 工程1.xpcmdbutton xpcmdbutton4
Height = 375
Left = 6240
TabIndex = 4
Top = 5640
Width = 1335
_extentx = 2355
_extenty = 661
caption = "退出"
font = "REGUNREG.frx":1324
End
Begin 工程1.xpcmdbutton xpcmdbutton3
Height = 375
Left = 3960
TabIndex = 3
Top = 5640
Width = 1335
_extentx = 2355
_extenty = 661
enabled = 0 'False
caption = "注销控件"
font = "REGUNREG.frx":1348
End
Begin 工程1.xpcmdbutton xpcmdbutton2
Height = 375
Left = 2520
TabIndex = 2
Top = 5640
Width = 1335
_extentx = 2355
_extenty = 661
enabled = 0 'False
caption = "注册控件"
font = "REGUNREG.frx":136C
End
Begin 工程1.xpcmdbutton xpcmdbutton1
Height = 375
Left = 240
TabIndex = 1
Top = 5640
Width = 1335
_extentx = 2355
_extenty = 661
caption = "关于..."
font = "REGUNREG.frx":1390
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 1440
Top = 4920
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "全部支持的类型|*.Ocx;*.dll"
End
Begin VB.Image Image1
Height = 3870
Left = 240
Picture = "REGUNREG.frx":13B4
Top = 840
Width = 1815
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 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()
If App.PrevInstance Then End '避免重复运行程序
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
End Sub
Private Sub Timer2_Timer()
SetProcessWorkingSetSize GetCurrentProcess(), -1&, -1& '内存压缩
End Sub
Private Sub xpcmdbutton1_Click()
Me.Hide '先隐藏主窗体
ShellAbout Me.hWnd, "RuActiveX 2.0 Build 5.11.04", "Created by Mr.David", ByVal 0& '调用系统关于对话框
Me.Show '看完关于对话框后再显示主界面
End Sub
Private Sub xpcmdbutton2_Click()
RegisterOcx '注册控件
End Sub
Private Sub xpcmdbutton3_Click()
UnRegisterOcx '注销控件
End Sub
Private Sub xpcmdbutton4_Click()
Unload Me
End Sub
Private Sub xpcmdbutton5_Click()
CommonDialog1.FileName = "" '打开对话框先清除以前打开的文件名
CommonDialog1.ShowOpen '打开选择对话框
Text1 = CommonDialog1.FileName '将文件名赋值给文本框
End Sub
Private Sub xpcmdbutton6_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 xptopbuttons1_Click()
Unload Me
End Sub
Private Sub xptopbuttons2_Click() '最小化窗体
Me.WindowState = 1
End Sub
Private Sub Timer1_Timer() '实时检测输入的文件是否是为空或ActiveX控件
Dim a As String * 3
If Text1 = "" Then
xpcmdbutton2.Enabled = False
xpcmdbutton3.Enabled = False
xpcmdbutton6.Enabled = False
Else
xpcmdbutton2.Enabled = True
xpcmdbutton3.Enabled = True
xpcmdbutton6.Enabled = True
a = UCase$(Right$(Text1, 3)) '取文本框文件名右边3位然后大写化
If a = "OCX" Or a = "DLL" Then
Else
Me.Hide
Form2.Show
Form2.Label1 = "你选择的文件不是ActiveX控件！"
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.Text = sFileName
End If
End Sub
Private Sub RegisterOcx() '注册控件
menum = RegisterComponent(Trim$(Text1), DllRegisterServer)
If menum = [File Could Not Be Loaded Into Memory Space] Then
Form2.Label1 = "你选择的ActiveX控件不能打开！"
ElseIf menum = [Not A Valid ActiveX Component] Then
Form2.Label1 = "这不是一个合法的ActiveX控件！"
ElseIf menum = [ActiveX Component Registration Failed] Then
Form2.Label1 = "你选择的ActiveX控件注册失败！"
ElseIf menum = [ActiveX Component Registered Successfully] Then
Form2.Label1 = "你选择的ActiveX控件注册成功!"
End If
Me.Hide
Form2.Show
End Sub
Private Sub UnRegisterOcx() '注销控件
menum = RegisterComponent(Trim$(Text1), DllUnRegisterServer)
If menum = [File Could Not Be Loaded Into Memory Space] Then
Form2.Label1 = "你选择的ActiveX控件不能打开！"
ElseIf menum = [Not A Valid ActiveX Component] Then
Form2.Label1 = "这不是一个合法的ActiveX控件！"
ElseIf menum = [ActiveX Component Registration Failed] Then
Form2.Label1 = "你选择的ActiveX控件注销失败！"
ElseIf menum = [ActiveX Component UnRegistered Successfully] Then
Form2.Label1 = "你选择的ActiveX控件注销成功!"
End If
Me.Hide
Form2.Show
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)字符
End Function
Private Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, procOld)
Set Form1 = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -