📄 frm_find.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Frm_Find
BorderStyle = 1 'Fixed Single
Caption = "查找触摸屏程序路径"
ClientHeight = 4500
ClientLeft = 45
ClientTop = 330
ClientWidth = 6975
Icon = "Frm_Find.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4500
ScaleWidth = 6975
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton VsNetBut4
Caption = "关闭(&X)"
Height = 375
Left = 4080
TabIndex = 15
Top = 4080
Width = 1335
End
Begin VB.CommandButton VsNetBut3
Caption = "保存(&S)"
Height = 375
Left = 1320
TabIndex = 14
Top = 4080
Width = 1335
End
Begin VB.Frame Frame2
Caption = "符合条件的所有文件"
Height = 1455
Left = 0
TabIndex = 7
Top = 2520
Visible = 0 'False
Width = 6975
Begin VB.ListBox List1
ForeColor = &H00FF0000&
Height = 1140
Left = 120
TabIndex = 10
Top = 240
Width = 6735
End
Begin VB.FileListBox File1
Height = 810
Left = 2400
TabIndex = 9
Top = 240
Visible = 0 'False
Width = 2175
End
Begin VB.DirListBox Dir1
Height = 720
Left = 120
TabIndex = 8
Top = 240
Visible = 0 'False
Width = 2175
End
End
Begin MSComDlg.CommonDialog Cmd
Left = 5400
Top = 120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "Exe文件(*.exe)|*.exe|所有文件(*.*)|*.*"
End
Begin VB.Frame Frame1
Height = 2415
Left = 0
TabIndex = 0
Top = 0
Width = 6975
Begin VB.CommandButton VsNetBut2
Caption = "查找(&S)"
Height = 375
Left = 5400
TabIndex = 13
Top = 1800
Width = 1455
End
Begin VB.CommandButton VsNetBut1
Caption = "选择(&C)"
Height = 375
Left = 5400
TabIndex = 12
Top = 720
Width = 1455
End
Begin VB.TextBox Text2
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
Locked = -1 'True
TabIndex = 5
Top = 1800
Width = 4455
End
Begin VB.OptionButton Option2
Caption = "自动查找触摸屏程序所在路径："
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 4
Top = 1440
Width = 2895
End
Begin VB.OptionButton Option1
Caption = "手工指定触摸屏程序所在路径："
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 3
Top = 360
Width = 2895
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
Locked = -1 'True
TabIndex = 1
Top = 720
Width = 4455
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "正在查找触摸屏文件，请稍等....."
ForeColor = &H000000FF&
Height = 180
Left = 3360
TabIndex = 11
Top = 1470
Visible = 0 'False
Width = 2790
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "路径->"
ForeColor = &H000000FF&
Height = 180
Index = 1
Left = 240
TabIndex = 6
Top = 1920
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "路径->"
ForeColor = &H000000FF&
Height = 180
Index = 0
Left = 240
TabIndex = 2
Top = 840
Width = 540
End
Begin VB.Shape Shape1
FillColor = &H00FF0000&
FillStyle = 0 'Solid
Height = 45
Left = 120
Top = 1200
Width = 6750
End
End
End
Attribute VB_Name = "Frm_Find"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim sarray() As String
Dim FileNamePath As String
Private Sub Command1_Click()
End Sub
Private Sub Form_Load()
Text2.Enabled = False
Text2.BackColor = &H8000000B
VsNetBut2.Enabled = False
Frame2.Visible = False
VsNetBut3.Top = 2480
VsNetBut4.Top = 2480
Me.Height = 3270
End Sub
Private Sub List1_Click()
If List1.ListCount = 0 Then
Exit Sub
Else
Text2.Text = UCase(List1.Text)
End If
End Sub
Private Sub Option1_Click()
Text1.Enabled = True
Text1.BackColor = vbWhite
VsNetBut1.Enabled = True
Text2.Text = ""
Text2.Enabled = False
Text2.BackColor = &H8000000B '灰色
VsNetBut2.Enabled = False
'收缩Frame2
Frame2.Visible = False
VsNetBut3.Top = 2480
VsNetBut4.Top = 2480
Me.Height = 3270
End Sub
Private Sub Option2_Click()
Text1.Text = ""
Text1.Enabled = False
Text1.BackColor = &H8000000B
VsNetBut1.Enabled = False
Text2.Enabled = True
Text2.BackColor = vbWhite
VsNetBut2.Enabled = True
'展开Frame2
Me.Height = 4875
Frame2.Visible = True
VsNetBut3.Top = 4080
VsNetBut4.Top = 4080
End Sub
Private Sub VsNetBut1_Click()
Cmd.ShowOpen
If Cmd.filename = "" Then
MsgBox "你没有选择触摸屏程序的路径!", vbOKOnly + vbInformation, "提示"
FileNamePath = ""
Exit Sub
Else
FileNamePath = UCase(Cmd.filename)
End If
Text1.Text = FileNamePath
End Sub
Private Sub VsNetBut2_Click()
Call 查找文件
End Sub
Private Sub VsNetBut3_Click()
Dim myIniFile As New cIniFile
myIniFile.INIFile = App.Path & "\Txt\setting.ini"
If Text1.Text = "" Then
Cmp_File = Text2.Text
Else
Cmp_File = Text1.Text
End If
myIniFile.WriteFile "setting", "FilePath", Cmp_File
MsgBox "路径已保存!", 64, "提示"
End Sub
Private Sub VsNetBut4_Click()
Unload Me
End Sub
Sub DirWalk(ByVal sPattern As String, ByVal CurrDir As String, sFound() As String)
'定义变量
Dim i As Integer, sCurrPath As String, sFile As String, ii As Integer
Dim iFiles As Integer, iLen As Integer
If Right$(CurrDir, 1) <> "\" Then
Dir1.Path = CurrDir & "\"
Else
Dir1.Path = CurrDir
End If
For i = 0 To Dir1.ListCount
If Dir1.List(i) <> "" Then
DoEvents
Call DirWalk(sPattern, Dir1.List(i), sFound())
Else
If Right$(Dir1.Path, 1) = "\" Then
sCurrPath = Left(Dir1.Path, Len(Dir1.Path) - 1)
Else
sCurrPath = Dir1.Path
End If
File1.Path = sCurrPath
File1.Pattern = sPattern
If File1.ListCount > 0 Then
'在目录中找到符合的文件
For ii = 0 To File1.ListCount - 1
ReDim Preserve sFound(UBound(sFound) + 1)
sFound(UBound(sFound) - 1) = sCurrPath & "\" & File1.List(ii)
Next ii
End If
iLen = Len(Dir1.Path)
Do While Mid(Dir1.Path, iLen, 1) <> "\"
iLen = iLen - 1
Loop
Dir1.Path = Mid(Dir1.Path, 1, iLen)
End If
Next i
'使用方法如下，如果要加快查找速度，可以将File1和Dir1的Visiable设为False
'找寻 Windows 目录下文件类型为 OLE*.DLL 的所有文件
'Call DirWalk("OLE*.DLL", "C:\WINNT", sarray)
End Sub
Sub 查找文件()
On Error Resume Next
Dim i As Integer
Me.MousePointer = 11
Label1.Visible = True
List1.Clear
ReDim sarray(0) As String
'找寻目录下文件名为"HiTouch.exe"的所有文件
Call DirWalk("HiTouch.exe", "C:", sarray)
'Call DirWalk("Hitouch.exe", "D:", sarray)
'Call DirWalk("Hitouch.exe", "E:", sarray)
'将阵列的资料放到 List1 中
For i = LBound(sarray) To UBound(sarray) - 1
List1.AddItem sarray(i)
Next
Me.MousePointer = 0
Label1.Visible = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -