Question

我正在尝试按对象比较文件以找到dublicate。我在文件夹中有2900个文件，我需要检查它们。换句话说，我必须运行比较方法2900 * 2900次，每次比较两个文件我需要打开和关闭其中一个。如果有办法使用Corel文件不打开它们？或者从Corel VBA文件中获取metadata \ metadata.xml是否可以检查并比较一些参数，如对象（形状）计数？我在绝望中......

我正在使用这个逻辑系统

Private Sub CommandButton1_Click()

    Dim Folder As String
    MousePointer = fmMousePointerHourGlass
    Folder = BrowseForFolderDlg("o:\", "Select Source Folder", GetWindowHandle("ThunderDFrame", Me.Caption))
    tb_inputFolder.text = Folder

End Sub

Private Sub CommandButton2_Click()

    Dim fso As Object
    Dim objFolder As Object
    Dim objFileList As Object
    Dim vFile, vFile1 As Variant
    Dim inputFolder As String, outputFolder As String

    inputFolder = tb_inputFolder.text 'input folder

    If (inputFolder = "") Then
        Exit Sub
    End If


    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(inputFolder)
    Set objFileList = objFolder.Files

    Dim currentFile As String

    Dim dunFiles() As String
    Dim arrLength As Integer
    ReDim Preserve dunFiles(1)
    arrLength = 1
    dunFiles(0) = ""



    For Each vFile In objFileList

        Dim doc As Document, doc1 As Document, buf As String
        Dim fName As String
        fName = (Left(vFile.name, Len(vFile.name) - 4))

        buf = Right(vFile.path, 3)

        If (buf = "cdr" And findArrayElement(dunFiles, arrLength, vFile.name) = -1) Then

            Set doc = OpenDocument(vFile.path) 'document opend

            dunFiles(arrLength - 1) = vFile.name
            ReDim Preserve dunFiles((arrLength + 1))
            arrLength = arrLength + 1


            For Each vFile1 In objFileList
                buf = Right(vFile1.path, 3)

                If (vFile1.name = currentFile Or findArrayElement(dunFiles, arrLength, vFile1.name) <> -1 Or buf <> "cdr") Then
                    GoTo nextElement
                End If

                'Set doc1 = OpenDocument(vFile1.path) 'document opend
                Dim res As Variant


                res = writeFile(doc.FileName + " VS " + vFile1.name + " " + Str(Now), doc.FilePath + "compare.log")

                If (compareDocs(doc, vFile1.path)) Then

                    dunFiles(arrLength - 1) = fName + "_" + vFile1.name
                    ReDim Preserve dunFiles((arrLength + 1))
                    arrLength = arrLength + 1

                    Dim name As String
                    name = vFile.ParentFolder.path + "\" + fName + "_" + vFile1.name
                    Name vFile1.path As name


                    res = writeFile(vFile.ParentFolder.path + "\" + fName + " the same as " + name, doc.FilePath + "rename.log")

                End If

                'doc1.Close
nextElement:

            Next vFile1
            doc.Close

        End If




       ' doc.Close 'close document

    Next vFile

    lb_info.Caption = "Finished! Press exit"

End Sub

Private Function findArrayElement(inputArray() As String, inputLen As Integer, element As String)
    Dim e As String
    Dim i As Integer

    findArrayElement = -1

    For i = 0 To inputLen - 1
        If (inputArray(i) = element) Then
            findArrayElement = i
            Exit Function
        End If
    Next i


End Function

Private Function compareDocs(doc As Document, path2 As String)
    Dim doc1 As Document
    Dim e1 As Shape, e2 As Shape, elements() As String
    Dim sameShapesCount As Integer
    sameShapesCount = 0
    ReDim elements(1) As String
    elements(0) = ""

    Set doc1 = OpenDocument(path2) 'document opend
    compareDocs = False


    lb_info.Caption = "Comapre " + doc.FullFileName + " with " + path2

    For Each e1 In doc.SelectableShapes
        e1.UngroupAll
    Next e1

    For Each e2 In doc1.SelectableShapes
        e2.UngroupAll
    Next e2

    If (doc.SelectableShapes.Count <> doc1.SelectableShapes.Count) Then
        doc1.Close
        Exit Function
    End If


    For Each e1 In doc.SelectableShapes




        'If (findArrayElement(elements, (UBound(elements) + 1), Str(e1.StaticID)) = -1) Then
            'ReDim Preserve elements(UBound(elements) + 1) As String
            'elements(UBound(elements)) = e1.StaticID

            For Each e2 In doc1.SelectableShapes
                If (findArrayElement(elements, (UBound(elements) + 1), "2_" + Str(e2.StaticID)) = -1) Then



                    If (e1.CompareTo(e2, cdrCompareShapeType, cdrCompareEquals)) Then
                        If (e1.CompareTo(e2, cdrCompareFillType, cdrCompareEquals)) Then
                            If (e1.CompareTo(e2, cdrCompareOutline, cdrCompareEquals)) Then
                                If (e1.CompareTo(e2, cdrCompareOutlineColor, cdrCompareEquals)) Then
                                    If (e1.CompareTo(e2, cdrCompareOutlineWidth, cdrCompareEquals)) Then
                                        'If (e1.CompareTo(e2, cdrCompareShapeHeight, cdrCompareEquals)) Then
                                            If (e1.CompareTo(e2, cdrCompareFil, cdrCompareEquals)) Then
                                                'If (e1.CompareTo(e2, cdrCompareShapeWidth, cdrCompareEquals)) Then
                                                    ReDim Preserve elements(UBound(elements) + 1) As String
                                                    elements(UBound(elements)) = "2_" + Str(e2.StaticID)
                                                    sameShapesCount = sameShapesCount + 1
                                                    GoTo nextElement1
                                                'End If
                                            End If
                                        'End If
                                    End If
                                End If
                            End If
                        End If
                    End If

                End If
            Next e2

        'End If
nextElement1:
    Next e1

    If (doc.SelectableShapes.Count = sameShapesCount) Then
        compareDocs = True
    End If

    doc1.Close

End Function


Private Function writeFile(text As String, path As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object


    If Not Dir(path, vbDirectory) = vbNullString Then
        Set oFile = fso.OpenTextFile(path, 8)
    Else
        Set oFile = fso.CreateTextFile(path, 0)
    End If


    oFile.WriteLine text
    oFile.Close

    Set fso = Nothing
    Set oFile = Nothing
End Function

主要问题是＆＃34;开放流程＆＃34;可以持续几分钟，并检查2k corel fiels我需要一年

Answer 1

在第一遍中，打开每个文件一次。

查看您关心的数据 - 对象数或其他 - 必须相等。

从这些数据中，构建一个哈希 - 一个伪随机值，它结合了每个值的信息。

构建一个从 hash 映射到一组与哈希匹配的绘制文件的表。

现在您只需要比较具有相同哈希值的文件，而不是每对文件。设计良好的哈希和数据可以将它的碰撞率降低到接近零。

这可以使你的程序加速1000到3000左右。

为确保哈希/冲突能够正常工作，您的第一遍应该只是哈希并打印出冲突列表。

Answer 2

按文件大小排序列表。仅比较大小相似的文件。您可以使用dir按大小生成排序列表。

您只需要打开一次文件。哈希每个文件（可能是按字母顺序排列的对象名称列表）。存储和排序以及欺骗是相同的对象。

如果您需要使用excel，则可以使用excel，如果需要在代码中执行，则可以使用记录集。

如何使用Corel VBA快速比较Corel文件的内容而不是打开文件

2 个答案: