http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** 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
http://dieseyer.de • all rights reserved • © 2011 v11.4