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