http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** v10.2 *** www.dieseyer.de *****************************
'
' Datei: dateienvergleich-1.vbs
' Autor: W. Schmelz
' Auf: www.dieseyer.de
'
' Vergleich von zwei im Explorer markierter Dateien.
' Diese sind auch zusammen per Drag & Drop aufsetzbar.
' Die Unterschiede beider Dateien und Einschübe werden
' zeilenweise samt Nummerierung dieser Zeilen in einer
' Datei Datei-Vgl.txt im Programm-Ordner aufgelistet.
' Anfangs werden beide Dateien nummeriert angegeben.
' Die Leerstellen zum Einrücken (am Zeilenanfang) werden
' nicht beachtet. Die "Fc.exe" (FileCompare) von
' MS versagte an mehreren Beispielen und meldete Fehler -
' so hat sich die (Neu-) Programmierung immerhin gelohnt!
'
'***********************************************************
' CopyRight W. Schmelz, 10.02.2010 (Stammt aus 9/2007)
'Objekte u.a. für Arbeit des Programmes bereit stellen:
'******************************************************
Set Wss=WScript.CreateObject("WScript.Shell")
Set Fso=WScript.CreateObject("Scripting.FileSystemObject")
Set IE=CreateObject("InternetExplorer.Application")
Set Arg=Wscript.Arguments
Titel=" Zwei Dateien vergleichen !"
UV=VbCR&VbCR
'Dim für Weitergabe zwischen Programm und Sub-Programmen:
'********************************************************
Dim Stelle, Neu1, Neu2, i, Plus1, Plus2, Ende1, Ende2, Ende
Dim Zeile1(), Zeile2(), Datei, Datei1, Datei2, Ident, Leer
Dim Nicht, Ort, Schrb, Edg1, Edg2, Dazu, Lang, Voll, Stern
Dim Verschd, Zeilen1(), Zeilen2()
'Prüfen, ob zwei Dateien zum Vergleich aufgesetzt wurden:
'********************************************************
If Arg.Count<>"2" then
Ask=MsgBox (UV&"Sollen jetzt zwei im Explorer zu bestimmen-"&_
UV&"de Dateien verglichen werden ? Die Dateien"&UV&_
"werden zeilenweise auf deren Unterschiede"&UV&_
"überprüft und während dessen getestet, ob "&_
UV&"in diese beiden Dateien Einschübe gemacht"&UV&_
"wurden ! Soll der Explorer geöffnet werden ?"&UV&_
"Man kann aber auch die 2 Dateien aufsetzen?"&UV, _
VbOkCancel+VbDefaultButton1+VbInformation+VbSystemModal,Titel)
If Ask="2" then WScript.Quit
else
'Evtl. aufgesetzte Dateien erkennen:
'***********************************
Datei1=Arg.Item(0)
Datei2=Arg.Item(1)
Text=" "&Arg.Item(0)&VbCR&" "&Arg.Item(1)
Ask=MsgBox(UV&"Folgende Dateien werden jetzt verglichen:"&_
" "&UV&Text&UV, _
VbOkCancel+VbDefaultButton1+VbInformation+VbSystemModal,Titel)
If Ask="2" then WScript.Quit
End If
'Falls nicht beide zu vergleichenden Dateien aufgesetzt wurden,
'statt dessen Auswahl der beiden Dateien im Explorer vornehmen:
'**************************************************************
If Arg.Count<>"2" then
IE.Navigate("About:Blank")
IE.Document.Write "<HTML><BODY><INPUT ID=""Files""Type=""File"">"
IE.Height="0" 'Muss sein, damit IE verborgen bleibt !!!
IE.Width="0"
IE.Visible=True
With IE.Document.All.Files
'Explorer-Fenster muss unbedingt sofort nach vorne kommen:
'*********************************************************
Befehl="about:blank - Microsoft Internet Explorer"
If Wss.AppActivate (Befehl) then Wss.AppActivate (Befehl)
'"Datei1" im Explorer auswählen:
'*******************************
.Click
Datei1= .Value
'Bei Abbruch der Auswahl:
'************************
If Datei1="" then
IE.Quit
Set IE=Nothing
WScript.Quit
End If
WScript.Sleep 500 '1/2 Sek. Pause zum Übergang
'"Datei2" im Explorer auswählen:
'*******************************
.Click
Datei2= .Value
IE.Quit
Set IE=Nothing
'Falls Dateien gleich oder Datei2="" sind:
'*****************************************
If Datei2="" then WScript.Quit
If Datei1=Datei2 then
MsgBox UV&" Abbruch, da die Datei1 = Datei2 !"&_
" "&UV,VbInformation+VbSystemModal,Titel
WScript.Quit
End If
End With
End If
'Prüfen, ob beide Dateien geeignet sind:
'***************************************
Edg1=LCase(Right(Datei1,3))
Edg2=LCase(Right(Datei2,3))
If not (Edg1="txt" or Edg1="vbs" or Edg1="hta" or _
Edg1="bat" or Edg1="sys" or Edg1="ini" or _
Edg1="log" or Edg1="cfg" or Edg1="old") or _
not (Edg2="txt" or Edg2="vbs" or Edg2="hta" or _
Edg2="bat" or Edg2="sys" or Edg2="ini" or _
Edg2="log" or Edg2="cfg" or Edg2="old") _
then MsgBox UV&"Diese Dateien sind leider ungeeignet! "&_
" "&UV,VbCritical+VbSystemModal,Titel:WScript.Quit
'Datei mit weniger Zeilen "Datei1" nennen:
'*****************************************
Set File1=Fso.OpenTextFile(Datei1,1,true)
i=1
Do until File1.AtEndOfStream
File1.ReadLine
i=i+1
Loop
Ende1=i-1
File1.Close
Set File1=Nothing
Set File2=Fso.OpenTextFile(Datei2,1,true)
i=1
Do until File2.AtEndOfStream
File2.ReadLine
i=i+1
Loop
Ende2=i-1
File2.Close
Set File2=Nothing
If Ende1>Ende2 then
DateiX=Datei1
Datei1=Datei2
Datei2=DateiX
else
'Nrn. bleiben so
End If
'"Datei1" zeilenweise auslesen:
'******************************
Set File1=Fso.OpenTextFile(Datei1,1,true)
i=1
Do until File1.AtEndOfStream
ReDim Preserve Zeile1(i)
Zeile1(i)=File1.ReadLine
i=i+1
Loop
Ende1=i-1
File1.Close
Set File1=Nothing
'"Datei2" zeilenweise auslesen:
'******************************
Set File2=Fso.OpenTextFile(Datei2,1,true)
i=1
Do until File2.AtEndOfStream
ReDim Preserve Zeile2(i)
Zeile2(i)=File2.ReadLine
i=i+1
Loop
Ende2=i-1
File2.Close
Set File2=Nothing
'Dateien gleich, wenn gleich lang und Zeilen identisch:
'******************************************************
If Ende1=Ende2 then
Ident="0" 'Sind sämtliche Zeilen gleich?
For i=1 to Ende1
If Zeile1(i)=Zeile2(i) then Ident=1+Ident
Next
If Ident=Ende1 then
MsgBox UV&"Datei1 = Datei2, sind völlig identisch !"&_
" "&UV,VbInformation,Titel : WScript.Quit
End If
End If
'"Ende" ist Länge der längeren "Datei2":
'***************************************
Ende=Ende2
'Zeilenunterschied der Dateien in Suche einplanen:
'*************************************************
'Folgende Spanne müsste beim Vergleich der Zeilen
'rückwärts und vorwärts ausreichend sein!?
Dazu=CInt(2*(Ende-Ende1))+50
'Leeren Zeilenüberhang für die Dateien schaffen:
'***********************************************
ReDim Preserve Zeile1(2*Ende)
For r=1+Ende1 to 2*Ende
Zeile1(r)=""
Next
ReDim Preserve Zeile2(2*Ende)
For r=1+Ende2 to 2*Ende
Zeile2(r)=""
Next
'Prüfen, ob die Dateien evtl. zu ungleich sind:
'**********************************************
Verschd="0"
x=1
Do until (x>200 or x>Ende1)
y=1
Do until (x>200 or y>Ende2)
If (Zeile1(x)=Zeile2(y) and Zeile1(x)<>"" and _
Left(Zeile1(x),1)<>"'" and LCase(Right(Zeile1(x),6)) _
<>"end if" and LCase(Right(Zeile1(x),4))<>"next" and _
LCase(Right(Zeile1(x),12))<>"wscript.quit" and _
LCase(Right(Zeile1(x),4))<>"else" and _
LCase(Right(Zeile1(x),7))<>"end sub" and _
LCase(Right(Zeile1(x),12))<>"end function" and _
LCase(Right(Zeile1(x),4))<>"loop") then Verschd=1+Verschd
y=y+1
Loop
x=x+1
Loop
'Abbruch, wenn viel zu wenige Gemeinsamkeiten bestehen:
'******************************************************
If (Verschd="0" or Verschd<=10) then MsgBox UV&VbTab&_
"Die Dateien sind viel zu "&_
"ungleich! "&UV,,Titel:WScript.Quit 'Abbruch!
'Zeit-Warnung, wenn beide Dateien sehr groß sind:
'************************************************
If Ende>1000 then MsgBox UV&VbTab&"Da die Dateien ziemlich "&_
"groß sind, "&UV&VbTab&"kann der Vergleich"&_
" etwas dauern!"&UV,VbSystemModal,Titel
'ZeilenX(r) nach Streichen der Leerstellen speichern:
'****************************************************
ReDim Preserve Zeilen1(Ende1)
For r=1 to Ende1
Zeilen1(r)=Zeile1(r)
Next
ReDim Preserve Zeilen2(Ende2)
For r=1 to Ende2
Zeilen2(r)=Zeile2(r)
Next
'In Zeilen1(i) Leerstellen u.ä. am Anfang streichen:
'***************************************************
For i=1 to Ende1
If Zeile1(i)<>"" then
Schluss="0"
k=1
Do until (k=Len(Zeile1(i))+1 or Schluss="1")
'Prüfen, ob anfangs Tabs/Leerstellen sind: streichen!
'****************************************************
If not (Mid(Zeile1(i),k,1)=" " or Mid(Zeile1(i),k,1)=" " _
or Mid(Zeile1(i),k,1)=" ") then
Schluss="1"
Zeile1(i)=Right(Zeile1(i),Len(Zeile1(i))-k+1)
End If
k=k+1
Loop
End If
Next
'In Zeilen2(i) Leerstellen u.ä. am Anfang streichen:
'***************************************************
For i=1 to Ende2
If Zeile2(i)<>"" then
Schluss="0"
k=1
Do until (k=Len(Zeile2(i))+1 or Schluss="1")
'Prüfen, ob anfangs Tabs/Leerstellen sind: streichen!
'****************************************************
If not (Mid(Zeile2(i),k,1)=" " or Mid(Zeile2(i),k,1)=" " _
or Mid(Zeile2(i),k,1)=" ") then
Schluss="1"
Zeile2(i)=Right(Zeile2(i),Len(Zeile2(i))-k+1)
End If
k=k+1
Loop
End If
Next
'############################################
'Datei für Angabe der Unterschiede festlegen und schreiben:
'**********************************************************
Datei=Left(Datei1,Len(Datei1)-4)&"-Vgl.txt"
Set File=Fso.OpenTextFile(Datei,2,true)
'Kopf der Unterschiede - Datei wird jetzt geschrieben,
'zunächst Dateien zeilenweise und nummeriert angeben !
'*****************************************************
File.WriteLine("")
File.WriteLine("")
File.WriteLine("Dies ist zeilenweise """&Datei1&"""")
File.WriteLine("**************************************************")
File.WriteLine("")
For a=1 to Ende1
File.WriteLine(a&VbTab&Zeilen1(a)) 'Bei VbTab Längenausgleich!
Next
File.WriteLine("")
File.WriteLine("")
File.WriteLine("################################################")
File.WriteLine("")
File.WriteLine("")
File.WriteLine("Dies ist zeilenweise """&Datei2&"""")
File.WriteLine("**************************************************")
File.WriteLine("")
For b=1 to Ende2
File.WriteLine(b&VbTab&Zeilen2(b))
Next
File.WriteLine("")
File.WriteLine("")
File.WriteLine("################################################")
File.WriteLine(" ################################################")
File.WriteLine("################################################")
File.WriteLine("")
File.WriteLine("")
File.WriteLine("Verglichen werden """&Datei1&"""")
File.WriteLine("und """&Datei2&"""")
File.WriteLine("")
File.WriteLine("Die Zahlen vorne sind Zeilen von Datei1 bzw. Datei2 ")
File.WriteLine("")
'Beide Dateien werden zeilenweise verglichen:
'********************************************
Plus1="0" 'Zusatzzeilen durch Einschübe in Datei1
Plus2="0" ' ... in Datei2
For i=1 to Ende '<<<<<< Suchschleife
If (i+Plus1>Ende1 or i+Plus2>Ende2) then Fertig 'beenden!
'Prüfen, wie weit ab dem Ort die Dateizeilen gleich sind:
'********************************************************
Ort=i
GleicheZeilen 'Sub-Programm aufrufen, s.u.
i=Stelle 'Neuen Startpunkt festlegen!
'Ab hier wieder ungleich!
Leerzeilen 'Evtl. Leerzeilen danach werden übersprungen:
'Besteht Änderung einer einzelnen Zeile in beiden Dateien?
'Einschübe in eine Datei oder Einschübe neben Änderungen??
'*********************************************************
Erfolg="0"
Aenderg 'Änderung, Einschübe, Änderung + Einschübe testen!
Stelle=1+i 'Evtl. Leerzeilen danach werden übersprungen!
Leerzeilen
Next '<<<<<<<< Ende der Suchschleife
'Sub-Programm zum Schließen dieses Programmes:
'*********************************************
Fertig
WScript.Quit
'############################################
'**************************************************
' *
' Als Nächstes die erforderlichen Sub - Programme *
' *
'**************************************************
Sub Leerzeilen
'Evtl. Leerzeilen danach überspringen:
'*************************************
If (Zeile1(Stelle+Plus1)="" or Zeile2(Stelle+Plus2)="") then
'Überprüfung von "Datei1" auf Leerzeilen:
'****************************************
Leer="0"
Plus="0"
k=0
Do until (Leer="1" or Stelle+Plus1+k>Ende1)
If Zeile1(Stelle+Plus1+k)="" then
Plus=1+Plus
else
Leer="1"
End If
k=k+1
Loop
If (Leer="1" and Plus<>"0") then Plus1=Plus1+Plus
'Überprüfung von "Datei2" auf Leerzeilen:
'****************************************
Leer="0"
Plus="0"
k=0
Do until (Leer="1" or Stelle+Plus2+k>Ende2)
If Zeile2(Stelle+Plus2+k)="" then
Plus=1+Plus
else
Leer="1"
End If
k=k+1
Loop
If (Leer="1" and Plus<>"0") then Plus2=Plus2+Plus
End If
End Sub
'############################################
Sub Fertig
'Unterschiede-Datei, Programm schließen, Ergebnis ausgeben:
'**********************************************************
File.Close
Set File=Nothing
'Datei mit Liste der Unterschiede öffnen, ggf. löschen(?):
'*********************************************************
Wss.Run "Notepad """&Datei&""" "
WScript.Sleep 500
'Frage, ob die ausgegebene Datei zu löschen ist:
'***********************************************
Ask=MsgBox(UV&UV&"Soll die Datei mit den Unterschieden "&_
"gelöscht werden ? "&UV&"Sie befindet"&_
" sich im Verzeichnis der ersten Datei!"&_
UV&UV,VbYesNo+VbDefaultButton2+VbCritical,Titel)
If Ask="7" then WScript.Quit 'Bei "Nein" Abbruch!
'Auf Wunsch Datei mit den Unterschieden löschen:
'***********************************************
Fso.DeleteFile Datei
WScript.Quit
End Sub
'############################################
Sub GleicheZeilen
'Prüfen, bis wohin "Datei1" und "Datei2" gleich sind:
'****************************************************
Schluss="0"
x=Ort
Do until (Schluss="1" or x+Plus1>Ende1 or x+Plus2>Ende2)
If Zeile1(x+Plus1)<>Zeile2(x+Plus2) then
Schluss="1"
Stelle=x 'Bei x-1 letztes Mal gleiche Zeilen!
If x>Ort then Exit Sub 'Falls gleiche Zeilen da!
End If
x=x+1
Loop
Stelle=Ort 'Wenn keine neuen gleichen Zeilen gefunden
End Sub
'############################################
Sub Aenderg 'Enthält ein Unter-Sub-Programm
'Prüfen, ob einzelne Zeile verändert wurde:
'******************************************
Erfolg="0"
If (Zeile1(i+Plus1)<>Zeile2(i+Plus2) and _
Zeile1(i+Plus1+1)=Zeile2(i+Plus2+1) and _
Zeile1(i+Plus1+1)<>"") then
File.WriteLine("")
File.WriteLine("####### Diese Einzelzeile wurde geändert: #######")
File.WriteLine((i+Plus1)&VbTab&Zeilen1(i+Plus1))
File.WriteLine((i+Plus2)&VbTab&Zeilen2(i+Plus2))
File.WriteLine("#################################################")
File.WriteLine("")
Plus1=1+Plus1
Plus2=1+Plus2
Erfolg="1"
Exit Sub 'Zurück !
End If
'******************************************************
'* *
'* Falls hier keine veränderte Einzelzeile vorliegt : * *
'* Testen, ob Einschübe zu finden sind oder geänderte *
'* Zeilen samt Einschüben zusammen vorliegen können : *
'* *
'******************************************************
WeiterSuchen 'Obiges in weiterem Sub-Programm testen
If Erfolg="1" then Exit Sub
End Sub
'############################################
Sub WeiterSuchen
If Zeile1(i+Plus1)<>Zeile2(i+Plus2) then
'Evtl. Einschub1 in "Datei1" ermitteln:
'**************************************
Neu1="0"
Gleich="0"
a=1
Do until (Gleich="1" or i+Plus1+a>Ende1 or a>Dazu)
If (Zeile1(i+Plus1+a)=Zeile2(i+Plus2) and _
Zeile2(i+Plus2)<>"") then Gleich="1"
a=a+1
Loop
If (a-1>0 and Gleich="1") then Neu1=a-1
'Evtl. Einschub2 in "Datei2" ermitteln:
'**************************************
Neu2="0"
Gleich="0"
If Zeile1(i+Plus1)<>Zeile2(i+Plus2) then
b=1
Do until (Gleich="1" or i+Plus2+a>Ende2 or b>Dazu)
If (Zeile1(i+Plus1)=Zeile2(i+Plus2+b) and _
Zeile1(i+Plus1)<>"") then Gleich="1"
b=b+1
Loop
If (b-1>0 and Gleich="1") then Neu2=b-1
End If
'Wenn welche gefunden, den sinnvolleren Einschub wählen:
'*******************************************************
If (Neu1>0 or Neu2>0) then
If ((Neu1>0 and Neu2=0) or Neu1<Neu2) then
Einschub1
Erfolg="1"
Exit Sub
End If
If ((Neu1=0 and Neu2>0) or Neu2<=Neu1) then
Einschub2
Erfolg="1"
Exit Sub
End If
End If
'Ein Einschub neben geänderten Zeilen in den Dateien,
'oder unterschiedliche Zeilenblöcke in den Dateien !?
'****************************************************
Gleich="0"
Grenz="0"
k=i+Plus1
Do until (k>i+Plus1+Dazu or k>Ende1 or Gleich="1")
'Beim Vergleich der Zeilen rückwärts und vorwärts schauen:
'*********************************************************
l=k-Dazu 'aber nicht vor letzte Gleichheit gehen:
If k-Dazu<i+Plus2 then l=i+Plus2
Do until (l>i+Plus2+Dazu or l>Ende2 or Gleich="1")
'Verhindern, dass '********* o.ä. zur Gleichheit führt:
'******************************************************
Stern="0"
Lang=Len(Zeile1(k))
'Zeile mit gleichen Zeichen muss mind. 4 Stellen haben:
'******************************************************
If Lang>=4 then
If (Mid(Zeile1(k),Lang-2,1)=Mid(Zeile1(k),Lang-1,1) and _
Mid(Zeile1(k),Lang-1,1)=Right(Zeile1(k),1)) then Stern="1"
End If
'Prüfen, ob Zeilen gleich sind:
'******************************
If (Zeile1(k)=Zeile2(l) and (Right(Zeile1(k),4) _
<>"("""")" and Zeile1(k)<>"" and Stern="0" and _
k>i+Plus1 and l>i+Plus2)) then
Gleich="1"
Erfolg="1"
End If
l=l+1
Loop
k=k+1
Loop
'Falls in den Dateien nur Leerzeilen zu finden:
'**********************************************
Nicht="0"
For a=i+Plus1-1 to k-1
If Zeile1(a)<>"" then Nicht="1"
Next
For b=i+Plus2-1 to l-1
If Zeile2(b)<>"" then Nicht="1"
Next
If Nicht="0" then
Plus1=Plus1+k-1-(i+Plus1) 'Verschiebungen notieren!
Plus2=Plus2+l-1-(i+Plus2)
Exit Sub
End If
'Falls nichts Gleiches mehr zu finden:
'*************************************
If k>Ende1 then
Grenz="1"
Gleich="1"
End If
'Wenn, dann bis zum Ende ungleiche Zeilen ausgeben:
'**************************************************
If Grenz="1" then
k=Ende1+2
l=Ende2+2
End If
'Unterschiede von "Datei1" und "Datei2" notieren:
'*************************************************
If Gleich="1" then
File.WriteLine("")
File.WriteLine("§§§§§§§ Die Unterschiede in Datei1 §§§§§§§")
If k-1=Ende1 then k=k-1 'Am Ende von "Datei1" um 1 zurücknehmen
For a=i+Plus1-1 to k-2 'bei k-2 schon gleiche Zeile gefunden !
File.WriteLine((a)&VbTab&Zeilen1(a))
Next
File.WriteLine("§§§§§§§ und Datei2 §§§§§§§")
If l-1=Ende2 then l=l-1 'Am Ende von "Datei2" um 1 zurücknehmen
For b=i+Plus2-1 to l-2 'bei l-2 schon gleiche Zeile gefunden !
File.WriteLine((b)&VbTab&Zeilen2(b))
Next
File.WriteLine("§§§§§§§ Dies waren die Unterschiede §§§§§§§")
File.WriteLine("")
Plus1=Plus1+k-1-(i+Plus1) 'Verschiebungen berücksichtigen!
Plus2=Plus2+l-1-(i+Plus2)
End If
End If
End Sub
'############################################
Sub Einschub1
'Erkannten Einschub1 aus "Datei1" schreiben:
'*******************************************
'Prüfen, ob nicht alles nur Leerzeilen waren:
'********************************************
Voll="0"
For z=1 to Neu1
If Zeile1(i+Plus1+z-1)<>"" then Voll="1"
Next
If Voll="0" then
Plus1=Plus1+Neu1 'Verschiebung durch Einschub2
Exit Sub 'bei Leerzeilen einen Abbruch
End If
File.WriteLine("")
File.WriteLine("Dies ist ein Einschub in die Datei1 : ")
File.WriteLine(">> 1 >> 1 >> 1 >> 1 >> 1 >> 1 >> 1 >> ")
For z=1 to Neu1
File.WriteLine((i+Plus1+z-1)&VbTab&Zeilen1(i+Plus1+z-1))
Next
File.WriteLine(">> 1 >> 1 >> 1 >> 1 >> 1 >> 1 >> 1 >>")
File.WriteLine("")
Erfolg="1"
'Verschiebung durch den Einschub1 festhalten:
'********************************************
Plus1=Plus1+Neu1
End Sub
'############################################
Sub Einschub2
'Erkannten Einschub2 aus "Datei2" schreiben:
'*******************************************
'Prüfen, ob nicht alles nur Leerzeilen waren:
'********************************************
Voll="0"
For z=1 to Neu2
If Zeile2(i+Plus2+z-1)<>"" then Voll="1"
Next
If Voll="0" then
Plus2=Plus2+Neu2 'Verschiebung durch Einschub2
Exit Sub 'bei Leerzeilen einen Abbruch
End If
File.WriteLine("")
File.WriteLine("Dies ist ein Einschub in die Datei2 : ")
File.WriteLine(">> 2 >> 2 >> 2 >> 2 >> 2 >> 2 >> 2 >> ")
For z=1 to Neu2
File.WriteLine((i+Plus2+z-1)&VbTab&Zeilen2(i+Plus2+z-1))
Next
File.WriteLine(">> 2 >> 2 >> 2 >> 2 >> 2 >> 2 >> 2 >>")
File.WriteLine("")
Erfolg="1"
'Verschiebung durch den Einschub2 festhalten:
'********************************************
Plus2=Plus2+Neu2
End Sub
http://dieseyer.de • all rights reserved • © 2011 v11.4