FindFolder.frm
上传用户:guantou168
上传日期:2015-06-25
资源大小:74k
文件大小:4k
- VERSION 5.00
- Begin VB.Form FindFolder
- BorderStyle = 1 'Fixed Single
- Caption = "查找文件夹"
- ClientHeight = 4980
- ClientLeft = 45
- ClientTop = 330
- ClientWidth = 3585
- LinkTopic = "FindFile"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4980
- ScaleWidth = 3585
- StartUpPosition = 1 '所有者中心
- Begin VB.CommandButton FldrDone
- Caption = "完成"
- Height = 375
- Left = 960
- TabIndex = 2
- Top = 4600
- Width = 1575
- End
- Begin VB.TextBox DirPath
- Appearance = 0 'Flat
- Height = 285
- Left = 120
- TabIndex = 1
- Top = 120
- Width = 3375
- End
- Begin VB.ListBox FolderList
- Appearance = 0 'Flat
- BeginProperty Font
- Name = "Terminal"
- Size = 9
- Charset = 255
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 3990
- ItemData = "FindFolder.frx":0000
- Left = 120
- List = "FindFolder.frx":0002
- Sorted = -1 'True
- TabIndex = 0
- Top = 480
- Width = 3375
- End
- End
- Attribute VB_Name = "FindFolder"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- Dim DrvS(32) As String
- Dim LastStr As String
- Dim DrvC As Integer
- Private Sub FldrDone_Click()
- Form_Terminate
- End Sub
- Private Sub FolderList_Click()
- Dim s As String, t As String, s2 As String
- Dim i As Integer
- i = FolderList.ListIndex + 1
- s2 = FolderList.Text
- If Mid(s2, 1, 1) = "[" Then
- s2 = Mid(s2, 2, 2) & ""
- DirPath = s2
- Else
- If FolderList.Text = ".." Then
- s = Left(LastStr, Len(LastStr) - 1)
- Do Until Right(s, 1) = ""
- s = Left(s, Len(s) - 1)
- Loop
- s2 = s
- DirPath = s2
- Else
- s2 = DirPath & FolderList.Text & ""
- DirPath = s2
- End If
- End If
- LastStr = s2
- FolderList.Clear
- 'Debug.Print i; s2
- s = FindFile("*.*", s2)
- Add_Drives
- End Sub
- Private Sub Form_Load()
- Dim s As String
- GetSystemDrives 'load the system drives
- If AddEditDir.Tag <> "" Then
- LastStr = AddEditDir.Tag
- DirPath = LastStr
- s = FindFile("*.*", AddEditDir.Tag)
- End If
- Add_Drives
- End Sub
- Private Sub Add_Drives()
- Dim x As Integer
- For x = 1 To DrvC
- FolderList.AddItem "[" & DrvS(x) & "]"
- Next
- End Sub
- Private Sub Form_Terminate()
- AddEditDir.Tag = DirPath.Text
- Unload Me
- End Sub
- Private Sub GetSystemDrives()
- Dim rtn As Long
- Dim d As Integer
- Dim AllDrives As String
- Dim CurrDrive As String
- Dim tmp As String
- tmp = Space(64)
- rtn = GetLogicalDriveStrings(64, tmp)
- AllDrives = Trim(tmp) 'get the list of all available drives
- d = 0
- Do Until AllDrives = Chr$(0)
- d = d + 1
- CurrDrive = StripNulls(AllDrives) 'strip off one drive item from the allDrives
- CurrDrive = Left(CurrDrive, 2) 'we can't have the trailing slash, so ..
- DrvS(d) = CurrDrive
- DrvC = d
- Loop
- End Sub
- Private Function StripNulls(startstr) As String
- Dim pos As Integer
- pos = InStr(startstr, Chr$(0))
- If pos Then
- StripNulls = Mid(startstr, 1, pos - 1)
- startstr = Mid(startstr, pos + 1, Len(startstr))
- Exit Function
- End If
- End Function