资源管理器.bas

用XML做专家系统的一个编译器,有说明书,使用简单,有模板

Attribute VB_Name = "资源管理器"
Option Explicit

' DirView sample by Matt Hart - [e-mail]
' http://www.webczar.com/defcon/mh/vbhelp.html
' http://www.webczar.com/defcon/mh
'
' This shows how to populate a TreeView control with a directory
' and sub-directory listing.  It uses a recursive FindDirs call.
' I've modified this to use the FindFirstFile API call rather than
' VB's built in Dir$ call.  Dir$ will return the first Directory
' it finds, but subsequent Dir$ calls return both files and directories,
' so you must use FileAttr to test for directories - very slow, because
' you must do 2 API calls (Dir$ and FileAttr) while one API call can
' do both for you.

Const MAX_PATH = 260
Const FILE_ATTRIBUTE_DIRECTORY = &H10

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

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 Type DirInfo
    DirName     As String
End Type

Public Sub FindDirs(D$, T As TreeView)
    Dim nx As Node, C$
    C$ = CurDir$
    
    ChDir D$
    
    If Len(Dir$("*.*", vbDirectory)) Then
        On Local Error Resume Next
        ChDir ".."
        ChDir ".."
        Set nx = T.Nodes.Add(CurDir$, 4, C$, LastPath$(C$), 4)
        nx.Expanded = True
        If Err Then
            Set nx = T.Nodes.Add(, , C$, C$, 4)
            nx.Expanded = True
        End If
        ChDir C$
        ChDir D$
        'Set nx = T.Nodes.Add(C$, 4, , D$)
    Else
        Set nx = T.Nodes.Add(C$, 4, , D$, 4)
        nx.Expanded = True
    End If
    'T.Nodes(T.Nodes.Count).EnsureVisible
    
    'DoEvents
    
    Dim N As Integer, Srch$, i As Integer, NewD$
    
    Srch$ = "*.*"
    ReDim Dees(1 To 10) As DirInfo
    Call LoadDirs(Dees(), N, Srch$)
    If N = 0 Then
        ChDir ".."
        Exit Sub
    End If

    
    'For i = 1 To N
    '    NewD$ = RTrim$(Dees(i).DirName)
    '    Call FindDirs(NewD$, T)
    'Next
    
    'ChDir ".."
End Sub

Private Function LastPath$(P$)
    Dim i
    For i = Len(P$) To 1 Step -1
        If Mid$(P$, i, 1) = "\" Then
            LastPath$ = Mid$(P$, i + 1)
            Exit For
        End If
    Next
End Function

Private Sub LoadDirs(D() As DirInfo, N As Integer, Srch$)
    Dim a$, Max As Integer, i As Integer, k As Integer, W32 As WIN32_FIND_DATA, fHandle As Long, lResult As Long
    Max = UBound(D)
    N = 0
    
    fHandle = FindFirstFile(Srch$, W32)

    If fHandle Then
        Do
            a$ = Left$(W32.cFileName, InStr(W32.cFileName, Chr$(0)) - 1)
            If a$ <> "." And a$ <> ".." And ((W32.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) > 0) Then
                N = N + 1
                If Max < N Then
                    Max = Max + 10
                    ReDim Preserve D(1 To Max) As DirInfo
                End If
                D(N).DirName = a$
            End If
            'DoEvents
            lResult = FindNextFile(fHandle, W32)
        Loop While lResult
        lResult = FindClose(fHandle)
    End If

    For i = 1 To N - 1
        For k = i + 1 To N
            If D(i).DirName > D(k).DirName Then
                a$ = D(k).DirName
                D(k).DirName = D(i).DirName
                D(i).DirName = a$
            End If
        Next
    Next
End Sub