趣味プログラミングblog

---

操作感としていちいちファイル指定はやってられないので、対象の2ファイルをドラッグ&ドロップしたら動く仕様に。

ドラッグ&ドロップしたオブジェクト数が2以外ならエラーで即終了。
オブジェクトがファイル以外でも即終了。

一旦、テキストファイルを読み込んで、辞書型配列にコンテンツをキーとして、行数を値として格納。

改めてテキストファイルを辞書型配列と比較して、もう一方のファイルにないものはコンテンツと行数を記録。
メッセージボックスとファイルに出力するという仕様。

---

簡単にできるかと思ったけど、2時間以上かかってしまった。
操作感はまずまず。ファイル1,2がどっちかわからなくならないよう、結果にファイル名を入れる機能を追加した。

以下、ソース。

---

Option Explicit

 

'ファイルドロップ共通モジュール　起動条件で分岐してメイン処理を呼ぶ
call FileDrop()

 

sub main
    dim strFileName, strFullName,f1name,f2name
  dim fcnt, txf,dt1,dt2,tmp,gyo
  dim Dic1  : set Dic1 = CreateObject("Scripting.Dictionary")
  dim Dic2  : set Dic2 = CreateObject("Scripting.Dictionary")
  with CreateObject("Scripting.FileSystemObject")
    for each strFullName In WScript.Arguments
      If .FolderExists(strFullName) then ' is folder.
        call ErrorEnd("フォルダは対象外です。")
      ElseIf .FileExists(strFullName) then' is file.
        fcnt = fcnt + 1
        if fcnt = 1 then  ' テキストファイル1入力
          f1name = strFullName
          gyo =0
          Set txf = .OpenTextFile(strFullName, 1)
          Do Until txf.AtEndOfStream = True
            gyo=gyo+1
                tmp = txf.ReadLine
            if Dic1.exists(tmp) = False then
              Dic1.Add tmp ,gyo & "行"
            end if
                dt1 = dt1 & tmp & vbCrLf
          Loop
          txf.Close
        end if
        if fcnt = 2 then  ' テキストファイル2入力
          f2name = strFullName
          gyo =0
          Set txf = .OpenTextFile(strFullName, 1)
          Do Until txf.AtEndOfStream = True
            gyo=gyo+1
                tmp = txf.ReadLine
            if Dic2.exists(tmp) = False then
              Dic2.Add tmp ,gyo & "行"
            end if
                dt2 = dt2 & tmp & vbCrLf
          Loop
          txf.Close
        end if
      else      ' is unknown.
        call errorEnd("謎のデータがドロップされました。終了します。")
      End If
    next
    ' テキストファイル比較
    if getPath(f1name)=getPath(f2name) then
      f1name = replace(f1name,getPath(f1name),"")
      f2name = replace(f2name,getPath(f2name),"")
    end if
    dim oText,k
    dim dt  : dt = split(dt1,vbCrLf)
    oText = oText & "【" &  f1name & "】ファイル１を解析"  & vbCrLf
    for k = 0 to ubound(dt)
      if  dt(k) <> "" and Dic2.exists(dt(k)) = false then
        oText = oText & dt(k) & "‡(" & Dic1(dt(k)) & "目)は、ファイル2にありません。"& vbCrLf
      end if
    next 
    oText = oText & vbCrLf

 

    dt = split(dt2,vbCrLf)
    oText = oText & "【" &  f2name & "】ファイル2を解析"  & vbCrLf
    for k = 0 to ubound(dt)
      if dt(k) <> "" and  Dic1.exists(dt(k)) = false then
        oText = oText & dt(k) & "‡(" & Dic2(dt(k)) & "目)は、ファイル1にありません。"& vbCrLf
      end if
    next 
    oText = oText & vbCrLf

 

    'テキストファイルを作って書き込み
    dim fPath : fPath = getPath(Wscript.ScriptFullname) & "\比較結果.txt"
    dim tso  :Set tso = .OpenTextFile(fPath, 2,True)
    tso.Write(oText)
    tso.Close
  end with
  msgbox "処理を実行しました。詳細については比較結果.txtを参照してください。" & vbCrLf & vbCrLf & oText
end sub

 

sub FileDrop
    'ファイルドロップ共通モジュール　ファイルならメイン処理を呼ぶ
    If WScript.Arguments.count = 2 then    '引数２つの場合
  call main()
    else    '引数２以外の場合
        call errorend("WScript.Arguments.count = " & WScript.Arguments.count & " 、２つのファイルをドラッグドロップしてください")
    end if
end sub

 

Function getPath(strFullName)
    dim fileName    :   fileName = getFileName(strFullName)
    dim filePath    :   filePath=left(strFullName,len(strFullName)-len(fileName))
    getPath = filePath
end function

 

Function getFileName(FileName )
    Dim yPos
    yPos = InStrRev(FileName, "\")
    If yPos <> 0 Then
    getFileName = Right(FileName, Len(FileName) - yPos)
    Else
    getFileName = ""
    End If
End Function

 

sub ErrorEnd(msg)
    WScript.Echo msg
    WScript.Quit
end sub