'*** 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 "" 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 Neu10) 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-Dazui+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