|
２つのテキストファイルの差分を解析するサンプル(VB6)
|
＜このサンプルの概要＞
テキスト差分を解析するロジックに興味を持ち色々調べましたが、良い公式を見つける事
が出来ませんでした。なぜテキスト差分という、今や当たり前のキーワードが公開されて
いないのか疑問に思いつつ、仕方無く自力(独自アルゴリズム)で考えました。
このサンプルは、２つのテキストファイルを比較し差分解析結果を返します。まず、変更
前／後のテキストファイルを読み込みます。読み込んだ変更前ファイルを先頭行から差分
解析し変更後ファイルと一致するかを確認します。一致していれば解析済み行としてカウ
ントアップします。一致していなければ次の一致行を探します。そこで見つかった一致行
までが差分となります。しかし、変更前ファイルからのみ差分解析すると、実際より差分
が大きくなってしまうので変更後ファイルからの差分解析も行います。変更前ファイルか
らの差分解析結果と変更後ファイルからの差分解析結果のを比較し一致行以降の一致行数
が多い方を採用します。そうして得た結果を配列に並べ、変更状態を示す文字列(UPD,ADD,
DEL) と共に返します。
バージョン2.04とは引数が変わっています。このモジュールではファイルの読込を行なわ
ないので、呼び出す側でファイル読み込みを行なってください。そして読み込んだ結果の
文字列を引数で渡してください。file0、file1と言う引数がありますが、特に重要な意味
では使っていません。
少し古いサンプルソースもあります。(差分解析ロジックVer2.04)
２つのテキストファイルの差分を解析するサンプル(VB6) 2.04版
VB.NET版のサンプルソースもあります。(差分解析ロジックVer5.01)
２つのテキストファイルの差分を解析するサンプル(VB.NET)
また、テキスト差分関係のツールをダウンロード頂けます。
テキスト差分表示ツール
フォルダ監視人
「ネット(Web)で手軽にテキスト差分表示サービス！！」をお試し頂けます。
テキスト差分表示ツール.NET
★標準モジュール(Module1.bas)
Option Explicit
'
' 関数名 : TextDiff
' 返り値 : テキスト差分解析結果２次元配列
' : （正常時）
' : 配列番号＝０はタイトル行、配列番号＝１以降にテキストデータ
' : 配列(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 のん All rights reserved
'
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 ' テキスト差分解析結果２次元配列定義
ReDim rtn(4, 0) ' テキスト差分解析結果２次元配列定義
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, p1, p2, p3)
' 最適一致行判定
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
Do While fdata0(fit0 - 1) = fdata1(fit1 - 1)
fit0 = fit0 - 1
fit1 = fit1 - 1
Loop
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
' @(f)
' 関数名 : FitAnalysis
'
' 返り値 : 一致行コレクション
'
' 引き数 : fdata0(i) : 変更前テキストデータ
' : fdata1(i) : 変更後テキストデータ
' : sumi0 (i) : 解析済行番号（変更前テキストファイル側）
' : sumi1 (i) : 解析済行番号（変更後テキストファイル側）
' : p1 (i) : 精度微調整パラメータ（一致判定行数）
' : p2 (i) : 精度微調整パラメータ（一致判定文字数）
' : p3 (i) : 精度微調整パラメータ（一致行解析数）
'
' 機能説明 : テキストファイルを比較し一致行コレクションを返します
'
' 備考 :
'
' 著作権 : Copyright(C) 2008 のん 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
On Error Resume Next
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 ' 文字列（汎用）
' 初期設定（最終行＋１を一致行とする）
Set rtn = New Collection
fit(0) = UBound(fdata0) + 1
fit(1) = UBound(fdata1) + 1
rtn.Add fit
' テキスト差分無し初期設定
diff = False
' 変更前ファイルの対象行を変更後ファイルから検索
For i = sumi0 + 1 To UBound(fdata0)
For j = sumi1 + 1 To UBound(fdata1)
If diff = True Then
ts = ""
' テキスト差分発見後はp1行以上、p2文字以上の一致が条件
For k = 0 To 99
If i + k > UBound(fdata0) Then Exit For
If j + k > UBound(fdata1) Then Exit For
If fdata0(i + k) <> fdata1(j + k) Then Exit For
If Len(ts) < p2 Then ts = ts & fdata0(i + k)
If k >= p1 - 1 And Len(ts) >= p2 Then
Exit For
End If
Next
If i + k > UBound(fdata0) Then Exit For
If j + k > UBound(fdata1) Then Exit For
If fdata0(i + k) = fdata1(j + k) Then
' 一致
fit(0) = i
fit(1) = j
rtn.Add fit
' 一致行解析数に達するまで保存
If rtn.Count >= p3 Then
Exit For
End If
End If
Else
Set rtn = New Collection
If fdata0(i) = fdata1(j) Then
' 一致
fit(0) = i
fit(1) = j
rtn.Add fit
Exit For
Else
' テキスト差分発見
diff = True
End If
End If
Next j
If i <= UBound(fdata0) And j <= UBound(fdata1) Then
If fdata0(i) = fdata1(j) Then
' 一致
Exit For
End If
End If
' 一致行解析数に達した時は終了
If rtn.Count >= p3 Then
Exit For
End If
Next i
' テキスト差分有り時は変更後ファイルの対象行を変更前ファイルから検索
If diff = True Then
For j = sumi1 + 1 To UBound(fdata1)
For i = sumi0 + 1 To UBound(fdata0)
ts = ""
' テキスト差分発見後はp1行以上、p2文字以上の一致が条件
For k = 0 To 99
If i + k > UBound(fdata0) Then Exit For
If j + k > UBound(fdata1) Then Exit For
If fdata0(i + k) <> fdata1(j + k) Then Exit For
If Len(ts) < p2 Then ts = ts & fdata0(i + k)
If k >= p1 - 1 And Len(ts) >= p2 Then
Exit For
End If
Next
If i + k > UBound(fdata0) Then Exit For
If j + k > UBound(fdata1) Then Exit For
If fdata0(i + k) = fdata1(j + k) Then
' 一致
fit(0) = i
fit(1) = j
rtn.Add fit
' 一致行解析数に達するまで保存
If rtn.Count >= p3 * 2 Then
Exit For
End If
End If
Next i
' 一致行解析数に達した時は終了
If rtn.Count >= p3 * 2 Then
Exit For
End If
Next j
End If
' 一致行コレクションを返す
Set FitAnalysis = rtn
End Function
★フォームモジュール(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