seek.frm

星级酒店管理系统VB源代码

            Height          =   4350
            Left            =   120
            TabIndex        =   2
            Top             =   540
            Width           =   3735
         End
         Begin VB.Label lblCount 
            Caption         =   "0"
            Height          =   255
            Left            =   1200
            TabIndex        =   4
            Top             =   120
            Width           =   1095
         End
         Begin VB.Label lblfound 
            Caption         =   "查找到的文件:"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   9.75
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   3
            Top             =   120
            Width           =   1275
         End
      End
      Begin VB.OLE OLE1 
         DataField       =   "内容"
         DataSource      =   "Data1"
         Height          =   855
         Left            =   -74760
         TabIndex        =   50
         Top             =   4680
         Width           =   8715
      End
   End
End
Attribute VB_Name = "WinSeek"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim SearchFlag As Integer   ' Used as flag for cancel and other operations.

Private Sub cmdExit_Click()
    If cmdExit.Caption = "退出" Then
        Unload Me
    Else                    ' If user chose Cancel, just end Search.
        SearchFlag = False
    End If
End Sub

Private Sub cmdSearch_Click()
' Initialize for search, then perform recursive search.
Dim FirstPath As String, DirCount As Integer, NumFiles As Integer
Dim result As Integer
  ' Check what the user did last.
    If cmdSearch.Caption = "重来" Then  ' If just a reset, initialize and exit.
        ResetSearch
        txtSearchSpec.SetFocus
        Exit Sub
    End If

    ' Update dirList.Path if it is different from the currently
    ' selected directory, otherwise perform the search.
    If dirList.Path <> dirList.List(dirList.ListIndex) Then
        dirList.Path = dirList.List(dirList.ListIndex)
        Exit Sub         ' Exit so user can take a look before searching.
    End If

    ' Continue with the search.

    cmdExit.Caption = "取消"

    filList.Pattern = txtSearchSpec.Text
    FirstPath = dirList.Path
    DirCount = dirList.ListCount

    ' Start recursive direcory search.
    NumFiles = 0                       ' Reset found files indicator.
    result = DirDiver(FirstPath, DirCount, "")
    filList.Path = dirList.Path
    cmdSearch.Caption = "重来"
    cmdSearch.SetFocus
    cmdExit.Caption = "退出"
End Sub

Private Function DirDiver(NewPath As String, DirCount As Integer, BackUp As String) As Integer
'  Recursively search directories from NewPath down...
'  NewPath is searched on this recursion.
'  BackUp is origin of this recursion.
'  DirCount is number of subdirectories in this directory.
Static FirstErr As Integer
Dim DirsToPeek As Integer, AbandonSearch As Integer, ind As Integer
Dim OldPath As String, ThePath As String, entry As String
Dim retval As Integer
    SearchFlag = True           ' Set flag so the user can interrupt.
    DirDiver = False            ' Set to True if there is an error.
    retval = DoEvents()         ' Check for events (for instance, if the user chooses Cancel).
    If SearchFlag = False Then
        DirDiver = True
        Exit Function
    End If
    On Local Error GoTo DirDriverHandler
    DirsToPeek = dirList.ListCount                  ' How many directories below this?
    Do While DirsToPeek > 0 And SearchFlag = True
        OldPath = dirList.Path                      ' Save old path for next recursion.
        dirList.Path = NewPath
        If dirList.ListCount > 0 Then
            ' Get to the node bottom.
            dirList.Path = dirList.List(DirsToPeek - 1)
            AbandonSearch = DirDiver((dirList.Path), DirCount%, OldPath)
        End If
        ' Go up one level in directories.
        DirsToPeek = DirsToPeek - 1
        If AbandonSearch = True Then Exit Function
    Loop
    ' Call function to enumerate files.
    If filList.ListCount Then
        If Len(dirList.Path) <= 3 Then             ' Check for 2 bytes/character
            ThePath = dirList.Path                  ' If at root level, leave as is...
        Else
            ThePath = dirList.Path + "\"            ' Otherwise put "\" before the filename.
        End If
        For ind = 0 To filList.ListCount - 1        ' Add conforming files in this directory to the list box.
            entry = ThePath + filList.List(ind)
            lstFoundFiles.AddItem entry
            lblCount.Caption = Str(Val(lblCount.Caption) + 1)
        Next ind
    End If
    If BackUp <> "" Then        ' If there is a superior directory, move it.
        dirList.Path = BackUp
    End If
    Exit Function
DirDriverHandler:
    If Err = 7 Then             ' If Out of Memory error occurs, assume the list box just got full.
        DirDiver = True         ' Create Msg and set return value AbandonSearch.
        MsgBox "You've filled the list box. Abandoning search..."
        Exit Function           ' Note that the exit procedure resets Err to 0.
    Else                        ' Otherwise display error message and quit.
        MsgBox Error
        End
    End If
