家庭/个人应用

开发平台：
Visual Basic

find.frm：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Find 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "查找"
   ClientHeight    =   2340
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4800
   ControlBox      =   0   'False
   Icon            =   "find.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2340
   ScaleWidth      =   4800
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "查找范围"
      Height          =   495
      Left            =   120
      TabIndex        =   3
      Top             =   720
      Width           =   3135
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "Label2"
         ForeColor       =   &H000000FF&
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   240
         Width           =   2895
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "查找内容"
      Height          =   615
      Left            =   120
      TabIndex        =   7
      Top             =   1320
      Width           =   3135
      Begin VB.CheckBox Check2 
         Caption         =   "文件"
         Height          =   255
         Left            =   1080
         TabIndex        =   9
         Top             =   240
         Value           =   1  'Checked
         Width           =   735
      End
      Begin VB.CheckBox Check1 
         Caption         =   "文件夹"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   240
         Value           =   1  'Checked
         Width           =   855
      End
   End
   Begin MSComctlLib.TreeView TreeView1 
      Height          =   975
      Left            =   3480
      TabIndex        =   6
      Top             =   1200
      Visible         =   0   'False
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   1720
      _Version        =   393217
      Style           =   7
      Appearance      =   1
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "返回"
      Height          =   375
      Left            =   3480
      TabIndex        =   2
      Top             =   720
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   3480
      TabIndex        =   1
      Top             =   240
      Width           =   1095
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   3135
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Height          =   180
      Left            =   120
      TabIndex        =   10
      Top             =   2040
      Width           =   90
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "请输入待查找的文件夹或文件名"
      Height          =   180
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   2520
   End
End
Attribute VB_Name = "Find"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim FindString As String
Dim Found As Boolean
Dim FoundOne As Boolean
Found = False
FindString = Trim(Text1.Text)
If FindString = "" Then
   Text1.SetFocus
   Exit Sub
