form1.frm

主要是一些文件操作的技巧

VERSION 5.00
Begin VB.Form frmFind 
   Caption         =   "查找"
   ClientHeight    =   5955
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8235
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   14.25
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5955
   ScaleWidth      =   8235
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox List1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4020
      Left            =   3480
      TabIndex        =   10
      Top             =   480
      Width           =   4215
   End
   Begin VB.DirListBox Dir2 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   510
      Left            =   120
      TabIndex        =   9
      Top             =   5040
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.DirListBox Dir1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2190
      Left            =   480
      TabIndex        =   8
      Top             =   2160
      Width           =   2655
   End
   Begin VB.TextBox txtFile 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   480
      TabIndex        =   6
      Text            =   "*.*"
      Top             =   480
      Width           =   2055
   End
   Begin VB.DriveListBox Drive1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   480
      TabIndex        =   4
      Top             =   1320
      Width           =   2655
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   5760
      TabIndex        =   2
      Top             =   4920
      Width           =   1695
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   3720
      TabIndex        =   1
      Top             =   4920
      Width           =   1695
   End
   Begin VB.CommandButton cmdFind 
      Caption         =   "查找"
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1680
      TabIndex        =   0
      Top             =   4920
      Width           =   1695
   End
   Begin VB.Label Label3 
      Caption         =   "开始目录："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   480
      TabIndex        =   7
      Top             =   1920
      Width           =   1095
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "驱动器："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   180
      Left            =   480
      TabIndex        =   5
      Top             =   1080
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "文件名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   180
      Left            =   480
      TabIndex        =   3
      Top             =   240
      Width           =   720
   End
End
Attribute VB_Name = "frmFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Abort As Integer

Private Sub cmdCancel_Click()
    '查找过程中用户选择取消
    Abort = -1
End Sub

Private Sub cmdExit_Click()
    End
End Sub

Private Sub cmdFind_Click()
    Dim i As Integer
    '
    '除了cmdCancel按钮外
    'Disable所有的控件当程序处于查找状态时
    cmdFind.Enabled = False
    txtFile.Enabled = False
    Drive1.Enabled = False
    Dir1.Enabled = False
    cmdCancel.Enabled = True
    '
    '清除列表框
    List1.Visible = False
    '让用户知道程序的进程
    CurrentX = List1.Left
    CurrentY = List1.Top + List1.Height / 2
    Print "清除列表框"
    For i = List1.ListCount - 1 To 0 Step -1
        List1.RemoveItem i
    Next i
    List1.Visible = True
    Abort = 0 '清除取消标志
    '
    '触发Dir2_Change事件
    If Dir2.Path = Dir1.Path Then
        Dir2_Change
    Else
        Dir2.Path = Dir1.Path
    End If
    '
    '查找完毕后恢复控件的Enabled属性
    cmdFind.Enabled = True
    txtFile.Enabled = True
    Drive1.Enabled = True
    Dir1.Enabled = True
    cmdCancel.Enabled = False
    cmdFind.SetFocus
End Sub

Private Sub Dir2_Change()
    '扫描当前的目录及其子目录
    '以查找相吻合的文件名
    Dim DirCount As Integer
    Dim i As Integer
    Dim T As Integer
    Dim FileName As String
    Dim SearchPath As String
    Dim DirList() As String
    '
    '在列表框中显示目录
    '初始化SearchPath
    List1.AddItem "-->" + Dir2.Path
    SearchPath = Dir2.Path
    If Right$(SearchPath, 1) <> "\" Then
        SearchPath = SearchPath + "\"
    End If
    SearchPath = SearchPath + txtFile.Text
    '
    '在当前的目录中查找符合的文件
    FileName = Dir$(SearchPath)
    Do While FileName <> ""
        List1.AddItem "        " + FileName
        FileName = Dir$
    Loop
    '
    '保存当前目录的所有子目录
    DirCount = Dir2.ListCount
    ReDim DirList(DirCount) As String
    For i = 0 To DirCount - 1
        DirList(i) = Dir2.List(i)
    Next i
    '
    '顺序扫描各个子目录
    '由于该过程较长，程序应该让用户在扫描的过程中选择Cancel
    For i = 0 To DirCount - 1
        T = DoEvents()
        If Abort Then Exit Sub
        Dir2.Path = DirList(i)
    Next i
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Private Sub txtFile_GotFocus()
    '高亮文本框内容
    txtFile.SelStart = 0
    txtFile.SelLength = Len(txtFile.Text)
End Sub