fileview.frm

国防工业部VB高级编程源码

    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 mnuFileAttr_Click()
    Dim nd As Node
    Dim litem As ListItem
    
    If m_bFocus Then
        Set nd = tvwFile.SelectedItem
        If nd.Tag = 2 Then '驱动器
            g_intWho = 0
            Set drv = fso.GetDrive(nd.Key)
        AttrForm.Show

        ElseIf nd.Tag = 1 Or nd.Tag = 0 Then
            g_intWho = 1
            Set fldr = fso.GetFolder(nd.Key)
        AttrForm.Show
        
        End If
        
    Else
        Set litem = lvwFile.SelectedItem
        g_intWho = litem.Tag
        Select Case g_intWho
        Case 0
            Set drv = fso.GetDrive(litem.Key)
        Case 1
            Set fldr = fso.GetFolder(litem.Key)
        Case 2
            Set fl = fso.GetFile(litem.Key)
        End Select
        AttrForm.Show
    
    End If
    
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()
    mnuFileFldr_Click
End Sub

Private Sub mnuFileOpen_Click()
    If m_bFocus Then
         tvwFile_NodeClick tvwFile.SelectedItem
    Else
        If lvwFile.ListItems.Count <> 0 Then
            OpenItem lvwFile.SelectedItem
        End If
    End If
    
End Sub

Private Sub mnuFileOpenpop_Click()
    mnuFileOpen_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