'*** 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 )