fileview.frm

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

                End If
            Else
                Cancel = True
            End If
        ElseIf lvwFile.SelectedItem.Tag = 2 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.FileExists(strPath) Then
                    MsgBox "此文件已存在！", vbOKCancel + vbCritical, "警告"
                    Cancel = True
                Else
                    bOk = True
                    fso.GetFile(lvwFile.SelectedItem.Key).Name = NewString
                     lvwFile.SelectedItem.Key = strPath
               End If
            Else
                Cancel = True
            End If
     
        End If
    Else
        Cancel = True
    End If
    
    If bOk = False Then
        '注意，这一句不可少
        lvwFile.SetFocus
        lvwFile.SelectedItem.Selected = True
        lvwFile.StartLabelEdit
    End If
End Sub

Private Sub lvwFile_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    lvwFile.SortKey = ColumnHeader.Index - 1
    lvwFile.Sorted = True
End Sub

Private Sub lvwFile_DragDrop(Source As Control, x As Single, y As Single)
    Set lvwFile.DropHighlight = Nothing
End Sub

Private Sub lvwFile_DragOver(Source As Control, x As Single, y As Single, State As Integer)
    Set lvwFile.DropHighlight = lvwFile.HitTest(x, y)
End Sub

Private Sub lvwFile_GotFocus()
    m_bFocus = False
End Sub

Private Sub lvwFile_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Dim sngtmclk As Single
    
    sngtmclk = Timer
    If m_bFClk = False Then
        m_sngtmDClk = sngtmclk
        m_bFClk = True
    Else
        If (sngtmclk - m_sngtmDClk) < 1 Then
            m_bFClk = False
         '运行程序
          OpenItem Item
        Else
            m_sngtmDClk = sngtmclk
            m_bFClk = True
        End If
    End If
    If Item.Tag = 0 Then
        If fso.GetDrive(Item.Key).IsReady Then
                stbForm.Panels(2).Text = CStr(Format(fso.GetDrive(Item.Key).TotalSize / 1024 / 1024 / 1024, "####.###")) + "G (剩余空间："
                stbForm.Panels(2).Text = stbForm.Panels(2).Text + CStr(Format(fso.GetDrive(Item.Key).FreeSpace / 1024 / 1024 / 1024, "####.###")) + "G)"
            Else
                stbForm.Panels(2).Text = "设备未准备好！"
            End If
    ElseIf Item.Tag = 1 Then
        stbForm.Panels(2).Text = CStr(Format(fso.GetFolder(Item.Key).Size / 1024 / 1024, "#######.##")) + "M (剩余空间："
        stbForm.Panels(2).Text = stbForm.Panels(2).Text + CStr(Format(fso.GetDrive(fso.GetDriveName(Item.Key)).FreeSpace / 1024 / 1024, "########.##")) + "M)"
    Else
        stbForm.Panels(2).Text = CStr(Format(fso.GetFile(Item.Key).Size / 1024, "#######.##")) + "K (剩余空间："
        stbForm.Panels(2).Text = stbForm.Panels(2).Text + CStr(Format(fso.GetDrive(fso.GetDriveName(Item.Key)).FreeSpace / 1024 / 1024, "########.##")) + "M)"
    End If
End Sub
Sub OpenItem(ByVal itemKey As ListItem)
    Set Item = itemKey
            If Item.Tag = 2 Then
                
               Openfile itemKey.Key
            Else '展开文件夹或者驱动器
                If Item.Tag = 0 Then
                    Set nd = tvwFile.Nodes(Item.Key)
                Else
                    Set nd = tvwFile.Nodes(Item.Key)
                End If
                tvwFile_NodeClick nd
                tvwFile.Nodes(Item.Key).Selected = True
                tvwFile.Nodes(Item.Key).Expanded = True
            End If

End Sub
 
'打开文件
Private Sub Openfile(ByVal strFileName As String)
    Dim str As String
    str = LCase(Right(strFileName, 3))
    Select Case str
    Case "exe"
        WinExec strFileName, SW_SHOWNORMAL
    Case "com"
        WinExec strFileName, SW_SHOWNORMAL
    Case "bat"
        WinExec strFileName, SW_SHOWNORMAL
    Case "txt"
        WinExec "notepad " + strFileName, SW_SHOWNORMAL
    Case Else
        MsgBox "对不起，本程序未给此文件作相关链接！", vbInformation + vbOKOnly, "注意"
    End Select
