form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Begin VB.Form form1 
   Caption         =   "快速全盘文件查找"
   ClientHeight    =   3975
   ClientLeft      =   2655
   ClientTop       =   3105
   ClientWidth     =   7305
   ClipControls    =   0   'False
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3975
   ScaleWidth      =   7305
   StartUpPosition =   1  '所有者中心
   Begin VB.ListBox List1 
      Height          =   2580
      Left            =   2340
      TabIndex        =   10
      Top             =   105
      Width           =   4890
   End
   Begin VB.TextBox Text2 
      Height          =   330
      Left            =   5610
      TabIndex        =   6
      Text            =   "*.*"
      Top             =   3240
      Width           =   1620
   End
   Begin VB.TextBox Text1 
      Height          =   300
      Left            =   555
      TabIndex        =   5
      Text            =   "Text1"
      Top             =   3240
      Width           =   3930
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      Height          =   345
      Left            =   5910
      TabIndex        =   4
      Top             =   3615
      Width           =   1300
   End
   Begin VB.CommandButton Command2 
      Caption         =   "停止"
      Height          =   345
      Left            =   4590
      TabIndex        =   3
      Top             =   3615
      Width           =   1300
   End
   Begin VB.CommandButton Command1 
      Caption         =   "查找"
      Height          =   345
      Left            =   3270
      TabIndex        =   2
      Top             =   3615
      Width           =   1300
   End
   Begin VB.DirListBox Dir1 
      Height          =   2610
      Left            =   105
      TabIndex        =   1
      Top             =   465
      Width           =   2160
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   105
      TabIndex        =   0
      Top             =   105
      Width           =   2190
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "文件个数："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   2460
      TabIndex        =   9
      Top             =   2835
      Width           =   4785
   End
   Begin VB.Label Label2 
      Caption         =   "查找文件"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   4530
      TabIndex        =   8
      Top             =   3270
      Width           =   1005
   End
   Begin VB.Label Label1 
      Caption         =   "路径："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   270
      Left            =   30
      TabIndex        =   7
      Top             =   3285
      Width           =   540
   End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit      '声明函数
Dim lhwnd As String
Dim dirs, Dir$, files As Integer
Dim isrun As Boolean
Dim WFD As WIN32_FIND_DATA, hItem&, hFile&
Private Sub Form_Load()
  lhwnd = List1.hwnd
  SendMessage lhwnd, LB_INITSTORAGE, 30000&, ByVal 30000& * 200
End Sub
Private Sub Form_Activate()    '设定默认路径
  Dir1.Path = App.Path
  Drive1.Drive = Left(Dir1.Path, 3)
End Sub
Private Sub Dir1_Change()    '选择文件夹
  Text1.Text = Dir1.Path & "\"
End Sub
Private Sub Drive1_Change()   '选择驱动器
  Dir1.Path = Drive1.Drive
End Sub
Private Sub SearchDirs(filepath$)
  Dim dircount, i As Integer
  Dim dirarray()
  DoEvents
  If Not isrun Then Exit Sub
  hItem& = FindFirstFile(filepath$ & "*.*", WFD)     '查找文件
  If hItem& <> INVALID_HANDLE_VALUE Then
     Do
     If (WFD.dwFileAttributes And vbDirectory) Then
         If Asc(WFD.cFileName) <> 46 Then
            dirs = dirs + 1
            If (dircount Mod 10) = 0 Then ReDim Preserve dirarray(dircount + 10)
               dircount = dircount + 1
               dirarray(dircount) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
            End If
          Else
            files = files + 1
         End If
     Loop While FindNextFile(hItem&, WFD)
     Call FindClose(hItem&)      '关闭FindFirstFile
     End If
       SendMessage lhwnd, WM_SETREDRAW, 0, 0
       hFile& = FindFirstFile(filepath$ & Dir$, WFD)
       If hFile& <> INVALID_HANDLE_VALUE Then
          Do
            DoEvents
            If Not isrun Then Exit Sub
            SendMessage lhwnd, LB_ADDSTRING, 0, _
            ByVal filepath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
            Label3.Caption = "文件个数： " & List1.ListCount & " 个"
          Loop While FindNextFile(hFile&, WFD)
          Call FindClose(hFile&)
       End If
        SendMessage lhwnd, WM_VSCROLL, SB_BOTTOM, 0
        SendMessage lhwnd, WM_SETREDRAW, 1, 0
  For i = 1 To dircount: SearchDirs filepath$ & dirarray(i) & "\": Next i
End Sub
Private Sub Text1_Change()   '
  If Len(Text1.Text) = 4 Then Text1.Text = Left(Text1.Text, 3)   '去掉路径中的\
End Sub
Private Sub Command1_Click()   '查找文件
  On Error Resume Next
  If isrun Then: isrun = False: Exit Sub
  Dir$ = Text2.Text
  MousePointer = 11
  isrun = True
  List1.Clear      '清空列表
  If isrun Then Call SearchDirs(Text1.Text)  '调用函数查找文件
  Label3.Caption = "文件个数： " & List1.ListCount & " 个"
  isrun = False
  MousePointer = 0
End Sub
Private Sub Command2_Click()    '停止查找
  isrun = False
  MousePointer = 0
End Sub
Private Sub Command3_Click()
  End
End Sub