|
VERSION 5.00
Begin VB.Form frmSearch
Caption = "File Finder - By Ben Bond"
ClientHeight = 4020
ClientLeft = 48
ClientTop = 276
ClientWidth = 4740
Icon = "frmSearch.frx":0000
LinkTopic = "Form1"
MinButton = 0 'False
ScaleHeight = 4020
ScaleWidth = 4740
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "S&top"
Enabled = 0 'False
Height = 252
Left = 2400
TabIndex = 6
Top = 6600
Width = 732
End
Begin VB.CommandButton Command1
Caption = "&Start"
Default = -1 'True
Height = 252
Left = 1440
TabIndex = 4
Top = 6600
Width = 852
End
Begin VB.ListBox list
Height = 2544
Left = 120
MultiSelect = 2 'Extended
TabIndex = 3
Top = 2520
Width = 4572
End
Begin VB.FileListBox FilList
Height = 2376
Left = 1800
TabIndex = 2
Top = 0
Width = 2892
End
Begin VB.DriveListBox DrvList
Height = 288
Left = 120
TabIndex = 1
Top = 0
Width = 1572
End
Begin VB.DirListBox DirList
Height = 2016
Left = 120
TabIndex = 0
Top = 360
Width = 1572
End
Begin VB.Label Foudn
BackStyle = 0 'Transparent
Caption = "Click Start To Start the Search"
Height = 252
Left = 360
TabIndex = 5
Top = 6120
Width = 3612
End
Begin VB.Menu mnuPopup
Caption = "popup"
Visible = 0 'False
Begin VB.Menu mnuAddToDb
Caption = "&Add To DataBase"
End
Begin VB.Menu mnuDel
Caption = "&Delete File"
End
Begin VB.Menu mnusep
Caption = "-"
End
Begin VB.Menu mnuClose
Caption = "&Close"
End
Begin VB.Menu a
Caption = "Check"
End
End
End
Attribute VB_Name = "frmSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim StopSearchFlag As Boolean
Dim FilOrList As Boolean
Private Sub a_Click()
Dim ben
Do While Not list.ListIndex = 0
list.RemoveItem (list.ListIndex)
ben = InputBox(list.Text, "Ben Rules")
Loop
End Sub
Private Sub Command1_Click()
Command2.Enabled = True
StopSearchFlag = False
list.Clear
Dim mDirToPeek As Integer
Dim mAbandon As Integer
Dim mOldPath As String
Dim mCurrPath As String
Dim mEntry As String
Dim mRetVal As Integer
Dim i As Integer
mDirToPeek = DirList.ListCount ' How many directories below this?
Do While mDirToPeek > 0 And StopSearchFlag = False
mOldPath = 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(mDirToPeek - 1)
mAbandon = DirDiver((DirList.Path), mDirCount%, mOldPath)
End If
' Go up one level in directories.
mDirToPeek = mDirToPeek - 1
If mAbandon = True Then
StopSearchFlag = True
Exit Sub
End If
Loop
End Sub
Private Function DirDiver(NewPath As String, mDirCount As Integer, BackUp As String) As Integer
If StopSearchFlag Then
Exit Function
End If
Dim mDirToPeek As Integer
Dim mAbandon As Integer
Dim mOldPath As String
Dim mCurrPath As String
Dim mEntry As String
Dim mRetVal As Integer
Dim i As Integer
DirDiver = False
mRetVal = DoEvents() ' Check for events (for instance, if the user chooses Cancel).
If StopSearchFlag Then
DirDiver = True
Exit Function
End If
mDirToPeek = DirList.ListCount ' How many directories below this?
Do While mDirToPeek > 0 And StopSearchFlag = False
mOldPath = 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(mDirToPeek - 1)
mAbandon = DirDiver((DirList.Path), mDirCount%, mOldPath)
End If
' Go up one level in directories.
mDirToPeek = mDirToPeek - 1
If mAbandon = True Then
StopSearchFlag = True
Exit Function
End If
Loop
' Call function to enumerate files.
If FilList.ListCount Then
If Len(DirList.Path) <= 3 Then
mCurrPath = DirList.Path
Else
mCurrPath = DirList.Path + "\"
End If
For i = 0 To FilList.ListCount - 1 ' Add conforming files in this directory to the list box.
mEntry = mCurrPath + FilList.list(i)
list.AddItem mEntry
filesCount = filesCount + 1
Next i
End If
If BackUp <> "" Then ' If there is a superior directory, move it.
DirList.Path = BackUp
End If
Foudn.Caption = "Files Found: " & list.ListCount
Exit Function
End Function
Private Sub Command2_Click()
StopSearchFlag = True
Command2.Enabled = False
End Sub
Private Sub DirList_Change()
FilList.Path = DirList.Path
End Sub
Private Sub DrvList_Change()
On Error GoTo errhandler
DirList.Path = DrvList.Drive
errhandler:
MsgBox Err.Number & " - " & Err.Description
End Sub
Private Sub FilList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
FilOrList = True
If FilList.FileName = "" Then
mnuAddToDb.Enabled = False
mnuDel.Enabled = False
Else
mnuAddToDb.Enabled = True
mnuDel.Enabled = True
End If
If Button = vbRightButton Then
Me.PopupMenu Me.mnuPopup
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
FilList.Pattern = frmOption.txtFileType.Text
Me.Picture = LoadPicture(App.Path & "\Skinz\srch.gif")
End Sub
Private Sub Form_Resize()
If Me.Height <= 5000 Then Me.Height = 5000
If Me.Width <= 3000 Then Me.Width = 3000
Command2.Left = Me.Width / 2 + 200
Command1.Left = Command2.Left - 400 - Command1.Width
list.Width = Me.Width - 350
Command1.Top = Me.Height - 750
Command2.Top = Command1.Top
Foudn.Top = Command1.Top - 300
list.Height = Me.Height - 1600 - DirList.Height
FilList.Width = Me.Width - DirList.Width - 400
FilList.Left = 0 + DirList.Width + 200
End Sub
Private Sub list_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
FilOrList = False
If list.SelCount = 0 Then
mnuAddToDb.Enabled = False
mnuDel.Enabled = False
Else
mnuAddToDb.Enabled = True
mnuDel.Enabled = True
End If
If Button = vbRightButton Then
Me.PopupMenu Me.mnuPopup
End If
End Sub
Private Sub mnuAddToDb_Click()
If FilOrList = False Then
MsgBox "This menu item was opened in the List Box"
End If
If FilOrList = True Then
MsgBox "This menu item was opened in the File Box"
End If
End Sub
Private Sub mnuClose_Click()
Unload Me
End Sub
Private Sub mnuDel_Click()
If FilOrList = False Then
If MsgBox("Deleting this file will remove it from you Hard Disc, it is not Undoable," & vbCrLf & vbCrLf & "Are you sure you want to delete this file?", vbYesNo, "Confirm Delete - ML") = vbYes Then
On Error Resume Next
Kill (list.Text)
End If
End If
End Sub
|