End Sub

Private Sub lvwFile_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        lvwFile_ItemClick lvwFile.SelectedItem
        lvwFile_ItemClick lvwFile.SelectedItem
    ElseIf KeyCode = 8 Then
        mnuViewUp_Click
    End If
End Sub

Private Sub lvwFile_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If 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, 2
    End If

End Sub

Private Sub lvwFile_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 mnuEditCopy_Click()
    Dim nd As Node
    Dim litem As ListItem
    ReDim m_arrayflPath(1) As String
    ReDim m_arrayfldrPath(1) As String
    
    m_arrayflPath(0) = ""
    m_arrayfldrPath(0) = ""

    m_bCopy = True

    If m_bFocus Then
        '树
        For Each nd In tvwFile.Nodes
            If nd.Selected Then
                nd.Bold = True
                ReDim Preserve m_arrayfldrPath(UBound(m_arrayfldrPath) + 1)
                m_arrayfldrPath(UBound(m_arrayfldrPath) - 1) = nd.Key
            End If
        Next
    Else
        For Each litem In lvwFile.ListItems
            If litem.Selected Then
                litem.Bold = True
                If litem.Tag = 1 Then
                    ReDim Preserve m_arrayfldrPath(UBound(m_arrayfldrPath) + 1)
                    m_arrayfldrPath(UBound(m_arrayfldrPath) - 1) = litem.Key
                ElseIf litem.Tag = 2 Then
                    ReDim Preserve m_arrayflPath(UBound(m_arrayflPath) + 1)
                    m_arrayflPath(UBound(m_arrayflPath) - 1) = litem.Key
                End If
            End If
       Next
    End If
End Sub

Private Sub mnuEditCopypop_Click()
    mnuEditCopy_Click
End Sub

Private Sub mnuEditCut_Click()
    Dim nd As Node
    Dim litem As ListItem
    ReDim m_arrayflPath(1) As String
    ReDim m_arrayfldrPath(1) As String
    
    m_arrayflPath(0) = ""
    m_arrayfldrPath(0) = ""
    
    m_bCopy = False

    If m_bFocus Then
        '树
        For Each nd In tvwFile.Nodes
            If nd.Selected Then
                nd.Bold = True
                ReDim Preserve m_arrayfldrPath(UBound(m_arrayfldrPath) + 1)
                m_arrayfldrPath(UBound(m_arrayfldrPath) - 1) = nd.Key
            End If
        Next
    Else
        For Each litem In lvwFile.ListItems
            If litem.Selected Then
                litem.Bold = True
                If litem.Tag = 1 Then
                    ReDim Preserve m_arrayfldrPath(UBound(m_arrayfldrPath) + 1)
                    m_arrayfldrPath(UBound(m_arrayfldrPath) - 1) = litem.Key
                ElseIf litem.Tag = 2 Then
                    ReDim Preserve m_arrayflPath(UBound(m_arrayflPath) + 1)
                    m_arrayflPath(UBound(m_arrayflPath) - 1) = litem.Key
                End If
            End If
       Next
    End If
End Sub

Private Sub mnuEditCutpop_Click()
    mnuEditCut_Click
End Sub

