fileview.frm

采用vb写的资料系统管理器功能特别

            TextSave        =   "Ti52e:09:52"
            Key             =   "time"
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            Alignment       =   1
            Object.Width           =   2117
            MinWidth        =   2117
            TextSave        =   "2001-12-23"
            Key             =   "date"
         EndProperty
         BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            AutoSize        =   1
            Bevel           =   0
            Enabled         =   0   'False
            Object.Width           =   2717
            MinWidth        =   1764
            Text            =   "资源管理器"
            TextSave        =   "资源管理器"
            Key             =   "welcome"
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFileCreate 
         Caption         =   "新建(&N)"
         Begin VB.Menu mnuFileFldr 
            Caption         =   "文件夹"
         End
         Begin VB.Menu mnuFileTxt 
            Caption         =   "文本文件"
         End
      End
      Begin VB.Menu mnuFileLine0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditDel 
         Caption         =   "删除(&D)"
      End
      Begin VB.Menu mnuEditReN 
         Caption         =   "重命名(&M)"
      End
      Begin VB.Menu mnuFileClose 
         Caption         =   "关闭(&C)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mnuEditCopy 
         Caption         =   "复制(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditCut 
         Caption         =   "剪切(&T)"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "粘贴(&P)"
         Shortcut        =   ^V
      End
      Begin VB.Menu munEditLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditLine2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditSelAll 
         Caption         =   "全选(&A)"
         Shortcut        =   ^A
      End
      Begin VB.Menu mnuFileSelR 
         Caption         =   "反向选择(&I)"
      End
   End
   Begin VB.Menu mnuView 
      Caption         =   "查看(&V)"
      Begin VB.Menu mnuViewTB 
         Caption         =   "工具栏"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuFileSB 
         Caption         =   "状态栏"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewLine0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewLi 
         Caption         =   "大图标"
      End
      Begin VB.Menu mnuViewSi 
         Caption         =   "小图标"
      End
      Begin VB.Menu mnuViewList 
         Caption         =   "列表"
      End
      Begin VB.Menu mnuViewDetail 
         Caption         =   "详细资料"
      End
      Begin VB.Menu mnuViewLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewRf 
         Caption         =   "刷新(&R)"
         Shortcut        =   {F5}
      End
      Begin VB.Menu mnuViewLine2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewUp 
         Caption         =   "上一级"
      End
   End
   Begin VB.Menu Help 
      Caption         =   "帮助(&H)"
      Begin VB.Menu About 
         Caption         =   "关于 资源管理器(&A)"
      End
   End
   Begin VB.Menu mnuPop 
      Caption         =   ""
      Begin VB.Menu mnuFileCreatepop 
         Caption         =   "新建(&N)"
         Begin VB.Menu mnuFileFldrpop 
            Caption         =   "文件夹"
         End
         Begin VB.Menu mnuFileTxtpop 
            Caption         =   "文本文件"
         End
      End
      Begin VB.Menu mnuFileLine0pop 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditCopypop 
         Caption         =   "复制(&C)"
      End
      Begin VB.Menu mnuEditCutpop 
         Caption         =   "剪切(&T)"
      End
      Begin VB.Menu mnuEditPastepop 
         Caption         =   "粘贴(&P)"
      End
      Begin VB.Menu mnuEditLine2pop 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditDelpop 
         Caption         =   "删除(&D)"
      End
      Begin VB.Menu mnuEditLine3pop 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditReNpop 
         Caption         =   "重命名(&M)"
      End
      Begin VB.Menu mnuEditLine4pop 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditSelAllpop 
         Caption         =   "全选(&A)"
      End
      Begin VB.Menu mnuFileSelRpop 
         Caption         =   "反向选择(&I)"
      End
      Begin VB.Menu mnuLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewUppop 
         Caption         =   "上一级"
      End
   End
End
Attribute VB_Name = "frmFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_sngtvwWidth As Single
'判断边界的移动
Private m_bMove As Boolean

Private m_lItems As ListItems

'判断ListItem的双击
Private m_sngtmDClk As Single
Private m_bFClk As Boolean

'当前Node
Private m_ndCur As Node

'谁得焦点
Private m_bFocus As Boolean

'复制、剪切
Private m_bCopy As Boolean
Private m_arrayflPath() As String
Private m_arrayfldrPath() As String

'动画
Private m_bStop As Boolean


