Module Module1
' 関数名 : 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-2009 のん All rights reserved
' : ---------------------------------------------------------------
' 使用条件 : このサンプルソースをご使用になるプログラムを不特定多数に配布
' : する場合は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 ' テキスト差分解析結果２次元配列定義
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
' 一致行解析
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
' 画面が固まらないように
Application.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
' リターン
ReDim TextDiff(0, 0)
TextDiff = rtn
End Function
' 関数名 : 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
Dim rtn As Collection ' 最適差分解析数用のコレクション
Dim i As Long ' カウンタ（変更前テキストファイル側）
Dim j As Long ' カウンタ（変更後テキストファイル側）
Dim k As Long ' カウンタ（汎用）
Dim diff As Boolean ' 差分発見フラグ
Dim fit(1) ' 一致行番号
Dim ts As String ' 文字列（汎用）
只今、都合によりサンプルソースの公開を停止しています。
申し訳ございませんが、テキスト差分解析DLL(VB6/VB.NET/C#.NET)でお試しください。
★フォームモジュール(Form1.vb)
Private strData0 As String
Private strData1 As String
Private Sub Form1_Load( _
ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles MyBase.Load
ListView1.FullRowSelect = True
ListView1.GridLines = True
ListView1.View = View.Details
Dim columnDmy As ColumnHeader = New ColumnHeader
Dim columnNo0 As ColumnHeader = New ColumnHeader
Dim columnTyp As ColumnHeader = New ColumnHeader
Dim columnNo1 As ColumnHeader = New ColumnHeader
Dim columnFl1 As ColumnHeader = New ColumnHeader
Dim columnFl2 As ColumnHeader = New ColumnHeader
Dim columnNo2 As ColumnHeader = New ColumnHeader
columnDmy.Width = 0
columnNo0.Text = "No."
columnNo0.Width = 40
columnTyp.Text = "状態"
columnTyp.Width = 40
columnNo1.Text = "行番号"
columnNo1.Width = 50
columnFl1.Text = "ファイル１"
columnFl1.Width = 385
columnFl2.Text = "ファイル２"
columnFl2.Width = 385
columnNo2.Text = "行番号"
columnNo2.Width = 50
Dim colHeaderRegValue() As ColumnHeader = _
{columnDmy, columnNo0, columnTyp, columnNo1, _
columnFl1, columnFl2, columnNo2}
ListView1.Columns.AddRange(colHeaderRegValue)
End Sub
Private Sub Button1_Click( _
ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles Button1.Click
Dim dlg As New OpenFileDialog
dlg.Filter = "すべてのファイル (*.*)|*.*"
If dlg.ShowDialog() = DialogResult.OK Then
Dim st As System.IO.Stream = dlg.OpenFile()
Dim sr As New System.IO.StreamReader(st, _
System.Text.Encoding.GetEncoding("SHIFT-JIS"))
strData0 = sr.ReadToEnd
st.Close()
sr.Close()
DiffDsp()
End If
End Sub
Private Sub Button2_Click( _
ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles Button2.Click
Dim dlg As New OpenFileDialog
dlg.Filter = "すべてのファイル (*.*)|*.*"
If dlg.ShowDialog() = DialogResult.OK Then
Dim st As System.IO.Stream = dlg.OpenFile()
Dim sr As New System.IO.StreamReader(st, _
System.Text.Encoding.GetEncoding("SHIFT-JIS"))
strData1 = sr.ReadToEnd
st.Close()
sr.Close()
DiffDsp()
End If
End Sub
Private Sub DiffDsp()
Dim i As Long
Dim diff(,) As String
diff = TextDiff(strData0, strData1)
ListView1.Items.Clear()
For i = 1 To UBound(diff, 2)
Dim dsp(6) As String
dsp(1) = i
dsp(2) = ""
If strData0 <> "" And strData1 <> "" Then
dsp(2) = diff(0, i)
End If
dsp(3) = diff(1, i)
dsp(4) = diff(2, i)
dsp(5) = diff(4, i)
dsp(6) = diff(3, i)
Dim item As ListViewItem = New ListViewItem(dsp)
If dsp(2) <> "" Then
item.BackColor = System.Drawing.Color.Cyan
End If
ListView1.Items.Add(item)
Next
End Sub
バージョンアップ(テキスト差分解析精度向上、文字コード判定)版をライブラリ(DLL)
として公開していますのでお試しください。(VBSとVBAでも動作確認しています)