FindFolder.frm
上传用户:guantou168
上传日期:2015-06-25
资源大小:74k
文件大小:4k
源码类别:

Ftp服务器

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Begin VB.Form FindFolder 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "查找文件夹"
  5.    ClientHeight    =   4980
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   3585
  9.    LinkTopic       =   "FindFile"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   4980
  13.    ScaleWidth      =   3585
  14.    StartUpPosition =   1  '所有者中心
  15.    Begin VB.CommandButton FldrDone 
  16.       Caption         =   "完成"
  17.       Height          =   375
  18.       Left            =   960
  19.       TabIndex        =   2
  20.       Top             =   4600
  21.       Width           =   1575
  22.    End
  23.    Begin VB.TextBox DirPath 
  24.       Appearance      =   0  'Flat
  25.       Height          =   285
  26.       Left            =   120
  27.       TabIndex        =   1
  28.       Top             =   120
  29.       Width           =   3375
  30.    End
  31.    Begin VB.ListBox FolderList 
  32.       Appearance      =   0  'Flat
  33.       BeginProperty Font 
  34.          Name            =   "Terminal"
  35.          Size            =   9
  36.          Charset         =   255
  37.          Weight          =   400
  38.          Underline       =   0   'False
  39.          Italic          =   0   'False
  40.          Strikethrough   =   0   'False
  41.       EndProperty
  42.       Height          =   3990
  43.       ItemData        =   "FindFolder.frx":0000
  44.       Left            =   120
  45.       List            =   "FindFolder.frx":0002
  46.       Sorted          =   -1  'True
  47.       TabIndex        =   0
  48.       Top             =   480
  49.       Width           =   3375
  50.    End
  51. End
  52. Attribute VB_Name = "FindFolder"
  53. Attribute VB_GlobalNameSpace = False
  54. Attribute VB_Creatable = False
  55. Attribute VB_PredeclaredId = True
  56. Attribute VB_Exposed = False
  57. Option Explicit
  58. Dim DrvS(32) As String
  59. Dim LastStr As String
  60. Dim DrvC As Integer
  61. Private Sub FldrDone_Click()
  62.   Form_Terminate
  63. End Sub
  64. Private Sub FolderList_Click()
  65. Dim s As String, t As String, s2 As String
  66. Dim i As Integer
  67.   i = FolderList.ListIndex + 1
  68.   s2 = FolderList.Text
  69.   If Mid(s2, 1, 1) = "[" Then
  70.     s2 = Mid(s2, 2, 2) & ""
  71.     DirPath = s2
  72.   Else
  73.     If FolderList.Text = ".." Then
  74.       s = Left(LastStr, Len(LastStr) - 1)
  75.       Do Until Right(s, 1) = ""
  76.         s = Left(s, Len(s) - 1)
  77.       Loop
  78.       s2 = s
  79.       DirPath = s2
  80.     Else
  81.       s2 = DirPath & FolderList.Text & ""
  82.       DirPath = s2
  83.     End If
  84.   End If
  85.   LastStr = s2
  86.   FolderList.Clear
  87.   'Debug.Print i; s2
  88.   s = FindFile("*.*", s2)
  89.   Add_Drives
  90. End Sub
  91. Private Sub Form_Load()
  92. Dim s As String
  93.   GetSystemDrives 'load the system drives
  94.   If AddEditDir.Tag <> "" Then
  95.     LastStr = AddEditDir.Tag
  96.     DirPath = LastStr
  97.     s = FindFile("*.*", AddEditDir.Tag)
  98.   End If
  99.   Add_Drives
  100. End Sub
  101. Private Sub Add_Drives()
  102. Dim x As Integer
  103.   For x = 1 To DrvC
  104.     FolderList.AddItem "[" & DrvS(x) & "]"
  105.   Next
  106. End Sub
  107. Private Sub Form_Terminate()
  108.   AddEditDir.Tag = DirPath.Text
  109.   Unload Me
  110. End Sub
  111. Private Sub GetSystemDrives()
  112. Dim rtn As Long
  113. Dim d As Integer
  114. Dim AllDrives As String
  115. Dim CurrDrive As String
  116. Dim tmp As String
  117.   tmp = Space(64)
  118.   rtn = GetLogicalDriveStrings(64, tmp)
  119.   AllDrives = Trim(tmp)               'get the list of all available drives
  120.   d = 0
  121.   Do Until AllDrives = Chr$(0)
  122.     d = d + 1
  123.     CurrDrive = StripNulls(AllDrives) 'strip off one drive item from the allDrives
  124.     CurrDrive = Left(CurrDrive, 2)    'we can't have the trailing slash, so ..
  125.     DrvS(d) = CurrDrive
  126.     DrvC = d
  127.   Loop
  128. End Sub
  129. Private Function StripNulls(startstr) As String
  130. Dim pos As Integer
  131.   pos = InStr(startstr, Chr$(0))
  132.   If pos Then
  133.     StripNulls = Mid(startstr, 1, pos - 1)
  134.     startstr = Mid(startstr, pos + 1, Len(startstr))
  135.     Exit Function
  136.   End If
  137. End Function