'*** v9.3 *** www.dieseyer.de ******************************** ' File: Ordnervergleich.vbs ' Autor: W.Schmelz ' http://dieseyer.de ' ' Zwei ausgesuchte Ordner in ihrem Gesamt-Inhalt vergleichen: ' Dabei wird untersucht, ob in beiden Ordnern alle Sub-Ordner ' da sind und gleiche Größe haben. Außer den evtln. Unterord- ' nern wird die Anwesenheit der einzelnen Dateien verglichen ' und, ob diese Dateien in Datum und in Größe übereinstimmen. ' Sind irgendwo Unterschiede, erfolgt Meldung u. der Abbruch! ' Es sind also Ordner mit - und auch ohne Sub-Ordner prüfbar! '************************************************************ ' CopyRight, W. Schmelz, 05.02.2009 ' Eine MsgBox zum Vorstellen dieses Programmes : '*********************************************** UV=VbCR&VbCR Titel=" Zwei Ordner in ihrem Inhalt vergleichen !" Ask=MsgBox (UV&UV&VbTab&"Bitte gleich zwei Ordner"&_ " aussuchen, deren "&UV&VbTab&_ "Inhalt miteinander verglichen werden soll !"&UV&VbTab&_ "Dateien, Größe und Datum werden geprüft !"&UV&VbTab&_ "Genauso evtl. vorhandene Unterordner !"&_ UV&UV&VbCR,VbOkCancel,Titel) If Ask="2" then WScript.Quit ' Die Objekte u.a. für das Programm bereit stellen : '*************************************************** Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Wss=WScript.CreateObject("WScript.Shell") Dim Pfad1, Pfad2, Zahl1, Zahl2, Datum1(), Datum2(), k Dim Datum3(), Datum4(), Diff, Gros ' Den 1. Ordner in einem Browser aussuchen : '******************************************* Set Shl=CreateObject("Shell.Application") Set ObF=Shl.BrowseForFolder(0,StrPrompt,BrowseInfo,Root) On Error Resume Next Err.Clear Pfad1=ObF.Self.Path If Err.Number<>0 then WScript.Quit Set All=Nothing ' Die Dateien im Ordner 1 werden gezählt : '***************************************** Set Data=Fso.GetFolder(Pfad1) Zahl1=Data.Files.Count Zahl11=Data.SubFolders.Count If (Zahl1="0" and Zahl11="0") then MsgBox UV&UV&"Der Ordner "&Pfad1&" ist leer !"&_ " "&UV&UV,VbCritical,Titel:WScript.Quit End If ' Den 2. Ordner in einem Browser aussuchen : '******************************************* Wss.Popup UV&UV&VbCR&VbTab&_ "Bitte den 2. Datei-Ordner aussuchen !"&_ " "&_ UV&UV&VbCR,3,Titel,VbInformation Set Shl=CreateObject("Shell.Application") Set ObF=Shl.BrowseForFolder(0,StrPrompt,BrowseInfo,Root) On Error Resume Next Err.Clear Pfad2=ObF.Self.Path If Err.Number<>0 then WScript.Quit Set All=Nothing ' Sind diese beiden Ordner wirklich verschieden ? '************************************************ If Pfad1=Pfad2 then MsgBox UV&UV&_ "Es wurden nicht zwei verschiedene Ordner ausgewählt !"&_ " "&UV&UV,VbCritical,Titel:WScript.Quit End If ' Die Dateien im Ordner 2 werden gezählt : ' **************************************** Set Data=Fso.GetFolder(Pfad2) Zahl2=Data.Files.Count Zahl21=Data.SubFolders.Count If (Zahl2="0" and Zahl21="0") then MsgBox UV&UV&"Der Ordner "&Pfad2&" ist leer !"&_ " "&UV&UV,VbCritical,Titel:WScript.Quit End If ' Die Kontroll - Meldung, welche Ordner ausgesucht wurden : '********************************************************** Msg=MsgBox (UV&VbTab&"Folgende beiden Datei - Ordner :"&_ UV&VbCR&VbTab&Pfad1&UV&VbTab&Pfad2&UV&VbCR&VbTab&_ "wurden gerade ausgesucht !"&VbCR&VbTab&"Sie werden "&_ "jetzt verglichen ! "&UV&VbCR,VbOkCancel,Titel) If Msg="2" then WScript.Quit 'Abbruch auf Wunsch '*************************************************** ' Der Abbruch, wenn die Ordner - Größen gleich sind, ' da dann mit größter Sicherheit die Ordner gleich ! '*************************************************** Set Folder1=Fso.GetFolder(Pfad1) Set Folder2=Fso.GetFolder(Pfad2) Size1=Folder1.Size Size2=Folder2.Size If Size1=Size2 then Ask=MsgBox (UV&UV&_ "Die beiden Ordner haben die gleiche Größe ! "&_ UV&"Sie sind daher mit größter Sicherheit gleich !"&_ UV&"Soll trotzdem das Programm weiter prüfen ?"&_ UV&UV,VbOkCancel+VbInformation,Titel) If Ask="2" then WScript.Quit 'Auf Wunsch der Abbruch End If ' Die Ordner 1 und Ordner 2 auf ihre Unterordner analysieren: '************************************************************ Set Fs1=Fso.GetFolder(Pfad1) Set Inhalt1=Fs1.SubFolders 'Unter-Ordner auflisten Set Fs2=Fso.GetFolder(Pfad2) Set Inhalt2=Fs2.SubFolders 'Unter-Ordner auflisten 'Prüfen, ob Unterordner-Größen gleich oder im 2. einer fehlt: '************************************************************ Diff="" 'Ungleiche Unterordner sammeln For each i in Inhalt1 Stelle1=InStrRev(i,"\") Ordn1=Right(i,Len(i)-Stelle1) Dort="0" 'Prüfen, ob Unterordner fehlen For each k in Inhalt2 Stelle2=InStrRev(k,"\") Ordn2=Right(k,Len(k)-Stelle2) If Ordn1=Ordn2 and not i.Size=k.Size then _ Diff=Diff&Ordn1&VbCR 'Ungleiche Unterordner sammeln ! If Ordn1=Ordn2 then Dort="1" 'Alle die Unterordner vorhanden? Next If Dort<>"1" then Fehlt1=Fehlt1&Ordn1&VbCR'Fehl. Unterordner? Next ' Prüfen, ob Unterordner alle gleich oder im 1. einer fehlt : '************************************************************ For each i in Inhalt2 Stelle2=InStrRev(i,"\") Ordn2=Right(i,Len(i)-Stelle2) Dort="0" 'Prüfen, ob Unterordner fehlen For each k in Inhalt1 Stelle1=InStrRev(k,"\") Ordn1=Right(k,Len(k)-Stelle1) If Ordn2=Ordn1 then Dort="1" 'Alle die Unterordner vorhanden? Next If Dort<>"1" then Fehlt2=Fehlt2&Ordn2&VbCR'Fehl. Unterordner? Next ' Abbruch, wenn Unterordner-Größen oder deren Inhalt ungleich : '************************************************************** If Fehlt1<>"" then MsgBox UV&UV&" Folgende Unterordner "&_ "des 1. sind nicht im 2. Ordner: "&UV&Fehlt1&UV&VbCR,, _ " Fehlende Unter-Ordner sind :" If Fehlt2<>"" then MsgBox UV&UV&" Folgende Unterordner "&_ "des 2. sind nicht im 1. Ordner: "&UV&Fehlt2&UV&VbCR,, _ " Fehlende Unter-Ordner sind :" If Diff<>"" then MsgBox UV&VbCR&" Folgende Unterordner "&_ "haben ungleiche Größe: "&UV&Diff&UV&VbCR,, _ " Ungleiche Unter-Ordner sind :" If (Fehlt1<>"" or Fehlt2<>"" or Diff<>"") then WScript.Quit ' Namen und Datum aller Einzel-Dateien des 1. Ordner ermitteln : '*************************************************************** Set Data=Fso.GetFolder(Pfad1).Files ReDim Preserve Datum1(Zahl1) k=1 For each i in Data Datum=Left(i.DateLastModified,19) 'Jahr, Monat, Tag, Std, Min, Sek der letzten Bearbeitung: Tag=Left(Datum,2) Monat=Mid(Datum,4,2) Jahr=Mid(Datum,7,4) Std=Mid(Datum,12,2) Min=Mid(Datum,15,2) Sek=Mid(Datum,18,2) Datum1(k)=i&Jahr&Monat&Tag&Std&Min&Sek 'Name & Datum k=1+k Next ' Namen und Datum der Einzel - Dateien des 2. Ordner ermitteln : '*************************************************************** Set Data=Fso.GetFolder(Pfad2).Files ReDim Preserve Datum2(Zahl2) k=1 For each i in Data Datum=Left(i.DateLastModified,19) 'Jahr, Monat, Tag, Std, Min, Sek der letzten Bearbeitung: Tag=Left(Datum,2) Monat=Mid(Datum,4,2) Jahr=Mid(Datum,7,4) Std=Mid(Datum,12,2) Min=Mid(Datum,15,2) Sek=Mid(Datum,18,2) Datum2(k)=i&Jahr&Monat&Tag&Std&Min&Sek 'Name & Datum k=1+k Next ' Den Namen und Größe aller Dateien des 1. Ordner ermitteln : '************************************************************ Set Data=Fso.GetFolder(Pfad1).Files ReDim Preserve Datum3(Zahl1) k=1 For each i in Data Datum3(k)=i&"#"&i.Size 'Name & Größe k=1+k Next ' Den Namen und Größe aller Dateien des 2. Ordner ermitteln : '************************************************************ Set Data=Fso.GetFolder(Pfad2).Files ReDim Preserve Datum4(Zahl2) k=1 For each i in Data Datum4(k)=i&"#"&i.Size 'Name & Größe k=1+k Next ' Welche Dateien im 1. Ordner haben andere Größe als im 2. ? '*********************************************************** Anders="" For i=1 to Zahl1 For k=1 to Zahl2 Stelle1=InStr(Datum3(i),"#") Stelle2=InStr(Datum4(k),"#") If (Fso.GetFileName(Left(Datum3(i),Stelle1-1))= _ Fso.GetFileName(Left(Datum4(k),Stelle2-1)) and _ not Right(Datum3(i),Len(Datum3(i))-Stelle1)= _ Right(Datum4(k),Len(Datum4(k))-Stelle2)) then _ Gros=Gros&Fso.GetFileName _ (Left(Datum3(i),Stelle1-1))&VbCR Next Next '*********************************************************** ' Welche Dateien im 1. Ordner haben anderes Datum als im 2.? ' Geprüft wird, ob der Unterschied mehr als 3 Sek. beträgt ! ' Es muss Jahr&Monat&Tag&Std gleich, Min&Sek bis auf 3 Sek.! ' Erlaubt ist auch genau 1 Std Verschiebung- SWZeit-Wechsel? '*********************************************************** Anders="" For i=1 to Zahl1 For k=1 to Zahl2 'Wie kann man 07:59 und 8:01 vergleichen !? 'Dazu erst die Minuten in Sek. ausdrücken! Min1=Left(Right(Datum1(i),4),2)*60 Min2=Left(Right(Datum2(k),4),2)*60 Min0=Min1-Min2 Std1=Left(Right(Datum1(i),6),2) Std2=Left(Right(Datum2(k),6),2) If Fso.GetFileName(Left(Datum1(i),Len(Datum1(i))-14))= _ Fso.GetFileName(Left(Datum2(k),Len(Datum2(k))-14)) and _ (Left(Right(Datum1(i),14),8)<>Left(Right(Datum2(k),14),8) _ or abs(Min0+Right(Datum1(i),2)-Right(Datum2(k),2))>3 _ or abs(Std1-Std2)>1) _ then Anders=Anders&Fso.GetFileName _ (Left(Datum1(i),Len(Datum1(i))-14))&VbCR Next Next ' Welche Dateien aus dem 1. Ordner sind nicht im 2. Ordner ? '*********************************************************** Set Data=Fso.GetFolder(Pfad1).Files Neu1="" For each File in Data If not Fso.FileExists(Pfad2&"\"&Fso.GetFileName(File)) _ then Neu1=Neu1&Fso.GetFileName(File)&VbCR Next ' Welche Dateien aus dem 2. Ordner sind nicht im 1. Ordner ? '*********************************************************** Set Data=Fso.GetFolder(Pfad2).Files Neu2="" For each File in Data If not Fso.FileExists(Pfad1&"\"&Fso.GetFileName(File)) _ then Neu2=Neu2&Fso.GetFileName(File)&VbCR Next 'Die Meldung zum Ergebnis des Vergleiches der beiden Ordner: '*********************************************************** Txt=Txt&UV If Neu2<>"" then Txt=Txt&" Im 1. Ordner sind diese "&_ "Dateien des 2. Ordner nicht vorhanden: " If Neu2<>"" then Txt=Txt&VbCR&Neu2&VbCR If Neu1<>"" then Txt=Txt&" Im 2. Ordner sind diese "&_ "Dateien des 1. Ordner nicht vorhanden:" If Neu1<>"" then Txt=Txt&VbCR&Neu1&VbCR If Gros<>"" then Txt=Txt&" Im 2. "&_ "Ordner haben diese Dateien andere Größe als im 1. : " Txt=Txt&VbCR&Gros Txt=Txt&VbCR End If If Anders<>"" then Txt=Txt&" Im 2. "&_ "Ordner haben diese Dateien anderes Datum als im 1.: " Txt=Txt&VbCR&Anders End If Txt=Txt&VbCR If (Neu1="" and Neu2="" and Anders="" and Gros="") then MsgBox UV&VbCR&VbTab&_ " Alles O K !"&_ VbCR&" In den Ordnern sind gleiche Dateien "&_ "mit gleichem Datum ! "&UV&UV,,Titel else MsgBox Txt,,Titel End If