End If
Me.Caption = "正在查找中...这需要一些时间,请稍候!"
TreeView1.Nodes.Clear
Me.MousePointer = 11
Dim FindKey As String
FindKey = "@@@@@***##查找结果@@@@@***##"
If Left(MainForm.TreeView1.SelectedItem.Key, 3) = "光盘库" Then
   ''''''''''''''''''''''''''''''''''''''''''''''''''''
      FoundOne = False
      Me.MousePointer = 11
      Me.TreeView1.Nodes.Clear
      ''''''''''''''''''''''''删除以前查找结果
      For i = 1 To MainForm.TreeView1.Nodes.Count
          If MainForm.TreeView1.Nodes(i).Key = FindKey Then
             Set nox = MainForm.TreeView1.Nodes(i).Child
             For ii = 1 To MainForm.TreeView1.Nodes(i).Children
                fname = nox.Text + ".fnd"
                If Dir(fname) <> "" Then
                   Kill fname
                End If
                If ii < MainForm.TreeView1.Nodes(i).Children Then
                   Set nox = nox.Next
                End If
             Next
             MainForm.TreeView1.Nodes.Remove i
             Exit For
           End If
      Next
      MainForm.TreeView1.Nodes.Add , , FindKey, "查找结果", 5
   '设置查找范围
      Dim CdromArray() As Node
      Dim nod As Node
      kk = 0
   If MainForm.TreeView1.SelectedItem.Key = "光盘库" Then
      For i = 2 To MainForm.TreeView1.Nodes.Count
          If Left(MainForm.TreeView1.Nodes(i).Key, 3) = "子光盘" Then
             ReDim Preserve CdromArray(kk) As Node
             Set CdromArray(kk) = MainForm.TreeView1.Nodes(i)
             kk = kk + 1
          End If
      Next
   Else
      For i = 2 To MainForm.TreeView1.Nodes.Count - 1
          If MainForm.TreeView1.Nodes(i).Parent.Key = MainForm.TreeView1.SelectedItem.Key Then
             ReDim Preserve CdromArray(kk) As Node
             Set CdromArray(kk) = MainForm.TreeView1.Nodes(i)
             kk = kk + 1
          End If
      Next
   End If
      For zz = 0 To UBound(CdromArray)
      Set nod = CdromArray(zz)
      CdromName = nod.Text
      '''************'''从文件中读取光盘镜像
      Label3.Caption = "读取光盘 " + nod.Text + " ..."
      Me.Refresh
      If Dir(nod.Text + ".cdo") = "" Then
         MsgBox "光盘 " + Chr(34) + nod.Text + Chr(34) + " 镜像文件丢失，请重新生成!", vbCritical
         Me.MousePointer = 0
         Me.Caption = "查找"
         Me.Label3 = "发生严重错误！请检查光盘镜像的好与坏！"
         Exit Sub
      End If
        Dim FileNotes As String
        fnum = FreeFile
        Open nod.Text + ".cdo" For Input As #fnum
        Line Input #fnum, FileNotes
        If FileNotes <> "@@@@@***##光盘镜像文件@@@@@***##" Then
         MsgBox "非法的光盘镜像文件 " + Chr(34) + nod.Text + Chr(34) + Chr(13) + Chr(13) + "请重新生成光盘镜像文件!", vbCritical
         Close fnum
         Me.MousePointer = 0
         Me.Caption = "查找"
         Me.Label3 = "发生严重错误！请检查光盘镜像文件的好坏！"
         Exit Sub
        Else
         '''正式开始
         MainForm.TreeView2.Nodes.Clear
         Line Input #fnum, FileNotes
         MainForm.TreeView2.Nodes.Add , , FileNotes, FileNotes, 1
            Do While Not EOF(fnum)
            Line Input #fnum, FileNotes
            If Right(FileNotes, 1) = "" Then
               fns1 = Left(FileNotes, Len(FileNotes) - 1)
               For i = Len(fns1) To 1 Step -1
                   If Mid(fns1, i, 1) = "" Then
                      Dim FnsPath As String
                      Dim FnsName As String
                      FnsPath = Left(fns1, i)
                      FnsName = Mid(fns1, i + 1)
                      Exit For
                   End If
               Next
               MainForm.TreeView2.Nodes.Add FnsPath, tvwChild, FileNotes, FnsName, 3, 2
            Else
               For i = Len(FileNotes) To 1 Step -1
                   If Mid(FileNotes, i, 1) = "" Then
                      FnsPath = Left(FileNotes, i)
                      FnsName = Mid(FileNotes, i + 1)
                      Exit For
                   End If
               Next
               MainForm.TreeView2.Nodes.Add FnsPath, tvwChild, FileNotes, FnsName, 10
            End If
         Loop
         Close fnum
      End If
      
      
      '''***********'''光盘镜像写入列表中
      If Dir(CdromName + ".fnd") <> "" Then
         Kill CdromName + ".fnd"
      End If
      fnum = FreeFile
      roots = MainForm.TreeView2.Nodes(1).Text
      Open CdromName + ".fnd" For Output As #fnum
      Print #fnum, FindString
      Print #fnum, roots
      Close fnum
       TreeView1.Nodes.Clear
       TreeView1.Nodes.Add , , roots, roots
       For yy = 2 To MainForm.TreeView2.Nodes.Count
          Label3.Caption = MainForm.TreeView2.Nodes(yy).Key
          If Check1.Value And Check2.Value Then '两样都找
             If InStr(1, UCase(MainForm.TreeView2.Nodes(yy).Text), UCase(FindString)) Then
                FoundOne = True
                Found = True
                FindFord MainForm.TreeView2.Nodes(yy).Key
             End If
          Else
             If Check1.Value Then '只找文件夹
                If Right(MainForm.TreeView2.Nodes(yy).Key, 1) = "" Then '是文件夹
                   If InStr(1, UCase(MainForm.TreeView2.Nodes(yy).Text), UCase(FindString)) Then
                      FoundOne = True
                      Found = True
                      FindFord MainForm.TreeView2.Nodes(yy).Key
                   End If
                End If
            Else '只找文件
                If Check2.Value Then
                If Right(MainForm.TreeView2.Nodes(yy).Key, 1) <> "" Then  '是文件夹
                   If InStr(1, UCase(MainForm.TreeView2.Nodes(yy).Text), UCase(FindString)) Then
                      FoundOne = True
                      Found = True
                      FindFord MainForm.TreeView2.Nodes(yy).Key
                   End If
                End If
                End If
            End If
          End If
      Next
      If FoundOne Then
         MainForm.TreeView1.Nodes.Add FindKey, tvwChild, FindKey + CdromName, CdromName, 1
         FoundOne = False
      End If
      '''************'''
      Next
      Label3.Caption = ""
      Me.MousePointer = 0
      Me.Caption = "查找"
      If Found = False Then
         Me.TreeView1.Nodes.Clear
         MsgBox "很遗憾，没找到待查字串 " + Chr(34) + FindString + Chr(34) + Chr(13) + Chr(13) + "你可以搜索整个光盘库或某个类别，如果你这样做了，还找不到!" + Chr(13) + "很遗憾，你没有这种光盘！", vbExclamation
         sfiles = Dir("*.fnd")
         Do While sfiles <> ""
            Kill sfiles
            sfiles = Dir
         Loop
         For i = 2 To MainForm.TreeView1.Nodes.Count
             If MainForm.TreeView1.Nodes(i).Key = FindKey Then
                MainForm.TreeView1.Nodes.Remove i
                Exit For
             End If
         Next
      Else
         MsgBox "恭喜,找到了待查字串 " + Chr(34) + FindString + Chr(34) + Chr(13) + Chr(13) + "请单击 查找结果 查看!", vbInformation
         For i = 2 To MainForm.TreeView1.Nodes.Count
             If MainForm.TreeView1.Nodes(i).Key = FindKey Then
                MainForm.TreeView1.Nodes(i).Expanded = True
                Exit For
             End If
         Next
      End If
      Unload Me
   ''''''''''''''''''''''''''''''''''''''''''''''''''''
   Else '单盘查找
       If Dir(CdromName + ".fnd") <> "" Then
          Kill CdromName + ".fnd"
       End If
       roots = MainForm.TreeView2.Nodes(1).Text
       fnum = FreeFile
       Open CdromName + ".fnd" For Output As #fnum
       Print #fnum, FindString
       Print #fnum, roots
       Close fnum
       TreeView1.Nodes.Add , , roots, roots
       For i = 2 To MainForm.TreeView2.Nodes.Count
          Label3.Caption = MainForm.TreeView2.Nodes(i).Key
          If Check1.Value And Check2.Value Then '两样都找
             If InStr(1, UCase(MainForm.TreeView2.Nodes(i).Text), UCase(FindString)) Then
                Found = True
                FindFord MainForm.TreeView2.Nodes(i).Key
             End If
          Else
             If Check1.Value Then '只找文件夹
                If Right(MainForm.TreeView2.Nodes(i).Key, 1) = "" Then '是文件夹
                   If InStr(1, UCase(MainForm.TreeView2.Nodes(i).Text), UCase(FindString)) Then
                      Found = True
                      FindFord MainForm.TreeView2.Nodes(i).Key
                   End If
                End If
            Else '只找文件
                If Check2.Value Then
                If Right(MainForm.TreeView2.Nodes(i).Key, 1) <> "" Then  '是文件夹
                   If InStr(1, UCase(MainForm.TreeView2.Nodes(i).Text), UCase(FindString)) Then
                      Found = True
                      FindFord MainForm.TreeView2.Nodes(i).Key
                   End If
                End If
                End If
            End If
          End If
      Next
      If Found Then
         FindKey = "@@@@@***##查找结果@@@@@***##"
         For i = 1 To MainForm.TreeView1.Nodes.Count
             If MainForm.TreeView1.Nodes(i).Key = FindKey Then
              If MainForm.TreeView1.Nodes(i).Children > 0 Then
                Set nox = MainForm.TreeView1.Nodes(i).Child
                For ii = 1 To MainForm.TreeView1.Nodes(i).Children
                   fname = nox.Text + ".fnd"
                    If Dir(fname) <> "" Then
                       If nox.Text <> CdromName Then
                          Kill fname
                       End If
                    End If
                    If ii < MainForm.TreeView1.Nodes(i).Children Then
                      Set nox = nox.Next
                    End If
                Next
             End If
                MainForm.TreeView1.Nodes.Remove i
                Exit For
             End If
         Next
         MainForm.TreeView1.Nodes.Add , , FindKey, "查找结果", 5
         MainForm.TreeView1.Nodes.Add FindKey, tvwChild, FindKey + CdromName, CdromName, 1
      End If
      Me.Caption = "查找"
      Me.MousePointer = 0
      If Found = False Then
         Me.TreeView1.Nodes.Clear
         sfiles = Dir("*.fnd")
         Do While sfiles <> ""
            Kill sfiles
            sfiles = Dir
         Loop
         For i = 2 To MainForm.TreeView1.Nodes.Count
             If MainForm.TreeView1.Nodes(i).Key = FindKey Then
                MainForm.TreeView1.Nodes.Remove i
                Exit For
             End If
         Next
         MsgBox "很遗憾，没找到待查字串 " + Chr(34) + FindString + Chr(34) + Chr(13) + Chr(13) + "你可以搜索整个光盘库或某个类别，如果你这样做了，还找不到!" + Chr(13) + "很遗憾，你没有这种光盘！", vbExclamation
       Else
         MsgBox "恭喜,找到了待查字串 " + Chr(34) + FindString + Chr(34) + Chr(13) + Chr(13) + "请单击" + Chr(34) + "查找结果" + Chr(34) + "查看!", vbInformation
         For i = 2 To MainForm.TreeView1.Nodes.Count
             If MainForm.TreeView1.Nodes(i).Key = FindKey Then
                MainForm.TreeView1.Nodes(i).Expanded = True
                Exit For
             End If
         Next
      End If
      Unload Me
   ''''''''''''''''''''''''''''''''''''''''''''''''
   End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
CencerForm Me
Label2.Caption = Info
End Sub
Public Sub FindFord(sFoundString As String)
Dim sNodeText As String
Dim sNodeKey As String
Dim k As Single, j As Single, i As Single
fnum = FreeFile
fname = CdromName + ".fnd"
Open fname For Append As #fnum
   k = 1
   For i = 1 To Len(sFoundString)
       If Mid(sFoundString, i, 1) = "" Then
              sNodeText = Mid(sFoundString, k, i - k)
              If Len(sNodeText) = 2 And Right(sNodeText, 1) = ":" Then
                 sNodeText = sNodeText + ""
              End If
              sNodeKey = Left(sFoundString, i)
              You = False '列表中有无该键名
              For j = 1 To TreeView1.Nodes.Count
                  If TreeView1.Nodes(j).Key = sNodeKey Then
                     You = True
                  End If
              Next
              If Not You Then
                 fathernode = FindFather(sNodeKey, True)
                 Print #fnum, sNodeKey
                 TreeView1.Nodes.Add fathernode, tvwChild, sNodeKey, sNodeText
              End If
              k = i + 1
       End If
  Next
  If i = k Then
     Close fnum
     Exit Sub
  End If
  If i > 1 And k > 1 Then
     sNodeKey = sNodeKey + Mid(sFoundString, k)
     sNodeText = Mid(sFoundString, k)
     For i = Len(sNodeKey) To 1 Step -1
         If Mid(sNodeKey, i, 1) = "" Then
            skey = Left(sNodeKey, i)
            Exit For
         End If
    Next
    Print #fnum, sNodeKey
    TreeView1.Nodes.Add skey, tvwChild, sNodeKey, sNodeText
  End If
  Close fnum
End Sub
Public Function FindFather(sFindString As String, Folder As Boolean) As String
If Folder Then
   ssFindString = Left(sFindString, Len(sFindString) - 1)
End If
For i = Len(ssFindString) To 1 Step -1
    If Mid(ssFindString, i, 1) = "" Then
       FindFather = Left(ssFindString, i)
       Exit For
    End If
Next
If InStr(1, FindFather, "") Then
Else
   FindFather = ssFindString
End If
End Function

						