http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** v8.4 *** www.dieseyer.de *******************************
'
' Datei: sendenan-sicherung.vbs
' Autor: dieseyer@gmx.de
' Auf: www.dieseyer.de
'
' Von den übergebenen Dateien wird ein Datensicherung mit
' laufender Nummerierung im Sicherungsverzeichnis angelegt.
'
' Über das Kontextmenü ('SendTo'- Verzeichnis) nimmt das VBS
' eine oder mehrere Dateinamen entgegen. Die Datei(en) werden
' mit ihren kompletten Pfad (die BackSlash's - also die "\" -
' werden durch ³ ersetzt)und fortlaufend nummeriert im Ziel-
' verzeichnis gespeichert. Als Zielverzeichnis sollte ein
' (Netzlaufwerk-) Verzeichnis sein, das professinell gesichert
' wird. Am schnellsten macht man aus der aktuellen Anwendung
' heraus eine Zwischensicherung über [Datei][Speichern unter].
' Im sich öffnenden Dateiauswahl-Dialog klickt man mit der
' rechten Maus-Taste auf die Datei - dort wartet schon das
' Kontextmenü!
'
' Zum Kennenlernen des Skripts: Einfach ausführen! Als Hilfe
' wird eine Paramaterdatei erzeugt und mit Erklärungen
' angezeigt.
'
' Für verschiedene Dateiendungen lassen sich andere VOR-
' Zeichenketten und NACH-Zeichenketten 'um' die Zeilennummer
' herum definieren.
'
' Werden zwei Dateien übergeben, wird ein Datei-Vergleich
' angeboten, wobei das Skript die Zeilennummern für den
' Dateivergleich auf alles Neunen (z.B. 999) setzt.
'
'************************************************************
Option Explicit
Dim SendToLink : SendToLink = "Sicherung"
Dim ShellLink, Txt, Tst, i, d, v
Dim FileIn, TestMode, ZielVerz, ZeilNr, ZNrSich
v = 0 : Redim Preserve DateiType( 3, v )
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim oArgs : Set oArgs = Wscript.Arguments
Txt = Len( fso.GetExtensionName( WScript.ScriptFullName ) ) ' : MsgBox Txt, , "047 :: "
Txt = Mid( WScript.ScriptName, 1, Len( WScript.ScriptName ) - Txt ) & "dat" ' : MsgBox Txt, , "048 :: "
Dim ParamDatei : ParamDatei = WshShell.Environment("PROCESS")("APPDATA") & "\" & Txt ' : MsgBox Txt, , "049 :: " ' : WScript.Quit
Dim PopUpDauer : PopUpDauer = 3
Dim MaxVerzInh : MaxVerzInh = 3
Dim KopieVerz, ZielDatei, DateiVergl
If InStr( UCase( WScript.ScriptFullName ), "DIESEYER.DE" ) = 0 Then SkriptInfo ' SUB Aufruf mit WScript.Quit
' ~~~~~~~~~~~~~~~~~~~~~~~~~
' Argumente testen/holen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If oArgs.Count = 0 then SkriptInfo ' SUB Aufruf mit WScript.Quit
' ~~~~~~~~~~~~~~~~~~~~~~~~~
'***************************************************************
' ANFANG - Das eigentliche Skript beginnt
'***************************************************************
If oArgs.Count = 1 then
Txt = Left( UCase(oArgs.item(0)), 2)
if Txt = "-S" OR Txt = "-I" then AutoStartLink ( SendToLink ) ' Function Aufruf mit WScript.Quit
End If
If not oArgs.Count > 0 then SkriptInfo ' SUB Aufruf mit WScript.Quit
' hole alle Argumente
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
d = 0 : v = 0
For i = 0 to oArgs.Count - 1 ' hole alle Argumente
If fso.FolderExists( oArgs.item(i) ) Then
ReDim Preserve Verz( v )
Verz( v ) = oArgs.item(i)
Txt = Txt & vbCRLF & "084 :: Verz:" & vbTab & Verz( v ) ' : MsgBox Verz( v ) , , "084 :: "
v = v + 1
End If
If fso.FileExists( oArgs.item(i) ) Then
ReDim Preserve Datei( d )
Datei( d ) = oArgs.item(i)
Txt = Txt & vbCRLF & "090 :: Datei:" & vbTab & Datei( d ) ' : MsgBox Datei( d ) , , "090 :: "
d = d + 1
End If
Next
' MsgBox Txt, , "094 :: "
' Wurden zwei Dateien übergeben, "DateiVergl = True" setzen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DateiVergl = False
If UBound( Datei ) = 1 Then DateiVergl = True ' : MsgBox "DateiVergl = " & DateiVergl & vbCRLF & "UBound( Datei ) = " & UBound( Datei ), , "100 :: "
If d = 0 And v = 0 Then SkriptInfo ' SUB Aufruf mit WScript.Quit
' ~~~~~~~~~~~~~~~~~~~~~~~~~
' Parameterdatei 'ParamDatei' prüfen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not fso.FileExists( ParamDatei ) Then Call ParamFehlt( ParamDatei )
' Parameterdatei 'ParamDatei' lesen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call ParamLesen( ParamDatei )
' Existiert Zielverzeichnis für Datensicherung?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Do
If fso.FolderExists( ZielVerz ) Then Exit Do
MsgBox "Zielverzeichnis " & vbCRLF & vbTab & ZielVerz & vbCRLF & "prüfen!", , "120 :: " : WshShell.Run "notepad " & ParamDatei, , True
Call ParamLesen( ParamDatei )
Loop
' Existiert Kopieverzeichnis für Datensicherung?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Do
If Len( KopieVerz ) < 4 Then Exit Do
If fso.FolderExists( KopieVerz ) Then Exit Do
MsgBox "KopieVerzeichnis " & vbCRLF & vbTab & KopieVerz & vbCRLF & "prüfen!", , "129 :: " : WshShell.Run "notepad " & ParamDatei, , True
Call ParamLesen( ParamDatei )
Loop
' MsgBox "ParamDatei: " & ParamDatei & vbCRLF & "ZielVerz: " & ZielVerz & vbCRLF & "ZeilNr: " & ZeilNr & vbCRLF & "ZNrSich: " & ZNrSich, , "133 :: " & WScript.ScriptName
' Dateien sichern
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not DateiVergl = True Then
For i = LBound( Datei ) To UBound( Datei )
Call SichDatei( Datei( i ) ) ' SichDatei() mit Call ZeilenAnpassg()
Next
End If
' Dateienvergleich - wenn zwei übergeben wurden
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If DateiVergl = True Then Call DateienVergleich( Datei( 0 ), Datei( 1 ) ) ' DateienVergleich() mit Call ZeilenAnpassg()
' Zielverzeichnis-Größe testen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Tst = fso.GetFolder( ZielVerz ).Size / 1024 / 1024 ' : MsgBox "ZielVerz: " & ZielVerz & vbCRLF & Tst & " MB", , "152 :: "
Tst = CLng( Tst )
MaxVerzInh = CLng( MaxVerzInh ) ' : MsgBox "Verz.Größe: " & Tst & vbCRLF & "MaxVerzInh: " & MaxVerzInh, , "154 :: " & WScript.ScriptName
If Tst < MaxVerzInh Then WScript.Quit
Txt = "Im Sicherungsverzeichnis befinden sich mehr als" & vbCRLF
Txt = Txt & vbTab & Tst & " MB" & vbCRLF
Txt = Txt & "Dateien - vielleicht sollte man 'etwas' löschen?" & vbCRLF & vbCRLF
Txt = Txt & "[Yes]" & vbTab & "Öffnet das Sicherungsverzeichnis." & vbCRLF
Txt = Txt & "[No]" & vbTab & "Öffnet die Parameterdatei"
Tst = WSHShell.Popup( Txt, 10, "163 :: " & WScript.ScriptName, 4096+32+3 )
If Tst = vbCancel Then : WScript.Quit
If Tst = vbYes Then WshShell.Run ZielVerz : WScript.Quit
If Tst <> vbNo Then : WScript.Quit
Call ParamLesen( ParamDatei )
Call ParamFehlt( ParamDatei )
WshShell.Run "notepad " & ParamDatei, , True
' If Tst = vbNo Then WshShell.Run "notepad """ & ParamDatei & """"
WScript.Quit
'***************************************************************
' ENDE - das eigentliche Skript endet
'***************************************************************
'***************************************************************
Sub SkriptInfo ' Sub Aufruf
'***************************************************************
Txt = ""
Txt = Txt & "Das ganze funktioniert so:" & vbCRLF & vbCRLF
Txt = Txt & "Das Skript muss über 'Senden an' angesprochen werden," & vbCRLF
Txt = Txt & "um Dateien an das Skript übergeben zu können." & vbCRLF & vbCRLF
Txt = Txt & "" & vbCRLF
Txt = Txt & "[ja]" & vbTab & vbTab & "Skript für 'Senden an' (SendTo) einrichten." & vbCRLF
Txt = Txt & "[nein]" & vbTab & vbTab & "Eine Parameterdatei (als Hilfe) ansehen." & vbCRLF
Txt = Txt & "[Abbrechen]" & vbTab & "Bei ""Aaaaaaaangst""." & vbCRLF
Txt = WSHShell.Popup (Txt , 30, "195 :: " & WScript.ScriptName, 4096 + 512 + 32 + 3 )
If vbCancel = Txt Then
WSHShell.Popup " . . . dann eben nicht!", 10, "197 :: " & WScript.ScriptName & " . . . ist zu Ende.", 48 + 4096
WScript.Quit
End If
If vbNo = Txt Then
Call ParamLesen( ParamDatei )
Call ParamFehlt( ParamDatei )
WshShell.Run "notepad " & ParamDatei, , True
WSHShell.Popup WScript.ScriptFullName & vbCRLF & vbCRLF & "hat nichts getan und beendet sich jetzt.", 13, "205 :: " & WScript.ScriptName, 48 + 4096
WScript.Quit
End If
If not vbYes = Txt Then
WSHShell.Popup " . . . dann eben nicht!", 10, "210 :: " & WScript.ScriptName & " . . . ist zu Ende.", 48 + 4096
WScript.Quit
End If
Txt = ""
Txt = Txt & "Das Skript " & UCase( WScript.ScriptName ) & " wird jetzt für den " & vbCRLF
Txt = Txt & "angemeldeten Benutzer unter 'Senden an' eingerichtet." & vbCRLF & vbCRLF
Txt = Txt & "Es ist dann als '" & SendToLink & "' verfügbar." & vbCRLF & vbCRLF
Txt = Txt & "Soll gleich die Parameterdatei angepasst werden?"
Txt = WSHShell.Popup( Txt, , "220 :: " & WScript.ScriptName , 64 + 32 + 4 )
If not Txt = vbYes Then AutoStartLink ( SendToLink ) ' SUB Aufruf mit WScript.Quit
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Parameterdatei 'ParamDatei' lesen um Parameter auszulesen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If fso.FileExists( ParamDatei ) Then Call ParamLesen( ParamDatei )
WScript.Sleep 500
' Parameterdatei 'ParamDatei' mit Parameter neu schreiben
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call ParamFehlt( ParamDatei )
' Parameterdatei 'ParamDatei' zum Editieren öffnen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
WshShell.Run "notepad " & ParamDatei, , True
AutoStartLink ( SendToLink ) ' SUB Aufruf mit WScript.Quit
End Sub ' SkriptInfo
'***************************************************************
Function AutoStartLink( SendToLink ) ' Function Aufruf
'***************************************************************
Dim Txt, TxtX, 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
Txt = Left( WSHShell.ExpandEnvironmentStrings("%WinDir%") , 3)
if fso.FolderExists( WSHShell.ExpandEnvironmentStrings("%Temp%") ) then TxtX = WSHShell.ExpandEnvironmentStrings("%Temp%")
if fso.FolderExists( Txt & "PROGRAM FILES" ) then TxtX = Txt & "PROGRAM FILES"
if fso.FolderExists( Txt & "programme" ) then TxtX = Txt & "programme"
TxtX = TxtX & "\dieseyer.de"
On Error Resume Next
if not fso.FolderExists( TxtX ) then fso.CreateFolder( TxtX )
On Error GoTo 0
if not fso.FolderExists( TxtX ) then
WSHShell.Popup TxtX & " konnte nicht angelegt werden!" , 30, "273 :: " & WScript.ScriptName & " . . . ist zu Ende!" , 64
WScript.Quit
End If
' Link zur Parameterdatei 'ParamDatei' neben das Skript schreiben
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call LinkErstellen( TxtX, ParamDatei ) ' : MsgBox TxtX & vbCRLF & ParamDatei, , "279 :: " : WScript.Quit
' das Skript kopieren
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' TxtX = TxtX & "\" & SendToLink & ".vbs"
TxtX = TxtX & "\" & WScript.Scriptname
' das Skript kopieren, wenn das Zielskript nicht das aktuelle,
' laufende, Skript ist:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not LCase(TxtX) = LCase(WScript.ScriptFullName) then
On Error Resume Next
fso.GetFile( TxtX ).attributes = 0
err.Clear
WScript.Sleep 333
fso.CopyFile WScript.ScriptFullName, TxtX , True
if not err.number = 0 then
WSHShell.Popup TxtX & " konnte nicht angelegt werden!" & vbCRLF & vbCRLF & err.Number & " - " & err.Description, 30, "297 :: " & 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
Txt = WSHShell.SpecialFolders("AllUsersStartup") & "\" & SendToLink & ".lnk"
If Txt = "\" & SendToLink & ".lnk" then ' bei Win9x
Txt = WSHShell.SpecialFolders("Startup") & "\" & SendToLink & ".lnk"
End If
Set ShellLink = WSHShell.CreateShortcut( Txt)
ShellLink.TargetPath = TxtX
ShellLink.Arguments = "-install"
ShellLink.WorkingDirectory = fso.GetParentFolderName( TxtX )
On Error Resume Next
ShellLink.Save
On Error GoTo 0
If not err.number = 0 then
WSHShell.Popup Txt & " konnte nicht angelegt werden!" , 30, "324 :: " & WScript.ScriptName , 64
End If
Txt = WSHShell.SpecialFolders("SendTo") & "\" & SendToLink & ".lnk"
Set ShellLink = WSHShell.CreateShortcut( Txt)
ShellLink.TargetPath = TxtX
ShellLink.WorkingDirectory = fso.GetParentFolderName( TxtX )
' ShellLink.Save =======> kommt später
On Error Resume Next
if fso.FileExists( Txt ) then
' WSHShell.Popup Txt & " wird überschrieben!" , 10, "337 :: " & WScript.ScriptName , 64
ShellLink.Save ' =======> kommt hier
If err.number = 0 then
' WSHShell.Popup Txt & " wurde überschrieben!" , 10, "341 :: " & WScript.ScriptName , 64
Else
WSHShell.Popup Txt & " konnte nicht überschrieben werden!" , 30, "343 :: " & WScript.ScriptName , 64
End If
Else
ShellLink.Save ' =======> kommt hier
If err.number = 0 then
' WSHShell.Popup Txt & " wurde angelegt!" , 10, "349 :: " & WScript.ScriptName , 64
Else
WSHShell.Popup Txt & " konnte nicht angelegt werden!" , 30, "351 :: " & WScript.ScriptName , 64
End If
End If
On Error GoTo 0
WScript.Quit
End Function ' AutoStartLink ( SendToLink )
'***************************************************************
Function ParamFehlt( ParamDatei )
'***************************************************************
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim Txt, Tst, FileOut
Txt = Txt & vbTab & "Es fehlt die Parameterdatei" & vbCRLF & vbCRLF & ParamDatei & vbCRLF & vbCRLF
Txt = Txt & vbTab & "Diese enthält u.a. das zu verwendende Sicherungsverzeichnis . . . und wird jetzt angelegt:" & vbCRLF
If not fso.FileExists( ParamDatei ) Then MsgBox Txt, , "370 :: " & WScript.ScriptName
On Error Resume Next
FSO.OpenTextFile ParamDatei , 2, true ' Datei zum Screiben öffnen; 2: immer neu anlegen
Tst = err.Number & " - " & err.Description
On Error GoTo 0
If Len( Tst ) > 5 Then
Txt = "! ! ! F E H L E R ! ! !" & vbCRLF & vbCRLF
Txt = Txt & "Keine Recht zum Schreiben von" & vbCRLF & vbCRLF & vbTab & ParamDatei & vbCRLF & vbCRLF
Txt = Txt & Tst & vbCRLF & vbCRLF
Txt = Tst & " . . . Skriptende!"
MsgBox Txt, , "381 :: " & WScript.ScriptName
WScript.Quit
End If
Set FileOut = FSO.OpenTextFile( ParamDatei , 8, true ) ' Datei zum Screiben öffnen; 2: immer neu anlegen
FileOut.WriteLine "; Folgende Parameter müssen angegeben werden, damit das Skript"
' FileOut.WriteLine ";" & vbTab & WScript.ScriptFullName
FileOut.WriteLine ";" & vbTab & WScript.ScriptName
FileOut.WriteLine "; 'vernüftig' arbeiten kann:"
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; Schaltet das Skript 'scharf'"
FileOut.WriteLine "; ""TestMode=no"" schaltet den TestMode aus - Kleinbuchstaben!."
FileOut.WriteLine "; Im TestMode wird die Datei mit den angepassten Zeilennummern"
FileOut.WriteLine "; unter einem anderen Namen gespeichert und mit Notepad angezeigt,"
FileOut.WriteLine "; als 'Vertrauensbildende Maßnahme' . . . ;-) "
FileOut.WriteLine "TestMode=" ' & TestMode
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; Bei der Übergabe von _zwei_ Dateien werden die Zeilenummern durch"
FileOut.WriteLine "; '999' ersezt und ein Vergleich der beiden Dateien angeboten."
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; ZielVerz=\\mein-pc\c$\Backup\"
FileOut.WriteLine "; ZielVerz=d:\temp"
FileOut.WriteLine "; nicht erlaubt: ZielVerz=X:\"
FileOut.WriteLine "; nicht erlaubt: ZielVerz=Z:"
FileOut.WriteLine "ZielVerz=" & ZielVerz
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; KopieVerz=\\mein-pc\c$\Kopie.en\"
FileOut.WriteLine "; KopieVerz=d:\SicherIstSicher"
FileOut.WriteLine "; nicht erlaubt: KopieVerz=X:\"
FileOut.WriteLine "; nicht erlaubt: KopieVerz=Z:"
FileOut.WriteLine "; Kopie wird nicht erstellt, wenn nicht angegeben: KopieVerz="
FileOut.WriteLine "KopieVerz=" & KopieVerz
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; ZeilNr=1 => Anpassen der Zeilennummern - "
FileOut.WriteLine "; dafür wird aufgerufen: ""Sub ZeilenAnpassg( Datei, ZeichenVor, ZeichenNach )"" "
FileOut.WriteLine "ZeilNr=" & ZeilNr
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; ZNrSich=0 => Die Sicherung wird _vor_ dem Aktualisieren der Zeilennummern erstellt."
FileOut.WriteLine "; ZNrSich=1 => Die Sicherung wird _nach_ dem Aktualisieren der Zeilennummern erstellt."
FileOut.WriteLine "ZNrSich=" & ZNrSich
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; Nach erfolgter Sicherung wird eine Meldung mit"
FileOut.WriteLine "; dem kompletten Pfad der zu sichernden Datei"
FileOut.WriteLine "; dem kompletten Pfad der zu Sicherungsdatei"
FileOut.WriteLine "; angezeigt - wie lange soll diese Anzeige dauern (0 zeigt keine)?"
FileOut.WriteLine "PopUpDauer=" & PopUpDauer
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; Wenn das Sicherungsverzeichnis eine bestimmte Größe"
FileOut.WriteLine "; (Größe in MegaByte) überschreitet, soll eine Meldung erscheinen"
FileOut.WriteLine "; MaxVerzInh=0 => NIE eine Meldung"
FileOut.WriteLine "MaxVerzInh=" & MaxVerzInh
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; Soll z.B. in .BAT- und .CMD-Dateien in der Zeichenkette"
FileOut.WriteLine "; echo 123 :: ! Wichtige Info ! "
FileOut.WriteLine "; die Zahl 123 in die aktuelle Zeilennummer geändert werden:"
FileOut.WriteLine "; DateiTypeA2=CMD"
FileOut.WriteLine "; DateiTypeB2=BAT"
FileOut.WriteLine "; ZeichenVor2=³echo ³"
FileOut.WriteLine "; ZeichenNach2=³ ::³"
FileOut.WriteLine "; WICHTIG ist die Zahl vor dem =, hier Gruppe eins. "
FileOut.WriteLine "; - ZeichenVor1 und ZeichenNach1 darf keine Zahlen enthalten!"
FileOut.WriteLine "; - ein Leerschritt nach dem 'echo'; Tab ist auch möglich"
FileOut.WriteLine "; - mit einem Leerschritt vor und nach den beiden Doppelpunkten"
FileOut.WriteLine "; - ³ (""hoch 3"" bzw. ""dritte Potenz"") gilt als Begrenzer"
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; Soll z.B. in .VBS- und .WSF und .HTA-Dateien in der Zeichenkette"
FileOut.WriteLine "; LogEintrag "" 123 :: ! Wichtige Info ! """
FileOut.WriteLine "; die Zahl 123 in die aktuelle Zeilennummer geändert werden:"
FileOut.WriteLine "; DateiTypeA1=WSF"
FileOut.WriteLine "; DateiTypeB1=vbs"
FileOut.WriteLine "; DateiTypeC1=htA"
FileOut.WriteLine "; ZeichenVor1=³""³"
FileOut.WriteLine "; ZeichenNach1=³ :: ³"
FileOut.WriteLine "; WICHTIG ist die Zahl vor dem =, hier Gruppe zwei. "
FileOut.WriteLine "; - ZeichenVor1 und ZeichenNach1 darf keine Zahlen enthalten!"
FileOut.WriteLine "; - ein Leerschritt nach dem 'echo'; Tab ist auch möglich"
FileOut.WriteLine "; - mit einem Leerschritt vor und nach den beiden Doppelpunkten"
FileOut.WriteLine "; - ³ (""hoch 3"" bzw. ""dritte Potenz"") gilt als Begrenzer"
FileOut.WriteLine vbCRLF
FileOut.WriteLine "; Erst DateiTypen mit '1' dann mit '2' . . ."
FileOut.WriteLine vbCRLF
If Len( DateiType( 1, 0 ) ) < 3 AND UBound( DateiType, 2 ) = 0 Then
FileOut.WriteLine "DateiTypeA1="
FileOut.WriteLine "ZeichenVor1="
FileOut.WriteLine "ZeichenNach1="
FileOut.Close
Set FileOut = nothing
Exit Function
End If
Txt = ""
Tst = ""
For v = LBound( DateiType, 2 ) to UBound( DateiType, 2 )
' Txt = " " : If not TestMode="no" Then Txt = "; " & v
FileOut.WriteLine Txt
If Len( DateiType( 1, v ) ) > 1 Then
Tst = Split( DateiType( 1, v ), "." )
For i = LBound( Tst ) to UBound( Tst )
If Len( Tst( i) ) > 1 Then FileOut.WriteLine "DateiType" & Chr( 65 + i ) & v & "=" & Tst( i)
Next
FileOut.WriteLine "ZeichenVor" & v & "=" & "³" & DateiType( 2, v ) & "³"
FileOut.WriteLine "ZeichenNach" & v & "=" & "³" & DateiType( 3, v ) & "³"
End If
Next
Set FileOut = nothing
End Function ' ParamFehlt( ParamDatei )
'***************************************************************
Function ParamLesen( ParamDatei )
'***************************************************************
Dim FileIn, Txt, Tst,v , i
Set FileIn = FSO.OpenTextFile( ParamDatei, 1 ) ' Datei zum Lesen öffnen
Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen
Txt = LCase( FileIn.Readline )
If not InStr( Txt, ";" ) = 1 AND Len( Txt ) > 5 Then
Tst = "testmode=" : If InStr( Txt,Tst )=1 Then TestMode = Replace( Txt, Tst, "" ) ' : MsgBox TestMode, , "497 :: "
Tst = "zielverz=" : If InStr( Txt,Tst )=1 Then ZielVerz = Replace( Txt, Tst, "" ) ' : MsgBox ZielVerz, , "498 :: "
Tst = "kopieverz=" : If InStr( Txt,Tst )=1 Then KopieVerz = Replace( Txt, Tst, "" ) ' : MsgBox KopieVerz, , "499 :: "
Tst = "zeilnr=" : If InStr( Txt,Tst )=1 Then ZeilNr = Replace( Txt, Tst, "" ) ' : MsgBox ZeilNr, , "500 :: "
Tst = "znrsich=" : If InStr( Txt,Tst )=1 Then ZNrSich = Replace( Txt, Tst, "" ) ' : MsgBox ZNrSich, , "501 :: "
Tst = "popupdauer=" : If InStr( Txt,Tst )=1 Then PopUpDauer = Replace( Txt, Tst, "" ) ' : MsgBox PopUpDauer, , "502 :: "
Tst = "maxverzinh=" : If InStr( Txt,Tst )=1 Then MaxVerzInh = Replace( Txt, Tst, "" ) ' : MsgBox MaxVerzInh, , "503 :: "
If InStr( Txt,"dateitype" ) = 1 Then
i = 0
Tst = Mid( Txt, InStr( Txt, "=" ) - 1, 1 ) ' das Zeichen vor dem = muss eine Zahl sein
Tst = Int( Tst ) ' das Zeichen vor dem = muss eine Zahl sein
Do
If i = Tst And InStr( Txt, i & "=" ) > 9 Then ' z.B. bei "DateiTypeA1="
v = i : If not v = UBound( DateiType, 2 ) Then ReDim Preserve DateiType( 3, v )
DateiType( 1, v ) = DateiType( 1, v ) & "." & Mid( Txt, InStr( Txt, "=" ) + 1 ) ' : MsgBox "DateiType( 1, " & v & " ) = >" & DateiType( 1, v ) & "<" & vbCRLF, , "512 :: "
End If
i = i + 1 : If i > 9 Then Exit Do ' DateiType-Zuordnungen-Zahl muss einstellig sein
Loop
End If
Txt = Replace( Txt, "³", "" )
Tst = "zeichenvor" : If InStr( Txt,Tst )=1 Then DateiType( 2, v ) = Mid( Txt, InStr( Txt, "=" ) + 1 ) ' : MsgBox PopUpDauer, , "519 :: "
Tst = "zeichennach" : If InStr( Txt,Tst )=1 Then DateiType( 3, v ) = Mid( Txt, InStr( Txt, "=" ) + 1 ) ' : MsgBox PopUpDauer, , "520 :: "
End If
Tst = ""
Tst = Tst & "DateiType( 1, " & v & " ) = >" & DateiType( 1, v ) & "<" & vbCRLF
Tst = Tst & "ZeichenVor = >" & DateiType( 2, v ) & "<" & vbCRLF
Tst = Tst & "ZeichanNach = >" & DateiType( 3, v ) & "<" & vbCRLF
Tst = Replace( Tst, "³", "" ) : Tst = Replace( Tst, vbTab, "vbTab" )
' If Len( DateiType( 1, v ) ) > 2 Then MsgBox Tst & Txt, , "527 :: "
' If Len( Txt ) < 2 And Len( DateiType( 1, v ) ) > 2 Then MsgBox Tst & Txt, , "528 :: "
Loop
FileIn.Close
Set FileIn = nothing
If ZeilNr = "" Then ZeilNr = 0
If ZNrSich = "" Then ZNrSich = 0
If PopUpDauer = "" Then PopUpDauer = 3
' MsgBox "TestMode: " & TestMode & vbCRLF & "ParamDatei: " & ParamDatei & vbCRLF & "ZielVerz: " & ZielVerz & vbCRLF & "ZeilNr: " & ZeilNr & vbCRLF & "ZNrSich: " & ZNrSich, , "537 :: " & WScript.ScriptName
' WScript.Quit
End Function ' ParamLesen( ParamDatei )
'***************************************************************
Function SichDatei( DateiName )
'***************************************************************
Dim Txt, Tst, Tst1, Tst2, i, n, x
Txt = DateiName
Txt = Replace( Txt, "\", "³" )
Txt = Replace( Txt, ":", "" )
' MsgBox InStrrev( ZielVerz, "\" ) & vbCRLF & Len( ZielVerz ), , "550 :: "
' Falls vorhanden, letztes "\" abschneiden
If InStrrev( ZielVerz, "\" ) = Len( ZielVerz ) Then ZielVerz = Mid( ZielVerz, 1, Len( ZielVerz ) - 1 )
If InStrrev( KopieVerz, "\" ) = Len( KopieVerz ) Then KopieVerz = Mid( KopieVerz, 1, Len( KopieVerz ) - 1 )
KopieVerz = KopieVerz & "\"
On Error Resume Next
If Len( KopieVerz ) > 3 Then fso.CopyFile DateiName, KopieVerz, True
On Error GoTo 0
Txt = ZielVerz & "\" & Txt
Tst2 = fso.GetExtensionName( Txt ) ' nur die Dateierweiterung
Tst1 = Len( fso.GetExtensionName( Txt ) ) ' Anz. der Zeichen der Dateierweiterung
Tst1 = Mid( Txt, 1, Len( Txt ) - Tst1 -1 ) ' Datei ohne Dateierweiterung
x = " 000."
Txt = Tst1 & x & Tst2 ' : MsgBox Txt, , "566 :: "
Do ' freie Nummer für Dateisicherung ermitteln
If not fso.FileExists( Txt ) Then Exit Do
n = n + 1 : x = n
If Len( x ) < 3 Then x = "0" & x
If Len( x ) < 3 Then x = "0" & x
x = " " & x & "."
Txt = Tst1 & x & Tst2 ' neue Nummer für Dateisicherung
' MsgBox Txt, , "575 :: "
Wscript.Sleep 1
Loop
ZielDatei = Txt
' Sicherung ohne Anpassung der Zeilennummer
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not ZeilNr=1 Then
fso.CopyFile DateiName, ZielDatei
If PopUpDauer > 0 Then WSHShell.Popup "Erfolgreich kopiert:" & vbCRLF & vbCRLF & vbTab & "ZielDatei: " & ZielDatei & vbCRLF & vbTab & "DateiName: " & DateiName, PopUpDauer, "587 :: " & WScript.ScriptName, 4096+64
Exit Function
End If
' Sicherung vor Anpassung der Zeilennummer
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not ZNrSich=1 Then
fso.CopyFile DateiName, ZielDatei
If PopUpDauer > 0 Then WSHShell.Popup "Erfolgreich (vor Anpassen der Zeilennr.) kopiert:" & vbCRLF & vbCRLF & vbTab & "ZielDatei: " & vbCRLF & ZielDatei & vbCRLF & vbTab & "DateiName: " & vbCRLF & DateiName, PopUpDauer, "596 :: " & WScript.ScriptName, 4096+64
End If
' Anpassung der Zeilennummer
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = LCase( fso.GetExtensionName( DateiName ) ) ' Dateityp ermitteln
For v = LBound( DateiType, 2 ) to UBound( DateiType, 2 )
If Len( DateiType( 1, v ) ) > 1 Then ' die unterstüzten DateiTypen ermittel
Tst = Split( DateiType( 1, v ), "." )
For i = LBound( Tst ) to UBound( Tst )
If Len( Tst( i ) ) > 1 Then ' die DateiTyp mit unterstüzten DateiTypen vergleichen
If LCase( Tst( i ) ) = Txt Then Call ZeilenAnpassg( DateiName, DateiType( 2, v ), DateiType( 3, v ) )
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~_____________~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End If
Next
End If
Next
On Error Resume Next
If Len( KopieVerz ) > 3 Then fso.CopyFile DateiName, KopieVerz, True
On Error GoTo 0
' Sicherung (erfolgte bereits) vor Anpassung der Zeilennummer
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not ZNrSich=1 Then
' If PopUpDauer > 0 Then WSHShell.Popup "Erfolgreich (vor Anpassen der Zeilennr.) kopiert:" & vbCRLF & vbCRLF & vbTab & "ZielDatei: " & vbCRLF & ZielDatei & vbCRLF & vbTab & "DateiName: " & vbCRLF & DateiName, PopUpDauer, "622 :: " & WScript.ScriptName, 4096+64
Exit Function
End If
' Sicherung nach Anpassung der Zeilennummer
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
fso.CopyFile DateiName, ZielDatei
If PopUpDauer > 0 Then WSHShell.Popup "Erfolgreich (nach Anpassen der Zeilennr.) kopiert:" & vbCRLF & vbCRLF & vbTab & "ZielDatei: " & vbCRLF & ZielDatei & vbCRLF & vbTab & "DateiName: " & vbCRLF & DateiName, PopUpDauer, "630 :: " & WScript.ScriptName, 4096+64
End Function ' SichDatei( DateiName )
'***************************************************************
Sub ZeilenAnpassg( Datei, ZeichenVor, ZeichenNach )
'***************************************************************
' Von der 'Datei' wird keine Sicherung erstellt - 'Datei' wird komplett eingelesen
' und anschließend mit korregierten Zeilennummern beim Schreiben überschrieben.
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim ZeileTxt, Txt, Tst, Ttt, Tyt, Tzt, Tut, i, n, PC
Dim FileOut, FileIn
Dim TestWeiter : TestWeiter = True
Dim VorNachGleich : VorNachGleich = True ' Vorher-Nachher-Vergleich; VorNachGleich = False wenn min. eine Zeilennumer geändert wurde
' MsgBox "Sub ZeilenAnpassg( " & Datei & ", " & ZeichenVor & ", " & ZeichenNach & " )" & vbCRLF & "DateiVergl: " & DateiVergl , , "647 :: "
' alle Zeilen lesen und an Array übergeben
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set FileIn = FSO.OpenTextFile(Datei, 1 ) ' Datei zum Lesen öffnen
i=0
Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen
ReDim Preserve Zeile(i)
Zeile(i) = FileIn.Readline
i = i + 1
Loop
If i < 1 Then
ReDim Preserve Zeile(i)
Zeile(i) = "Leerdatei"
End If
FileIn.Close
Set FileIn = nothing
' Array bearbeiten; hier: Zeilennummer einfügen/anpassen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
for i = LBound( Zeile ) to UBound( Zeile )
Txt = Zeile(i) : ZeileTxt = Zeile(i) ' Zeile merken für Vorher-Nachher-Vergleich
If InStr( Txt, ZeichenVor ) > 0 AND InStr( Txt, ZeichenNach ) > 0 Then
Zeile(i) = "" ' leeren
Tst = ""
' Zeile zerlegen
Tst = Split( Txt, ZeichenNach )
' Tut = i + 1 & vbTab & UBound( Tst ) & vbCRLF
' For n = LBound( Tst ) to UBound( Tst )
' Tut = Tut & n & vbTab & Tst( n ) & vbCRLF
' Next
Txt = "Vor" & vbTab & Txt & vbCRLF & "ZeichenVor:" & vbTab & ZeichenVor & vbCRLF & "ZeichenNach:" & vbTab & ZeichenNach & vbCRLF & "===> " & i + 1 & ". Zeile . . . "
For n = LBound( Tst ) to UBound( Tst )
' MsgBox "Zeile( " & i+1 & " ) wird bearbeitet", 4096, "682 :: " ' : WScript.Quit
' MsgBox "Len( """ & ZeichenVor & """ ) + 2 = " & Len( ZeichenVor ) + 2 & vbCRLF & "InStrRev( Tst( " & n+1 & " ), """ & ZeichenVor & """ ) = " & InStrRev( Tst( n ), ZeichenVor ) & vbCRLF & "Len( Tst( " & n & " ) ) = " & Len( Tst( n ) ) & vbCRLF & "Ttt = " & Ttt & vbCRLF & "Tst( " & n & " ) = " & Tst( n ), 4096, "685 :: " ' : WScript.Quit
If InStrRev( Tst( n ), ZeichenVor ) > 0 AND n <> UBound( Tst ) AND Len( Tst ( n ) ) > Len( ZeichenVor ) + 1 Then
' MsgBox "Len( """ & ZeichenVor & """ ) + 2 = " & Len( ZeichenVor ) + 2 & vbCRLF & "InStrRev( Tst( " & n+1 & " ), """ & ZeichenVor & """ ) = " & InStrRev( Tst( n ), ZeichenVor ) & vbCRLF & "Len( Tst( " & n & " ) ) = " & Len( Tst( n ) ) & vbCRLF & "Ttt = " & Ttt & vbCRLF & "Tst( " & n & " ) = " & Tst( n ), 4096, "687 :: " ' : WScript.Quit
Ttt = InStrRev( Tst( n ), ZeichenVor ) ' Ttt = Anzahl Zeichen _vor_ 'ZeichenVor'
Ttt = Ttt + Len( ZeichenVor ) ' Ttt = muss Position der ersten Zahl zwischen 'ZeichenVor' und 'ZeichenNach' enthalten
Do
' Zahlen entfernen bzw. Suche der Stelle nach der letzten Ziffer in der alten Zeilennummer
If IsNumeric( Mid( Tst( n ), Ttt, 1 ) ) = False Then Exit Do
Ttt = Ttt + 1 ' : MsgBox "Zeile( " & i+1 & " ) = " & Zeile(i) & vbCRLF & "erste Zahl>>>" & Mid( Tst( n ), Ttt ) & vbCRLF , 4096, "694 :: " : WScript.Quit
Loop
' MsgBox "Ttt - 1 = " & Ttt - 1 & vbCRLF & "Len( """ & ZeichenVor & """ ) + 2 = " & Len( ZeichenVor ) + 2 & vbCRLF & "InStrRev( Tst( " & n+1 & " ), """ & ZeichenVor & """ ) = " & InStrRev( Tst( n ), ZeichenVor ) & vbCRLF & "Len( Tst( " & n & " ) ) = " & Len( Tst( n ) ) & vbCRLF & "Ttt = " & Ttt & vbCRLF & "Tst( " & n & " ) = " & Tst( n ), 4096, "697 :: " ' : WScript.Quit
If Len( Tst( n ) ) = Ttt - 1 Then ' Ttt muss das Ende von Tst( n ) erreicht haben
Tzt = Len( UBound( Zeile ) ) ' Anzahl der Stellen für die neue Zeilennummer
Tyt = i + 1 : If Len( Tyt ) < Tzt Then Tyt = "0" & Tyt : If Len( Tyt ) < Tzt Then Tyt = "0" & Tyt : If Len( Tyt ) < Tzt Then Tyt = "0" & Tyt : If Len( Tyt ) < Tzt Then Tyt = "0" & Tyt
' neue Zeilennumer ist gebildet
If DateiVergl = True Then Tyt = String( Tzt, "9" ) ' : MsgBox "Tyt: >" & Tyt & "<", , "704 :: "
' Wenn ein Dateivergleich durchgeführt werden soll, wird die Zeilennummer nur '9' enthalten
' MsgBox "Len( Tst( " & n & " ) ) = " & Len( Tst( n ) ) & vbCRLF & "Ttt = " & Ttt & vbCRLF & "Tst( " & n & " ) = " & Tst( n ), , "707 :: " : : WScript.Quit
Tst( n ) = Left( Tst( n ), InStrRev( Tst( n ), ZeichenVor ) + Len( ZeichenVor ) - 1 )
' die Zeichen vor der Zeilennummer
Tst( n ) = Tst( n ) & Tyt ' die neue Zeilennummer
Tst( n ) = Tst( n ) & ZeichenNach ' in Tst(n) fehlt 'ZeichenNach'
Else
Tst( n ) = Tst( n ) & ZeichenNach ' in Tst(n) fehlt 'ZeichenNach'
End If
Else
' MsgBox "Len( """ & ZeichenVor & """ ) + 2 = " & Len( ZeichenVor ) + 2 & vbCRLF & "InStrRev( Tst( " & n+1 & " ), """ & ZeichenVor & """ ) = " & InStrRev( Tst( n ), ZeichenVor ) & vbCRLF & "Len( Tst( " & n & " ) ) = " & Len( Tst( n ) ) & vbCRLF & "Ttt = " & Ttt & vbCRLF & "Tst( " & n & " ) = " & Tst( n ), 4096, "717 :: " ' : WScript.Quit
If n <> UBound( Tst ) Then Tst( n ) = Tst( n ) & ZeichenNach ' in Tst(n) fehlt 'ZeichenNach'
End If
Zeile(i) = Zeile(i) & Tst( n )
If TestMode="-no" Then Txt = Txt & vbCRLF & n & vbTab & "Ttt = " & Ttt & vbCRLF & n & vbTab & ">" & Tst( n ) & "< ___ " & Len( Tst(n ) )
Next
' MsgBox Zeile(i) & vbCRLF & Txt , 4096, "726 :: " ' : WScript.Quit
If not TestMode="no" AND TestWeiter = True Then Txt = MsgBox( "Nach" & vbTab & Zeile(i) & vbCRLF & Txt & vbCRLF & "Datei: " & vbTab & Datei, 4096 + 1, "727 :: " )' : WScript.Quit
If not Txt = vbOK Then TestWeiter = False
Else
Txt = ""
Txt = Txt & "ZeichenVor: " & vbTab & ZeichenVor & vbCRLF & "Pos.ZeichenVor: " & vbTab & InStr( Txt, ZeichenVor ) & vbCRLF
Txt = Txt & "ZeichenNach: " & vbTab & ZeichenNach & vbCRLF & "Pos.ZeichenNach: " & vbTab & InStr( Txt, ZeichenNach ) & vbCRLF
' If InStr( Zeile(i) , "TstZeile" ) > 0 Then MsgBox i + 1 & vbCRLF & Zeile(i) & vbCRLF & vbCRLF & Txt, 4096, "733 :: " ' : WScript.Quit
End If
If ZeileTxt <> Zeile(i) Then VorNachGleich = False ' die Zeilennummer wurde angepasst
Next
' Array in (Ziel-) Datei schreiben
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not TestMode = "no" Then Datei = Datei & ".txt"
If VorNachGleich = False OR not TestMode="no" Then
Set FileOut = FSO.OpenTextFile( Datei , 2, true) ' Datei zum Screiben öffnen; 2: immer neu anlegen
for i = 0 to UBound( Zeile )
FileOut.WriteLine( Zeile(i) )
next
FileOut.Close
Set FileOuT = nothing
Else
WSHShell.Popup Datei & vbCRLF & vbCRLF & vbTab & "wurde unverändert gesichert.", 3, "753 :: " & WScript.ScriptName , 4096
End If
' (Ziel-) Datei anzeigen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If not TestMode="no" Then WSHShell.run "notepad """ & Datei & """" , , True ' True: Skriptabarbeitung wartet bis Programm (notepad) beendet ist
If Datei = WScript.ScriptFullName Then WSHShell.run "notepad """ & Datei & """" , , True ' True: Skriptabarbeitung wartet bis Programm (notepad) beendet ist
End Sub ' ZeilenAnpassg( Datei, ZeichenVor, ZeichenNach )
'***************************************************************
Sub DateienVergleich( Datei1, Datei2 )
'***************************************************************
' angepasst aus "dateienvergleich.vbs" v3.B
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim Txt, Tst
Txt = vbTab & "Die Dateien " & vbCRLF & vbCRLF
Txt = Txt & Datei1 & vbCRLF
Txt = Txt & Datei2 & vbCRLF & vbCRLF
Txt = Txt & vbTab & "werden jetzt BINÄR verglichen." & vbCRLF & vbCRLF
Txt = Txt & ". . . oder reicht ein Txt -Vergleich? [Yes] in 5 sec."
Txt = WSHShell.Popup (Txt, 10, "778 :: " & WScript.ScriptName , 4096+32+3 )
If Txt = vbCancel then
WSHShell.Popup " . . . dann eben nicht!", 10, "780 :: " & WScript.ScriptName , 48
Exit Sub ' WScript.Quit
End If
' die beiden Dateien nach %Temp% kopieren
Tst = WSHShell.ExpandEnvironmentStrings("%Temp%") & "\" & fso.GetFileName( Datei1 )
Txt = WSHShell.ExpandEnvironmentStrings("%Temp%") & "\" & fso.GetFileName( Datei2 )
fso.CopyFile Datei1, Tst, True : Datei1 = Tst
fso.CopyFile Datei2, Txt, True : Datei2 = Txt
' Anpassung der Zeilennummer: Datei1
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = LCase( fso.GetExtensionName( Datei1 ) ) ' Dateityp ermitteln
For v = LBound( DateiType, 2 ) to UBound( DateiType, 2 )
If Len( DateiType( 1, v ) ) > 1 Then ' die unterstüzten DateiTypen ermittel
Tst = Split( DateiType( 1, v ), "." )
For i = LBound( Tst ) to UBound( Tst )
If Len( Tst( i ) ) > 1 Then ' die DateiTyp mit unterstüzten DateiTypen vergleichen
If LCase( Tst( i ) ) = Txt Then Call ZeilenAnpassg( Datei1, DateiType( 2, v ), DateiType( 3, v ) )
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~_____________~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End If
Next
End If
Next
' Anpassung der Zeilennummer: Datei2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Txt = LCase( fso.GetExtensionName( Datei2 ) ) ' Dateityp ermitteln
For v = LBound( DateiType, 2 ) to UBound( DateiType, 2 )
If Len( DateiType( 1, v ) ) > 1 Then ' die unterstüzten DateiTypen ermittel
Tst = Split( DateiType( 1, v ), "." )
For i = LBound( Tst ) to UBound( Tst )
If Len( Tst( i ) ) > 1 Then ' die DateiTyp mit unterstüzten DateiTypen vergleichen
If LCase( Tst( i ) ) = Txt Then Call ZeilenAnpassg( Datei2, DateiType( 2, v ), DateiType( 3, v ) )
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~_____________~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End If
Next
End If
Next
Tst = "%comspec% /c fc /N /L" ' Vergleichmodus 'ASCII'
If Txt = vbNo then Tst = "%comspec% /c fc /B " ' Vergleichmodus 'binär'
Txt = WScript.ScriptFullName & ".txt" ' temp. Zieldatei
Txt = WSHShell.ExpandEnvironmentStrings("%Temp%") & "\" & WScript.ScriptName & ".tmp" ' temp. Zieldatei
Tst = Tst & " """ & Datei1 & """ """ & Datei2 & """ > """ & Txt & """ " :' MsgBox Tst, , "827 :: "
WSHShell.run Tst , 7, True
' WScript.Sleep 3*1000
fso.DeleteFile Datei1, True
fso.DeleteFile Datei2, True
Tst = "notepad " & Txt
WSHShell.run Tst , , True
End Sub ' DateienVergleich( Datei1, Datei2 )
'*** v9.5 *** www.dieseyer.de *******************************
Sub LinkErstellen( LinkPfad, Ziel )
'***********************************************************
Dim LinkNeu, Tst
Tst = LinkPfad & Mid( Ziel, InStrRev( Ziel, "\" ) ) & ".lnk" ' Dateiname des Links
Set LinkNeu = CreateObject("WScript.Shell").CreateShortcut( Tst )
' LinkNeu.Arguments = "1 2 3"
LinkNeu.Description = Ziel
' LinkNeu.HotKey = "CTRL+ALT+SHIFT+X"
LinkNeu.IconLocation = "%SystemRoot%\system32\SHELL32.dll,1"
LinkNeu.TargetPath = Ziel
LinkNeu.WindowStyle = 3
LinkNeu.WorkingDirectory = Mid( Ziel, 1, InStrRev( Ziel, "\" ) )
LinkNeu.Save
Set LinkNeu = nothing
End Sub ' LinkErstellen( Ziel )
http://dieseyer.de • all rights reserved • © 2011 v11.4