用VB将目录里所有文件及子目录存储到一个类型数组中后,将基其反映在Treeview控件上

来源:互联网 发布:淘宝用户行为隐私保护 编辑:程序博客网 时间:2024/06/05 12:39

经过3天的苦苦思考,于今日终于完成了将一个目录里所有文件及子目录存储到一个类型数组中后,然后将这个数组信息存储到一个TreeView控件中。下面将我3天来的成绩写给大家,以供交流参考。

1、在Form上添加一个TreeView控件,命名为T;一个ImageList控件,命名为Img1,选择Img1控件,右键单击->属性->图像->插入两个图片(索引为1、2用于显示目录或文件);添加一个CommandButton按钮,Caption属性为:“遍历文件夹”,命名为BtnShowTree,代码如下:

Private Type Folder
     FolderName As String '文件夹的名字
     FolderLogo As String '文件夹的标志
End Type
Private Type FolderOrFile
        FName As String '名字
        FFather As String '父结点
        FType As Integer '用于判断是文件夹还是文件1代表文件夹,0代表文件
        Flogo As String '自身标志
End Type
Dim FolderFile() As FolderOrFile '定义文件夹及文件存储信息数组
Dim Folder() As Folder '定义文件夹信息
Dim N As Integer '用于目录及文件的个数
Dim nodX As Node  '树形控件中

Dim FolderN As Integer '文件夹个数
Dim FolderN_C As Integer '附文件夹个数

___________________________________________

Private Sub Form_Load()

T.LineStyle = tvwTreeLines
T.ImageList = Img1
T.Style = tvwTreelinesPlusMinusPictureText
Set nodX = T.Nodes.Add(, , "文件管理系统", "文件管理系统", 1) '添加一个根,注意这个文件夹的根须命名为“文件管理系统”如果要命为其他名称需改其中部分代码

End Sub

__________________________________________________________________

Public Sub SearchFolder(ByVal strpath As String) '该函数主要功能是先给“文件管理系统”目录下所有子目录定一个Key,因为TreeView中所有的结点都不能重名,strpath为路径名
On Error Resume Next
Dim Fso As Object
Dim Fol As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fol = Fso.GetFolder(strpath)
For Each Fol In Fol.subfolders
    FolderN = FolderN + 1
    ReDim Preserve Folder(FolderN)
    Folder(FolderN).FolderName = SJW(Fol.path, SMID(Fol.path))
    Folder(FolderN).FolderLogo = "Folder" & Trim(Str(FolderN))
    SearchFolder Fol
Next
Set Fso = Nothing
Set Fol = Nothing
End Sub

__________________________________________________________________________

Public Sub SeachFileorFolder(ByVal strpath As String, Flogo As String) 'strpath为路径,Flogo为父结点标志
   On Error Resume Next
   Dim Fso As Object
   Dim Fol As Object
   Dim Fil As Object
   Dim FolN As Object
   Set Fso = CreateObject("Scripting.FileSystemObject")
   Set Fol = Fso.GetFolder(strpath)
    Set Fil = Fol.Files
   Set FolN = Fso.GetFolder(strpath)
   Dim FFF As String
   Dim FFtype As Integer
   '扫描文件
         '一些相关操作
        If SJW(strpath, SMID(strpath)) = "文件管理系统" Then
           For Each Fil In Fol.Files
               N = N + 1
               ReDim Preserve FolderFile(N)
               FolderFile(N).FName = SJW(Fil.path, SMID(Fil.path))
               FolderFile(N).FFather = "文件管理系统"
               FolderFile(N).FType = 0
               FolderFile(N).Flogo = "根" & Trim(Str(N))
          Next
        Else
          For Each Fil In Fol.Files
               N = N + 1
               ReDim Preserve FolderFile(N)
               FolderFile(N).FName = SJW(Fil.path, SMID(Fil.path))
               FolderFile(N).FFather = Flogo
               FolderFile(N).FType = 0
               FolderFile(N).Flogo = Flogo & Trim(Str(N))
          Next
        End If
   '扫描子目錄
   FolderN_C = FolderN_C + 1
   For Each FolN In FolN.subfolders
       N = N + 1
       ReDim Preserve FolderFile(N)
       FolderFile(N).FName = SJW(FolN.path, SMID(FolN.path))
       If SJW(strpath, SMID(strpath)) = "文件管理系统" Then
          FolderFile(N).FFather = "文件管理系统"
       Else
          FolderFile(N).FFather = Flogo
       End If
       FolderFile(N).FType = 1
       FolderFile(N).Flogo = Trim(Folder(FolderN_C).FolderLogo)
       SeachFileorFolder FolN, Folder(FolderN_C).FolderLogo
   Next
  Set Fso = Nothing
  Set Fil = Nothing
  Set Fol = Nothing
  Set FolN = Nothing
End Sub

_____________________________________________________________

Private Sub ThowT(s As Integer) '将数组中的信息添加到树形控件中
On Error Resume Next
Dim FFtype As Integer '文件和文件夹使用图标的判断
Dim i As Integer
For i = 1 To N
       If FolderFile(i).FType = 1 Then
           FFtype = 1
       ElseIf FolderFile(i).FType = 0 Then
           FFtype = 2
       End If
       Set nodX = T.Nodes.Add(FolderFile(i).FFather, tvwChild, FolderFile(i).Flogo, FolderFile(i).FName, FFtype)
      
Next
End Sub

____________________________________________________________________________

Private Function SLeft(s As String, L As Integer) As String '取字符串
Dim i As Integer
For i = 1 To L
  SLeft = SLeft & Mid(s, i, 1)
Next
End Function
Private Function SMID(s As String) As Integer '取/的位置
If s = "" Then
   SMID = 0
End If
Dim i As Integer
For i = lstrlen(s) To 1 Step -1
   If Mid(s, i, 1) = "/" Then
      SMID = i
      Exit For
   End If
Next
If i = 0 Then
   SMID = 0
End If
End Function
Private Function SJW(s As String, T As Integer) As String '取/后的字符串
If s = "" Or T = 0 Then
   SJW = ""
   Exit Function
End If
Dim i As Integer
SJW = Mid(s, T + 1, lstrlen(s) - T)
End Function

___________________________________________________________

Private Sub BtnShowTree_Click()
FolderN_C = 0
FolderN = 0
N = 0
List1.Clear
List3.Clear
SearchFolder App.path & "/文件管理系统"
SeachFileorFolder App.path & "/文件管理系统", ""
ThowT N
End Sub

以上代码在VB6.0环境下调试通过

执行结果为:

原创粉丝点击