fileview.frm

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

    mnuFileFldr_Click
End Sub

Private Sub mnuFileSB_Click()
    If stbForm.Visible Then
        stbForm.Visible = False
        mnuFileSB.Checked = False
    Else
        stbForm.Visible = True
        mnuFileSB.Checked = True
    End If
    PlayOut
End Sub

Private Sub mnuFileSelR_Click()
    Dim litem As ListItem
    
    If lvwFile.ListItems.Count <> 0 Then
        For Each litem In lvwFile.ListItems
            If litem.Selected Then
                litem.Selected = False
            Else
                litem.Selected = True
            End If
        Next
    End If
    lvwFile.SetFocus
End Sub

Private Sub mnuFileSelRpop_Click()
    mnuFileSelR_Click
End Sub

Private Sub mnuFileTxt_Click()
    Dim strPath As String
    '新文件的数目
    Dim intNewCount As Integer
    Dim bExit As Boolean
    Dim nd As Node
    Dim litem As ListItem
    
    intNewCount = 1

    If m_ndCur.Tag = 2 Then
        strPath = m_ndCur.Key + "新建文件.txt"
    Else
        strPath = m_ndCur.Key + "\新建文件.txt"
    End If

NextNew1:
    bExit = fso.FileExists(strPath)
    If bExit = True Then
        If m_ndCur.Tag = 2 Then
            strPath = m_ndCur.Key + "新建文件"
        Else
            strPath = m_ndCur.Key + "\新建文件"
         End If
        strPath = strPath + CStr(intNewCount) + ".txt"
        intNewCount = intNewCount + 1
        GoTo NextNew1
    End If
        '创建文本文件
        Set txt = fso.CreateTextFile(strPath)
        txt.Close
        Set fl = fso.GetFile(strPath)
        fl.Attributes = Normal
    
    
    Set litem = m_lItems.Add(, fl.path, fl.Name, 12, 12)
    litem.Tag = 2 '表示为文件
    litem.ListSubItems.Add , , CStr(fl.Size / 1024) + "K"
    litem.ListSubItems.Add , , CStr(fl.Type)
    litem.ListSubItems.Add , , CStr(fl.DateLastModified)
    
    '注意，这一定要
    lvwFile.SetFocus
    
    litem.EnsureVisible
    litem.Selected = True
    lvwFile.StartLabelEdit

End Sub

Private Sub mnuFileTxtpop_Click()
    mnuFileTxt_Click
End Sub

Private Sub mnuViewDetail_Click()
    lvwFile.View = lvwReport
    mnuViewDetail.Checked = True
    mnuViewLi.Checked = False
    mnuViewSi.Checked = False
    mnuViewList.Checked = False
    
End Sub

Private Sub mnuViewLi_Click()
    lvwFile.View = lvwIcon
    mnuViewDetail.Checked = False
    mnuViewLi.Checked = True
    mnuViewSi.Checked = False
    mnuViewList.Checked = False

End Sub

Private Sub mnuViewList_Click()
    lvwFile.View = lvwList
    mnuViewDetail.Checked = False
    mnuViewLi.Checked = False
    mnuViewSi.Checked = False
    mnuViewList.Checked = True

End Sub

Private Sub mnuViewRf_Click()
    tvwFile_NodeClick tvwFile.SelectedItem
End Sub

Private Sub mnuViewSi_Click()
    lvwFile.View = lvwSmallIcon
    mnuViewDetail.Checked = False
    mnuViewLi.Checked = False
    mnuViewSi.Checked = True
    mnuViewList.Checked = False
End Sub

Private Sub mnuViewTB_Click()
    If clbForm.Visible Then
        clbForm.Visible = False
        mnuViewTB.Checked = False
    Else
        clbForm.Visible = True
        mnuViewTB.Checked = True
    End If
    PlayOut
End Sub

Private Sub mnuViewUp_Click()
    Dim nd As Node
    Set nd = tvwFile.SelectedItem
    If nd.Tag < 4 Then
        tvwFile_NodeClick nd.Parent
        nd.Parent.Selected = True
    End If
End Sub

Private Sub mnuViewUppop_Click()
    mnuViewUp_Click
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "copy"
        mnuEditCopy_Click
    Case "cut"
        mnuEditCut_Click
    Case "paste"
        mnuEditPaste_Click
    Case "delete"
        mnuEditDel_Click
    Case "up"
        mnuViewUp_Click
    End Select
End Sub

Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    Select Case ButtonMenu.Key
    Case "fldr"
        mnuFileFldr_Click
    Case "file"
        mnuFileTxt_Click
    Case "lview"
        mnuViewLi_Click
    Case "sview"
        mnuViewSi_Click
    Case "list"
        mnuViewList_Click
    Case "detail"
        mnuViewDetail_Click
    End Select
