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

Ftp服务器

开发平台:

Visual Basic

  1. Attribute VB_Name = "FndFile"
  2. Option Explicit
  3. Public Const MAX_PATH As Long = 260
  4. Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
  5. Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
  6. Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
  7. Public Const FILE_ATTRIBUTE_HIDDEN = &H2
  8. Public Const FILE_ATTRIBUTE_NORMAL = &H80
  9. Public Const FILE_ATTRIBUTE_READONLY = &H1
  10. Public Const FILE_ATTRIBUTE_SYSTEM = &H4
  11. Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
  12. Type FileTime
  13.   dwLowDateTime As Long
  14.   dwHighDateTime As Long
  15. End Type
  16. Public Type WIN32_FIND_DATA
  17.   dwFileAttributes As Long
  18.   ftCreationTime As FileTime
  19.   ftLastAccessTime As FileTime
  20.   ftLastWriteTime As FileTime
  21.   nFileSizeHigh As Long
  22.   nFileSizeLow As Long
  23.   dwReserved0 As Long
  24.   dwReserved1 As Long
  25.   cFileName As String * MAX_PATH
  26.   cAlternate As String * 14
  27. End Type
  28. Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  29. Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
  30. Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
  31. Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
  32. Public Declare Function SearchPath Lib "kernel32" Alias "SearchPathA" (ByVal lpPath As String, ByVal lpFileName As String, ByVal lpExtension As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
  33.     
  34. Public Function FindFile(ByVal Filename As String, ByVal Path As String) As String
  35. Dim hFile As Long, result As Long
  36. Dim ts As String, szPath As String
  37. Dim WFD As WIN32_FIND_DATA
  38. Dim szPath2 As String, szFilename As String
  39. Dim dwBufferLen As Long, szBuffer As String, lpFilePart As String
  40.   szPath = GetRDP(Path) & "*.*" & Chr$(0)
  41.   szPath2 = Path & Chr$(0)
  42.   szFilename = Filename & Chr$(0)
  43.   szBuffer = String$(MAX_PATH, 0)
  44.   dwBufferLen = Len(szBuffer)
  45.   result = SearchPath(szPath2, szFilename, vbNullString, dwBufferLen, szBuffer, lpFilePart)
  46.   If result Then
  47.     FindFile = StripNull(szBuffer)
  48.     Exit Function
  49.   End If
  50.   hFile = FindFirstFile(szPath, WFD)  'Start asking windows for files.
  51.   Do
  52.     If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
  53.       ts = StripNull(WFD.cFileName)
  54.       If ts <> "." Then
  55.         FindFolder.FolderList.AddItem (ts)
  56.       End If
  57.     End If
  58.     WFD.cFileName = ""
  59.     result = FindNextFile(hFile, WFD)
  60.   Loop Until result = 0
  61.   FindClose hFile
  62. End Function
  63. Public Function StripNull(ByVal WhatStr As String) As String
  64.   If InStr(WhatStr, Chr$(0)) > 0 Then
  65.     StripNull = Left$(WhatStr, InStr(WhatStr, Chr$(0)) - 1)
  66.   Else
  67.     StripNull = WhatStr
  68.   End If
  69. End Function
  70. Public Function GetRDP(ByVal sPath As String) As String
  71. 'Adds a backslash on the end of a path, if required.
  72.   If sPath = "" Then Exit Function
  73.   If Right$(sPath, 1) = "" Then GetRDP = sPath: Exit Function
  74.     GetRDP = sPath & ""
  75. End Function