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