End Function

Private Sub Combo2_Click()
    txtFields(9).Text = Combo2.Text
End Sub

Private Sub Combo3_Click()
    txtFields(12).Text = Combo3.Text
End Sub

Private Sub Combo4_Click()
    txtFields(13).Text = Combo4.Text
End Sub

Private Sub Command1_Click()
    Dim sa(1 To 15) As Variant
    Dim i As Integer
    
    sa(1) = txtFields(1)
    sa(2) = txtFields(2)
    sa(3) = txtFields(3)
    sa(4) = txtFields(4)
    sa(5) = txtFields(5)
    sa(6) = txtFields(6)
    sa(7) = txtFields(7)
    sa(8) = txtFields(8)
    sa(9) = txtFields(9)
    sa(10) = txtFields(10)
    sa(11) = txtFields(11)
    sa(12) = txtFields(12)
    sa(13) = txtFields(13)
    sa(14) = drvList.Drive
    sa(15) = txtSearchSpec.Text
    
    For i = 0 To lstFoundFiles.ListCount - 1
    txtFields(1) = sa(1)
    txtFields(2) = sa(2)
    txtFields(3) = sa(3)
    txtFields(4) = sa(4)
    txtFields(5) = sa(5)
    txtFields(6) = sa(6)
    txtFields(7) = sa(7)
    txtFields(8) = sa(8)
    txtFields(9) = sa(9)
    txtFields(10) = sa(10)
    txtFields(11) = sa(11)
    txtFields(12) = sa(12)
    txtFields(13) = sa(13)
    Label24.Caption = sa(14)
    Label26.Caption = sa(15)

    Adodc1.Recordset.UpdateBatch
    Adodc1.Refresh
    Adodc1.Recordset.MoveLast
    
    Data1.RecordsetType = 0
    Data1.Refresh
    Data1.Recordset.MoveLast
    OLE1.CreateEmbed (lstFoundFiles.List(i))
    OLE1.Update
    Data1.UpdateRecord
    Data1.RecordsetType = 1
    
    DEDocuments.Recordsets("文档信息表").AddNew
    Next
    
    txtFields(1) = sa(1)
    txtFields(2) = sa(2)
    txtFields(3) = sa(3)
    txtFields(4) = sa(4)
    txtFields(5) = sa(5)
    txtFields(6) = sa(6)
    txtFields(7) = sa(7)
    txtFields(8) = sa(8)
    txtFields(9) = sa(9)
    txtFields(10) = sa(10)
    txtFields(11) = sa(11)
    txtFields(12) = sa(12)
    txtFields(13) = sa(13)
    Label24.Caption = sa(14)
    Label26.Caption = sa(15)

End Sub

Private Sub Command2_Click()
    DEDocuments.Recordsets("文档信息表").AddNew
End Sub

Private Sub DataCombo1_Click(Area As Integer)
    txtFields(4).Text = DataCombo1.BoundText
End Sub

Private Sub DirList_Change()
    ' Update the file list box to synchronize with the directory list box.
    filList.Path = dirList.Path
End Sub

Private Sub DirList_LostFocus()
    dirList.Path = dirList.List(dirList.ListIndex)
End Sub

Private Sub DrvList_Change()
    On Error GoTo DriveHandler
    dirList.Path = drvList.Drive
    Exit Sub

DriveHandler:
    drvList.Drive = dirList.Path
    Exit Sub
End Sub

Private Sub Form_Load()
    Data1.Connect = "DSN=DM;UID=;PWD=;"
    Data1.DefaultType = 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unload Me
End Sub

Private Sub ResetSearch()
    ' Reinitialize before starting a new search.
    lstFoundFiles.Clear
    lblCount.Caption = 0
    SearchFlag = False                  ' Flag indicating search in progress.
    cmdSearch.Caption = "搜索"
    cmdExit.Caption = "退出"
    dirList.Path = CurDir: drvList.Drive = dirList.Path ' Reset the path.
End Sub

Private Sub Text7_Change()

End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
    If PreviousTab = 0 Then
        DEDocuments.Recordsets("文档信息表").MoveLast
        DEDocuments.Recordsets("文档信息表").MoveNext
    End If
    
End Sub

Private Sub txtSearchSpec_Change()
    ' Update file list box if user changes pattern.
    filList.Pattern = txtSearchSpec.Text
End Sub

Private Sub txtSearchSpec_GotFocus()
    txtSearchSpec.SelStart = 0          ' Highlight the current entry.
    txtSearchSpec.SelLength = Len(txtSearchSpec.Text)
End Sub