急求vb课程设计。

2025-03-01 11:14:17

推荐回答（1个）

回答1：

’‘’‘’‘’‘’‘’‘’‘’‘实现在盘中搜索你想找的文件...
‘’‘’‘’‘’‘’‘’‘’‘form1
Option Explicit

Dim Arr()

Dim tempArr()

Dim flag As Boolean

Dim path As String

Dim allDrive As Boolean

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Dim Fs As New FileSystemObject
Private Sub cmdFileCon_Click()
ReDim Arr(0 To 2, 0 To 0)

StatusBar1.Panels(1).Width = 40000

path = dSub.path

savePath path

FG1.aaBindArr Arr

StatusBar1.Panels(1).Text = "完成" & UBound(Arr, 2) & ""

End Sub
Sub savePath(path)
On Error Resume Next

StatusBar1.Panels(1).Text = "正在查找....." & path

Dim Upfd As Folder
Dim Fd As Folder
Dim Fi As File

' For Each Upfd In Fs.GetDrive(path).RootFolder
' addArr Upfd, "文件夹"
' savePath Upfd
' Next
For Each Fd In Fs.GetFolder(path).SubFolders
addArr Fd, "文件夹"
savePath Fd
Next

For Each Fi In Fs.GetFolder(path).Files
addArr Fi, "文件"

Next

End Sub
Sub addArr(path, cla)

ReDim Preserve Arr(0 To UBound(Arr, 1), 0 To UBound(Arr, 2) + 1)

Arr(1, UBound(Arr, 2)) = cla
Arr(2, UBound(Arr, 2)) = path

End Sub

Private Sub Command1_Click()
Dim Di As Drive
ReDim Arr(0 To 2, 0 To 0)
StatusBar1.Panels(1).Width = 40000

For Each Di In Fs.Drives

savePath Di & "\"

Next

FG1.aaBindArr Arr

StatusBar1.Panels(1).Text = "完成 " & UBound(Arr, 2) & ""
End Sub
Private Sub Command2_Click()

If Combo1.Text = "指定盘符" Then
cmdFileCon_Click
Else

Command1_Click

End If

SeleArr Arr, tempArr, "*" & Text1.Text & "*", 2

FG1.Rows = 1
FG1.Refresh

FG1.AutoRedraw = True

FG1.aaBindArr tempArr
StatusBar1.Panels(1).Text = "合计" & UBound(tempArr, 2)

End Sub

Private Sub Command3_Click()
'''''''''''''打开选中的文件选项
Select Case Right(Trim(FG1.Cell(FG1.ActiveCell.row, FG1.ActiveCell.Col).Text), 3)
Case "exe"
Shell Trim(FG1.Cell(FG1.ActiveCell.row, FG1.ActiveCell.Col).Text)
Case "txt"

Shell "notepad.exe " & FG1.ActiveCell.Text, vbNormalFocus

Case Else

' Call ShellExecute(0, "open", Trim(FG1.Cell(FG1.ActiveCell.row, FG1.ActiveCell.Col).Text), vbNullString, vbNormalFocus)
'

End Select

End Sub

Private Sub drMain_Change()

dSub.path = drMain.Drive & "\"

End Sub

Private Sub dSub_Click()

path = dSub.path

End Sub

Private Sub dSub_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
path = dSub.path
End Sub

Private Sub FG1_DblClick()
'''''''''''
On Error Resume Next

Select Case Right(Trim(FG1.Cell(FG1.ActiveCell.row, FG1.ActiveCell.Col).Text), 3)
Case "exe"
Shell Trim(FG1.Cell(FG1.ActiveCell.row, FG1.ActiveCell.Col).Text)
Case "txt"

Shell "notepad.exe " & FG1.ActiveCell.Text, vbNormalFocus

Case "xls"

Shell "excel.exe " & FG1.ActiveCell.Text, vbNormalFocus
Case ""

Case Else
If Left(Right(Trim(FG1.Cell(FG1.ActiveCell.row, FG1.ActiveCell.Col).Text), 4), 1) = "." Then

End If

MsgBox "请使用专用工具打开!"
End Select

End Sub

Private Sub Form_Load()
Label1.Caption = "#双击文件夹表示选中"

Dim X As Printer

For Each X In Printers
Set Printer = X

Next

Combo1.AddItem "指定盘符"
Combo1.AddItem "全盘搜索"

End Sub

'''''''''''''''''''模块
Option Explicit

Sub SeleArr(Arr1, Arr2, Str, KeyCol _
, Optional Str1 As String = "", Optional KeyCol1 = -1 _
, Optional Str2 As String = "", Optional KeyCol2 = -1 _
, Optional Str3 As String = "", Optional KeyCol3 = -1 _
, Optional Str4 As String = "", Optional KeyCol4 = -1 _
, Optional Str5 As String = "", Optional KeyCol5 = -1)
Dim t As Long, p As Long

Dim IsIt As String

ReDim Arr2(0 To UBound(Arr1, 1), 0 To UBound(Arr1, 2))

For p = 1 To UBound(Arr1)
Arr2(p, 0) = Arr1(p, 0)
Next

Dim row As Long
For t = 1 To UBound(Arr1, 2)
IsIt = ""
If Not (Vstr(Arr1(KeyCol, t)) Like Str) Then GoTo DoDo

If KeyCol1 <> -1 Then
If Not (Vstr(Arr1(KeyCol1, t)) Like Str1) Then GoTo DoDo
End If

If KeyCol2 <> -1 Then
If Not (Vstr(Arr1(KeyCol2, t)) Like Str2) Then GoTo DoDo
End If

If KeyCol3 <> -1 Then
If Not (Vstr(Arr1(KeyCol3, t)) Like Str3) Then GoTo DoDo
End If

If KeyCol4 <> -1 Then
If Not (Vstr(Arr1(KeyCol4, t)) Like Str4) Then GoTo DoDo
End If

If KeyCol5 <> -1 Then
If Not (Vstr(Arr1(KeyCol5, t)) Like Str5) Then GoTo DoDo
End If

row = row + 1
For p = 1 To UBound(Arr1)
Arr2(p, row) = Arr1(p, t)
Next
DoDo:
Next
ReDim Preserve Arr2(0 To UBound(Arr1, 1), 0 To row)
End Sub

Function Vstr(Str, Optional ByVal Rep As String = "")
On Error GoTo 100
If IsNull(Str) Then GoTo 100
Vstr = Str & ""
Exit Function
100
Vstr = Rep
End Function

Function VValue(Str, Optional ByVal Rep = 0)
On Error GoTo 100
If IsNull(Str) Then GoTo 100
VValue = Str * 1
Exit Function
100
VValue = Rep
End Function

'

最新问答

交通银行天津分行的工资高吗？

好的CF辅助YY频道

请比较蒲松龄的狼一三则与第二则狼的相同与不同之处

我是今年的湖南考生，为什么每次登陆湖南信息港是总是显示考生号错误或不存在

女人为什么要找感情寄托？为什么？

世界上女排最强的国家是哪个国家?前10

她发表说了一句我会好好珍惜你，我该怎么去接下一句？

在Android上用videoView远程播放MP4时，对MP4格式有什么要求

中国四大地区的显著特点

药学专业考公务员范围