End Sub

Private Sub tvwFile_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 tvwFile.SelectedItem.Tag = 2 Then '若是驱动器
            Cancel = True '取消
        Else '若是文件夹
        
            strPath = tvwFile.SelectedItem.Key
            strName = tvwFile.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(tvwFile.SelectedItem.Key).Name = NewString
                   tvwFile.SelectedItem.Key = strPath
                   tvwFile_NodeClick tvwFile.SelectedItem
                End If
            Else
                Cancel = True
            End If
               
        End If
    Else
        Cancel = True
    End If
    
    If bOk = False Then
        '注意，这一句不可少
        tvwFile.SetFocus
        tvwFile.SelectedItem.Selected = True
        tvwFile.StartLabelEdit
    End If
End Sub

Private Sub tvwFile_Collapse(ByVal Node As MSComctlLib.Node)
  '  tvwFile_NodeClick Node
End Sub

Private Sub tvwFile_Expand(ByVal Node As MSComctlLib.Node)
    Dim strPath As String
    Dim strName As String
    '此节点的下下一层要改变
    If Node.Key <> "desktop" And Node.Key <> "mycomp" Then
        If Node.Tag = 0 Then
            strPath = Node.Key
            strName = Node.Text
            Set fldr = fso.GetFolder(strPath)
            For Each fldr1 In fldr.SubFolders
                NextNode fldr1.path, fldr1
            Next
            Node.Tag = 1
        End If
    End If
End Sub

Private Sub tvwFile_GotFocus()
    m_bFocus = True
End Sub

Private Sub tvwFile_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        tvwFile_NodeClick tvwFile.SelectedItem
    ElseIf KeyCode = 8 Then
        mnuViewUp_Click
    End If
End Sub

Private Sub tvwFile_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If (lvwFile.Left - x) < 150 And x >= 0 And m_bMove = False Then
        frmFile.MousePointer = 9
        m_bMove = True
    ElseIf Button = 0 Then
        frmFile.MousePointer = 0
        m_bMove = False
    End If

    
    If Button = 1 And m_bMove Then

        MouseMove x, 1
    End If
End Sub

Private Sub MouseMove(x As Single, who As Integer)
    If x > 0 And x < frmFile.ScaleWidth Then
        If who = 1 Then '在Treeview中
            m_sngtvwWidth = x
        ElseIf who = 2 Then '在ListView中
            m_sngtvwWidth = lvwFile.Left + x
        End If
        PlayOut
    End If
End Sub

Private Sub tvwFile_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If m_bMove And Button = 1 Then
        frmFile.MousePointer = 0
        m_bMove = False
    End If
    If Button = 2 Then
        PopupMenu mnuPop
    End If
End Sub

