如何使用 Corel VBA 不打开文件来按内容快速比较 Corel 文件
How to fast compare Corel file by its content using Corel VBA not to open files
我正在尝试按对象比较文件以查找重复项。我的文件夹中有 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
主要问题是 "open process" 可能会持续几分钟，要检查 2k corel 字段我需要一年
按文件大小对列表进行排序。只比较大小相似的文件。您可以使用 dir 按大小生成排序列表。
您只需打开每个文件一次。散列每个文件（可能是按字母顺序排列的对象名称列表）。 Store and sort 和 dupes 是相同的对象。
如果是一次性的，您可以使用 excel，如果需要在代码中执行，则可以使用记录集。
第一次打开每个文件一次。
查看您关心的数据——对象计数或其他——必须相等。
根据这些数据，构建一个 散列 -- 一个伪随机值，它结合了每个数据的信息。
构建一个 table，从 哈希 映射到一组匹配哈希的绘制文件。
现在您只需比较具有相同哈希值的文件，而不是每一对文件。一个设计良好的散列和数据可以将你的冲突率降低到几乎为零。
这将使您的程序速度提高 1000 到 3000 倍左右。
为确保 hash/collision 正常工作，您的第一遍应该只是散列并打印出冲突列表。
我正在尝试按对象比较文件以查找重复项。我的文件夹中有 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
主要问题是 "open process" 可能会持续几分钟，要检查 2k corel 字段我需要一年
按文件大小对列表进行排序。只比较大小相似的文件。您可以使用 dir 按大小生成排序列表。
您只需打开每个文件一次。散列每个文件（可能是按字母顺序排列的对象名称列表）。 Store and sort 和 dupes 是相同的对象。
如果是一次性的，您可以使用 excel，如果需要在代码中执行，则可以使用记录集。
第一次打开每个文件一次。
查看您关心的数据——对象计数或其他——必须相等。
根据这些数据，构建一个 散列 -- 一个伪随机值，它结合了每个数据的信息。
构建一个 table，从 哈希 映射到一组匹配哈希的绘制文件。
现在您只需比较具有相同哈希值的文件，而不是每一对文件。一个设计良好的散列和数据可以将你的冲突率降低到几乎为零。
这将使您的程序速度提高 1000 到 3000 倍左右。
为确保 hash/collision 正常工作，您的第一遍应该只是散列并打印出冲突列表。