VB6 проверка на наличие пустого zip после выполнения кода - PullRequest
0 голосов
/ 30 октября 2019

Это код, который у меня есть, после выполнения он начинает удалять несопоставленные элементы из дерева. 2. 1001 *
, если некоторые zip-файлы не содержат совпадающих файлов, содержимое zip-файла удаляется, но zip-файл остается с размером. из 1k и его пустым.

Вместо того, чтобы оставлять мертвый пустой почтовый индекс, я могу скорее переместить почтовый индекс во вновь созданную папку в пути zip и оставить содержимое как есть и двигаться дальше.


Private Sub Command9_Click()
Dim objNode1 As Node
Dim objNode2 As Node
Dim objMatchNode As Node
Dim objChildNode1 As Node
Dim objChildNode2 As Node
Dim iCounter1 As Integer
Dim iCounter2 As Integer
Dim fFound As Boolean

On Error Resume Next

For Each objNode1 In TreeView2.Nodes

    ' Find matching node in Treeview2
    For Each objNode2 In TreeView1.Nodes
        If objNode2.Text = objNode1.Text Then
            ' Match found
            Set objMatchNode = objNode2
            Exit For
        End If
    Next

    If Not objMatchNode Is Nothing Then

        ' Check all children
        If objNode1.Children > 0 Then

            ' Get first Child
            Set objChildNode1 = objNode1.Child

            ' Loop through all children
            For iCounter1 = 1 To objNode1.Children

                'If objChildNode1.Image = 3 And objNode1.Image = 9 Then

                    ' Check if it already exists in Treeview2
                    If objMatchNode.Children > 0 Then

                        ' Get first Child
                        Set objChildNode2 = objMatchNode.Child

                        ' Set Found flag to False
                        fFound = False

                        ' Loop through all children
                        For iCounter2 = 1 To objMatchNode.Children

                            ' Check for match
                            If objChildNode2.Text = objChildNode1.Text Then
                                fFound = True
                                Exit For
                            End If

                            ' Get next node
                            Set objChildNode2 = objChildNode2.Next
DoEvents
                        Next

                        If fFound Then
                            ' Add to Treeview2
                            'TreeView2.Nodes.Add objMatchNode.Key, tvwChild, objChildNode1.Key, objChildNode1.Text, 3
             Else
DeleteFileFromArchive objChildNode1.Text, "C:\Users\sarah\Desktop\rom test\" & objNode2.Text




                        End If

                    End If

               ' End If

                ' Get next node
                Set objChildNode1 = objChildNode1.Next
DoEvents

            Next

        End If


    End If

Next
End Sub

1 Ответ

1 голос
/ 30 октября 2019

Следующий код найдет пустые узлы и удалит их. Вы можете добавить код для удаления самого Zip-файла здесь, где написано «Удалить Zip»:

Private Sub DeleteFromTreeView(ByRef p_objTreeView As TreeView)
    Dim objNode As Node
    Dim fDelete As Boolean
    Dim iDeleteIndex As Integer
    Dim sDeleteName As String

    ' Get first node from TreeView
    Set objNode = p_objTreeView.Nodes(1)

    Do While Not objNode Is Nothing

        ' Set Delete flag to false
        fDelete = False

        ' Check if node has children, otherwise delete file
        If objNode.Children = 0 Then
            fDelete = True
            iDeleteIndex = objNode.Index
            sDeleteName = objNode.Text
        End If

        ' Go to next sibling
        Set objNode = GetNextSibling(p_objTreeView, objNode)

        If fDelete Then
            ' Delete Zip
            p_objTreeView.Nodes.Remove iDeleteIndex
        End If

    Loop

End Sub

Этот код можно запустить в TreeView после существующего кода. sDeleteName будет содержать имя Zip, который вы хотите удалить, просто добавьте некоторый код для удаления файла, используя что-то вроде этого:

Sub DeleteFile(p_sFilePath)
    Dim objFSO As New FileSystemObject
    If objFSO.FileExists(p_sFilePath) Then objFSO.DeleteFile p_sFilePath
End Sub

Этот Sub использует FileSystemObject, поэтому убедитесь, что вы добавили ссылку Microsoft Scripting Runtime в вашем проекте.

Вам также понадобятся следующие вспомогательные функции, которые вы, возможно, уже имели в своем проекте:

Function GetNextSibling(ByRef p_objTreeView As TreeView, ByRef p_objNode As Node) As Node
    If HasSibling(p_objTreeView, p_objNode) Then
        Set GetNextSibling = p_objTreeView.Nodes(GetNextSiblingIndex(p_objNode))
    Else
        Set GetNextSibling = Nothing
    End If
End Function

Function HasSibling(ByRef p_objTreeView As TreeView, ByRef p_objNode As Node) As Boolean
    HasSibling = Not (p_objNode.LastSibling Is p_objNode)
End Function

Function GetNextSiblingIndex(ByRef p_objNode As Node) As Integer
    With p_objNode
        GetNextSiblingIndex = .Index + .Children + 1
    End With
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...