Private Sub mnuEditDel_Click()
    Dim nd As Node
    Dim litem As ListItem
    Dim i As Integer

    If m_bFocus Then
        '树
        Set nd = tvwFile.SelectedItem
            If nd.Selected And nd.Tag <> 2 Then
                i = MsgBox("是否真的要删除..\" + nd.Text + "？", vbYesNo + vbQuestion, "警告")
                If i = vbYes Then
                    fso.DeleteFolder nd.Key, True
                    tvwFile_NodeClick nd.Parent
                    tvwFile.Nodes.Remove (nd.Key)
                End If
            End If
        

    Else
        For Each litem In lvwFile.ListItems
            If litem.Selected Then
                If litem.Tag = 1 Then
                    i = MsgBox("是否真的要删除..\" + litem.Text + "？", vbYesNo + vbQuestion, "警告")
                    If i = vbYes Then
                        fso.DeleteFolder litem.Key, True
                        tvwFile.Nodes.Remove (litem.Key)

                    End If
                ElseIf litem.Tag = 2 Then
                    i = MsgBox("是否真的要删除..\" + litem.Text + "？", vbYesNo + vbQuestion, "警告")
                    If i = vbYes Then
                        fso.DeleteFile litem.Key, True
                    End If
                End If
            End If
    Next
     tvwFile_NodeClick tvwFile.SelectedItem

    End If
    
End Sub

Private Sub mnuEditDelpop_Click()
    mnuEditDel_Click
End Sub

Private Sub mnuEditPaste_Click()
    Dim k As Integer
    Dim strdPath As String
    Dim strsPath As String
    Dim strName As String
    '目标地点
        If tvwFile.SelectedItem.Tag = 2 Then
            strdPath = tvwFile.SelectedItem.Key
        Else
            strdPath = tvwFile.SelectedItem.Key + "\"
        End If
    '粘贴
    If UBound(m_arrayfldrPath) > 1 Or UBound(m_arrayflPath) > 1 Then
        '复制文件夹
        For k = 1 To UBound(m_arrayfldrPath) - 1
            strsPath = m_arrayfldrPath(k)
            strName = fso.GetFolder(strsPath).Name
            
            '不要复制到自己里面
            If strsPath + "\" <> strdPath Then
                If OverWrite(strdPath + strName, True) Then
                    fso.CopyFolder strsPath, strdPath
                End If
            End If
        Next
        '文件
        For k = 1 To UBound(m_arrayflPath) - 1
            strsPath = m_arrayflPath(k)
            strName = fso.GetFileName(strsPath)
            If OverWrite(strdPath + strName, False) Then
                fso.CopyFile strsPath, strdPath
            End If
        Next
        
        If m_bCopy = False Then
            '剪切
        '删除文件夹
        For k = 1 To UBound(m_arrayfldrPath) - 1
            strsPath = m_arrayfldrPath(k)
            fso.DeleteFolder strsPath
            tvwFile.Nodes.Remove (strsPath)
        Next
        '文件
        For k = 1 To UBound(m_arrayflPath) - 1
            strsPath = m_arrayflPath(k)
            fso.DeleteFile strsPath
        Next
        End If
     tvwFile_NodeClick tvwFile.SelectedItem
    End If
End Sub

Private Function OverWrite(path As String, bfldr As Boolean) As Boolean
    Dim i As Integer
    OverWrite = True
    If bfldr Then
        If fso.FolderExists(path) Then
            i = MsgBox("文件夹已经存在,是否覆盖它？", vbYesNo + vbQuestion, "注意")
            If i = vbYes Then
                OverWrite = True
            Else
                OverWrite = False
            End If
        End If
    Else
        If fso.FileExists(path) Then
            i = MsgBox("文件已经存在,是否覆盖它？", vbYesNo + vbQuestion, "注意")
            If i = vbYes Then
                OverWrite = True
            Else
                OverWrite = False
            End If
        End If
    End If
End Function

Private Sub mnuEditPastepop_Click()
    mnuEditPaste_Click
End Sub

Private Sub mnuEditReN_Click()
    
    If m_bFocus Then
        tvwFile.StartLabelEdit
    Else
        lvwFile.StartLabelEdit
    End If
End Sub

Private Sub mnuEditReNpop_Click()
    mnuEditReN_Click
End Sub

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

Private Sub mnuEditSelAllpop_Click()
    mnuEditSelAll_Click
End Sub

Private Sub mnuFileClose_Click()
    End
End Sub

Private Sub mnuFileFldr_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 + "新建文件夹"
    Else
        strPath = m_ndCur.Key + "\新建文件夹"
    End If

NextNew:
    bExit = fso.FolderExists(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)
        intNewCount = intNewCount + 1
        GoTo NextNew
    End If
        Set fldr = fso.CreateFolder(strPath)
        fldr.Attributes = Normal
   
    Set nd = tvwFile.Nodes.Add(m_ndCur.Key, 4, fldr.path, fldr.Name, 6, 6)
    nd.Tag = 0

    Set litem = m_lItems.Add(, fldr.path, fldr.Name, 6, 6)
    litem.Tag = 1 '表示为文件夹
    litem.ListSubItems.Add , , CStr(fldr.Size / 1024) + "K"
    litem.ListSubItems.Add , , CStr(fldr.Type)
    litem.ListSubItems.Add , , CStr(fldr.DateLastModified)
    
    '注意，这一定要
    lvwFile.SetFocus
    
    litem.EnsureVisible
    litem.Selected = True
    lvwFile.StartLabelEdit
    
End Sub

Private Sub mnuFileFldrpop_Click()