Поиск файл с помощью API функций — Visual Basic(Бейсик)

disel
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Attribute VB_Name = "mdlScanDir"
Option Explicit
  
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
  
Const MAX_PATH = 260
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
  
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
  
Public bStopScan As Boolean
'============================================
  
Public Function RemoveNull$(ByVal source$)
    Dim i&
    i = InStr(1, source, vbNullChar)
    If i > 0 Then
        RemoveNull = Left$(source, i - 1)
    Else
        RemoveNull = source
    End If
End Function
  
Public Function ScanDir(ByVal sPath$, ByVal sMask$) As Boolean
    Dim wfd As WIN32_FIND_DATA
    Dim hFind&, sFile$
    Dim bRet As Boolean
  
    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    If bStopScan Then
        ScanDir = False
        Exit Function
    End If
    SearchIn sPath
    hFind = FindFirstFile(sPath & sMask, wfd)
    bRet = hFind <> -1
    If bRet Then
        Do
            sFile = RemoveNull(wfd.cFileName)
            If sFile <> "." And sFile <> ".." Then
                If (wfd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then
                'If (GetFileAttributes(sPath & sFile) And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then
                    FileFounded sPath & sFile, True
                    If Not ScanDir(sPath & sFile, sMask) Then bRet = False
                    SearchIn sPath
                Else
                    FileFounded sPath & sFile, False
                End If
            End If
            If bStopScan Then
                bRet = False
                Exit Do
            End If
        Loop While FindNextFile(hFind, wfd)
        FindClose hFind
    End If
    ScanDir = bRet
End Function
  
Private Sub FileFounded(ByVal Name$, ByVal IsDir As Boolean)
    If bStopScan Then Exit Sub
    'founded Name
    If IsDir Then
        Form1.AddDir
    Else
        Form1.AddFile
    End If
    DoEvents
End Sub
Public Sub SearchIn(ByVal sDir$)
    If bStopScan Then Exit Sub
    Form1.lblSearchIn.Caption = sDir
End Sub
  
Public Function GetDrives() As String()
    Dim s$, lRet&
    s = String(255, " ")
    If GetLogicalDriveStrings(Len(s), s) > 0 Then
        lRet = InStr(1, s, vbNullChar & vbNullChar)
        If lRet > 0 Then s = Left$(s, lRet - 1)
        GetDrives = Split(s, vbNullChar)
    End If
End Function

Похожие записи/страницы:

Leave a Comment