http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** v10.1 *** www.dieseyer.de *****************************
'
' Datei: vbseditor+.vbs
' Autor: W. Schmelz
' Auf: www.dieseyer.de
'
' Vor der Ausführung das VBS als
' "V-b-sEditor+.v-b-s" speichern!
'
'***********************************************************
'********************************************************
'* *
'* Editoren gibt es viele! - Mich reizte es aber, mir *
'* selbst einen mit Mitteln des H-t-a zu schreiben !! *
'* Im Explorer ist eine beliebige Datei wählbar! Er - *
'* möglicht wird dieses für "Txt", "V-b-s", "H-t-a" ! *
'* Es wird hier mit eingebundener H-t-a gearbeitet,- *
'* diese gibt die Zeilen der betrachteten Datei aus ! *
'* - Oder Datei auf dieses Programm ziehen und fallen *
'* lassen! Die Datei wird in nummerierten Zeilen ab- *
'* schnittweise angezeigt. Dabei ist außer "Abbruch" *
'* auch ein "Zurück" und natürlich "Weiter" möglich , *
'* sowohl für die angezeigten Zeilenblöcke als auch *
'* für die darin in einem Textfeld bearbeitbar ange - *
'* zeigte Zeile! Diese kann man dann abändern und die *
'* Änderung in der betreffenden " Datei " speichern! *
'* Ferner können eine beliebige oder eine neue, noch *
'* völlig leere Datei im Explorer aufgerufen werden ! *
'* Es können die Objekte Fso, Wss oder der Inhalt der *
'* Ablage eingefügt und auf Wunsch widerrufen werden! *
'* Es kann auch ein bestimmtes "Wort" gesucht werden! *
'* Außerdem ist ein Wort durch ein anderes ersetzbar! *
'* Nachteil ist, dass nur eine Zeile immer bearbeitet *
'* werden kann, diese kann man aber schnell wechseln! *
'* Der Editor arbeitet wie andere, er druckt sogar!!! *
'* *
'********************************************************
'CopyRight: W. Schmelz, 16.12.2009
Zeit = Timer
' Objekte u.a. werden für das Programm bereit gestellt :
'*******************************************************
Set Wss=WScript.CreateObject("WScript.Shell")
Set Fso=WScript.CreateObject("Scripting.FileSystemObject")
Set Arg=Wscript.Arguments
Datei0=WScript.ScriptFullName
UV=VbCR&VbCR
' Voreinstellung einiger wichtiger Variablen :
'*********************************************
Start=""
Ende=""
Neu="0"
Anfang="1"
FrageKorr="1"
Plus="0"
Wort="0" 'Bestimmtes Wort suchen in der " Datei "
Block="0" 'Bei Blockaufrufen 1. Zeile als Textzeile
Dazu="0"
Suche="0"
Ersatz="0" 'Wort ggf. durch Ersatzwort ersetzen
Korr="0" 'Zeilenzahl-Korrektur bei überlangen Zeilen
Folge="0" 'Folgebefehl bei Zeilenspeicherung
Dim Ende, Doppel, Zeile(), Datei, AktVerz, Summe, Schnitt
Dim Liste(), Eins, Stelle, Summ(), Schluss, Datei0, DateiZ
Dim Wert, Frage, Wunsch, Start, Zeilen(), Noch, Nr, DateiN
Dim UrZeile(), FragZeil, Zeil(), NochA, Neu, Wrt(), Plus
Dim ZeilPlus(), FrageKorr, Block, Dazu, NochB, Zeit, Zei()
Dim Wort, Hier, Numb, Stamm, Wt(), SuchDat, Tg, TempVerz
Dim WortN, Ersatz
'**********************************************************
' Das temporäre Arbeitsverzeichnis wird vorweg festgelegt :
' Das temp. Verzeichnis des Users verweigerte den Zugriff ?
' Vermutlich eine Abwehr evtl. " schädlicher " Programme !?
'**********************************************************
OrtP="C:\Programme\Schmelz.W"
OrtPP=OrtP&"\"&"V"&"b"&"s"&"Editor"
If not Fso.FolderExists(OrtP) then Fso.CreateFolder OrtP, true
'"true" soll evtl. Schreibschutz aushebeln, auch für Weiteres!
If not Fso.FolderExists(OrtPP) then Fso.CreateFolder(OrtPP)
TempVerz=OrtPP&"\"
Titel=" VbsEditor"
'Aufgesetzte Datei oder zurück Gemeldetes wird ermittelt:
'********************************************************
For i=0 to Arg.Count-1 'Arg.Count:Zahl aufgesetzter Arg.
Datei=Arg.Item(0)
' oder : For i=1 to Arg.Count / Datei=Arg.Item(0)
If i=1 then Start=Arg.Item(1)
If i=2 then FragZeil=Arg.Item(2)
' Leerzeilen / Leerstellen nicht möglich, s.u.
If i=3 then Frage=Arg.Item(3)
If i=4 then Neu=Arg.Item(4)
If i=5 then Plus=Arg.Item(5)
'Zu suchendes Wort / evtl. Folgebefehl nach Speichern
If i=6 then Wort=Arg.Item(6)
Next
' Arg.Item(6) ist zu suchendes Wort oder Folgebefehl ?
'*****************************************************
If Left(Wort,3)="&%;" then
Wort=Right(Wort,Len(Wort)-3)
Folge="0"
else
Folge=Wort
Wort="0"
End If
' Wort ggf. in Wort und Ersatzwort aufspalten :
'**********************************************
Lang=Len(Wort)
If (Folge="0" and Len(Wort)>1) then
For i=1 to Lang
If Mid(Wort,i,3 )="###" then
WortN=Right(Wort,Len(Wort)-i+1-3)
Wort=Left(Wort,i-1)
Ersatz="1"
End If
Next
End If
'Datei auf alte Form bringen, mit Leerstellen !
'**********************************************
For i=1 to Len(Datei)
ReDim Preserve Wt(i)
Wt(i)=Mid(Datei,i,1)
If Wt(i)=Chr(30) then Wt(i)=" "
Next
Datei=Join(Wt,"")
'Verlangtes Wort suchen und dessen Fundstellen ausgeben,
'oder das Wort mit einem gewünschten neuem Wort ersetzen
'*******************************************************
If Wort<>"0" then Suchen
'*******************************************************
Sub Suchen
Titel=" Wort in Datei suchen ! "
' Wort auf alte Form bringen, mit Leerstellen !
'**********************************************
For i=1 to Len(Wort)
ReDim Preserve Wt(i)
Wt(i)=Mid(Wort,i,1)
If Wt(i)=Chr(30) then Wt(i)=" "
Next
Wort=Join(Wt,"")
Wort=LCase(Wort)
'Vorliegende Datei öffnen und auslesen:
'**************************************
Set File=Fso.OpenTextFile(Datei,1,true)
i=1
Do until File.AtEndOfStream
ReDim Preserve Zei(i)
Zei(i)=File.ReadLine
i=i+1
Loop
Ende=i-1
File.Close
Set File=Nothing
' Suche des Wortes in den Zeilen der Datei :
'*******************************************
Hier=""
Numb="0" 'Zahl der Fundstellen
For i=1 to Ende
k=1
Do until k>Len(Zei(i))-Len(Wort)+1
If LCase(Mid(Zei(i),k,Len(Wort)))=Wort then
If Ersatz="1" then
Zei(i)=Left(Zei(i),k-1)&WortN&Right(Zei(i),Len(Zei(i))-(Len(Wort)+k-1))
End If
If Len(Hier)>0 then Hier=Hier&"|"&i
If Hier="" then Hier=i
Numb=Numb+1 'Wie oft "Wort" gefunden ?
End If
k=k+1
Loop
Next
' Falls garnichts in der Datei zu finden gewesen war :
'*****************************************************
If Hier="" then MsgBox UV&VbCR&"Das Wort "" "&_
Wort&" "" ist nicht zu finden ! "&UV&_
VbCR,VbCritical,Titel:Exit Sub 'Abbruch !
' Ggf. eine neue Datei mit dem Ersatzwort schreiben :
'****************************************************
If Ersatz="1" then
Stamm=Fso.GetParentFolderName(Datei)
DateiNeu=Stamm&"\"&Fso.GetBaseName(Datei)&"-Neu."&Right(Datei,3)
Set File=Fso.OpenTextFile(DateiNeu,2,true)
For i=1 to Ende
File.WriteLine(Zei(i))
Next
File.Close
Set File=Nothing
MsgBox UV&VbTab&"Eine neue Datei :"&UV&" "&DateiNeu&_
" "&UV&VbTab&"wurde geschrieben!"
End If
' Wenn nur Wort gesucht wird, die Fundstellen aufschreiben :
'***********************************************************
If Ersatz="0" then
'Die Zeilen mit Nr. versehen:
'****************************
For i=1 to Ende
Zei(i)=i&VbTab&Zei(i)
Next
'Die Aufsplittung der Fundorte in Ort(i), beginnend mit Ort(0)!
'**************************************************************
Ort=Split(Hier,"|")
'Ausgabedatei festlegen und gefundene Zeilen mit Nr. schreiben:
'**************************************************************
Stamm=Fso.GetParentFolderName(Datei)
DateiN=Fso.GetBaseName(Datei)&"-Such.txt"
AktVerz=Replace(Datei,Fso.GetFileName(Datei),"")
DateiN=AktVerz&DateiN
Set File=Fso.OpenTextFile(DateiN,2,true)
File.WriteLine(" ")
File.WriteLine(" Das Wort "" "&Wort&" "" steht in diesen Zeilen :")
File.WriteLine("***************************************************")
i=0
Do until i=Numb 'Beginn mit i=0 !
File.WriteLine(" ")
File.WriteLine(Zei(Ort(i)))
i=i+1
Loop
File.Close
Set File=Nothing
'Bei Sucherfolg Datei mit Zeilen-Nr. am Ende zeigen :
'****************************************************
End If
End Sub
'****************************************************
' Bei völligem Neustart des Programmes :
'***************************************
If (Arg.Count=0 or Arg.Count=1) then
Set Data=Fso.GetFolder(Left(TempVerz,Len(TempVerz)-1)).Files
For each i in Data
Fso.DeleteFile(i) ' Temporäres Verzeichnis leeren!
Next
End If
If Frage=Start then Block="1" 'Bei Blockwechsel
If Start="" then Start="1"
'******************************************************
' *
' Falls aber überhaupt garkeine Datei hier aufgesetzt *
' wurde, kann man diese jetzt im "Explorer" browsen , *
' oder nach eigenem Wunsch beliebig, neu festlegen !! *
' Da Set IE aber viel Zeit kostet, erst hier setzen ! *
' *
'******************************************************
If Datei="" then
Ask=InputBox(UV&UV&_
"Man kann eine Datei auf das Programm aufsetzen,"&UV&_
"oder im Explorer die gewünschte Datei auswählen,"&UV&_
"oder einen Ordner aussuchen für eine neue Datei !"&UV&_
"Im 1. Fall abbrechen und Drag & Drop anwenden,"&UV&_
"Dateiauswahl erfolgt mit "" 1 "", neue Datei mit "&_
""" 2""!"&UV&UV,Titel,"1")
If Ask="" then WScript.Quit ' Abbruch, wenn "Cancel"
If Ask="1" then
' Eine gewünschte Datei im Explorer aussuchen :
'**********************************************
Set IE=CreateObject("InternetExplorer.Application")
IE.Navigate("About:Blank")
IE.Document.Write"<HTML><BODY>"&_
"<INPUT ID=""Files"" Type=""File""></BODY></HTML>"
IE.Height="0" 'Muss sein, damit IE verborgen!
IE.Width="0"
IE.Visible=True
With IE.Document.All.Files
.Click
Datei= .Value
End With
IE.Quit
Set IE=Nothing
Suche="1"
If Datei="" then WScript.Quit
End If
If Ask="2" then
' Eine gewünschte, neue Datei im Explorer festlegen :
'****************************************************
Set ObF=CreateObject("Shell.Application"). _
BrowseForFolder(0,Befehl,BrowseInfo,17)
'3. Stelle: 16 für Anzeige des ausgesuchten Ordners
'4. Stelle: 17 für Arbeitsplatz, 0 wäre Desktop
On Error Resume Next 'Evtl. Fehler werden ignoriert!
Pfad=ObF.Self.Path
Set All=Nothing
If Err.Number="0" then AktVerz=Pfad
On Error GoTo 0 'Ignorieren der Fehler aufheben!
If Pfad="" then WScript.Quit
Datei=InputBox(UV&UV&VbCr&"Bitte ergänzen Sie im aus"&_
"gesuchten Ordner den "&UV&_
"Namen der von Ihnen gewünschten neuen Datei !"&UV&_
UV,Titel,Pfad&"\... .vbs, txt oder h-t-a")
If Datei = "" then WScript.Quit
'Eine Nachfrage, wenn diese Datei bereits vorhanden ist:
'*******************************************************
If Fso.FileExists(Datei) then
Ask=MsgBox(UV&UV&"Die Datei existiert bereits ! "&_
"Fortsetzen ? "&UV&_
"Sie würde sonst einfach überschrieben !"&UV&_
UV,VbCritical+VbYesNo)
If Ask="7" then WScript.Quit ' Bei Abbruch!
End If
' Diese neue Datei wird nun erstellt :
'*************************************
Set Data=Fso.CreateTextFile(Datei)
Data.WriteLine("")
Data.WriteLine("")
Data.Close
Suche="1"
End If
End If
'Falls die aufgesetzte, bestimmte Datei ungeeignet ist:
'******************************************************
Endg=LCase(Right(Datei,3))
If not (Endg="txt" or Endg="vbs" or Endg="hta") then
MsgBox UV&VbCR&_
"Die aufgesetzte Datei ist ungeeignet ! "&_
UV&VbCR,VbCritical,Titel:WScript.Quit
End If
Titel=""""&Datei&""""
' Momentanes Datum, heutiger Wochentag, Dateidaten !
'***************************************************
Tag=Weekday(Date) 'Den Wochentag bestimmen !
Select Case Tag
Case "1" Tg="Sonntag"
Case "2" Tg="Montag"
Case "3" Tg="Dienstag"
Case "4" Tg="Mittwoch"
Case "5" Tg="Donnerstag"
Case "6" Tg="Freitag"
Case "7" Tg="Samstag"
End Select
Set File=Fso.GetFile(Datei)
Gross=File.Size 'Größe der Datei in Byte
Schaffen=File.DateCreated 'Datum der "Erstellung"
Aenderg=File.DateLastModified 'Datum letzter Änderung
Zugriff=File.DateLastAccessed 'Datum letzten Zugriffes
'***************************************************
'* *
'* Falls nicht die Rückwärtsdatei schon existiert *
'* oder die aufgesetzte Datei verändert worden ist *
'* diese aufgesetzte Datei zeilenweise auslesen ! *
'* Die Zeilenlänge aber auf 100 Zeichen begrenzen, *
'* indem der Rest in Zusatzzeilen darunter kommt ! *
'* *
'***************************************************
'Hilfsdatei für die Kehrzeilen wird DateiR benannt:
'***************************************************
DateiR=TempVerz&Fso.GetBaseName(Datei)&_
"-Rueck."&Endg
If not Fso.FileExists (DateiR) or Neu="1" then
'############################################## s.u.
Set File=Fso.OpenTextFile(Datei,1,true)
NochA="0" 'Zahl aller Zusatzzeilen
i=1
Do until File.AtEndOfStream
ReDim Preserve Zeile(i)
ReDim Preserve UrZeile(i)
Zeile(i)=File.ReadLine 'Zeilen von "Datei" lesen
UrZeile(i-NochA)=Zeile(i) 'Urzeilen zurücklegen
' Alle Nr. auf gleiche Länge bringen:
'************************************
Nr=i-NochA
If Len(Nr)=1 then Nr="000"&Nr
If Len(Nr)=2 then Nr="00"&Nr
If Len(Nr)=3 then Nr="0"&Nr
Zeile(i)=Nr&" "&Zeile(i)
Noch="0" ' Zusatzzeilen dieser Zeile(i)
'Falls Zeile zu lang ist, in Zusatzzeilen aufteilen:
'***************************************************
If Len(Zeile(i))>100 then ' <<<<<<<<<<<<<< s.u.
Rest=Zeile(i)
Zeile(i)=Left(Zeile(i),100)
Rest=Right(Rest,Len(Rest)-100) 'Zeilenrest
If Rest<>"" then
k=i
Do
k=k+1
ReDim Preserve Zeile(k)
If Len(Rest)<=100 then
Zeile(k)=" "&Rest
Rest=""
else
Zeile(k)=" "&Left(Rest,100)
Rest=Right(Rest,Len(Rest)-100) 'Zeilenrest
End If
Noch=1+Noch
Loop until Rest=""
End If
End If ' <<<<<<<<<<<<<< s.o.
NochA=NochA+Noch 'Zahl bisheriger Zusatzzeilen
i=i+1+Noch 'Zahl aller bisheriger Zeilen
Loop
Ende=i-1 'Die Zahl aller dieser Zeilen
File.Close
Set File=Nothing
'******************************************************
' *
' Beim Neustart die Textzeile in die 1. Zeile setzen: *
' *
'******************************************************
If not Fso.FileExists(DateiR) then
FragZeil=UrZeile(1)
' In dieser "FragZeil" die " " " mit "" " ersetzen :
'*******************************************************
i=1
Do until Mid(FragZeil,i,1)=""
If Mid(FragZeil,i,1)="""" then
FragZeil=Left(FragZeil,i-1)&"""&_
Right(FragZeil,Len(FragZeil)-i)
i=i+1
End If
i=i+1
Loop
End If
'Zusatzzeilen hier definieren, aber erst später festlegen:
'*********************************************************
For i=1 to Ende
ReDim Preserve ZeilPlus(i)
ZeilPlus(i)="0"
Next
' Die Anführungsstriche " in den Zeilen sind zu verdoppeln,
' ist zum Schreiben der " H-t-a " - Datei unbedingt nötig !
'**********************************************************
For i=1 to Ende
Doppel="0" 'Zahl der Verdoppelungen
k=1
Do until k=Len(Zeile(i))+1+Doppel
If Mid (Zeile(i),k,1)="""" then
Zeile(i)=Left(Zeile(i),k)&""""&_
Right(Zeile(i),Len(Zeile(i))-k)
Doppel=1+Doppel
k=k+1
End If
k=k+1
Loop
Next
'***********************************************************
'* *
'* Da Hta - Programmteile wie Input - Fenster und Radio - *
'* Button - statt nur angezeigt - ausgeführt werden, ergab *
'* sich Chaos. So werden alle Zeilen rückwärts geschrieben *
'* an "DateiZ" übergeben. Da werden sie wieder umgekehrt!! *
'* *
'***********************************************************
For i=1 to Ende
ReDim Preserve Zeilen(i)
Zeilen(i)=Zeile(i)
Zeile(i)=""
Next
For i=1 to Ende
For k=1 to Len(Zeilen(i))
Zeile(i)=Zeile(i)&Mid(Zeilen(i), _
Len(Zeilen(i))+1-k,1)
Next
Next
'***********************************************************
' *
' Die DateiR schreiben ( die rückwärts geschriebene aufge- *
' setzte Datei ) damit diese nicht laufend umzukehren ist! *
' *
'***********************************************************
On Error Resume Next
' Bei H-t-a - Dateien traten teilweise Probleme auf !?
Set Abcd=Fso.CreateTextFile(DateiR,true)
For n=1 to Ende
Abcd.WriteLine(Zeile(n))
Next
Abcd.Close
Set Abcd=Nothing
On Error GoTo 0
End If
'############################# s.o.
'**************************************************************
' Folg. Abschnitt wird nur bei wiederholten Aufrufen gestartet:
'**************************************************************
If (Fso.FileExists(DateiR) and not Start="") then
'Diese rückwärts geschriebene Datei: " DateiR " jetzt auslesen:
'**************************************************************
Set Data=Fso.OpenTextFile(DateiR,1,true)
NochA="0"
Frage=CInt(Frage) ' Gefragte Zeile rückwärts schreiben, suchen!
If Len(Frage)="1" then Frage="000"&Frage
If Len(Frage)="2" then Frage="00"&Frage
If Len(Frage)="3" then Frage="0"&Frage
FrageRev=Right(Frage,1)&Mid(Frage,3,1)&Mid(Frage,2,1)&Left(Frage,1)
k="0"
i=1
Do until Data.AtEndOfStream
ReDim Preserve Zeile(i)
ReDim Preserve Zeil(i)
ReDim Preserve ZeilPlus(i)
Zeile(i)=Data.ReadLine 'Zeilen von "DateiR" lesen
If Right(Zeile(i),4)=FrageRev then FrageKorr=i
'Beim Blockwechsel : " Frage " hat keine Zeilenverschiebung:
'***********************************************************
If CInt(Start)=i then NochB=NochA
If (CInt(Start)=i-1 and Block="1" and Right(Zeile(i-1),7) _
<>";061#& " and i>=2) then Frage=Frage-NochB
If (CInt(Start)=i-1 and Block="1" and Right(Zeile(i-1),7) _
=";061#& " and i>=2) then
Frage=Frage-NochB+1
Dazu="2"
If Right(Zeile(i),7)=";061#& " then
Frage=1+Frage
Dazu="4"
End If
End If
'Eine Korrektur der Zeilenzahl bei " überlangen " Zeilen:
'********************************************************
If Right(Zeile(i),7)=";061#& " then NochA=1+NochA
ZeilPlus(i)=NochA ' Zahl der Zusatzzeilen
Zeil(i)=Zeile(i)
i=i+1
Loop
Ende=i-1
Data.Close
Set Data = Nothing
' Beim Blockwechsel die Textzeile an den Anfang setzen :
'*******************************************************
If Block="1" then FrageKorr=CInt(Start)+CInt(Dazu)
' Falls eine neue Zeile für das Textfeld bestimmt wurde ,
' dann diese rückwärts geschriebene Zeile auch umkehren :
'********************************************************
If FragZeil="&&&###;;;" then 'Merkmal für neue Textzeile
' Die Zusatzzeilen sind nun wieder aneinander zu setzen,
' dabei sind auch die Nummern der Zeilen zu korrigieren !
'********************************************************
Doppel="0"
For k=1 to Ende
If Right(Zeile(k),35)=";061#& ;061#& ;061#& ;061#& ;061#& " then
Zeil(k-1-Doppel)=Left(Zeile(k),Len _
(Zeile(k))-35)&Zeil(k-1-Doppel)
Doppel=1+Doppel
else
Zeil(k-Doppel)=Zeile(k)
End If
Next
'Die neue Textzeile rückwärts, d.h. richtig schreiben:
'*****************************************************
FragZeil=Left(Zeil(Frage),Len(Zeil(Frage))-10)
For k=1 to Len(FragZeil)
FragZei=FragZei&Mid(FragZeil,Len(FragZeil)+1-k,1)
Next
FragZeil=FragZei
' In der neuen Zeile die " mit " " " ersetzen :
'**************************************************
i=1
Do until Mid(FragZeil,i,1)=""
If Mid(FragZeil,i,2)="""""" then
FragZeil=Left(FragZeil,i-1)&"""&_
Right(FragZeil,Len(FragZeil)-i-1)
i=i+1
End If
i=i+1
Loop
End If
End If
'****************************************************************
' *
' Die Leerstellen in "FragZeil" müssen unbedingt mit " " *
' ersetzt werden, sonst ist FragZeil bei "Weiter" oder "Zurück" *
' nicht übermittelbar, denn im Übermittelten sind " " verboten! *
' *
'****************************************************************
If FragZeil<>"" then
i=1
Do until Mid(FragZeil,i,1)=""
If Mid(FragZeil,i,1)=" " then
FragZeil=Left(FragZeil,i-1)&" "&_
Right(FragZeil,Len(FragZeil)-i )
End If
i=i+1
Loop
End If
' Bei ihrem Aufruf vor die Textzeile immer 10 Zeilen setzen :
'************************************************************
If Plus="1" then Start=FrageKorr-10
If Start<1 then Start="1"
'##############################################################
'# #
'# #
'# H-t-a-Datei zur Anzeige des gewünschten Blockes schreiben: #
'# #
'# #
'##############################################################
DateiZ=TempVerz&"DateiZeigen."&"h"&"t"&"a"
DateiOld=Fso.GetFileName(Datei)
DateiOld=Left(DateiOld,Len(DateiOld)-4)&"Old"&Right(DateiOld,4)
DateiOld=TempVerz&DateiOld 'Sicherungsdatei1
DateiNeu=Fso.GetFileName(Datei)
DateiNeu=Left(DateiNeu,Len(DateiNeu)-4)&"Neu"&Right(DateiNeu,4)
DateiNeu=TempVerz&DateiNeu 'Sicherungsdatei2
'Vorige Version von DateiZ löschen, wenn noch vorhanden:
'*******************************************************
On Error Resume Next
If Fso.FileExists(DateiZ) then Fso.DeleteFile(DateiZ)
On Error GoTo 0
' Datei "DateiZ" ist jedes Mal völlig neu zu schreiben :
'*******************************************************
If not Fso.FileExists(DateiZ) then
'Nur bei Neustart die Frage links oben als 0001 setzen :
'*******************************************************
If (Arg.Count="1" or Suche="1") then Frage="0001"
Set F=Fso.CreateTextFile(DateiZ)
F.WriteLine(" <Html> ")
F.WriteLine(" <Head> ")
F.Write(" <Hta:Application Id=""OHTA"" Border=""Yes""")
F.WriteLine(" InnerBorder=""Yes"" Scroll=""No""> ")
F.WriteLine(" <Style Type=""Text/Css""> ")
F.Write(" TD{Font-Size:12Pt;Color:Black; ")
F.WriteLine(" Font-Style:Bold;Font-Family:Arial} ")
F.Write(" Input{Font-Size:11pt;Color:Black; ")
F.WriteLine(" Font-Style:Bold;Font-Family:Arial} ")
F.WriteLine(" </Style> ")
F.WriteLine(" <Script Language=""VBScript""> ")
F.WriteLine(" Set Wss=CreateObject(""Wscript.Shell"") ")
F.WriteLine(" Set Fso=CreateObject(""Scripting.FileSystemObject"") ")
F.WriteLine(" Dim Start, Ende, XYZ, UV,Datei1, Datei2,DateiZ,Txt() ")
F.WriteLine(" Dim Zahl, Neues, Frage, Anders, Wrt(), Stoppen, Plus ")
F.WriteLine(" Dim Nichts, FrageKorr, Reihe(), LeerZ, Zeile(),Datei ")
F.WriteLine(" Dim DateiOld, Anzahl, NeuD, DateiNeu, Nein,Schluss,Fso")
F.WriteLine(" Dim Tg, Bis, NochA, Aenderg, Gross, Test, Verschd,Flg")
F.WriteLine(" Dim TempVerz, Oben, Unten, Befehl, Folge, No, Spch,Wss")
F.WriteLine(" UV=VbCR&VbCR ")
F.WriteLine(" Plus=""0"" ")
F.WriteLine(" Verschd=""0"" ")
F.WriteLine(" NeuD=""0"" ")
F.WriteLine(" Flg=""0"" ")
F.WriteLine(" Stoppen=""0"" ")
F.WriteLine(" Folge="""&Folge&""" ")
F.WriteLine(" If Folge<>""0"" then Flg=""1"" ")
F.WriteLine(" XYZ="" "" ")
F.WriteLine(" Datei="""""""&Datei&""""""" ") 'Sonderzeichen?
F.WriteLine(" Datei0="""""""&Datei0&""""""" ")
F.WriteLine(" DateiR="""""""&DateiR&""""""" ")
F.WriteLine(" DateiOld="""""""&DateiOld&""""""" ")
F.WriteLine(" DateiNeu="""""""&DateiNeu&""""""" ")
' Inhalt der angezeigten Textzeile rückwärts schreiben :
'*******************************************************
FragZeiln=FragZeil
FragZeil=""
For k=1 to Len(FragZeiln)
FragZeil=FragZeil&Mid(FragZeiln,Len(FragZeiln)+1-k,1)
Next
F.WriteLine(" FragZeil="""&FragZeil&""" ")
F.WriteLine(" TempVerz="""&Left(TempVerz,Len(TempVerz)-1)&""" ")
F.WriteLine(" DateiZ=TempVerz&""\DateiZeigen.""&""h""&""t""&""a"" ")
F.WriteLine(" Start="""&Start&""" ")
F.WriteLine(" Anfang="""&Anfang&""" ")
F.WriteLine(" Anders=""0"" ")
F.WriteLine(" Ende="""&Ende&""" ")
F.WriteLine(" NochA="""&NochA&""" ")
F.WriteLine(" Frage="""&Frage&""" ")
F.WriteLine(" FrageKorr="""&FrageKorr&""" ")
F.WriteLine(" Zeit1="""&Zeit1&""" ")
F.WriteLine(" Tg="""&Tg&""" ")
F.WriteLine(" Gross="""&Gross&""" ")
F.WriteLine(" Aenderg="""&Aenderg&""" ")
F.WriteLine(" Window.ResizeTo 1000,730 ")
F.WriteLine(" Window.MoveTo 0,0 ")
' Evtl. Folgebefehl nach Speichern schreiben :
'*********************************************
If Folge<>"0" then
F.WriteLine( " "&Folge )
F.WriteLine( " Folge=""0"" " )
End If
Folge="0" ' Folgebefehl zurück setzen
' Es folgen jetzt die sämtlichen Sub - Prgramme :
'§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Beginn ")
F.WriteLine(" ")
F.WriteLine(" If CInt(Start)=""1"" then Exit Sub ") 'Abbruch!
F.WriteLine(" ")
F.WriteLine("Befehl=""Beginn"" ")' Evtl. Folgebefehl
' Textzeile geändert? Bei Folgebefehl abbrechen :
F.WriteLine(" Aendrg ")
F.WriteLine(" If CInt(Stoppen)=""1"" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Start=""1"" ") ' An den Beginn gehen !
F.WriteLine(" Frage=""15"" ")
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Zurueck ")
F.WriteLine(" ")
F.WriteLine(" If CInt(Start)=""1"" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Befehl=""Zurueck"" ")'Evtl. Folgebefehl
' Textzeile geändert? Bei Folgebefehl abbrechen :
F.WriteLine(" Aendrg ")
F.WriteLine(" If CInt(Stoppen)=""1"" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" If CInt(Start)<>""1"" then ")
F.WriteLine(" Start=Start-30 ")
F.WriteLine(" else ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" Frage=Start ") 'Textzeile an den Anfang setzen
F.WriteLine(" If CInt(Frage)<1 then Frage=""1"" ")
F.WriteLine(" If CInt(Start)<1 then Start=""1"" ") 'Notbremse
F.WriteLine(" ")
F.WriteLine(" Ruf ") 'Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Weiter ")
F.WriteLine(" ")
F.WriteLine(" If CInt(Start)+29>=CInt(Ende) then Exit Sub")'Abbruch!
F.WriteLine(" ")
F.WriteLine(" Befehl=""Weiter"" ") 'Evtl. Folgebefehl
' Textzeile geändert? Bei Folgebefehl abbrechen :
F.WriteLine(" Aendrg ")
F.WriteLine(" If CInt(Stoppen)=""1"" then Exit Sub ")
F.WriteLine(" If CInt(Start)+30<CInt(Ende) then ")
F.WriteLine(" Start=Start+30 ")
F.WriteLine(" else ")
F.WriteLine(" Start=Start ") 'Textzeile an Anfang
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" Frage=Start ")
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Grenze ")
F.WriteLine(" ")
F.WriteLine(" If CInt(Start)+29>=CInt(Ende) then Exit Sub")'Abbruch!
F.WriteLine(" " )
F.WriteLine(" Befehl=""Grenze"" ")' Evtl. Folgebefehl
' Textzeile geändert? Bei Folgebefehl abbrechen :
F.WriteLine(" Aendrg ")
F.WriteLine(" If CInt(Stoppen )=""1"" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Start=CInt(Ende)-17 ")
F.WriteLine(" Frage=CInt(Ende)-CInt(NochA) ")'Letzte Zeile rufen!
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" " )
F.WriteLine(" Sub Oeffnen ")
F.WriteLine(" ")
F.WriteLine(" Set IE=CreateObject(""InternetExplorer.Application"") ")
F.WriteLine(" IE.Navigate(""About:Blank"") ")
F.Write(" IE.Document.Write ""<HTML><BODY><INPUT ID= ")
F.WriteLine(" """"Files"""" Type=""""File""""></BODY></HTML>"" ")
F.WriteLine(" IE.Height=""0"" 'Muss sein, damit IE verborgen! ")
F.WriteLine(" IE.Width=""0"" ")
F.WriteLine(" IE.Visible=True ")
F.WriteLine(" ")
F.WriteLine(" With IE.Document.All.Files ")
F.WriteLine(" .Click ")
F.WriteLine(" DatN= .Value ")
F.WriteLine(" End With ")
F.WriteLine(" ")
F.WriteLine(" IE.Quit ")
F.WriteLine(" Set IE=Nothing ")
F.WriteLine(" ")
F.WriteLine(" If DatN="""" then Exit Sub ") 'Bei Abbruch !
F.WriteLine(" Wss.Run ""Notepad """"""&DatN&"""""" "" ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" " )
F.WriteLine(" Sub DatNeu ")
F.WriteLine(" " )
F.WriteLine(" Nein=""0"" ")
F.WriteLine(" NeuD=""1"" ")
F.WriteLine(" Speichern ") 'Jetzigen Zustand speichern !
F.WriteLine(" If Nein=""1"" then Exit Sub ")
F.WriteLine(" " )
F.WriteLine(" DateiNeu=TempVerz&""\DatNeu.txt"" ")
F.WriteLine(" ")
F.WriteLine(" Set Data=Fso.CreateTextFile(DateiNeu) ")
F.WriteLine(" Data.WriteLine("""") ")
F.WriteLine(" Data.WriteLine("""") ")
F.WriteLine(" Data.Close ")
F.WriteLine(" Set Data=Nothing ")
F.WriteLine(" ")
F.WriteLine(" Start=""1"" ")
F.WriteLine(" Wss.Run Datei0&"" ""&DateiNeu&"" ""&Start ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub NeuZeile ")
F.WriteLine(" ")
F.WriteLine(" Befehl="""" ") ' Evtl. Folgebefehl
' Textzeile geändert? Bei Folgebefehl abbrechen :
F.WriteLine(" Aendrg ")
F.WriteLine(" ")
F.WriteLine(" Frage=CInt(Document.All.ZeilNr.Value) ")
F.WriteLine(" ")
F.WriteLine(" 'Den jetzigen Zustand dieser Datei sichern: ")
F.WriteLine(" '****************************************** ")
F.Write(" If Left(Datei,1)="""""""" then ")
F.WriteLine(" Datei=Mid(Datei,2,Len(Datei)-2) ")
F.Write(" If Left(DateiOld,1)="""""""" then ")
F.WriteLine(" DateiOld=Mid(DateiOld,2,Len(DateiOld)-2) ")
F.WriteLine(" Fso.CopyFile Datei,DateiOld ")
F.WriteLine(" ")
F.WriteLine(" 'Eine Leerzeile soll jetzt eingefügt werden: ")
F.WriteLine(" '******************************************* ")
F.WriteLine(" ReDim Preserve Reihe(Frage+1) ")
F.WriteLine(" Reihe(Frage+1)="""" ")
F.WriteLine(" Anzahl=""1"" ")
F.WriteLine(" LeerZ=""1"" ")
F.WriteLine(" ")
F.WriteLine(" Schreib ' Änderungen schreiben !")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Ram ")
F.WriteLine(" ")
F.WriteLine(" Frage=CInt(Document.All.ZeilNr.Value) ")
F.WriteLine(" ")
F.WriteLine(" Befehl="""" ") ' Evtl. Folgebefehl
' Textzeile geändert? Bei Folgebefehl abbrechen :
F.WriteLine(" Aendrg ")
F.WriteLine(" ")
F.WriteLine(" 'Jetzigen Zustand dieser Datei sichern: ")
F.WriteLine(" '************************************** ")
F.Write(" If Left(Datei,1)="""""""" then ")
F.WriteLine(" Datei=Mid(Datei,2,Len(Datei)-2) ")
F.Write(" If Left(DateiOld,1)="""""""" then ")
F.WriteLine(" DateiOld=Mid(DateiOld,2,Len(DateiOld)-2) ")
F.WriteLine(" Fso.CopyFile Datei,DateiOld ")
F.WriteLine(" ")
F.WriteLine("'Einen ausgelagerten Text aus dem Clipboard holen: ")
F.WriteLine("'************************************************* ")
F.WriteLine(" On Error Resume Next ' Fehlermeldungen unterdrücken ")
F.WriteLine(" Set Obj=CreateObject(""InternetExplorer.Application"") ")
F.WriteLine(" Obj.Navigate(""About:Blank"") 'Leere Seite verbergen! ")
F.Write(" Lesen=Obj.Document.ParentWindow." )
F.WriteLine(" ClipBoardData.GetData(""Text"") " )
F.WriteLine(" Obj.Quit 'IE schließen ! ")
F.WriteLine(" Set Obj=Nothing ")
F.WriteLine(" ")
F.WriteLine(" 'Inhalt des Clipboard zeilenweise auslesen: ")
F.WriteLine(" '****************************************** ")
F.WriteLine(" Anzahl=""1"" ")
F.WriteLine(" If Len(Lesen)>=2then ")
F.WriteLine(" For i=1 to Len(Lesen)-2 ")
F.WriteLine(" If Mid(Lesen,i,2)=Chr(13)&Chr(10) then Anzahl=1+Anzahl ")
F.WriteLine(" Next ")
F.WriteLine(" else ")
F.WriteLine(" MsgBox VbCR&"" Der Textspeicher ist leer ! "" ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" " )
F.WriteLine(" Reih=Split(Lesen,Chr(13)&Chr(10)) 'Beginn bei 0! " )
F.WriteLine(" For i=1 to Anzahl " )
F.WriteLine(" ReDim Preserve Reihen(i) ")
F.WriteLine(" Reihen(i)=Reih(i-1) ")
F.WriteLine(" Next ")
F.WriteLine(" ")
F.WriteLine(" 'Bei Kopie aus diesem Editor die Zahlen entfernen: ")
F.WriteLine(" '************************************************* ")
F.Write(" If (Asc(Mid(Reihen(1),1,1))>47 and ")
F.Write(" Asc(Mid(Reihen(1),1,1))<58 and ")
F.Write(" Asc(Mid(Reihen(1),2,1))>47 and ")
F.Write(" Asc(Mid(Reihen(1),2,1))<58 and ")
F.Write(" Asc(Mid(Reihen(1),3,1))>47 and ")
F.Write(" Asc(Mid(Reihen(1),3,1))<58 and ")
F.Write(" Asc(Mid(Reihen(1),4,1))>47 and ")
F.Write(" Asc(Mid(Reihen(1),4,1))<58 and ")
F.WriteLine(" Mid(Reihen(1),5,1)="" "") then ")
F.WriteLine(" For i=1 to Anzahl ")
F.WriteLine(" Reihen(i)= Right(Reihen(i),Len(Reihen(i))-5) ")
F.WriteLine(" Next ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" 'Reihe(Frage+1)-Reihe(Frage+Anzahl) festlegen: ")
F.WriteLine(" '********************************************* ")
F.WriteLine(" For i=1 to Anzahl ")
F.WriteLine(" ReDim Preserve Reihe(i+Frage) ")
F.WriteLine(" Reihe(i+Frage)=Reihen(i) ")
F.WriteLine(" Next ")
F.WriteLine(" On Error GoTo 0 'Fehlermeldung wieder einschalten ")
F.WriteLine(" " )
F.WriteLine(" Schreib ' Änderungen in Datei schreiben! ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Objkt ")
F.WriteLine(" ")
F.WriteLine(" Frage=CInt(Document.All.ZeilNr.Value) ")
F.WriteLine(" ")
F.WriteLine(" Befehl="""" ") ' Evtl. Folgebefehl
' Textzeile geändert? Bei Folgebefehl abbrechen :
F.WriteLine(" Aendrg ")
F.WriteLine(" ")
F.WriteLine(" If Right(Frage,1)=""X"" then ")
F.WriteLine(" MsgBox UV&""Links oben steht keine Nummer !""&_ ")
F.WriteLine(" "" ""&UV,VbCritical ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" 'Jetzigen Zustand dieser Datei sichern: ")
F.WriteLine(" '************************************** ")
F.Write(" If Left(Datei,1)="""""""" then ")
F.WriteLine(" Datei=Mid(Datei,2,Len(Datei)-2) ")
F.Write(" If Left(DateiOld,1)="""""""" then ")
F.WriteLine(" DateiOld=Mid(DateiOld,2,Len(DateiOld)-2 ) ")
F.WriteLine(" Fso.CopyFile(Datei),(DateiOld) ")
F.WriteLine(" ")
F.WriteLine(" 'Objekte oder Programm - Teile einfügen : ")
F.WriteLine(" '**************************************** ")
F.WriteLine(" 'Reihe(Frage+1) bis Reihe(Frage+15) festlegen: ")
F.WriteLine(" For i=1 to 15 ")
F.WriteLine(" ReDim Preserve Reihe(Frage+i) ")
F.WriteLine(" Next ")
F.WriteLine(" Ask=InputBox(UV&""Welches Objekt oder Teil - Programm sol""&_ ")
F.WriteLine(" ""l nach""&VbCR&"""""" Nr. """" eingefügt werden?""&UV&VbCR&_ ")
F.WriteLine(" ""1 = Fso und Wss""&UV&""2 = Arg ( Drag & Drop )""&UV&_")
F.WriteLine(" ""3 = Ordner auswählen""&UV&""4 = Datei auswählen""&_ ")
F.WriteLine(" UV&""5 = Datei aufrufen und Teile mit Strg + C in""&VbCR&_ ")
F.WriteLine(" "" Zwischenspeicher nehmen""&UV,"" Objektauswahl"")")
F.WriteLine(" If Ask="""" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Select Case Ask ")
F.WriteLine(" Case ""1"" ")
F.WriteLine(" Anzahl=""2"" ")
F.Write(" Reihe(Frage+1)=""Set Fso=WScript.CreateObject ")
F.WriteLine(" (""""Scripting.FileSystemObject"""")"" ")
F.Write(" Reihe(Frage+2)=""Set Wss=WScript.CreateObject ")
F.WriteLine(" (""""WScript.Shell"""")"" ")
F.WriteLine(" ")
F.WriteLine(" Case ""2"" ")
F.WriteLine(" Anzahl=""4"" ")
F.WriteLine(" Reihe(Frage+1)=""Set Arg=Wscript.Arguments"" ")
F.WriteLine(" Reihe(Frage+2)=""If Arg.Count>0 then Datei=Arg(0)"" ")
F.Write(" Reihe(Frage+3)=""If Datei="""""""" then MsgBox UV&")
F.WriteLine("VbCR&"""" Bitte Datei""""&_"" ")
F.Write(" Reihe(Frage+4)="""""" aufsetzen! """"")
F.WriteLine("&UV&VbCR:WScript.Quit"" ")
F.WriteLine(" ")
F.WriteLine(" Case ""3"" ")
F.WriteLine(" Anzahl=""8"" ")
F.Write(" Reihe(Frage+1)=""Set Shl=CreateObject ")
F.WriteLine(" (""""Shell.Application"""")"" ")
F.Write(" Reihe(Frage+2)=""Set ObF=Shl.BrowseForFolder ")
F.WriteLine(" (0,StrPrompt,BrowseInfo,Root)"" ")
F.WriteLine(" Reihe(Frage+3)=""On Error Resume Next"" ")
F.WriteLine(" Reihe(Frage+4)=""Err.Clear"" ")
F.WriteLine(" Reihe(Frage+5)=""Pfad=ObF.Self.Path"" ")
F.WriteLine(" Reihe(Frage+6)=""If Err.Number>0 then WScript.Quit"" ")
F.WriteLine(" Reihe(Frage+7)=""Set All=Nothing"" ")
F.WriteLine(" Reihe(Frage+8)=""On Error GoTo 0'Ignorierung weg !"" ")
F.WriteLine(" ")
F.WriteLine(" Case ""4"" ")
F.WriteLine(" Anzahl=""13"" ")
F.Write(" Reihe(Frage+1)=""Set IE=CreateObject ")
F.WriteLine(" (""""InternetExplorer.Application"""")"" ")
F.WriteLine(" Reihe(Frage+2)=""IE.Navigate(""""About:Blank"""")"" ")
F.WriteLine(" Reihe(Frage+3)=""IE.Document.Write""""<HTML>""""&_"" ")
F.Write(" Reihe(Frage+4)="" """"<BODY><INPUT ID=""""""""")
F.WriteLine(" Files"""""""" Type=""""""""File""""""""></BODY></HTML>""""""")
F.Write(" Reihe(Frage+5)=""IE.Height=""""0"""" ")
F.WriteLine(" 'Muss sein, damit IE verborgen!"" ")
F.WriteLine(" Reihe(Frage+6)=""IE.Width=""""0"""""" ")
F.WriteLine(" Reihe(Frage+7)=""IE.Visible=True"" ")
F.WriteLine(" Reihe(Frage+8)=""With IE.Document.All.Files"" ")
F.WriteLine(" Reihe(Frage+9)="" .Click"" ")
F.WriteLine(" Reihe(Frage+10)=""Datei= .Value"" ")
F.WriteLine(" Reihe(Frage+11)=""End With"" ")
F.WriteLine(" Reihe(Frage+12)=""IE.Quit"" ")
F.WriteLine(" Reihe(Frage+13)=""Set IE=Nothing"" ")
F.WriteLine(" ")
F.WriteLine(" Case ""5"" ")
F.WriteLine(" Oeffnen ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Case else ")
F.WriteLine(" MsgBox UV&"" Ungeeignete Eingabe! ""&UV ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End Select ")
F.WriteLine(" ")
F.WriteLine(" Schreib ' Änderungen in Datei schreiben ! ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Druckn ")
F.WriteLine( " " )
F.WriteLine( " ' ""Datei"" öffnen, drucken, schließen :" )
F.WriteLine( " '***************************************" )
F.WriteLine( " Lang=Len(Fso.GetFileName(Datei))" )
F.WriteLine( " Programm=""Notepad.exe"" " )
F.WriteLine( " Wss.Run Programm&"" ""&Datei" )
F.Write( " Ask = Wss.Popup (UV&""Ist der Drucker bereit ? ""& " )
F.WriteLine( " UV,5,,VbInformation+VbOkCancel+VbSystemModal) ")
F.WriteLine(" If Ask=""1"" then ")
F.WriteLine( " Wss.Sendkeys ""^{p}"" 'Strg+P? P ergibt Fehler!?" )
F.WriteLine( " Wss.Sendkeys ""{Enter}""" )
F.Write( " Wss.Popup UV&""Ist der Drucker fertig ? ""& " )
F.WriteLine( " UV,10,,VbInformation+VbSystemModal ")
F.WriteLine( " End If" )
F.WriteLine( " " )
F.WriteLine( " ' Mit ""Notepad.exe"" geöffnete Dateien:" )
F.WriteLine( " '**************************************" )
F.WriteLine( " Set ObjWinGm=GetObject(""WinmGmts:{ImpersonationLevel=""&_ " )
F.WriteLine( " ""Impersonate}!\\.\Root\Cimv2"" )" )
F.WriteLine( " Set Prozesse=ObjWinGm.ExecQuery(""Select * from ""&_ " )
F.WriteLine( " ""Win32_Process where name like '""&Programm&""'"") " )
F.WriteLine( " " )
F.WriteLine( " ' Zum Drucken geöffnete Datei schließen: " )
F.WriteLine( " '*************************************** " )
F.WriteLine( " For each ObjItem in Prozesse " )
F.WriteLine( " If Right(ObjItem.CommandLine,Lang)= _ " )
F.WriteLine( " Fso.GetFileName(Datei) then ObjItem.Terminate " )
F.WriteLine( " Next " )
F.WriteLine( " " )
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Lies ")
F.WriteLine(" ")
F.WriteLine(" Set Data=Fso.OpenTextFile("""&Datei&""") ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until Data.AtEndOfStream ")
F.WriteLine(" ReDim Preserve Zeile(i) ")
F.WriteLine(" Zeile(i)=Data.ReadLine ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" Data.Close ")
F.WriteLine(" Zahl=i-1 ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Schreib0 ")
F.WriteLine(" ")
F.Write(" If Left(Datei,1)="""""""" then ")
F.WriteLine(" Datei=Mid(Datei,2,Len(Datei)-2) ")
F.WriteLine(" ")
F.WriteLine(" Set Data=Fso.CreateTextFile(Datei) ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until i>Zahl+Anzahl ")
F.WriteLine(" Data.WriteLine(Zeile(i)) ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" Data.Close ")
F.WriteLine(" Set Data=Nothing ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Schreib ")
F.WriteLine(" ")
F.WriteLine(" 'Alte Datei auslesen und Zeilen abändern: ")
F.WriteLine(" '**************************************** ")
F.WriteLine(" Lies ")
F.WriteLine(" ")
F.WriteLine(" 'Leerzeile, Fso/Wss oder Ram-Inhalt einfügen: ")
F.WriteLine(" '******************************************** ")
F.WriteLine(" For k=1 to Anzahl ' Zusätzliche Zeilen def. ")
F.WriteLine(" ReDim Preserve Zeile(Zahl+k) ")
F.WriteLine(" Next ")
F.WriteLine(" ")
F.WriteLine(" 'Zeilen hinter dem neuen Teil weiterrücken: ")
F.WriteLine(" '****************************************** ")
F.WriteLine(" i=CInt(Zahl)+CInt(Anzahl) ")
F.WriteLine(" Do until i=CInt(Frage)+CInt(Anzahl) ")
F.WriteLine(" Zeile(i)=Zeile(i-CInt(Anzahl)) ")
F.WriteLine(" i=i-1 ")
F.WriteLine(" Loop ")
F.WriteLine(" 'Die neuen Zeilen werden jetzt eingerückt: ")
F.WriteLine(" '***************************************** ")
F.WriteLine(" For i=1 to Anzahl ")
F.WriteLine(" Zeile(Frage+i)=Reihe(Frage+i) ")
F.WriteLine(" Next ")
F.WriteLine(" ")
F.WriteLine(" 'Die neue Datei schreiben und dann aufrufen: ")
F.WriteLine(" '******************************************* ")
F.WriteLine(" Schreib0 ")
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Loeschen ")
F.WriteLine(" ")
F.WriteLine(" Frage=CInt(Document.All.ZeilNr.Value) ")
F.WriteLine(" If Frage=""1"" then ")
F.WriteLine(" MsgBox VbCR&"" Die erste Zeile ist nicht zu löschen ! "" ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" If Frage=Ende-NochA then ")
F.WriteLine(" MsgBox VbCR&"" Die letzte Zeile ist nicht zu löschen ! """)
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" 'Jetzigen Zustand der Datei sichern: ")
F.WriteLine(" '*********************************** ")
F.Write(" If Left(Datei,1)="""""""" then ")
F.WriteLine(" Datei=Mid(Datei,2,Len(Datei)-2)")
F.Write(" If Left(DateiOld,1)="""""""" then ")
F.WriteLine(" DateiOld=Mid(DateiOld,2,Len(DateiOld)-2) ")
F.WriteLine(" Fso.CopyFile Datei,DateiOld ")
F.WriteLine(" ")
F.WriteLine(" 'Alte Datei auslesen und Zeilen abändern: ")
F.WriteLine(" '**************************************** ")
F.WriteLine(" Lies ")
F.WriteLine(" ")
F.WriteLine(" 'Eine bestimmte Zeile soll gelöscht werden: ")
F.WriteLine(" '****************************************** ")
F.WriteLine(" For i=Frage to (Zahl-1) ")
F.WriteLine(" Zeile(i)=Zeile(i+1) ")
F.WriteLine(" Next ")
F.WriteLine(" ")
F.WriteLine(" 'Datei neu schreiben und dabei abändern: ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" Zahl=Zahl-1 ")
F.WriteLine(" Schreib0 ")
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" " )
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Return ")
F.WriteLine(" ")
F.Write(" If Left(DateiOld,1)="""""""" then ")
F.WriteLine(" DateiOld=Mid(DateiOld,2,Len(DateiOld)-2) ")
F.WriteLine(" If not Fso.FileExists(DateiOld) then ")
F.WriteLine(" MsgBox VbCR&"" Die Datei wurde nicht geändert ! "" ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.Write(" If Left(DateiNeu,1)="""""""" then ")
F.WriteLine(" DateiNeu=Mid(DateiNeu,2,Len(DateiNeu)-2) ")
F.WriteLine(" If not Fso.FileExists(DateiOld) then Exit Sub ")
F.Write(" If Left(Datei,1)="""""""" then ")
F.WriteLine(" Datei=Mid(Datei,2,Len(Datei)-2) ")
F.WriteLine(" ")
F.WriteLine(" 'Widerruf auch wieder rückgängig machen können: ")
F.WriteLine(" '********************************************** ")
F.WriteLine(" Fso.CopyFile Datei,DateiNeu,true ")
F.WriteLine(" Fso.CopyFile DateiOld,Datei,true ")
F.WriteLine(" Fso.DeleteFile DateiOld,true ")
F.WriteLine(" Fso.MoveFile DateiNeu,DateiOld ")
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Speicher ")
F.WriteLine(" ")
F.WriteLine(" Spch=""1"" 'Nötig wegen Folgebefehlen in Speichern!")
F.WriteLine(" Speichern ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*********************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Speichern ")
F.WriteLine(" ")
F.WriteLine(" Neues=Document.All.Linie.Value ")
F.WriteLine(" Neues0=Neues ") 'Richtige Zeile sichern !
F.Write(" If Left(Datei, 1)="""""""" then ")
F.WriteLine(" Datei=Mid(Datei,2,Len(Datei)-2) ")
F.Write(" If Left(DateiOld,1)="""""""" then ")
F.WriteLine(" DateiOld=Mid(DateiOld,2,Len(DateiOld)-2) ")
F.WriteLine(" Fso.CopyFile Datei,DateiOld ")
F.WriteLine(" ")
F.WriteLine(" 'Fragzeil hat statt Leerstellen, Neues nicht ! ")
F.WriteLine(" 'Und es sind " statt der "" , in Neues nicht ! ")
F.WriteLine(" '*************************************************** ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until Mid(Neues,i,1)="""" ")
F.WriteLine(" If Mid(Neues,i,1)="" "" then ")
F.WriteLine(" Neues=Left(Neues,i-1)&"" ""&_ ")
F.WriteLine(" Right(Neues,Len(Neues)-i) ")
F.WriteLine(" End If ")
F.WriteLine(" If Mid(Neues,i,1)="""""""" then ")
F.WriteLine(" Neues=Left(Neues,i-1)&"""""&_ ")
F.WriteLine(" Right(Neues,Len(Neues)-i) ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" If (Verschd=""0"" and Anders=""0"" and NeuD=""0"") then ")
F.WriteLine(" If (Neues<>FragZeil) then ")
F.WriteLine(" Ask=MsgBox ( UV&""Die Zeile im Textfeld wurde ver""&_ ")
F.WriteLine(" ""ändert ! ""&UV&"" Wollen Sie die Änder""&_")
F.WriteLine(" ""ung speichern ?"",VbCritical+VbYesNo) ")
F.WriteLine(" If Ask=""7"" then Exit Sub ")
F.WriteLine(" else ")
F.WriteLine(" MsgBox UV&""Die Zeile im Textfeld ist unver""&_ ")
F.WriteLine(" ""ändert ! ""&UV,VbCritical")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" If NeuD=""1"" then ")
F.WriteLine(" Ask=MsgBox(UV&UV&""Wollen Sie eine neue Datei ein""&_ ")
F.WriteLine(" ""richten ? ""&UV&UV,VbCritical+VbOkCancel) ")
F.WriteLine(" If Ask=""2"" then ")
F.WriteLine(" Nein=""1"" ' Für Abbruch in Sub DatNeu! ")
F.WriteLine(" NeuD=""0"" ' Variable ganz zurücksetzen ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" If Ask=""1"" then Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" 'Alte Datei auslesen und Zeile ändern: ")
F.WriteLine(" '************************************* ")
F.WriteLine(" Lies ")
F.WriteLine(" ")
F.WriteLine(" Zeile(Frage)=Neues0 ")
F.WriteLine(" ")
F.WriteLine(" 'Die Datei mit neuer Zeile schreiben : ")
F.WriteLine(" '************************************* ")
F.WriteLine(" Schreib0 ")
F.WriteLine(" ")
F.Write(" If (not (Folge=""0"" or Folge="""") or Folge=")
F.WriteLine(" ""Sonder"") then Ruf ") ' Neuaufruf
F.WriteLine(" If Spch=""1"" then Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Ziel ")
F.WriteLine(" ")
F.WriteLine(" 'Ziel-Ordner und die Datei auswählen : ")
F.WriteLine(" '************************************* ")
F.WriteLine(" Set Sha=CreateObject(""Shell.Application"") ")
F.WriteLine(" Set Fld=Sha.BrowseForFolder(0,StrPrompt,BrowseInfo,Root) ")
F.WriteLine(" ")
F.WriteLine(" On Error Resume Next ")
F.WriteLine(" Err.Clear ")
F.WriteLine(" Pfad=Fld.Self.Path ")
F.WriteLine(" If Err.Number>0 then WScript.Quit ")
F.WriteLine(" Set All=Nothing ")
F.WriteLine(" " )
F.WriteLine(" If Pfad="""" then Exit Sub ") 'Bei Abbruch!
F.WriteLine(" ")
F.WriteLine(" On Error GoTo 0 'Ignorieren wieder aufheben ! ")
F.WriteLine(" Fragen=InputBox(UV&VbCr&""Bitte ergänzen Sie hier""&_")
F.WriteLine(" "" den Namen der ""&UV&_ ")
F.WriteLine(" ""von Ihnen ausgesuchten Zieldatei !""&UV&_")
F.WriteLine(" VbCR,,Pfad&""\"") ")
F.WriteLine(" If Fragen="""" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" 'Nachfrage, wenn die Datei bereits vorhanden : ")
F.WriteLine(" '********************************************* ")
F.WriteLine(" If Fso.FileExists(Fragen) then ")
F.WriteLine(" Ask=MsgBox(UV&UV&""Die Datei existiert bereits ! ""&_ ")
F.WriteLine(" ""Fortsetzen ??? ""&UV&UV,VbCritical+VbYesNo) ")
F.WriteLine(" If Ask=""7"" then Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" Fso.CopyFile Mid(Datei,2,Len(Datei)-1),Fragen ")
F.WriteLine(" Datei=Fragen ")
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Aendern ")
F.WriteLine(" ")
F.WriteLine(" FrageAlt=CInt(Frage) ")
F.Write(" If CInt(Frage)=CInt(Document.All.ZeilNr.Value) ")
F.WriteLine(" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Befehl=""Sonder"" ") ' Ausgangspunkt festlegen
F.WriteLine(" " )
F.WriteLine(" Ungleich ") ' Prüfen, ob Zeile geändert
F.WriteLine(" If No=""1"" then ")
F.WriteLine(" Folge=""Sonder"" ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" Frage=CInt(Document.All.ZeilNr.Value) ")
F.WriteLine(" If Frage<""1"" then Frage=""1"" ")
F.WriteLine(" If Frage>CInt(Ende)-CInt(NochA) then ")
F.WriteLine(" MsgBox UV&""Die Nummer ist größer als die Zeilenz""&_ ")
F.WriteLine(" ""ahl ""&Ende-NochA&"" ""&UV,VbCritical ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.Write(" If Frage=CInt(Ende)-CInt(NochA) then ")
F.WriteLine(" Start=CInt(Ende)-17 ")
F.WriteLine(" ")
F.WriteLine(" If CInt(Frage)=CInt(Oben) then Start=Start-3 ")
F.WriteLine(" If CInt(Frage)=CInt(Unten) then Start=Start-3 ")
F.WriteLine(" If Start<1 then Start = ""1"" ")
F.WriteLine(" ")
F.WriteLine(" Plus=""1"" ") 'Hier Zusatzzeilen davor setzen
F.WriteLine(" ")
F.WriteLine(" 'Probleme bei Übertragung von Leerstellen vermeiden : ")
F.WriteLine(" '**************************************************** ")
F.WriteLine(" Leerstelle ")
F.WriteLine(" FragZeil=""&&&###;;;"" ") 'Kann Leerstelle enthalten!
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" Self.Close ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Sonder ")
F.WriteLine(" ")
F.WriteLine(" Folge=""0"" ") 'Folgebefehl zuücksetzen!
F.WriteLine(" Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Auf ")
F.WriteLine(" ")
F.WriteLine(" If CInt(Frage)=CInt(Ende)-CInt(NochA) then Exit Sub ")
F.WriteLine(" " )
F.WriteLine(" Befehl=""Auf"" ") ' Evtl. Folgebefehl
' Textzeile geändert? Bei Folgebefehl abbrechen :
F.WriteLine(" Aendrg ")
F.WriteLine(" If CInt(Stoppen)=""1"" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Frage=1+CInt(Frage) ")
F.WriteLine(" If CInt(FrageKorr)-CInt(Start)>=15 then Start=18+Start")
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Ab ")
F.WriteLine(" ")
F.WriteLine(" If CInt(Frage)=""1"" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Befehl=""Ab"" ") ' Evtl. Folgebefehl
' Textzeile geändert? Bei Folgebefehl abbrechen :
F.WriteLine(" Aendrg ")
F.WriteLine(" If CInt(Stoppen)=""1"" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Frage=CInt(Frage)-1 ")
F.WriteLine(" If CInt(Start)>CInt(FrageKorr) then Start=Start-30 ")
F.WriteLine(" If Start<""1"" then Start=""1"" ")
F.WriteLine(" ")
F.WriteLine(" Ruf ") ' Neuaufruf
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" " )
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Suchen ")
F.WriteLine(" ")
F.WriteLine(" Wort=InputBox(UV&"" Bitte unten ein zu suchendes ""&_")
F.WriteLine(" ""Wort ein-""&UV&"" geben -- oder mit ### da""&_ ")
F.WriteLine(" ""zwischen ein""&UV&"" neues Wort : es wird für ""&_ ")
F.WriteLine(" ""das 1. gesetzt !""&UV,""Wort suchen - oder ersetzen !!!"") ")
F.WriteLine(" If Wort="""" then Exit Sub ")
F.WriteLine(" ")
F.WriteLine(" Befehl=""Sonder"" ") ' Ausgangspunkt festlegen
F.WriteLine(" " )
F.WriteLine(" Ungleich ")
F.WriteLine(" If No=""1"" then Folge=""Sonder"" ")
F.WriteLine(" ")
F.WriteLine(" 'Wort ohne problem. Leerstellen weitergeben: ")
F.WriteLine(" '******************************************* ")
F.WriteLine(" For i=1 to Len(Wort) ")
F.WriteLine(" ReDim Preserve Wt(i) ")
F.WriteLine(" Wt(i)=Mid(Wort,i,1) ")
F.WriteLine(" If Wt(i)="" "" then Wt(i)=Chr(30) ")
F.WriteLine(" Next ")
F.WriteLine(" Wort=Join(Wt,"""") ")
' Um "Wort" und "Folge" bei Arg.Item(6) unterscheiden zu können !
'****************************************************************
F.WriteLine(" Wort=""&%;""&Wort ")
F.WriteLine(" 'Probleme bei Übertragung von Leerstellen vermeiden: ")
F.WriteLine(" Leerstelle ")
F.WriteLine(" FragZeil=""&&&###;;;"" ") 'Kann Leerstelle enthalten !
F.WriteLine(" ")
F.Write(" Wss.Run Datei0&"" ""&Datei&"" ""&Start&"" ""& ")
F.WriteLine(" FragZeil&"" ""&Frage&"" ""&""1""&"" ""&Plus&"" ""&Wort")
F.WriteLine(" ")
F.WriteLine(" 'Editor nicht schließen und nicht erneut aufrufen!")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Ungleich ")
'Bei evtl. Folgebefehl Dauer-Schleifen vermeiden:
'************************************************
F.WriteLine(" If CInt(Flg)=""1"" then Exit Sub ")
F.WriteLine(" Neues=Document.All.Linie.Value ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until Mid(Neues,i,1)="""" ")
F.WriteLine(" If Mid(Neues,i,1)="" "" then ")
F.WriteLine(" Neues=Left(Neues,i-1)&"" ""&_ ")
F.WriteLine(" Right(Neues,Len(Neues)-i) ")
F.WriteLine(" End If ")
F.WriteLine(" If Mid(Neues,i,1)="""""""" then ")
F.WriteLine(" Neues=Left(Neues,i-1) & """"" &_ ")
F.WriteLine(" Right(Neues,Len(Neues)-i) ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" If not (FragZeil=""&&&###;;;"" or FragZeil=Neues) then ")
F.WriteLine(" If Befehl=""Sonder"" then ")
F.WriteLine(" MsgBox UV&"" Die Textzeile wurde verändert !""&_")
F.WriteLine(" "" Bitte""&UV&"" mit """"Speichern"""" die Z""&_")
F.WriteLine(" ""eile speichern ! ""&UV ")
F.WriteLine(" No=""1"" ")
F.WriteLine(" Exit Sub ")
F.WriteLine(" else ")
F.WriteLine(" Ask=MsgBox(UV&""Wollen Sie diese Änderung speic""&_")
F.WriteLine(" ""hern ? ""&UV,VbCritical+VbYesNo)")
F.WriteLine(" If Ask = ""6"" then ")
F.WriteLine(" If Befehl<> """" then Folge=Befehl ")
F.WriteLine(" Verschd=""1"" ")
F.WriteLine(" Speichern ")
F.WriteLine(" Stoppen=""1"" ")
F.WriteLine(" End If ")
F.WriteLine(" End If ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Leerstelle ")
F.WriteLine(" ")
F.WriteLine(" 'Datei ohne problem. Leerstellen weitergeben: ")
F.WriteLine(" '******************************************** ")
F.WriteLine(" For i= 1 to Len(Datei) ")
F.WriteLine(" ReDim Preserve Wrt(i) ")
F.WriteLine(" Wrt(i)=Mid(Datei,i,1) ")
F.WriteLine(" If Wrt(i)="" "" then Wrt(i)=Chr(30) ")
F.WriteLine(" Next ")
F.WriteLine(" Datei=Join(Wrt,"""") ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Aendrg ")
F.WriteLine(" ")
F.WriteLine(" If Folge=""0"" then ")
F.WriteLine(" Ungleich ") ' Prüfen, ob Textzeile geändert
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" If Stoppen=""0"" then Folge=""0"" ")'Keine Änderung da
F.WriteLine(" If Folge<>""0"" then Self.Close ")'Daueraufruf stoppen
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*********************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Ruf ")
F.WriteLine(" ")
F.WriteLine(" 'Probleme bei Übertragung von Leerstellen vermeiden: ")
F.WriteLine(" '*************************************************** ")
F.WriteLine(" Leerstelle ")
F.WriteLine(" FragZeil=""&&&###;;;"" ") 'Kann Leerstelle enthalten!
F.WriteLine(" ")
F.Write(" Wss.Run Datei0&"" ""&Datei&"" ""&Start&"" ""&FragZeil")
F.WriteLine("&"" ""&Frage&"" ""&""1""&"" ""&Plus&"" ""&Folge ")
F.WriteLine(" Folge=""0"" ") 'Folge wieder zurücksetzen !
F.WriteLine(" Self.Close ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Schliess ")
F.WriteLine(" ")
F.WriteLine(" Neues=Document.All.Linie.Value 'Inhalt der Textzeile ")
F.WriteLine(" ")
F.WriteLine(" 'Neues enthält wieder Leerstellen, erst ersetzen : ")
F.WriteLine(" 'Ebenso müssen die "" "" "" ersetzt werden! ")
F.WriteLine(" i=1 ")
F.WriteLine(" Do until Mid(Neues,i,1)="""" ")
F.WriteLine(" If Mid(Neues,i,1)="" "" then ")
F.WriteLine(" Neues=Left(Neues,i-1)&"" ""&_ ")
F.WriteLine(" Right(Neues,Len(Neues)-i ) ")
F.WriteLine(" End If ")
F.WriteLine(" If Mid(Neues,i,1)="""""""" then ")
F.WriteLine(" Neues=Left(Neues,i-1)&"""""&_ ")
F.WriteLine(" Right(Neues,Len(Neues)-i) ")
F.WriteLine(" End If ")
F.WriteLine(" i=i+1 ")
F.WriteLine(" Loop ")
F.WriteLine(" ")
F.WriteLine(" 'Frage bei Änderung, ob gespeichert werden soll: ")
F.WriteLine(" If (FragZeil<>Neues and not FragZeil=""&&&###;;;"")then")
F.WriteLine(" Ask=MsgBox (UV&UV&""Die Zeile im Textfeld wurde ge""&_ ")
F.WriteLine(" ""ändert ! ""&UV&""Soll diese gespei""&_ ")
F.WriteLine(" ""chert werden ! ? ?""&UV&UV,VbCritical+VbYesNo) ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" If Ask=""6"" then ")
F.WriteLine(" Anders=""1"" ")
F.WriteLine(" Speichern ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" 'Für DatNeu.txt Zielordner und Namen bestimmen! ")
F.WriteLine(" '********************************************** ")
F.WriteLine(" Datei=Mid(Datei,2,Len(Datei)-2) ")
F.WriteLine(" If Right(Datei,10)=""DatNeu.txt"" then ")
F.WriteLine(" ")
F.Write(" MsgBox UV&"" Diese Datei ist mit richtigem Namen ")
F.WriteLine(" zu speichern! ""&UV ")
F.WriteLine(" Set Sha=CreateObject(""Shell.Application"") ")
F.WriteLine(" Set Fld=Sha.BrowseForFolder(0,StrPrompt,BrowseInfo,Root)")
F.WriteLine(" ")
F.WriteLine(" On Error Resume Next ")
F.WriteLine(" Err.Clear ")
F.WriteLine(" Pfad=Fld.Self.Path ")
F.WriteLine(" If Err.Number>0 then WScript.Quit ")
F.WriteLine(" Set All=Nothing ")
F.WriteLine(" ")
F.WriteLine(" If Pfad="""" then Self.Close ") ' Bei Abbruch !
F.WriteLine(" ")
F.WriteLine(" On Error GoTo 0 'Ignorieren wieder aufheben ! ")
F.WriteLine(" Fragen=InputBox(UV&VbCr&""Bitte ergänzen Sie hier""&_")
F.WriteLine(" "" den Namen der ""&UV&_ ")
F.WriteLine(" ""von Ihnen ausgesuchten Zieldatei !""&UV&_")
F.WriteLine(" VbCR,,Pfad&""\"") ")
F.WriteLine(" If Fragen="""" then Self.Close ")
F.WriteLine(" ")
F.WriteLine(" 'Nachfrage, wenn diese Datei bereits vorhanden ist: ")
F.WriteLine(" '************************************************** ")
F.WriteLine(" If Fso.FileExists(Fragen) then ")
F.WriteLine(" Ask=MsgBox(UV&UV&""Die Datei existiert bereits ! ""&_ ")
F.WriteLine(" ""Fortsetzen ??? ""&UV&UV,VbCritical+VbYesNo)")
F.WriteLine(" If Ask=""7"" then Exit Sub ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" Fso.MoveFile(Datei),Fragen ")
F.WriteLine(" End If ")
F.WriteLine(" 'Beim Beenden das temporäre Verzeichnis löschen: ")
F.WriteLine(" '*********************************************** ")
F.WriteLine(" Set Data=Fso.GetFolder(TempVerz).Files ")
F.WriteLine(" For each i in Data ")
F.WriteLine(" Fso.DeleteFile(i) ")
F.WriteLine(" Next ")
F.WriteLine(" Fso.DeleteFolder(TempVerz) ")
F.WriteLine(" Self.Close ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" Sub Eintraege ")
F.WriteLine(" ")
F.Write(" Lin=Lin&""<Input Type=""""Text"""" ")
F.Write(" Style=""""Width:38"""" ")
F.Write(" Name=""""ZeilNr"""" ")
F.WriteLine(" Value="""""&Frage&""""">"" ")
F.WriteLine(" 'Inhalt gezeigter Textzeile richtig stellen: ")
F.WriteLine(" '******************************************* ")
F.WriteLine(" FragZeiln=FragZeil ")
F.WriteLine(" FragZeil="""" ")
F.WriteLine(" For k=1 to Len(FragZeiln) ")
F.WriteLine(" FragZeil=FragZeil&Mid(FragZeiln, _ ")
F.WriteLine(" Len(FragZeiln)+1-k,1) ")
F.WriteLine(" Next ")
F.Write(" Lin=Lin&""<Input Type=""""Text"""" ")
F.Write(" Style=""""Width:710"""" ")
F.Write(" Name=""""Linie"""" ")
F.WriteLine(" Value=""""""&FragZeil&"""""">"" ")
F.Write(" Lin=Lin&"" <Input Type=""""Button"""" ")
F.Write(" Name=""""Anders"""" Style=""""Width:30"""" ")
F.Write(" Value=""""Nr"""" OnClick=""""Aendern"""" ")
F.WriteLine(" Title="""" Ganz links eingetragene Zeile zeigen """"> """)
F.Write(" Lin=Lin&"" <Input Type=""""Button"""" Name= ")
F.Write(" """"X-1"""" Style=""""Width:30"""" Value="""" ")
F.Write(" /\ """" OnClick=""""Ab"""" Title="""" Die vorige ")
F.WriteLine("Zeile aufrufen """">"" ")
F.Write(" Lin=Lin&""<Input Type=""""Button"""" ")
F.Write(" Name=""""X+1"""" Style=""""Width:30"""" ")
F.Write(" Value="""" \/ """" OnClick=""""Auf"""" Title="""" ")
F.WriteLine(" Die nächste Zeile aufrufen """">"" ")
F.Write(" Lin=Lin&"" <Input Type=""""Button"""" ")
F.Write(" Name=""""Suche"""" Style=""""Width:55"""" ")
F.Write(" Value=""""Suche"""" OnClick=""""Suchen"""" Title=""""")
F.Write("Bestimmtes Wort in der Datei suchen oder das Wort")
F.WriteLine(" durch ein anderes ersetzen """" > "" ")
F.WriteLine(" ")
F.WriteLine(" Document.All.MeldZeil.InnerHTML=Lin ")
If ( CInt(Start)+29<CInt(Frage) or CInt(Start)+29<CInt(FrageKorr) _
or CInt(FrageKorr)="1" ) then FrageKorr=CInt(Start)
If CInt(Start)+29<=CInt(Ende) then
Schluss = CInt(Start)+29
else
Schluss = CInt(Ende )
End If
' Es kommt erst der 1. Teil der Blockzeilen :
'********************************************
If CInt(Start)<=CInt(FrageKorr)-1 then
For n=Start to FrageKorr-1
F.WriteLine(" ReDim Preserve Txt("&n&") ")
F.WriteLine(" Txt("&n&")="""&Zeile(""&n&"")&""" ")
'***********************************************************
'* *
'* Die aus den oben genannten Gründen rückwärts geschrie- *
'* benen Zeilen müssen wieder richtig geschrieben werden ! *
'* *
'***********************************************************
F.WriteLine(" ReDim Preserve TxtR("&n&") ")
F.WriteLine(" TxtR("&n&")=Txt("&n&") ")
F.WriteLine(" Txt("&n&")="""" ")
F.WriteLine(" ")
F.WriteLine(" For k=1 to Len(TxtR("&n&")) ")
F.Write(" Txt("&n&")=Txt("&n&")& ")
F.WriteLine(" Mid(TxtR("&n&"), Len(TxtR("&n&"))+1-k, 1) ")
F.WriteLine(" Next ")
F.WriteLine(" 'Problematische ""<"", "">"" verstecken: ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" Txt("&n&")=Replace(Txt("&n&"),""<"",""&60"") ")
F.WriteLine(" Txt("&n&")=Replace(Txt("&n&"),"">"",""&62"") ")
F.WriteLine(" Txt("&n&")=Replace(Txt("&n&"),"" "",XYZ) ")
'Nr. der obersten Zeile auslesen, wenn neutralen Wert:
'**********************************************************
F.WriteLine("If "&n&"=Start then Oben=Left(Txt("&n&"),4) ")
F.WriteLine("If ("&n&"=Start and Oben="""") then Oben=FrageKorr ")
Next
F.WriteLine(" If CInt(FrageKorr)-1>=CInt(Start) then ")
F.WriteLine(" For n=CInt(Start) to CInt(FrageKorr)-1 ")
F.WriteLine(" Text1=Text1&Txt(n)&""<BR>"" ")
F.WriteLine(" Next ")
F.WriteLine(" End If ")
F.WriteLine(" ")
F.WriteLine(" Document.All.Meldung1.InnerHTML=Text1 ")
End If
' Es folgt jetzt der 2. Teil der Blockzeilen :
'*********************************************
For n=1+CInt(FrageKorr) to CInt(Schluss)
'Falls nach der verlangten Zeile noch überhängende Zeilen sind:
'**************************************************************
If n=1+CInt(FrageKorr) then
Lang = Len(Zeile(1 + CInt(FrageKorr)))
If (Mid(Zeile(1+CInt(FrageKorr)),Lang-4,1)<>"&" and _
Mid(Zeile(1+CInt(FrageKorr)),Lang-5,1)<>"#") then
i=1
Do
Lang=Len(Zeile(i+CInt(FrageKorr)))
Zeile(i+CInt(FrageKorr))=" - - - "
i=i+1
Lang = Len(Zeile(i+CInt(FrageKorr)))
Loop until (Asc(Mid(Zeile(i+CInt(FrageKorr)),Lang,1))>47 and _
Asc(Mid(Zeile(i+CInt(FrageKorr)),Lang,1))<58 and _
Asc(Mid(Zeile(i+CInt(FrageKorr)),Lang-1,1))>47 and _
Asc(Mid(Zeile(i+CInt(FrageKorr)),Lang-1,1))<58 and _
Asc(Mid(Zeile(i+CInt(FrageKorr)),Lang-2,1))>47 and _
Asc(Mid(Zeile(i+CInt(FrageKorr)),Lang-2,1))<58 and _
Asc(Mid(Zeile(i+CInt(FrageKorr)),Lang-3,1))>47 and _
Asc(Mid(Zeile(i+CInt(FrageKorr)),Lang-3,1))<58 )
End If
End If
F.WriteLine(" ReDim Preserve Txt("&n&") ")
F.WriteLine(" Txt("&n&")="""&Zeile(""&n&"")&""" ")
'***********************************************************
'* *
'* Die aus den oben genannten Gründen rückwärts geschrie- *
'* benen Zeilen müssen wieder richtig geschrieben werden ! *
'* *
'***********************************************************
F.WriteLine(" ReDim Preserve TxtR("&n&") ")
F.WriteLine(" TxtR("&n&")=Txt("&n&") ")
F.WriteLine(" Txt("&n&")="""" ")
F.WriteLine(" ")
F.WriteLine(" For k=1 to Len(TxtR("&n&")) ")
F.Write(" Txt("&n&")=Txt("&n&")& ")
F.WriteLine(" Mid(TxtR("&n&"),Len(TxtR("&n&"))+1-k,1) ")
F.WriteLine(" Next ")
F.WriteLine(" ")
F.WriteLine(" 'Problemat. "" < "", "" > "" verstecken: ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" Txt("&n&")=Replace(Txt("&n&"),""<"",""&60"") ")
F.WriteLine(" Txt("&n&")=Replace(Txt("&n&"),"">"",""&62"") ")
F.WriteLine(" Txt("&n&")=Replace(Txt("&n&"),"" "",XYZ) ")
Next
F.WriteLine(" '********************************************* ")
F.WriteLine(" 'Evtl. kürzeren letzten Block extra behandeln: ")
F.WriteLine(" '********************************************* ")
F.WriteLine(" If CInt(Start)+29<=CInt(Ende) then ")
F.WriteLine(" Bis=CInt(Start)+29 ")
F.WriteLine(" else ")
F.WriteLine(" Bis=CInt(Ende) ")
F.WriteLine(" End If ")
F.WriteLine(" For n=1+CInt(FrageKorr) to Bis ")
F.WriteLine(" Text2=Text2&Txt(n)&""<BR>"" ")
' Nr. der untersten Zeile auslesen, wenn neutralen Wert :
'*************************************************************
F.WriteLine(" If n=Bis then Unten=Left(Txt(Bis),4) ")
F.WriteLine(" If (n=Bis and Unten="""") then Unten=FrageKorr ")
F.WriteLine(" Next ")
F.WriteLine(" 'In evtl. kürzerem letzten Block Rest Leerzeilen: ")
F.WriteLine(" '************************************************ ")
If Ende-Start<29 then
For i=1 to (Start+29-Ende)
F.WriteLine(" Text2=Text2&""<BR>"" ")
Next
End If
F.WriteLine(" Document.All.Meldung2.InnerHTML=Text2 ")
F.WriteLine(" ")
F.WriteLine(" End Sub ")
F.WriteLine(" ")
F.WriteLine(" '*************************************** ")
F.WriteLine(" ")
F.WriteLine(" </Script> ")
F.WriteLine(" </Head> ")
F.WriteLine(" <Title> VbsEditor : . . . . . . . . . . . . . . . . " )
F.Write(" """&Datei&""". . . . . . . . . . . . . . . . </Title>")
F.WriteLine(" <Body OnLoad=""Eintraege"" bgcolor=""#d2b470""> ")
F.WriteLine(" <Form> ") '#f0e68c maisgelb/ #d2b470 hellbraun
F.Write(" <Table Border=""6"" Cellspacing=""10px"" ")
F.WriteLine(" Width=""100%"" > ")
F.WriteLine(" <Tr> ") '#f5fffa hellsilber/#90ee90 hellgrün
F.WriteLine(" <Td bgcolor=#fffffa> ") '#hffffh hellblau
If CInt(FrageKorr)>CInt(Start) then 'Falls erster Teil da
F.WriteLine(" <Div Id=Meldung1></Div> ")
End If
F.WriteLine(" <Div Id=MeldZeil></Div> ")
F.WriteLine(" <Div Id=Meldung2></Div> ")
F.WriteLine(" <Center> ")
F.WriteLine(" <BR> ")
F.Write(" <Input Type=""Button"" Name=""Beginn!"" ")
F.Write(" Value="" |< "" OnClick=""Beginn"" ")
F.WriteLine(" Title="" Ersten Zeilenblock anzeigen ""> ")
F.Write(" <Input Type=""Button"" Name=""Zurück!"" ")
F.Write(" Value=""<<"" OnClick=""Zurueck"" ")
F.WriteLine(" Title="" Vorigen Zeilenblock anzeigen ""> ")
F.Write(" <Input Type=""Button"" Name=""Weiter!"" ")
F.Write(" Value="">>"" OnClick=""Weiter"" ")
F.WriteLine(" Title="" Nächsten Zeilenblock anzeigen ""> ")
F.Write(" <Input Type=""Button"" Name=""Letztes"" ")
F.Write(" Value="" >| "" OnClick=""Grenze"" ")
F.WriteLine(" Title="" Letzten Zeilenblock anzeigen ""> ")
F.Write(" <Input Type = ""Button"" Name = ")
F.Write(" ""Neu!"" Value="" Neu "" OnClick=""DatNeu"" ")
F.WriteLine(" Title="" Eine neue, leere Datei erschaffen ""> ")
F.Write(" <Input Type=""Button"" Name= ")
F.Write(" ""Oeffnen!"" Value=""Öffnen"" OnClick=""Oeffnen"" ")
F.WriteLine(" Title="" Eine andere Datei neben dieser öffnen""> ")
F.Write(" <Input Type=""Button"" Name=""Speichern"" ")
F.Write(" Value=""Speichern"" OnClick=""Speicher"" ")
F.WriteLine(" Title="" Die veränderte Zeile Nr. speichern ""> ")
F.Write(" <Input Type=""Button"" Name=""Unter"" Value=""")
F.Write(". . in "" OnClick=""Ziel"" ")
F.WriteLine(" Title="" Diese Datei speichern unter . . . "" > ")
F.Write(" <Input Type=""Button"" Name=""")
F.Write(" Loesch"" Value=""Lösche"" OnClick=""Loeschen"" ")
F.WriteLine(" Title="" Die Zeile Nr. löschen ""> ")
F.Write(" <Input Type=""Button"" ")
F.Write(" Name=""Widerruf"" Value=""<<<"" OnClick=""Return"" ")
F.WriteLine(" Title="" Die letzte Aktion widerrufen ""> ")
F.Write(" <Input Type=""Button"" Name="" ")
F.Write(" NeuZeil"" Value=""Leer"" OnClick=""NeuZeile"" ")
F.WriteLine(" Title="" Nach Zeile Nr. Leerzeile einfügen ""> ")
F.Write(" <Input Type=""Button"" Name=""Ram !"" ")
F.Write(" Value=""Ablage"" OnClick=""Ram"" ")
F.Write(" Title = "" Nach Zeile Nr. als neue Zeilen die Zwischenab - ")
F.WriteLine(" lage einfügen ! ( Anklicken, mit Strg + C dahin! ) ""> ")
F.Write(" <Input Type=""Button"" Name=""Objekte"" ")
F.Write(" Value=""Objekt"" OnClick=""Objkt"" ")
F.WriteLine(" Title="" Nach Zeile Nr. ein gewünschtes Objekt setzen ""> ")
F.Write(" <Input Type=""Button"" Name=""Drucken"" ")
F.Write(" Value=""Drucken"" OnClick=""Druckn"" ")
F.WriteLine(" Title="" Die vorliegende Datei drucken ! ""> ")
F.Write(" <Input Type=""Button"" Name= ")
F.Write(" ""Ende"" Value="" X "" OnClick=""Schliess"" ")
F.WriteLine(" Title="" Editor samt Hilfsdateien schließen ! "" > ")
F.WriteLine(" <BR><BR> ")
' Am Schluss Angaben über Zeit und die Datei :
'*********************************************
F.Write(" Heute ist "&Left(Tg,2)&"., der "&Date&", ")
F.Write(" "&Left(Time,5)&" Uhr! Die Datei hat "&Ende-NochA&" Zei")
F.Write("len mit "&Gross&" B, wurde am "&Left(Aenderg, 10)&" um ")
F.WriteLine(" "&Left(Right(Aenderg,8),5)&" zuletzt geändert!<Br> ")
' F.WriteLine(" "&Timer-Zeit&" ") 'Ggf. Zeitmessung
F.WriteLine(" </Center> ")
F.WriteLine(" ")
F.WriteLine(" </Td> ")
F.WriteLine(" </Tr> ")
F.WriteLine(" </Body> ")
F.WriteLine(" </Html> ")
F.Close
Set F = Nothing
End If
'##############################################################
'# #
'# Diese gerade geschriebene H - t - a - Datei nun aufrufen , #
'# außer im Falle, die Suche eines Wortes wurde durchgeführt! #
'# #
'##############################################################
On Error Resume Next
' Bei der Suche eines Wortes geschieht kein neuer Aufruf :
'*********************************************************
If Wort="0" then
DateiZ=TempVerz&"DateiZeigen."&"h"&"t"&"a"
Wss.Run DateiZ,,true
If Fso.FileExists(DateiZ) then Fso.DeleteFile(DateiZ)
End If
' Bei Sucherfolg Datei mit Zeilen-Nr. zeigen & löschen :
'*******************************************************
If Fso.FileExists(DateiN) then
Wss.Run "Notepad """&DateiN&""" "
WScript.Sleep 500
Fso.DeleteFile DateiN
End If
On Error GoTo 0
WScript.Quit
http://dieseyer.de • all rights reserved • © 2011 v11.4