'v3.1*********************************************************** ' File: StringAnPositionInDateiTauschen.vbs ' Autor: dieseyer@gmx.de ' dieseyer.de ' ' Ersetzt in jeder Zeile einer Datei Zeichen an einer Position. '*************************************************************** Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl Dim WSHShell, fso, FileIn, FileOut Dim Datei, Text, Txt, i, arrSort, arrTest(), oArgs Dim Aktion, Akt1, Akt2, SendToLink Dim TxtParameter, TxtErsatz, TxtSonderz, TextNeu Set WSHShell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") Set oArgs = Wscript.Arguments SendToLink = fso.GetBaseName( WScript.ScriptName ) '*************************************************************** ' ANFANG - Das eigentliche Skript beginnt '*************************************************************** TxtParameter = "Folgende Parameter sind möglich:" & vbCRLF TxtParameter = TxtParameter & " l 10 " & vbTab & "ersetzt in jeder Zeile die " & vbCRLF TxtParameter = TxtParameter & vbTab & vbTab & "ersten (linken) 10 Zeichen" & vbCRLF TxtParameter = TxtParameter & " r 10 " & vbTab & "ersetzt in jeder Zeile die " & vbCRLF TxtParameter = TxtParameter & vbTab & vbTab & "letzten (rechten) 10 Zeichen" & vbCRLF TxtParameter = TxtParameter & " m 10 20 " & vbTab & "ersetzt in den Zeilen (mittendrin) " & vbCRLF TxtParameter = TxtParameter & vbTab & vbTab & "die Zeichen an Pos. 10 bis 20 " & vbCRLF & vbCRLF TxtErsatz = "Als ERSATZ sind beliebige Zeichen möglich:" & vbCRLF TxtErsatz = TxtErsatz & "- wird kein Zeichen eingegeben, werden die " & vbCRLF TxtErsatz = TxtErsatz & " (z.B. 10) Zeichen gelöscht." & vbCRLF TxtErsatz = TxtErsatz & "- 3 Leerzeichen ("" "") ersetzen (z.B.10) Zeichen." & vbCRLF & vbCRLF TxtSonderz = "Folgende Sonderzeichen sind nur einzeln als ERSATZ einsetzbar: " & vbCRLF TxtSonderz = TxtSonderz & " vbCRLF" & vbTab & "neue Zeile (bzw. vbLF / vbCR)" & vbCRLF TxtSonderz = TxtSonderz & " vbTab " & vbTab & "Tabulator" & vbCRLF TxtSonderz = TxtSonderz & " vbNullChar" & vbTab & "ein NULL-Zeichen Chr(0)," & vbCRLF TxtSonderz = TxtSonderz & vbTab & vbTab & "also kein! Leerschritt" & vbCRLF ' Argumente testen/holen '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If oArgs.Count = 0 then SkriptInfo ' SUB Aufruf If oArgs.Count = 2 then SkriptInfo ' SUB Aufruf If oArgs.Count > 4 then SkriptInfo ' SUB Aufruf ' ~~~~~~~~~~~~~~~~~~~~~~~~~ Aktion = "---" Akt1 = 0 Akt2 = 0 If oArgs.Count = 1 then Datei = oArgs.item(1-1) ' #X#~-_-~#X# if not fso.FileExists( Datei ) then Text = "Die Datei " & Datei & " existiert nicht!" WSHShell.Popup Text, 10, WScript.ScriptName & " . . . ist zu Ende." , 64 WScript.Quit End If Else Akt1 = oArgs.item(3-1) ' #X#~-_-~#X# Aktion = oArgs.item(2-1) ' #X#~-_-~#X# Datei = oArgs.item(1-1) ' #X#~-_-~#X# Aktion = UCase( Aktion ) End If Akt1 = CInt( Akt1 ) If oArgs.Count = 4 then ' vier Param.? - das muss Datei und "m 10 20" sein Akt2 = oArgs.item(4-1) ' #X#~-_-~#X# Akt2 = CInt( Akt2 ) if Aktion = "M" AND Akt2 >= Akt1 AND Akt1 > 0 then Mittendrin ' Sub Aufruf ' ~~~ ~~~ ~~~ End If if Aktion = "L" then Links ' Sub Aufruf if Aktion = "R" then Rechts ' Sub Aufruf ' wurde nur eine Datei (Drag & Drop) übergeben, müssen die parameter erfragt werden Text = UCase ( Datei) & " soll bearbeitet werden. " & vbCRLF & vbCRLF Text = Text & TxtParameter & TxtErsatz & TxtSonderz Text = InputBox( Text, WScript.ScriptName) ' ~~~~~~~~ Txt = UCase( Left( Text, 2)) ' die linken zwei Zeichen if Txt = "L " then Aktion = UCase( Left( Txt, 1)) if Txt = "R " then Aktion = UCase( Left( Txt, 1)) if Txt = "M " then Aktion = UCase( Left( Txt, 1)) Text = UCase( Mid( Text, 3)) ' die Zeichen nach den ersten beiden if 0 = InStr (Text, " " ) then Akt1 = Cint(Text) ' es gibt nur einen Parameter if not 0 = InStr (Text, " " ) then ' es gibt mehrer Parameter if Len( Text) > InStr( Text, " " ) then Akt1 = Left( Text, InStr (Text, " " ) -1) Akt1 = CInt( Akt1 ) Text = UCase( Mid( Text, InStr (Text, " " ) +1)) ' den nächsten Parameter if 0 = InStr (Text, " " ) then Akt2 = Text ' es gibt nur einen weiteren Parameter if not 0 = InStr (Text, " " ) then ' es gibt mehrer weiteren Parameter Akt2 = Left( Text, InStr (Text, " " ) -1) Akt2 = CInt( Akt2 ) End If End If End If ' MsgBox Aktion & vbCRLF & Akt1 & vbCRLF & Akt2 & vbCRLF & Datei, , "Aktion Akt1 Akt2 Datei" if Aktion = "L" then Links ' Sub Aufruf if Aktion = "R" then Rechts ' Sub Aufruf if Aktion = "M" then if akt1 < akt2 then Mittendrin ' Sub Aufruf End If Text = "Das waren: Keine VERNÜNFTIGEN Eingaben!" & vbCRLF & vbCRLF Text = Text & Aktion & " " & akt1 & " " & akt2 WSHShell.Popup Text, 10, WScript.ScriptName & " . . . ist zu Ende." , 64 WScript.Quit '*************************************************************** ' ENDE - Das eigentliche Skript beginnt (SUB'S weiter unten) '*************************************************************** Sub SendenAnLink ' Sub Aufruf ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ End Sub ' SendenAnLink Sub SkriptInfo ' Sub Aufruf ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Text = "" Text = Text & "Das Ganze funktioniert so:" & vbCRLF Text = Text & " Eine Datei mit der Maus auf das Skript ziehen " & vbCRLF Text = Text & " und fallen lassen ODER dem Skript über " & vbCRLF Text = Text & " 'Senden an' die Datei übergeben. " & vbCRLF & vbCRLF Text = Text & TxtParameter & TxtErsatz & TxtSonderz MsgBox Text, , "WScript.Quit" WScript.Quit End Sub ' SkriptInfo Sub Links ' Sub Aufruf ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' MsgBox "Links >" & Aktion & "< >" & Akt1 & "< >" & Akt2 & "<", , "WScript.Quit" Text = "In der Datei " & UCase(Datei) & " sollen die linken (ersten) Zeichen bis zum Zeichen " Text = Text & Akt1 & " ersetzt werden. " & vbCRLF & vbCRLF Text = Text & TxtErsatz & TxtSonderz & vbCRLF Text = Text & "Wie lauten die Ersatz-Zeichen?" TextNeu = Ersatz ' Sub Aufruf '~~~~~~~~~~~~~~~~~~ Set FileIn = FSO.OpenTextFile(Datei, 1 ) ' Datei zum Lesen öffnen Datei = Datei & ".txt" Set FileOut = FSO.OpenTextFile(Datei, 2, true) ' Datei zum Schreiben öffnen FileOut.Writeline ( WScript.ScriptName & " " & Aktion &" " & Akt1 ) ' eine Zeile schreiben i=0 Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zuende ist, weiter machen i = i + 1 Text = FileIn.Readline ' eine Zeile lesen if Len( Text ) >= CInt(Akt1) then Text = TextNeu & Mid ( Text , CInt(Akt1) +1 ) Else Text = TextNeu End If FileOut.Writeline (Text) ' eine Zeile schreiben Loop FileIn.Close Set FileIn = nothing FileOut.Close Set FileOut = nothing WSHShell.Run Datei WScript.Quit End Sub ' Links Sub Rechts ' Sub Aufruf ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' MsgBox "Rechts >" & Aktion & "< >" & Akt1 & "< >" & Akt2 & "<", , "WScript.Quit" Text = "In der Datei " & UCase(Datei) & " sollen alle! Zeichen ab dem Zeichen " Text = Text & Akt1 & " (inkl. Zeichen " & Akt1 & ") ersetzt werden. " & vbCRLF & vbCRLF Text = Text & TxtErsatz & TxtSonderz & vbCRLF Text = Text & "Wie lauten die Ersatz-Zeichen?" TextNeu = Ersatz ' Sub Aufruf '~~~~~~~~~~~~~~~~~~ Set FileIn = FSO.OpenTextFile(Datei, 1 ) ' Datei zum Lesen öffnen Datei = Datei & ".txt" Set FileOut = FSO.OpenTextFile(Datei, 2, true) ' Datei zum Schreiben öffnen FileOut.Writeline ( WScript.ScriptName & " " & Aktion &" " & Akt1 ) ' eine Zeile schreiben i=0 Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zuende ist, weiter machen i = i + 1 Text = FileIn.Readline ' eine Zeile lesen if Len( Text ) >= CInt(Akt1) then Text = Mid ( Text , 1, CInt(Akt1) -1 ) & TextNeu ' Else ' Text = "" End If FileOut.Writeline (Text) ' eine Zeile schreiben Loop FileIn.Close Set FileIn = nothing FileOut.Close Set FileOut = nothing WSHShell.Run Datei WScript.Quit End Sub ' Rechts Sub Mittendrin ' Sub Aufruf ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' MsgBox "MittenDrin >" & Aktion & "< >" & Akt1 & "< >" & Akt2 & "<", , "WScript.Quit" Text = "In der Datei " & UCase(Datei) & " sollen die Zeichen von " Text = Text & Akt1 & " bis " & Akt2 & " ersetzt werden. " & vbCRLF & vbCRLF Text = Text & TxtErsatz & TxtSonderz & vbCRLF Text = Text & "Wie lauten die Ersatz-Zeichen?" TextNeu = Ersatz ' Sub Aufruf '~~~~~~~~~~~~~~~~~~ Set FileIn = FSO.OpenTextFile(Datei, 1 ) ' Datei zum Lesen öffnen Datei = Datei & ".txt" Set FileOut = FSO.OpenTextFile(Datei, 2, true) ' Datei zum Schreiben öffnen FileOut.Writeline ( WScript.ScriptName & " " & Aktion &" " & Akt1 & " " & Akt2 ) ' eine Zeile schreiben i=0 Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zuende ist, weiter machen i = i + 1 Text = FileIn.Readline ' eine Zeile lesen if Len( Text ) >= CInt(Akt2) then Text = Mid ( Text , 1, CInt(Akt1) -1 ) & TextNeu & Mid ( Text , CInt(Akt2) +1 ) Else if Len( Text ) >= CInt(Akt1) then Text = Mid ( Text , 1, CInt(Akt1) -1 ) & TextNeu End If End If FileOut.Writeline (Text) ' eine Zeile schreiben Loop FileIn.Close Set FileIn = nothing FileOut.Close Set FileOut = nothing WSHShell.Run Datei WScript.Quit End Sub ' Mittendrin Function Ersatz ' Aufruf ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ersatz = InputBox( Text, WScript.ScriptName) if UCase(Ersatz) = UCase("vbCRLF" ) then Ersatz = Chr(13) & Chr(10) if UCase(Ersatz) = UCase("vbCR" ) then Ersatz = Chr(13) if UCase(Ersatz) = UCase("vbLF" ) then Ersatz = Chr(10) if UCase(Ersatz) = UCase("vbTab" ) then Ersatz = Chr(9) if UCase(Ersatz) = UCase("vbNullChar" ) then Ersatz = Chr(0) End Function ' Ersatz