'*** v7.8 *** www.dieseyer.de ******************************* ' ' Datei: dateienvergleich.vbs ' Autor: dieseyer@gmx.de ' Auf: www.dieseyer.de ' ' Vergleich zwei Dateien mit "fc /b %1 %2" ' ' Vergleicht, wie der Name bereits verrät, (zwei) Dateien - ' über eine Auswahl per Binär- oder Textvergleich. Dazu die ' beiden zu vergleichenden Dateien auf das Skript ziehen und ' fallen lassen (Drag & Drop). Wird das Skript (mit Doppel- ' klick) gestartet, bietet es an, das Windows-Explorer - ' Kontextmenü zu erweitern. Dann kann man im Explorer zwei ' Dateien markieren und (dann durch Klicken mit der rechten ' Maus-Taste und über 'Senden an') die markierten Dateien an ' das Skript übergeben. ' Das Skript verwendet das Befehlszeilenprogramm 'fc.exe', ' das beim zeilenweisen Vergleich auch nach mehren (unter- ' schiedlichen) Zeilen wieder synchronisiert - DAS wollte ' ich nicht nach programmieren. ' '************************************************************ Option Explicit Dim SendToLink, Text, Txt, TextX, i, lang Dim WSHShell, fso, oArgs, ShellLink Set WSHShell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") set oArgs = Wscript.Arguments SendToLink = "2 Dateien vergleichen" ' Argumente testen/holen '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If oArgs.Count = 0 then SkriptInfo ' SUB Aufruf ' ~~~~~~~~~~~~~~~~~~~~~~~~~ Text = "" '*************************************************************** ' ANFANG - Das eigentliche Skript beginnt '*************************************************************** If oArgs.Count = 1 then Text = Left( UCase(oArgs.item(0)), 2) if Text = "-S" OR Text = "-I" then AutoStartLink ( SendToLink ) ' Function Aufruf End If If not oArgs.Count = 2 then SkriptInfo ' SUB Aufruf Else Text = vbCRLF For i = 0 to oArgs.Count - 1 ' hole alle Argumente if fso.FileExists( oArgs.item(i) ) then TextX = TextX & """" & oArgs.item(i) & """ " Text = Text & oArgs.item(i) & vbCRLF End If Next End If Text = "Die Dateien " & vbCRLF & Text & vbCRLF & "werden jetzt BINÄR verglichen." & vbCRLF & vbCRLF Text = Text & ". . . oder reicht ein TEXT -Vergleich? [Yes] in 5 sec." Text = WSHShell.Popup (Text, 10, WScript.ScriptName , 32+3 ) if Text = -1 then TextX = "%comspec% /c fc /N " & TextX if Text = vbYes then TextX = "%comspec% /c fc /N " & TextX if Text = vbNo then TextX = "%comspec% /c fc /B " & TextX if Text = vbCancel then WSHShell.Popup " . . . dann eben nicht!", 10, WScript.ScriptName & " . . . ist zu Ende!" , 48 WScript.Quit End If TextX = TextX & " > """ & WScript.ScriptName & ".log""" ' WSHShell.Popup TextX, 10, WScript.ScriptName , 64 ' WSHShell.run TextX , , True WSHShell.run TextX , 7, True TextX = "notepad """ & WScript.ScriptName & ".log""" WSHShell.run TextX , , True '*************************************************************** ' ENDE - das eigentliche Skript endet '*************************************************************** ' WSHShell.Popup Text, 10, WScript.ScriptName & " . . . ist zu Ende. " , 64 Text = "" Text = Text & " " & vbCRLF WScript.Quit '********************************* Sub SkriptInfo ' Sub Aufruf '********************************* Text = "" Text = Text & "Das ganze funktioniert so:" & vbCRLF & vbCRLF Text = Text & "ZWEI Dateien (wirklich genau 2 Dateien)" & vbCRLF Text = Text & "mit der Maus auf das Skript ziehen und fallen lassen, " & vbCRLF Text = Text & "oder dem Skript über 'Senden an' die Dateien bzw. " & vbCRLF Text = Text & "Verzeichnisse übergeben. " & vbCRLF & vbCRLF Text = Text & "Soll das Skript über 'Senden an' (SendTo) erreichbar sein?" & vbCRLF If not vbYes = WSHShell.Popup (Text , 30, WScript.ScriptName, 32 + 4 ) then WSHShell.Popup " . . . dann eben nicht!", 10, WScript.ScriptName & " . . . ist zu Ende." , 48 WScript.Quit End If Text = "" Text = Text & "Das Skript " & UCase( WScript.ScriptName ) & " wird jetzt für alle Benutzerkonten " & vbCRLF Text = Text & "oder, wenn das nicht geht, für den angemeldeten Benutzer " & vbCRLF Text = Text & "unter 'Senden an' eingerichtet." & vbCRLF & vbCRLF Text = Text & "Es ist dann als '" & SendToLink & "' verfügbar." WSHShell.Popup Text, 10, WScript.ScriptName , 64 AutoStartLink ( SendToLink ) ' SUB Aufruf ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~ WScript.Quit End Sub ' SkriptInfo '*************************************************************** Function AutoStartLink( SendToLink ) ' Function Aufruf '*************************************************************** Dim Text, TextX, ShellLink Dim WSHShell, fso Set WSHShell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") ' wohin soll das Skript kopiert werden? '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' folgende Zeile müsste c:\ ergeben Text = Left( WSHShell.ExpandEnvironmentStrings("%WinDir%") , 3) if fso.FolderExists( WSHShell.ExpandEnvironmentStrings("%Temp%") ) then TextX = WSHShell.ExpandEnvironmentStrings("%Temp%") if fso.FolderExists( Text & "PROGRAM FILES" ) then TextX = Text & "PROGRAM FILES" if fso.FolderExists( Text & "programme" ) then TextX = Text & "programme" TextX = TextX & "\dieseyer.de" On Error Resume Next if not fso.FolderExists( TextX ) then fso.CreateFolder( TextX ) On Error GoTo 0 if not fso.FolderExists( TextX ) then WSHShell.Popup TextX & " konnte nicht angelegt werden!" , 30, WScript.ScriptName & " . . . ist zu Ende!" , 64 WScript.Quit End If ' das Skript kopieren '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ TextX = TextX & "\" & SendToLink & ".vbs" ' das Skript kopieren, wenn das Zielskript nicht das aktuelle, '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' laufende Skript ist If not LCase(TextX) = LCase(WScript.ScriptFullName) then On Error Resume Next fso.CopyFile WScript.ScriptName, TextX , True if not err.number = 0 then WSHShell.Popup TextX & " konnte nicht angelegt werden!" , 30, WScript.ScriptName & " . . . ist zu Ende!" , 64 WScript.Quit End If On Error GoTo 0 End If ' Link in 'Autostart' von 'All Users' installieren ... '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' ... der wird dann bei jedem Aufruf den 'Senden An' - Link erstellen Text = WSHShell.SpecialFolders("AllUsersStartup") & "\" & SendToLink & ".lnk" If Text = "\" & SendToLink & ".lnk" then ' bei Win9x Text = WSHShell.SpecialFolders("Startup") & "\" & SendToLink & ".lnk" End If Set ShellLink = WSHShell.CreateShortcut( Text) ShellLink.TargetPath = TextX ShellLink.Arguments = "-install" ShellLink.WorkingDirectory = fso.GetParentFolderName( TextX ) On Error Resume Next ShellLink.Save On Error GoTo 0 If not err.number = 0 then WSHShell.Popup Text & " konnte nicht angelegt werden!" , 30, WScript.ScriptName , 64 End If Text = WSHShell.SpecialFolders("SendTo") & "\" & SendToLink & ".lnk" Set ShellLink = WSHShell.CreateShortcut( Text) ShellLink.TargetPath = TextX ShellLink.WorkingDirectory = fso.GetParentFolderName( TextX ) ' ShellLink.Save =======> kommt später On Error Resume Next if fso.FileExists( Text ) then ' WSHShell.Popup Text & " wird überschrieben!" , 10, WScript.ScriptName , 64 ShellLink.Save ' =======> kommt hier If err.number = 0 then ' WSHShell.Popup Text & " wurde überschrieben!" , 10, WScript.ScriptName , 64 Else WSHShell.Popup Text & " konnte nicht überschrieben werden!" , 30, WScript.ScriptName , 64 End If Else ShellLink.Save ' =======> kommt hier If err.number = 0 then ' WSHShell.Popup Text & " wurde angelegt!" , 10, WScript.ScriptName , 64 Else WSHShell.Popup Text & " konnte nicht angelegt werden!" , 30, WScript.ScriptName , 64 End If End If On Error GoTo 0 WScript.Quit End Function ' AutoStartLink ( SendToLink ) '***************************************************************