NonSoft

2つのテキストファイルの差分を解析するサンプル(VB6)


 サンプル(ソース/コード)
<このサンプルの概要>
テキスト差分(Diff)を解析するロジックに興味を持ち色々調べましたが、良い公式を見つ
ける事が出来ませんでした。なぜテキスト差分という、今や当たり前のキーワードが公開
されていないのか疑問に思いつつ、仕方無く自力(独自アルゴリズム)で考えました。
このサンプルは、2つのテキストファイルを比較し差分解析結果を返します。まず、変更
前/後のテキストファイルを読み込みます。読み込んだ変更前ファイルを先頭行から差分
解析し変更後ファイルと一致するかを確認します。一致していれば解析済み行としてカウ
ントアップします。一致していなければ次の一致行を探します。そこで見つかった一致行
までが差分となります。しかし、変更前ファイルからのみ差分解析すると、実際より差分
が大きくなってしまうので変更後ファイルからの差分解析も行います。変更前ファイルか
らの差分解析結果と変更後ファイルからの差分解析結果のを比較し一致行以降の一致行数
が多い方を採用します。そうして得た結果を配列に並べ、変更状態を示す文字列(UPD,ADD,
DEL) と共に返します。

バージョン2.04とは引数が変わっています。このモジュールではファイルの読込を行なわ
ないので、呼び出す側でファイル読み込みを行なってください。そして読み込んだ結果の
文字列を引数で渡してください。file0、file1と言う引数がありますが、特に重要な意味
では使っていません。

<このサンプルを使用しテキスト差分を表示した画面イメージ>
テキスト差分表示イメージ


