cdirectory.cls

来自「vb开发的连接mysql的工作流设置程序,图形化工作流自定义工具,原先是连接到D」· CLS 代码 · 共 82 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CDirectory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private mFiles As Collection
Private mDirs As Collection
Private mText As String
Private mParent As CDirectory
Public Property Get Files() As Object
    Set Files = mFiles
End Property

Public Property Get SubDirectories() As Object
    Set SubDirectories = mDirs
End Property

Public Property Let Text(Value As String)
    mText = Value
End Property

Public Property Get Text() As String
    Text = mText
End Property

Public Property Set Parent(Value As CDirectory)
    Set mParent = Value
End Property

Public Property Get Parent() As CDirectory
    Set Parent = mParent
End Property

Public Sub AddFile(FilePath As String)
    Dim i As Long, l As Long, cnt As Long
    Dim clsdir As CDirectory
    l = InStr(1, FilePath, "\")
    On Error GoTo ErrHandler
    If l = 0 Then
        mFiles.Add Text & FilePath, LCase(Text & FilePath)
    Else
        Set clsdir = mDirs(mText & Left$(FilePath, l))
        clsdir.AddFile Right$(FilePath, Len(FilePath) - l)
    End If
    Exit Sub
ErrHandler:
    If l <> 0 Then
        Set clsdir = New CDirectory
        Set clsdir.Parent = Me
        clsdir.Text = mText & Left$(FilePath, l)
        clsdir.AddFile Right$(FilePath, Len(FilePath) - l)
        mDirs.Add clsdir, LCase(clsdir.Text)
    End If
End Sub

Public Sub Create(Text As String, Files() As String)
    Dim i As Long
    Me.Text = Text
    For i = LBound(Files) To UBound(Files)
        AddFile Files(i)
    Next i
End Sub

Private Sub Class_Initialize()
    Set mFiles = New Collection
    Set mDirs = New Collection
End Sub

Private Sub Class_Terminate()
    Set mFiles = Nothing
    Set mDirs = Nothing
End Sub