Private Sub clbForm_HeightChanged(ByVal NewHeight As Single)
    PlayOut
End Sub

Private Sub Form_Load()
    m_sngtvwWidth = frmFile.ScaleWidth / 3
    m_bMove = False
    m_bFClk = False
    m_bBak = False
    'treeview得焦点
    m_bFocus = True
    
    m_bStop = False
    
    Dim m_arrayflPath(1) As String
    Dim m_arrayfldrPath(1) As String
    
    m_arrayflPath(0) = ""
    m_arrayfldrPath(0) = ""
    
    ReadDir
    
    lvwFile.ColumnHeaders.Add , "Name", "名称", lvwFile.Width * 2
    lvwFile.ColumnHeaders.Add , "Size", "大小", lvwFile.Width
    lvwFile.ColumnHeaders.Add , "Type", "类型", lvwFile.Width
    lvwFile.ColumnHeaders.Add , "MDate", "修改时间", lvwFile.Width * 2
   
    lvwFile.View = lvwReport
    
    tvwFile.Nodes("C:\").Selected = True
    ImageCombo1_Dropdown

    tvwFile_NodeClick tvwFile.Nodes("C:\")
    tvwFile.Nodes("C:\").Expanded = True
    tvwFile.Nodes("C:\").Selected = True
    
    '保存当前node
    Set m_ndCur = tvwFile.Nodes("C:\")
End Sub

'读出文件系统出来，放于TreeView中
Private Sub ReadDir()
    '图像索引号
    Dim intimgindex As Integer
    '父节点
    Dim strParent As String
    
    Dim nd As Node
    
     '创建文件系统对象
    Set fso = CreateObject("scripting.filesystemobject")
    Set drvs = fso.Drives
    
    Set nd = tvwFile.Nodes.Add(, 0, "desktop", "桌面", 1, 1)
    nd.Tag = 4
    Set nd = tvwFile.Nodes.Add("desktop", 4, "mycomp", "我的电脑", 2, 2)
    nd.Tag = 3
    
    For Each drv In drvs
        Select Case drv.DriveType
        Case CDRom
            intimgindex = 5
        Case RamDisk
            intimgindex = 4
        Case Removable
            intimgindex = 3
        Case Network
            intimgindex = 9
        Case Unknown
            intimgindex = 4
        Case Fixed
            intimgindex = 4
        End Select
        If drv.DriveType = Fixed Then
            Set nd = tvwFile.Nodes.Add("mycomp", 4, drv.path, drv.DriveLetter + "(" + drv.VolumeName + ")", intimgindex, intimgindex)
        Else
            Set nd = tvwFile.Nodes.Add("mycomp", 4, drv.path, drv.DriveLetter, intimgindex, intimgindex)

        End If
        nd.Key = nd.Key & "\"
        nd.Tag = 2
        
        '文件夹
        intimgindex = 6
        If drv.DriveType <> Removable Then
            If drv.IsReady Then
                '开始读取
                strParent = drv.path + "\"
                Set fldr = drv.RootFolder
                Set fldrs = fldr.SubFolders
                '有子文件夹
                  
                For Each fldr1 In fldrs
                    Set nd = tvwFile.Nodes.Add(strParent, 4, fldr1.path, fldr1.Name, intimgindex, intimgindex)
                    nd.Tag = 0
                    NextNode fldr1.path, fldr1
                Next
                

            End If
        End If
    Next

    
End Sub

Private Sub NextNode(Parent As String, ByVal folder As Scripting.folder)
    Dim nd As Node
    If folder.SubFolders.Count <> 0 Then
        Set fldrs = folder.SubFolders
        For Each fldr1 In fldrs
            Set nd = tvwFile.Nodes.Add(Parent, 4, fldr1.path, fldr1.Name, 6, 6)
            nd.Tag = 0
            '穷尽所有的子文件夹
            'NextNode fldr1.Path, fldr1
        Next
    End If
End Sub

Private Sub Form_Resize()
    PlayOut
End Sub

Private Sub PlayOut()
    Dim sngheight As Single
    '窗体布局
    If frmFile.WindowState <> 1 Then
    tvwFile.Left = 0
    sngheight = frmFile.ScaleHeight
    If clbForm.Visible Then
        sngheight = sngheight - clbForm.Height
        tvwFile.Top = clbForm.Height
    Else
        tvwFile.Top = 0
    End If
    If stbForm.Visible Then
        sngheight = sngheight - stbForm.Height
    End If
    tvwFile.Height = sngheight
    tvwFile.Width = m_sngtvwWidth
    
    lvwFile.Top = tvwFile.Top
    lvwFile.Left = tvwFile.Width
    lvwFile.Height = tvwFile.Height
    lvwFile.Width = frmFile.ScaleWidth - tvwFile.Width
    End If
End Sub

Private Sub ImageCombo1_Click()
    tvwFile_NodeClick tvwFile.Nodes(ImageCombo1.SelectedItem.Key)
    tvwFile.Nodes(ImageCombo1.SelectedItem.Key).Expanded = True
    tvwFile.Nodes(ImageCombo1.SelectedItem.Key).EnsureVisible
End Sub

Private Sub ImageCombo1_Dropdown()
    Dim cmbitem As ComboItem
    Dim nd As Node
    Dim fullPath As String
    Dim subPath() As String
    Dim rootPath As String
    Dim intlocal As Integer
    Dim k As Integer
    Dim i As Integer
    k = 0
    
    ReDim subPath(1) As String
    
    Set nd = tvwFile.SelectedItem
    fullPath = nd.Key
    
    intlocal = 1
    intlocal = InStr(intlocal, fullPath, "\", vbTextCompare)
        
    Do While intlocal > 0
        ReDim Preserve subPath(UBound(subPath) + 1)
        subPath(k) = Left(fullPath, intlocal - 1)
        k = k + 1
        intlocal = intlocal + 1
        intlocal = InStr(intlocal, fullPath, "\", vbTextCompare)
    Loop
    subPath(k) = fullPath
     
     ImageCombo1.ComboItems.Clear
     Set nd = tvwFile.Nodes("desktop")
     Set cmbitem = ImageCombo1.ComboItems.Add(1, nd.Key, nd.Text, nd.Image, , 0)
     cmbitem.Tag = nd.Tag
     Set nd = tvwFile.Nodes("mycomp")
     Set cmbitem = ImageCombo1.ComboItems.Add(2, nd.Key, nd.Text, nd.Image, , 1)
     cmbitem.Tag = nd.Tag
     
     i = 3
     '决定顺序
     For Each drv In fso.Drives
            Set cmbitem = ImageCombo1.ComboItems.Add(i, drv.DriveLetter + ":\", drv.DriveLetter, , , 2)
            cmbitem.Image = tvwFile.Nodes(drv.path + "\").Image
            cmbitem.Tag = tvwFile.Nodes(drv.path + "\").Tag
            i = i + 1
        If drv.path = subPath(0) Then
          
            For intlocal = 1 To k
                If subPath(intlocal) <> drv.path + "\" Then
                    Set nd = tvwFile.Nodes(subPath(intlocal))
                    Set cmbitem = ImageCombo1.ComboItems.Add(i, nd.Key, nd.Text, nd.Image, , 2 + intlocal)
                        cmbitem.Tag = nd.Tag
                    i = i + 1
                End If
            Next
        End If
     Next
     ImageCombo1.ComboItems(fullPath).Selected = True
        
        
End Sub

Private Sub lvwFile_AfterLabelEdit(Cancel As Integer, NewString As String)
    Dim strPath As String
    Dim strName As String
    Dim bOk As Boolean
    '检查是否为空
    bOk = False
    NewString = Trim(NewString)
    If Len(NewString) <> 0 Then
        If lvwFile.SelectedItem.Tag = 0 Then '若是驱动器
            Cancel = True '取消
        ElseIf lvwFile.SelectedItem.Tag = 1 Then '若是文件夹
        
            strPath = lvwFile.SelectedItem.Key
            strName = lvwFile.SelectedItem.Text
            If StrComp(UCase(strName), UCase(NewString)) <> 0 Then
                strPath = Left(strPath, Len(strPath) - Len(strName)) + NewString
                    
                If fso.FolderExists(strPath) Then
                    MsgBox "此文件夹已存在！", vbOKCancel + vbCritical, "警告"
                    Cancel = True
                Else
                    bOk = True
                    fso.GetFolder(lvwFile.SelectedItem.Key).Name = NewString
                    '注意这个顺序，不可以互换
                    tvwFile.Nodes(lvwFile.SelectedItem.Key).Text = NewString
                    tvwFile.Nodes(lvwFile.SelectedItem.Key).Key = strPath
                    lvwFile.SelectedItem.Key = strPath