バージョンアップ(テキスト差分解析精度向上、文字コード判定)版をライブラリ(DLL)
として公開していますのでお試しください。(VBSとVBAでも動作確認しています)
テキスト差分解析DLL(VB6/VB.NET/C#.NET)


VB.NET版のサンプルソースもあります。(差分解析ロジックVer5.01)
2つのテキストファイルの差分を解析するサンプル(VB.NET)

少し古いサンプルソースがあります。(差分解析ロジックVer2.04)
2つのテキストファイルの差分を解析するサンプル(VB6) 2.04版

また、テキスト差分関係のツールをダウンロード頂けます。
テキスト差分表示ツール
フォルダ監視人

「ネット(Web)で手軽にテキスト差分表示サービス!!」をお試し頂けます。
テキスト差分表示ツール.NET

ファイル比較関係のその他のツールやサンプルソースはこちらです。
ファイル比較/フォルダ比較

★標準モジュール(Module1.bas)
Option Explicit
'
' 関数名    : TextDiff
' 返り値    : テキスト差分解析結果2次元配列
'           : (正常時)
'           : 配列番号=0はタイトル行、配列番号=1以降にテキストデータ
'           : 配列(0,0) = "TYPE"
'           : 配列(1,0) = "NO."
'           : 配列(2,0) = file0PATH
'           : 配列(3,0) = "NO."
'           : 配列(4,0) = file1PATH
'           : 配列(0,1〜) = 変更状態を示す文字列(UPD,ADD,DEL)
'           : 配列(1,1〜) = file0の行番号
'           : 配列(2,1〜) = file0の各行テキストデータ
'           : 配列(3,1〜) = file1の行番号
'           : 配列(4,1〜) = file1の各行テキストデータ
' 引き数    : strData0(i) : 変更前テキストデータ
'           : strData1(i) : 変更後テキストデータ
'           : p1      (i) : 精度微調整パラメータ(一致判定行数)
'           : p2      (i) : 精度微調整パラメータ(一致判定文字数)
'           : p3      (i) : 精度微調整パラメータ(一致行解析数)
'           : file0   (i) : 変更前テキストファイル(file0PATH)
'           : file1   (i) : 変更後テキストファイル(file1PATH)
' 機能説明  : テキストファイルを比較し、テキスト差分解析結果を返します
' 備考      : テキスト差分解析ロジックVer5.01
' 著作権    : Copyright(C) 2008-2009 のん All rights reserved
' ---------------------------------------------------------------------------
' 使用条件  : このサイトの内容を使用(流用/改変/転載/等全て)した成果物を不特定
'           : 多数に公開/配布する場合は、このサイトを参考にした旨を記述してく
'           : ださい。(例)WEBページやReadMeにリンクを貼ってください
' ---------------------------------------------------------------------------
Public Function TextDiff(ByVal strData0 As String, _
                         ByVal strData1 As String, _
                         Optional ByVal p1 As Long = 1, _
                         Optional ByVal p2 As Long = 5, _
                         Optional ByVal p3 As Long = 10, _
                         Optional ByVal file0 As String = "file0PATH", _
                         Optional ByVal file1 As String = "file1PATH") As String()
    On Error Resume Next

    Dim rtn() As String             ' テキスト差分解析結果2次元配列定義
    ReDim rtn(4, 0)                 ' テキスト差分解析結果2次元配列定義
    Dim i As Long                   ' カウンタ(汎用)
    Dim j As Long                   ' カウンタ(汎用)
    Dim k As Long                   ' カウンタ(汎用)
    Dim fitCol As Collection        ' 最適テキスト差分解析数用のコレクション
    Dim fit0 As Long                ' 一致行番号(変更前テキストファイル側)
    Dim fit1 As Long                ' 一致行番号(変更後テキストファイル側)
    Dim sumi0 As Long               ' 解析済行番号(変更前テキストファイル側)
    Dim sumi1 As Long               ' 解析済行番号(変更後テキストファイル側)
    Dim fdata0() As String          ' 変更前テキストデータ配列
    Dim fdata1() As String          ' 変更後テキストデータ配列
    
    ' 変更前テキストデータ配列準備
    strData0 = Replace(strData0, vbCrLf, vbLf)
    strData0 = Replace(strData0, vbCr, vbLf)
    strData0 = vbLf & strData0
    fdata0 = Split(strData0, vbLf)
    If fdata0(UBound(fdata0)) = "" Then
        ReDim Preserve fdata0(UBound(fdata0) - 1)
    End If
    
    ' 変更後テキストデータ配列
    strData1 = Replace(strData1, vbCrLf, vbLf)
    strData1 = Replace(strData1, vbCr, vbLf)
    strData1 = vbLf & strData1
    fdata1 = Split(strData1, vbLf)
    If fdata1(UBound(fdata1)) = "" Then
        ReDim Preserve fdata1(UBound(fdata1) - 1)
    End If
    
    ' テキスト差分解析開始
    sumi0 = 0
    sumi1 = 0
    Do
        ' テキスト差分解析終了判定
        If sumi0 >= UBound(fdata0) And sumi1 >= UBound(fdata1) Then
            Exit Do
        End If

        ' 一致行解析
        Set fitCol = FitAnalysis(fdata0, fdata1, sumi0, sumi1, 1, 5, 10)

        ' 最適一致行判定
        fit0 = UBound(fdata0) + 1
        fit1 = UBound(fdata1) + 1
        If fitCol.Count = 1 Then
            fit0 = fitCol.Item(1)(0)
            fit1 = fitCol.Item(1)(1)
        Else
            Dim maxCnt As Long
            maxCnt = 0
            ' 解析済行に近い一致行を採用
            For i = 1 To fitCol.Count
                Dim c As Long
                c = (fitCol.Item(i)(0) - sumi0) + _
                    (fitCol.Item(i)(1) - sumi1)
                If maxCnt = 0 Or maxCnt > c Then
                    maxCnt = c
                    fit0 = fitCol.Item(i)(0)
                    fit1 = fitCol.Item(i)(1)
                End If
            Next i
        End If

        ' 変更行をテキスト差分解析結果へ設定
        If fit0 - 1 - sumi0 > 0 And fit1 - 1 - sumi1 > 0 Then
            ' 変更行をテキスト差分解析結果に設定
            Dim dfp As Long
            Dim smj As Long
            dfp = UBound(rtn, 2)
            smj = sumi1
            For i = sumi0 + 1 To fit0 - 1
                For j = smj + 1 To fit1 - 1
                    If Len(fdata0(i)) > p2 And fdata0(i) = fdata1(j) Then
                        ' 細かく調べると、一致行を発見。。。
                        For k = smj + 1 To j - 1
                            ' 変更後テキストをテキスト差分解析結果に設定
                            If UBound(rtn, 2) < dfp + k - smj Then
                                ReDim Preserve rtn(4, UBound(rtn, 2) + 1)
                            End If
                            rtn(3, dfp + k - smj) = k
                            rtn(4, dfp + k - smj) = fdata1(k)
                        Next k
                        ' 変更前/変更後テキストをテキスト差分解析結果に設定
                        ReDim Preserve rtn(4, UBound(rtn, 2) + 1)
                        rtn(1, UBound(rtn, 2)) = i
                        rtn(2, UBound(rtn, 2)) = fdata0(i)
                        rtn(3, UBound(rtn, 2)) = j
                        rtn(4, UBound(rtn, 2)) = fdata1(j)
                        dfp = UBound(rtn, 2)
                        smj = j
                        Exit For
                    End If
                Next j
                If j > fit1 - 1 Then
                    ' 変更前テキストをテキスト差分解析結果に設定
                    ReDim Preserve rtn(4, UBound(rtn, 2) + 1)
                    rtn(1, UBound(rtn, 2)) = i
                    rtn(2, UBound(rtn, 2)) = fdata0(i)
                End If
            Next i
            ' 変更後テキストをテキスト差分解析結果に設定
            For i = smj + 1 To fit1 - 1
                If UBound(rtn, 2) < dfp + i - smj Then
                    ReDim Preserve rtn(4, UBound(rtn, 2) + 1)
                End If
                rtn(3, dfp + i - smj) = i
                rtn(4, dfp + i - smj) = fdata1(i)
            Next i
        ElseIf fit0 - 1 - sumi0 > 0 And fit1 - 1 - sumi1 <= 0 Then
            ' 削除行をテキスト差分解析結果に設定
            For i = sumi0 + 1 To fit0 - 1
                ReDim Preserve rtn(4, UBound(rtn, 2) + 1)
                rtn(0, UBound(rtn, 2)) = "DEL"
                rtn(1, UBound(rtn, 2)) = i
                rtn(2, UBound(rtn, 2)) = fdata0(i)
            Next i
        ElseIf fit0 - 1 - sumi0 <= 0 And fit1 - 1 - sumi1 > 0 Then
            ' 追加行をテキスト差分解析結果に設定
            For i = sumi1 + 1 To fit1 - 1
                ReDim Preserve rtn(4, UBound(rtn, 2) + 1)
                rtn(0, UBound(rtn, 2)) = "ADD"
                rtn(3, UBound(rtn, 2)) = i
                rtn(4, UBound(rtn, 2)) = fdata1(i)
            Next i
        End If

        ' 一致行をテキスト差分解析結果に設定
        If fit0 <= UBound(fdata0) And fit1 <= UBound(fdata1) Then
            ReDim Preserve rtn(4, UBound(rtn, 2) + 1)
            rtn(1, UBound(rtn, 2)) = fit0
            rtn(2, UBound(rtn, 2)) = fdata0(fit0)
            rtn(3, UBound(rtn, 2)) = fit1
            rtn(4, UBound(rtn, 2)) = fdata1(fit1)
        End If

        ' 解析済み行の設定
        sumi0 = fit0
        sumi1 = fit1
        
        ' 画面が固まらないように
        DoEvents
    Loop

    ' タイトル行設定
    rtn(0, 0) = "TYPE"
    rtn(1, 0) = "NO."
    rtn(2, 0) = file0
    rtn(3, 0) = "NO."
    rtn(4, 0) = file1
    
    ' TYPE(ADD,DEL,UPD)の設定
    For i = 1 To UBound(rtn, 2)
        rtn(0, i) = ""
        If rtn(1, i) = "" Then
            rtn(0, i) = "追加"
        ElseIf rtn(3, i) = "" Then
            rtn(0, i) = "削除"
        ElseIf rtn(2, i) <> rtn(4, i) Then
            rtn(0, i) = "変更"
        End If
    Next i
    
    ' リターン
    TextDiff = rtn
End Function

' 関数名    : FitAnalysis
' 返り値    : 一致行コレクション
' 引き数    : fdata0(i) : 変更前テキストデータ
'           : fdata1(i) : 変更後テキストデータ
'           : sumi0 (i) : 解析済行番号(変更前テキストファイル側)
'           : sumi1 (i) : 解析済行番号(変更後テキストファイル側)
'           : p1   (i) : 精度微調整パラメータ(一致判定行数)
'           : p2   (i) : 精度微調整パラメータ(一致判定文字数)
'           : p3   (i) : 精度微調整パラメータ(一致行解析数)
' 機能説明  : テキストファイルを比較し一致行コレクションを返します
' 備考      :
' 著作権    : Copyright(C) 2008 - 2009 のん All rights reserved
Private Function FitAnalysis( _
    ByRef fdata0() As String, ByRef fdata1() As String, _
    ByVal sumi0 As Long, ByVal sumi1 As Long, _
    ByVal p1 As Long, ByVal p2 As Long, ByVal p3 As Long) As Collection
    
    Dim rtn As Collection           ' 最適差分解析数用のコレクション
    Dim i As Long                   ' カウンタ(変更前テキストファイル側)
    Dim j As Long                   ' カウンタ(変更後テキストファイル側)
    Dim k As Long                   ' カウンタ(汎用)
    Dim diff As Boolean             ' 差分発見フラグ
    Dim fit(0 To 1)                 ' 一致行番号
    Dim ts As String                ' 文字列(汎用)

只今、都合によりサンプルソースの公開を停止しています。
申し訳ございませんが、テキスト差分解析DLL(VB6/VB.NET/C#.NET)でお試しください。

★フォームモジュール(Form1.frm)
Option Explicit
Private Sub Command1_Click()
    Dim bytCode() As Byte
    Dim intFileNo As Integer
    Dim strFpath As String
    
    Dim strData1 As String: strData1 = ""
    strFpath = App.Path & "\a.txt"
    intFileNo = FreeFile
    ReDim bytCode(FileLen(strFpath) - 1) As Byte
    Open strFpath For Binary As intFileNo
    Get intFileNo, , bytCode
    Close
    strData1 = StrConv(bytCode, vbUnicode)

    Dim strData2 As String: strData2 = ""
    strFpath = App.Path & "\b.txt"
    intFileNo = FreeFile
    ReDim bytCode(FileLen(strFpath) - 1) As Byte
    Open strFpath For Binary As intFileNo
    Get intFileNo, , bytCode
    Close
    strData2 = StrConv(bytCode, vbUnicode)

    Text1.Text = ""
    Dim i As Long
    Dim diff() As String
    diff = TextDiff(strData1, strData2)
    For i = 1 To UBound(diff, 2)
        Text1.Text = Text1.Text & _
                    diff(0, i) & vbTab & _
                    diff(1, i) & vbTab & _
                    diff(2, i) & vbTab & _
                    diff(3, i) & vbTab & _
                    diff(4, i) & vbCrLf
    Next i
End Sub