Private Sub tvwFile_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim litem As ListItem
    Dim nd As Node
    Dim i As Integer
    Dim strdrv As String
    Dim lsitem As ListSubItem
    
    On Error GoTo Line1
    '保存当前node
    Set m_ndCur = tvwFile.Nodes(Node.Key)
    
   '显示文件夹内容
    
    Set m_lItems = lvwFile.ListItems
    m_lItems.Clear
    If Node.Key = "desktop" Then
        Set litem = m_lItems.Add(, "mycomp", "我的电脑", "mycomp", "mycomp")
    ElseIf Node.Key = "mycomp" Then
        'Set nd = Node.Child
        'i = 1
        'Do While i <= Node.Children
        '    Set lItem = m_lItems.Add(, nd.Key, nd.Text, nd.Image, nd.Image)
        '   Set nd = nd.Next
        '    i = i + 1
        'Loop
        
        '先将栏题换调
        lvwFile.ColumnHeaders("Size").Text = "类型"
        lvwFile.ColumnHeaders("Type").Text = "总容量"
        lvwFile.ColumnHeaders("MDate").Text = "可用空间"
        lvwFile.ColumnHeaders("Type").Alignment = lvwColumnRight
        lvwFile.ColumnHeaders("MDate").Alignment = lvwColumnRight
        lvwFile.ColumnHeaders("Size").Alignment = lvwColumnLeft
        
        Set drvs = fso.Drives
        If drvs.Count <> 0 Then
           For Each drv In drvs
                Set litem = m_lItems.Add(, drv.DriveLetter + ":\", drv.DriveLetter, tvwFile.Nodes(drv.path + "\").Image, tvwFile.Nodes(drv.path + "\").Image)
                litem.Tag = 0 '表示为驱动器
                '类型，总容量，可用空间
                Select Case drv.DriveType
                Case CDRom
                    strdrv = "光驱"
                Case RamDisk
                    strdrv = "RAM"
                Case Removable
                    strdrv = "软驱"
                Case Network
                    strdrv = "网络驱动器"
                Case Unknown
                    strdrv = "未知"
                Case Fixed
                    strdrv = "本地磁盘"
                End Select
                litem.ListSubItems.Add , , strdrv
                
                If drv.IsReady Then
                    litem.ListSubItems.Add , , CStr(Format(drv.TotalSize / 1024 / 1024 / 1024, "###.###")) + "G"
                    litem.ListSubItems.Add , , CStr(Format(drv.FreeSpace / 1024 / 1024 / 1024, "###.###")) + "G"
                End If
           Next
        End If
    Else '每个磁盘里的文件
       ' Set nd = Node.Child
        'i = 1
       ' Do While i <= Node.Children
        '    Set lItem = m_lItems.Add(, nd.Key, nd.Text, nd.Image, nd.Image)
        '    Set nd = nd.Next
        '    i = i + 1
       ' Loop
        
        '显示文件夹
        
                '先将栏题换调
        lvwFile.ColumnHeaders("Size").Text = "大小"
        lvwFile.ColumnHeaders("Type").Text = "类型"
        lvwFile.ColumnHeaders("MDate").Text = "修改时间"
        lvwFile.ColumnHeaders("Size").Alignment = lvwColumnRight
        lvwFile.ColumnHeaders("Type").Alignment = lvwColumnLeft
        lvwFile.ColumnHeaders("MDate").Alignment = lvwColumnLeft

TryAgain:
        Set drv = fso.GetDrive(fso.GetDriveName(Node.Key))
        
         If drv.IsReady Then
          Set fldr = fso.GetFolder(Node.Key)
        
             Set fldrs = fldr.SubFolders
             If fldrs.Count <> 0 Then
                For Each fldr In fldrs
                     Set litem = m_lItems.Add(, fldr.path, fldr.Name, 6, 6)
                     litem.Tag = 1 '表示为文件夹
                     litem.ListSubItems.Add , , CStr(Format(fldr.Size / 1024 / 1024, "######.###")) + "M"
                     litem.ListSubItems.Add , , CStr(fldr.Type)
                     litem.ListSubItems.Add , , CStr(fldr.DateLastModified)
                Next
            End If
            
            '显示文件
            Set fldr = fso.GetFolder(Node.Key)
            Set fls = fldr.Files
            If fls.Count <> 0 Then
                For Each fl In fls
                    Set litem = m_lItems.Add(, fl.path, fl.Name, 12, 12)
                    litem.Tag = 2 '表示为文件
                    litem.ListSubItems.Add , , CStr(Format(fl.Size / 1024, "########.##")) + "K"
                    litem.ListSubItems.Add , , CStr(fl.Type)
                    litem.ListSubItems.Add , , CStr(fl.DateLastModified)
                    
                Next
            End If
        Else    '对于可移动磁盘来说。
            Dim msg As Integer
            msg = MsgBox("无法访问" + drv.path + Chr(13) & Chr(10) + "设备未准备好", vbRetryCancel + vbInformation, _
            "浏览—" + imglTvw.ListImages(Node.Image).Tag)
            If msg = vbRetry Then GoTo TryAgain
                
        End If
    End If
    Node.Selected = True
    Node.Expanded = True
    Node.EnsureVisible
    ImageCombo1_Dropdown
    
    stbForm.Panels(1).Text = Node.Text
    Select Case Node.Tag
    Case 4
        stbForm.Panels(2).Text = "桌面"
    Case 3
        stbForm.Panels(2).Text = "我的电脑"
    Case 2
        If fso.GetDrive(Node.Key).IsReady Then
            stbForm.Panels(2).Text = CStr(Format(fso.GetDrive(Node.Key).TotalSize / 1024 / 1024 / 1024, "####.###")) + "G (剩余空间："
            stbForm.Panels(2).Text = stbForm.Panels(2).Text + CStr(Format(fso.GetDrive(Node.Key).FreeSpace / 1024 / 1024 / 1024, "####.###")) + "G)"
        Else
            stbForm.Panels(2).Text = "设备未准备好！"
        End If
    Case Else
        stbForm.Panels(2).Text = CStr(Format(fso.GetFolder(Node.Key).Size / 1024 / 1024, "#######.##")) + "M (剩余空间："
        stbForm.Panels(2).Text = stbForm.Panels(2).Text + CStr(Format(fso.GetDrive(fso.GetDriveName(Node.Key)).FreeSpace / 1024 / 1024, "########.##")) + "M)"
    End Select
    
Line1:
     
End Sub