VB6 Collection实现百万文本去重

上一篇数组的去重说到，对于千次计算以上的去重基本上特别的吃力，这里就介绍一种方法，通过Collection集合对象来过滤重复。

Option Explicit

'//By: InkHin

'// 参考：https://bbs.csdn.net/topics/350065116

'引用：Microsoft scriptiong Runtime

'感谢 析弱大叔 qq: 1265382638  的指点.

'// 2019-03-10


'// 测试 Collection 去重 百万条文本数据过滤

'// 请编译执行

Private Function Out_Remove_Same(ByVal Path As String, ByVal InName As String, ByVal OutName As String)
Dim col As Collection
    Set col = New Collection
    Dim fso As Variant
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim stream1 As Scripting.TextStream
    
    'Function BuildPath(Path As String, Name As String) As String  '目录路径 文件名称
    
    Set stream1 = fso.OpenTextFile(fso.BuildPath(Path, InName), ForReading, False)
    
    Dim stream2 As Scripting.TextStream
    
    Set stream2 = fso.OpenTextFile(fso.BuildPath(Path, OutName), ForWriting, True)
    
    While Not stream1.AtEndOfStream
        Dim strLine As String
        strLine = stream1.ReadLine
        
        Dim vntValue As Variant
        vntValue = Empty
        
        On Error Resume Next
        vntValue = col.Item(strLine)
        On Error GoTo 0
        
        If IsEmpty(vntValue) Then
            Call col.Add(Null, strLine)
            Call stream2.WriteLine(strLine)
        End If
    Wend
    
    Call stream1.Close
    Call stream2.Close
End Function