Option Explicit
'Button数组枚举
Enum ButtonName
iHelp = 1
iCancel = 2
iBack = 3
iNext = 4
iFinish = 5
iOpen = 6
End Enum
Enum FrameName
WelCome = 0
SelectActiveX = 1
End Enum
Enum TextName
About = 0
ActiveXName = 1
ClearText = 2
End Enum
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Sub Form_Load()
Call InitCommonControls
Call ReadOnlyText(txt(About)) '只读文本框
fra(SelectActiveX).Left = fra(WelCome).Left
fra(SelectActiveX).Top = fra(WelCome).Top
End Sub
Private Sub cmd_Click(Index As Integer)
Select Case Index
Case iHelp
dlgOpenFile.HelpFile = App.Path & "\FREEACTIVEX.HLP"
dlgOpenFile.HelpCommand = cdlHelpContents
dlgOpenFile.ShowHelp '调用帮助文件,Action = 6
Case iNext
cmd(iBack).Enabled = True
cmd(iFinish).Enabled = True
cmd(iNext).Enabled = False
fra(WelCome).Visible = False
fra(SelectActiveX).Visible = True
Case iBack
cmd(iBack).Enabled = False
cmd(iNext).Enabled = True
cmd(iFinish).Enabled = False
fra(SelectActiveX).Visible = False
fra(WelCome).Visible = True
Case iOpen
With dlgOpenFile
.FileName = "" '清除上一次打开的文件
.DialogTitle = "想打开哪一个文件呢？" '设置对话框标题上显示的字
.Filter = "All File|*.*|全部支持的类型|*.ocx;*.dll" '给用户提供可以选择的文件类型,分号就是两种类型的文件的分隔符
.FilterIndex = 2 '指定缺省的过滤器 即*.exe
.ShowOpen '打开对话框,Action = 1
End With
txt(ActiveXName).Text = dlgOpenFile.FileName
Case iFinish
If Len(txt(ActiveXName).Text) = 0 Then
MsgBox "你还未选择ActiveOcx控件！", vbCritical, "错误"
ElseIf Len(txt(ClearText).Text) = 0 Then
MsgBox "你还未输入要清除的标题！", vbCritical, "错误"
Else
Call FindTitle
End If
Case iCancel
Unload Me
End Select
End Sub
Public Sub FindTitle()
Dim i As Long, j As Long
Dim abytFile() As Byte
Dim abytTitle() As Byte
Dim BakFileName As String
lblExplain(7).Caption = "正在检索...."
Open txt(ActiveXName) For Binary As #1
ReDim abytFile(FileLen(txt(ActiveXName)))
Get #1, , abytFile
Close #1
abytTitle = txt(ClearText)
Do
If abytFile(i) = abytTitle(0) Then
For j = 1 To UBound(abytTitle)
If abytFile(i + j) <> abytTitle(j) Then Exit For
If j = UBound(abytTitle) Then Exit Do
Next
End If
i = i + 1
If i > UBound(abytFile) Then
MsgBox "未搜索到对话框的标题，请重新选择ActiveX部件！", vbInformation, "失败"
lblExplain(7).Caption = ""
Exit Sub
End If
Loop
BakFileName = Left$(txt(ActiveXName), Len(txt(ActiveXName)) - 4) & ".bak"
FileCopy txt(ActiveXName), BakFileName
Open txt(ActiveXName) For Binary As #1
Put #1, i, 0 '对发现的标题处理首字节,随便你怎么写,目的是破坏资源对话框结构
Close #1
lblExplain(7).Caption = "正在清除...."
MsgBox "清除ActiveX部件对话框成功！", vbInformation, "成功"
lblExplain(7).Caption = ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmMain = Nothing
End Sub
