Datei = GrdProbl.doc vom 07.07.2008 Copyright 2008 W. Schmelz. Alle Rechte vorbehalten. In dieser Datei habe ich alles das gesammelt, was mir als interessant für andere Programm-Vorhaben vorkam. Mit Sich- erheit ist sie noch ziemlich unvollständig, sie lässt sich aber in Zukunft immer weiter ergänzen! Ein wesentlicher An- fang ist mindestens gemacht! Trotz größter Sorgfalt alles ohne Gewähr ! Liste einiger Grund - Probleme in VBS: **************************************** ( Das Meiste unter Win ME erprobt, vieles jetzt in XP ) Aktive Programme der Taskleiste ermitteln, schließen 106 Aktuelles Verzeichnis ermitteln 102 Anführungszeichen in andere Dateien übertragen 030 Arrey anlegen 080 Arrey - Speicherung 064 Attribute einer Audio-Datei auslesen 120 Attribute einer Datei ändern 045 Beenden eines Programmes aus Taskleiste, mit DOS !!! 103 Bild- und Faxanzeige erzwingen als Bild-Programm 108 Bremse, die Programm anhält, bis Vorgang erledigt 098 CD - Rom öffnen 097 CDBL, Streichen von Punkten 076 Cookies löschen 048 CPU, daraus Dauer abschätzen 094 CPU-Daten und Ram-Daten mit Auslastung ermitteln 110 Datei, alle Zeichen je in eine Zeile setzen 066 Datei - Attribute entfernen 045 Datei, bestimmte Angabe auslesen 046 Datei-Informationen 109 Datei-Namen oder Verzeichnis isolieren, . . . . 040 Datei-Gruppe aussuchen zur weiteren Behandlung 085 Datei anlegen 063 Datei aufsetzen und Teile erkennen lassen (Drag&Drop) 042 Datei, Einzelzeilen auslesen 061 Datei, Hilfsdatei dazu erzeugen 060 Dateienanzahl im Ordner zählen 077 Dateien alphabetisch sortieren, auf und ab 083 Dateien eines Ordners aufzählen, Liste erstellen 078 Dateien kopieren 005 Dateien löschen 006 Dateien neu anlegen und hineinschreiben 013 Dateien öffnen 039 Dateien umbenennen 020 Dateien verschieben 021 Datei-Inhalt einer bestehenden Datei mit Zusätzen 014 in eine neue Datei schreiben Datei-Inhalt der 1. Datei nach neue 2. Datei schreiben 032 Datei mit Datum und Zeit der Öffnung versehen 015 Dateien browsen 086 Dateien - Kette browsen 087 Dateien mit bestimmten Merkmalen behandeln 023 Dateien in einem Ordner zählen 113 Datei vollständig zeilenweise auslesen 059 Datei, Zeichen darin suchen 062 Datum, heutiges anzeigen 029 Datum der Dateien eines Ordners anzeigen 082 Desktopbild aktualisieren 105 DesktopIcon sichern bzw. wieder herstellen 112 Doppeltes aussortieren 118 Echo - Meldungs - Box 022 Elemente abwärts sortieren, Doppeltes aussortieren 118 Error, Fehlermeldung ausschalten / einschalten 095 Excel - Datei erschaffen, mit Einträgen 016 Excel - Datei, vorhandene abändern 017 Exe-Datei, ein Objekt dort hinein übertragen 084 Festplatte "X:\" analysieren, ob genügend Platz übrig 111 Formatieren einer Diskette u. a. 001 Function anwenden 064 Grafik - Karte ermitteln 119 Herauslesen von Anfang oder Ende einer Variablen 054 If - Befehl 009 If ... then/ ElseIf ... then... /else ... /end if 028 InputBox 010 InputBox - Kette verwenden 011 Int, Fix, CInt, round, abs 093 Join-Befehl zum Aneinanderfügen von z.B. aller Zfll(i) 075 Kleine oder große Buchstaben erzeugen 068 Laufwerke, höchste aktive feststellen 071 Laufwerke ermitteln 096 Laufwerk prüfen ( Scandisk ) 027 Laufwerk - Buchstabe, nächster freier 116 Link in Desktop schreiben 018 Loop, For - Next 034 Minimieren, alles 104 Modulo-Funktion bei Zahlen 074 MsgBox verwenden 008 MsgBox, Kennzahlen, Rückgabewerte 088 Neustart (2k/NT) 019 Ordner festlegen zur weiteren Behandlung 049 Ordner in einem Ordner zählen 113 Ordner neu anlegen 012 Ordner kopieren 024 Ordner löschen 007 Ordner beim Hochfahren löschen 099 Ordner umbenennen 026 Ordner - Unterordner - Kette anlegen 043 Ordner verschieben 025 Ort der Win - Version 052 PopUp- Meldung, zeitl. festgelegte Zwischenmeldung 035 Programm schließen 007 Programm startet voreingestellte Programme 089 RAM-Daten und CPU-Daten mit Auslastung ermitteln 110 Read(6), ReadLine 092 Registry, Befehle einfügen oder ändern 051 Replace - Befehl 090 Schalt-Fenster für 16 s mit eingeblendeter Restzeit 081 Schleife ( Loop, For - Next ) 034 SendKey / Tastenbefehle in Vbs umsetzen 100 Set ..., Set Arg=WScript.Arguments usw. 091 Shredder 067 Splitten einer Eingabe gemäß Symbol " # " 065 Start einer Datei aus richtigem Ordner? 101 Starten eines Programmes z.B. Excel 002 Starten einer Datei 003 Start - Verzögerung eines Vorganges 004 Startmenü um verschiedene Programme zu starten 058 Stopp - Uhr 037 Sub - Befehl 056 Temp. Internet - Dateien löschen 055 Timer, Stopp-Uhr, TimeSerial (normale Zeitangabe) 038 Trimmen einer Variablen 073 Typ der Win - Version 053 Variable, Befehle daran ausführen 041 Variable in neue Anwendung mitnehmen 069 Variablen in Text übertragen 072 Variablenliste Dat(k) für k=1 bis 7 anlegen 070 VBS - Programm von innen beenden 079 Vbs-Programm, bestimmtes laufendes von außen schließen 114 Win - Version und deren Lage feststellen 047 Windows-Version, Ort und Eigentümer für XP (ME) ? 115 Windows beenden (9X,ME) 050 Win XP : Schluss, Neustart oder Standby 117 Wochentag ermitteln zu einem Datum 033 Wort in bestimmter Datei suchen 121 Zeichenketten untersuchen (Len-, Left-, Mid-, Right-, 057 InStr-, InStrRev-Befehle) Zeit - Differenzen 044 Zeiten als Variable setzen 031 Zufalls - Generator 036 Einzelbefehle und Tipps 122 Beginn der erklärenden Abschnitte. "Suchen.vbs" startet hier ############################################################ 001 Formatieren einer Diskette u. a.: ************************************* ' Schnell-Formatierung: 'Set WshShell=WScript.CreateObject ("WScript.Shell") 'WshShell.Run "Format A: /F:1440 /Q /V:DISK1440",,True ' Vollständige Formatierung: 'Set WshShell=WScript.CreateObject("WScript.Shell") 'WshShell.Run "Format A: /F:1440 /V:DISK1440",,True ' Beliebiges Laufwerk formatieren: 'Set WshShell=WScript.CreateObject("WScript.Shell") 'WshShell.Run "Format G:",,True 002 Aufruf eines Programmes z.B. Excel: *************************************** 'Sucht nach einer Datei, die "Excel" heißt: WScript.CreateObject("WScript.Shell").Run "Excel" WScript.CreateObject("WScript.Shell").Run "Notepad" WScript.CreateObject("WScript.Shell").Run "WinWord" 003 Bestimmte Datei starten: **************************** WScript.CreateObject("WScript.Shell").Run "C:\Tools\Data\Formular.xls" ' oder Set Wsh=WScript.CreateObject("WScript.Shell") Wsh.Run "%WinDir%\Notepad.exe" ' auch kurz: WScript.CreateObject("WScript.Shell").Run "Notepad" 'oder: 'Desktop aktualisieren, dazu wird auf den Desktop zugegriffen: Befehl="""C:\Windows\Anwendungsdaten\Microsoft\"&_ "Internet Explorer\Quick Launch\Desktop anzeigen.scf""" 'Trennung offensichtlich möglich; warum die """ ??? Wss.Run Befehl WScript.Sleep 1000 Wss.Sendkeys "{F5}" 'Aktualisieren! 004 Verzögerung beim Start eines Vorganges: ******************************************* '(Leider erst ab Win ME): 'vor den verspätet auszuführenden Befehl stellen! Wait=3000 'in mSec, d.h. 1000 bedeutet 1 Sec ! WScript.Sleep Wait 'oder kurz: WScript.Sleep 3000 005 Zwei Möglichkeiten, Dateien zu kopieren: ******************************************** Datei="C:\Ab\Versuch.txt" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.CopyFile Datei,"C:\Tools\" 'Anmerkung: Der Flash hinter dem Zielordner muss sein! ' oder kürzer: Set Fso=WScript.CreateObject ("Scripting.FileSystemObject") Fso.CopyFile "C:\Ab\Versuch.txt","C:\Tools\" 'Anmerkung: Der Flash hinter dem Zielordner muss sein! 006 Zwei Möglichkeiten, eine bestimmte Datei zu löschen: ******************************************************** Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Datei=Fso.GetFile ("C:\Ab\Test.txt") Datei.Delete ' oder kürzer: Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.DeleteFile "C:\Ab\Test.txt",true 'true heißt restlos löschen!? 007 Zwei Möglichkeiten, einen bestimmten Ordner zu löschen: *********************************************************** Set Fso=WScript.CreateObject ("Scripting.FileSystemObject") Set Ordner=Fso.GetFolder ("C:\Ablage\Versuch") Ordner.Delete ' oder kürzer: Set Fso=WScript.CreateObject ("Scripting.FileSystemObject") Fso.DeleteFolder ("C:\Ablage\Versuch") 008 Verwendung der MsgBox : *************************** 'Man kann den Zeilenvorschub VbCR vereinfachen: UV=VbCR&VbCR UVW=UV&VbCR XX=VbTab 'Problem: Durch Schleifen (Loop) mit Variablen u, v, w, x, die verwendet 'wurden, werden diese Variablen gestört !!! Ttl=" Bilddateien eines Ordners umbenennen !" Msg=UV&XX&"Unklare Namen der Digital - Kamera nerven, sind"&UV&_ XX&"mühsam von Hand in klarere Namen zu ändern ? "&UV&_ XX&"Dann ist dies Programm nötig !"&UVW&_ XX&"Benennt alle Bilder im Ordner um, die Nr. bleibt,"&UV&_ XX&"ggf. nur einen Bereich(!)- oder es wird alles durch-"&UV&_ XX&"nummeriert ! Sonstige Dateien bleiben !"&UVW&_ XX&"Programm starten ?"&UV Frg=MsgBox(Msg,4,Ttl) If Frg=7 then WScript.Quit ' oder : Titel="XY-PROGRAMM" Ask=MsgBox("XY-PROGRAMM installieren? ", _ VbYesNo+VbDefaultButton1+VbQuestion,Titel) If Ask<>VbYes then MsgBox" . . . denn eben nicht!",,Titel ' Antwort ungleich Ja If Ask<>VbYes then WScript.Quit ' Antwort nicht(!) Ja 'oder Text="" Text=Text&" Soll installiert werden ?"&VbCR Text=Text&VbCR Text=Text&VbCR Text=Text&VbCR Ask=MsgBox(Text,vbYesNo+vbDefaultButton1+vbQuestion,"XY-PROGRAMM") If Ask<>VbYes then MsgBox"Nun gut , . . . dann halt nicht!",,"XY-PROGRAMM" ' s. o. If Ask="6" then WScript.Quit ' Auch diese Weiche ist möglich! ' oder MsgBox" XY-PROGRAMM wird installiert",VbInformation,"XY-PROGRAMM" ' oder MsgBox Text,VbYesNoCancel+VbDefaultButton3+VbExclamation,"XY-PROGRAMM" In Mitte möglich: + VbYesNo + VbOkOnly + VbYesOnly + VbAbortRetryIgnore + VbOkCancel+VbCancel In Mitte möglich: + VbQuestion + VbInformation + VbCritical + VbExclamation In Mitte möglich: z. B. + VbDefaultButton3 ' oder Frage=MsgBox(VbCR&VbCR&" Wirklich löschen ?"&VbCR&VbCR _ ,VbCritical+VbYesNo,"Zwischenfrage") If Frage="7" then WScript.Quit If Frage="6" then MsgBox" Weiter geht es!" 'Bei Benennung der MsgBox muss (!!) deren Programmierung in Klammern stehen! 009 If - Befehl: **************** Set Fso=WScript.CreateObject ("Scripting.FileSystemObject") If not Fso.FileExists("%WinDir%\Classes.dat") then ... 'Bei einzeiligen Befehlen ist "End If" unnötig 'oder Frage=MsgBox(VbCR&VbCR&"Soll das XY-PROGRAMM installiert werden?"&_ VbCR&VbCR,VbYesNo," X Y") If Frage="7" then MsgBox " Also nicht " If Frage="6" then MsgBox " Es geht jetzt los ! " 'oder Set Fso=WScript.CreateObject("Scripting.FileSystemObject") If Fso.FileExists(Text) and (or) . . . then TextX=Text 'oder Set Fso=CreateObject("Scripting.FileSystemObject") If Fso.FileExists ("C:\Tools\Mahnung\Mahnung.txt") then MsgBox "Diese Nummer existiert bereits !",VbCritical,"Erinnerung" End If If Fso.FileExists ("C:\Tools\Mahnung\Mahnung.txt") then WScript.Quit ' s.a. "If ... then/ ElseIf ... then... /else ... /end if" (s.28 ) 010 Verwendung der InputBox: **************************** Titel=" V e r s u c h " Anzeige=VbCR&VbCR&" Soll X Y installiert werden ? "&VbCR&VbCR Eingabe=InputBox (Anzeige,VbYesNo,"Ja") If not Eingabe="Ja" or Eingabe="" then MsgBox VbCR&VbCR&" . . . dann halt nicht!"&VbCR&VbCR,,Titel WScript.Quit End If MsgBox VbCR&VbCR&" . . . dann geht es weiter !"&VbCR&VbCR,,Titel 'oder Eingabe=InputBox (VbCR&VbCR&VbCR&_ "Es waren höchstens 4 Unter - Ordner möglich ,"& VbCR&VbCR&_ "diese wurden mit dem Zeichen "" # "" getrennt !"& VbCR&VbCR&_ "Überprüfen Sie die Namen der Unter - Ordner :"& VbCR&VbCR&_ VbCR&VbCR,Titel,"Original#Zwischen#Bearbtng") If Eingabe="" then WScript.Quit ' Abbruch, wenn "Cancel"("") 'Die Eingabe kann mit "S p l i t" aufgespalten werden, s. 65 'oder Temp=InputBox ("Geben Sie die Temperatur in Grad Celsius ein !","Temperatur") MsgBox "Die Temperatur ist "&Temp&" Grad Celsius !",,"Temperatur" 'oder Set Wss=CreateObject("WScript.Shell") Input=InputBox("Welches Programm soll gestartet werden?"&VbCRLF&VbCRLF&_ "1 = Taschenrechner"&VbCRLF&"2 = Notepad"&VbCRLF&"3 = Excel"&VbCRLF&_ "4 = Winword"&VbCRLF&"5 = WordPro"&VbCRLF&"6 = StarOffice","Programmauswahl") Select Case Input Case "1" Wss.Run("%WinDir%\calc.exe") Case "2" Wss.Run("%WinDir%\notepad.exe") Case "3" Wss.Run "Excel" Case "4" Wss.Run "WinWord" Case "5" Wss.Run "WordPro" Case "6" Wss.Run "SOffice" Case else MsgBox " Ungeeignete Eingabe!" End Select 011 Input - Kette verwenden: **************************** Titel1=" NUMMER" Titel2=" NAME, VORNAME" Txt=Txt&VbCR Txt=Txt&VbCR Txt=Txt&" BITTE EINTRAGEN : S. O."&VbCR Txt=Txt&VbCR Txt=Txt&VbCR Text1=InputBox(Txt,Titel1,Text1) Text2=InputBox(Txt,Titel2,Text2) ' . ' . ' Dies kann fortgesetzt werden! 012 Ordner neu anlegen: *********************** Set Fso=WScript.CreateObject ("Scripting.FileSystemObject") Set TextStream=Fso.CreateFolder ("C:\Ablage") 'auch Set Data=.., u.a. möglich Set TextStream=Fso.CreateFolder ("C:\Ablage\Versuch") ' u.s.w. 013 Dateien neu anlegen und hineinschreiben: ******************************************** Set Fso=WScript.CreateObject ("Scripting.FileSystemObject") Set Ordner=Fso.GetFolder ("C:\Ablage") 'Ordner muss da sein, s.o. Set Dat=Ordner.CreateTextFile("Versuch.txt") 'Beliebiges wie Dat. . . Dat.Write (" Hoffentlich klappt es !") Dat.WriteLine (" ? ? ?") Dat.WriteBlankLines (3) Dat.WriteLine (" Wird es schon ! ! !") Dat.WriteBlankLines (2) Dat.Close 'Anmerkung: 'Dat.WriteLine(" ... ") schreibt eine Zeile 'Dat.Write(" ... ") fügt an letzte Zeile an, 'wenn davor der Write-Befehl stand 014 Datei-Inhalt einer besteh. Datei mit Zusätzen in neue Datei schreiben: ************************************************************************** Datei="C:\Autoexec.bat" 'zu öffnende Datei Set ObjF=CreateObject("Scripting.FileSystemObject") If ObjF.FileExists(Datei) then Set ObjF=ObjF.OpenTextFile(Datei) i=1 Do until ObjF.AtEndOfStream ReDim Preserve Zeile(i) Zeile(i)=ObjF.ReadLine i=i+1 Loop ObjF.Close Zahl=i-1 Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Ordner=Fso.GetFolder("C:\AB") 'Ziel-Ordner Set Dat=Ordner.CreateTextFile("Autoexec.txt") 'Name der neuen Datei Dat.WriteBlankLines(1) i=1 Do until i>Zahl Dat.WriteLine(Zeile(i)) i=i+1 Loop Dat.WriteBlankLines(2) Dat.WriteLine(" Hoffentlich klappt's?") Dat.WriteBlankLines(2) Dat.Write(" Wird schon klappen!") 'Zusatztext Dat.Close End If 015 Text in vorhandene Datei mit Datum und Uhrzeit schreiben: ************************************************************* Set Fso=WScript.CreateObject ("Scripting.FileSystemObject") Set Data=Fso.OpenTextFile(WScript.ScriptName,8,true) 'Zum Erweitern öffnen Set Dat=Fso.OpenTextFile(WScript.ScriptName&".Log",8,true)'log-Datei schreiben TxtX="'"&Now&VbTab&WScript.ScriptName&" wurde benutzt" Dat.WriteBlankLines(1) Dat.WriteLine(TxtX) 'Datum, Zeit u. Text unter Datei schreiben Dat.Close Set Dat=Nothing 016 Excel-Datei neu schreiben: ****************************** Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set TextStream=Fso.CreateTextFile("C:\Ab\Versuch.xls") Set ObjXL=WScript.CreateObject("Excel.Application") objXL.Workbooks.Open("C:\Ab\Versuch.xls") objXL.Visible=true objXL.Columns(1).ColumnWidth=20 objXL.Columns(2).ColumnWidth=30 objXL.Columns(3).ColumnWidth=40 objXL.Rows(1).RowHeight=40 objXL.Cells(1, 1).Value=" Datum" objXL.Cells(2, 3).Value=" Betrag" objXL.Cells(3, 5).Value=" Grund" objXL.ActiveWorkbook.Save objXL.ActiveWindow.Close objXL.Application.Quit 017 Vorhandene Excel - Datei abändern: ************************************** Txt6=Txt6&VbCRLF Txt6=Txt6&VbCRLF Txt6=Txt6&" Prozentsatz ( z.B. 0,35 ) einfügen "&VbCRLF Txt6=Txt6&VbCRLF Txt6=Txt6&" und "" OK "" drücken !"&VbCRLF Txt6=Txt6&VbCRLF Txt6=Txt6&VbCRLF Text6=InputBox(Txt6,Titel,Text6) Dim objXL Objekt="C:\Ab\Formular.xls" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set objXL=WScript.CreateObject("Excel.Application") If Fso.FileExists(Objekt) then objXL.Workbooks.Open(Objekt) If not Fso.FileExists(Objekt) then WScript.Quit objXL.visible=true objXL.Range("D3").Select objXL.Selection.value=Text6 objXL.ActiveWorkbook.Save objXL.ActiveWindow.Close objXL.Application.Quit 018 Link schreiben: ******************* Set WSHShell=WScript.CreateObject("WScript.Shell") Path=WSHShell.SpecialFolders("Desktop") Set Lnk=WSHShell.CreateShortcut(Path&"\Versuch.lnk") Lnk.TargetPath=WSHShell.ExpandEnvironmentStrings("C:\Sicher\Bats\BootDisk.bat") Lnk.Save oder Set WSHShell=WScript.CreateObject("WScript.Shell") Name="Versuch" Set Lnk=WSHShell.CreateShortcut("C:\Tools\Chiffre\Desktop\"&Name&".lnk") Lnk.TargetPath=WSHShell.ExpandEnvironmentStrings("C:\Tools\Chiffre\Data\"&Name&".txt") Lnk.Save Oder 'Datei aufsetzen, zu der ein Link gewünscht wird, loslassen 'Link wird dorthin geschrieben, wo "Link.vbs" ist Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set oArgs=Wscript.Arguments For i=0 to oArgs.Count -1 Objekt=oArgs.item(i) Ziel=Fso.GetFileName(Objekt) Ort=fso.GetParentFolderName(WScript.ScriptFullName) Next Set WSHShell=WScript.CreateObject("WScript.Shell") Set Lnk=WSHShell.CreateShortcut(Ort&"\"&Ziel&".lnk") Lnk.TargetPath=WSHShell.ExpandEnvironmentStrings(Objekt) Lnk.Save 019 Neustart fahren( 2k/NT ): ***************************** Set WshShell=WScript.CreateObject("WScript.Shell") WshShell.sendkeys "^ {ESC}" WshShell.sendkeys "{ESC}" WshShell.sendkeys "%{F4}" WshShell.sendkeys "n" 020 Dateien umbenennen: *********************** Datei="C:\Ab\Versuch1.txt" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.MoveFile Datei,"C:\Ab\Versuch2.txt" ' kurz Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.MoveFile"C:\Ab\Versuch1.txt","C:\Ab\Versuch2.txt" 021 Dateien verschieben: ************************ Datei="C:\Ab\Versuch1.txt" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.MoveFile Datei,"C:\Ablage\" ' kurz Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.MoveFile"C:\Ab\Versuch1.txt","C:\Ablage\" ' Anmerkung: Der Flash hinter dem Zielordner muss sein! 022 Echo - Meldungs - Box: ************************** WScript.Echo "Das XY-PROGRAMM wird installiert" ' unterbrechende Zwischenmeldungs-Box, die auf fortsetzt ' oder Set Arg=WScript.Arguments WScript.Echo Arg(i) 'aufgesetzte Datei wird in MsgBox angezeigt 023 Dateien mit bestimmten Merkmalen behandeln: *********************************************** Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Nr=InputBox(VbCR&" Geben Sie die Nummer des zu "&vbCRLF& _ "stornierenden Merkzettels ein, z. B. 3 !"&VbCR,,"Stornierung") If Nr="" then MsgBox "Nun gut , . . . dann halt nicht!",,"Stornierung" If Nr="" then WScript.Quit Fso.DeleteFile"C:\Windows\Startmenü\Programme\Autostart\Mahnen"&Nr&".vbs" Fso.DeleteFile"C:\Tools\Mahnung\Desktop\Mahnung"&Nr&".vbs.txt" ' Das geht aber auch für Verschiebung und ähnliche Vorgänge ! 024 Ordner kopieren: ******************** 'Schreibt aus C:\Ab\Versuch den Ordner samt Inhalt nach C:\Tools, 'keine Einzel-Dateien! Ordner="C:\Ab\Versuch\*" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.CopyFolder Ordner,("C:\Tools\") ' Anmerkung: Der Flash hinter dem Zielordner muss sein! ' kurz Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.CopyFolder("C:\Ab\Versuch\*"),("C:\Tools\") 025 Ordner verschieben: *********************** 'Verschiebt aus C:\Ab\Versuch Ordner samt Inhalt nach C:\Tools, keine Einzel-Dateien! Ordner="C:\Ab\Versuch\*" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.MoveFolder Ordner,("C:\Tools\") ' Anmerkung: Der Flash hinter dem Zielordner muss sein! ' kurz Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.MoveFolder("C:\Ab\Versuch\*"),("C:\Tools\") 026 Ordner umbenennen: ********************** Ordner="C:\Ab\Versuch1" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.MoveFolder Ordner,("C:\Ab\Versuch2") ' kurz Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Fso.MoveFolder("C:\Ab\Versuch1"),("C:\Ab\Versuch2") 027 Laufwerk prüfen ( Scandisk ): ********************************* Set WSHShell=WScript.CreateObject("WScript.Shell") WSHShell.Run"Scandisk G:",,true 028 If ... then/ ElseIf ... then... /else ... /end if: ***************************************************** X="10" If X-1<7 then ' Anweisungen muss man in die nächste Zeile setzen MsgBox VbCR&X-1&" ist weniger als 7"&VbCR&VbCR,," Probe" ElseIf X-2<7 then MsgBox VbCR&X-2&" ist weniger als 7"&VbCR&VbCR,," Probe" ElseIf X-3<7 then MsgBox VbCR&X-3&" ist weniger als 7"&VbCR&VbCR,," Probe" ' Bis zur letzten Else-Bedingung sind mehrere ElseIf-Blöcke möglich. ' Es müssen aber auch gar keine sein. Else MsgBox VbCR&X-4&" ist >= 7"&VbCR&vbCR,," Probe" End if ' Ein " if ... then ... else ... "-Block ist auch einzeilig möglich: X="10" If X-2<7 then MsgBox X-2&" ist weniger als 7" _ else MsgBox X-2&" ist >= 7" If (Inhalt2.Count=0 and Inhalt2.Count=0) then MsgBox VbCR&VbCR&"Das Verzeichnis ist leer ! "&VbCR&VbCR, _ VbExclamation," Verzeichnis leer !" else 'im anderen Falle: WshShell.Run "Notepad """&Fso.GetParentFolderName(WScript.ScriptFullName)&_ "\"&"Liste.txt"&"""" End If 'Zahlenkette von 1 bis Zahl festlegen! Zahlen<=5 vorweg streichen! If i/3=Int(i/3) or i/5=Int(i/5) then Numb(i)="" '1. Möglichkeit else Numb(i)=i 'andernfalls End If 029 Das heutige Datum anzeigen: ******************************* ' Datei=Datum.vbs Tag=day(date) Monat=month(date) Jahr=year(date) MsgBox " Heute ist der "&VbCR&" "&Tag&" . " _ &Monat&" . "&Jahr&VbCR&VbCR&". . . sogar den ganzen Tag !" _ &VbCR,," Das heutige Datum ist :" 030 Anführungszeichen, in andere Dateien übertragen: **************************************************** ' Datei: Anfhrzei.vbs ' Variablen können per Input-Box def. werden oder mit "=", dann sind "" er- ' forderlich. Beim Übertrag in neue Datei fallen die Zeichen weg, sie müssen ' aber stehen! Das ist nicht einfach möglich, wie an Beispielen unten ' zu sehen ist! Ebenso schlecht werden "" in Befehlen übertragen, s.u.! Auch ' in MsgBox hat man mit ihnen Probleme. ' Hier wird als Beispiel C:\Ablage\Test.txt geschrieben Stunde1="14" Min1="15" Meldung=" Meier anrufen !" Nr="7" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Ordner=Fso.GetFolder("C:\Ablage") Set Data=Ordner.CreateTextFile("Test.txt") Data.WriteBlankLines(1) Data.WriteLine("Stunde1="&Stunde1) Data.WriteLine("Min1="&Min1) Data.WriteLine("Meldung="&""""&Meldung&"""") '& trennt die Abschnitte, die Schreibeinheit dazwischen steht in ", 'die " um die Meldung entstehen aus "" ! ' auch möglich: Data.WriteLine("Meldung="""&Meldung&"""") Data.WriteLine("Nr="&""""&Nr&"""") Data.WriteLine("MsgBox Meldung") ' Data.Close ' oder noch: ' Trennung mit " _ " bei TextStream u.a. unmöglich !!! Data.WriteLine("Start="&"""" &Beginn&"""") Data.WriteLine("MsgBox ""&VbCR&"&""" Die Zeit betrug """&"&Timer-Start&"&_ """ sec """&"&VbCR,VbInformation,"&""" Die Stopp - Uhr ! """&"") Data.WriteLine("Set Fso=WScript.CreateObject("&"""Scripting.FileSystemObject"""&")") Data.WriteLine("Set WshShell=WScript.CreateObject("&"""WScript.Shell"""&")") Data.WriteLine("Fso.DeleteFile"&"""C:\Tools\StoppUhr\Desktop\Läuft.lnk"""&"") Data.WriteLine("Fso.DeleteFile"&"""C:\Tools\StoppUhr\Data\Stoppen.vbs"""&"") Data.WriteLine("Fso.DeleteFile"&"""C:\Tools\StoppUhr\Data\Zwischen.vbs"""&"") Data.WriteLine("Set Data=Fso.OpenTextFile(WScript.ScriptName,8,true)") Data.WriteLine("Set Data=Fso.OpenTextFile(WScript.ScriptName&"&""".txt"""&",8,true)") Data.WriteLine("Data.WriteBlankLines (1)") Data.WriteLine("Data.WriteLine"&"""MsgBox"&""""&""""&"""&"&"""Die Uhr läuft nicht! """&"&"""&""""&""""&""""&" ") Data.WriteLine("Data.Close") Data.WriteLine("Set Data=Nothing") ' auch noch als andere Beispiele: Text1=" Heute ist "" HOCHZEITSTAG ! "" " MsgBox Text1 MsgBox " "" Jetzt ist der "&Date&" um "&Time& " """ 031 Zeiten als Variable setzen: ******************************* ' Über folgende Befehle werden Zeiten als Variable definiert: Jahr=year(date) Monat= month(date) Tag=day(date) Stunde=hour(time) Minute=minute(time) Sekunde=second(time) oder sec= . . . ' Gleiches ist auch möglich mit zuvor in Input-Box definierten Zeiten, Daten. ' Bezeichnungen sind beliebig wählbar, müssen aber unmissverständlich sein 032 Datei - Inhalt einer 1. Datei hinter neue 2. Datei schreiben: ***************************************************************** ' Der Inhalt von Versuch1.vbs wird in Versuch2.vbs hinter den ' dort geplanten Text gesetzt Datei="C:\Tools\Versuch1.vbs" Set ObjFileSystem=CreateObject("Scripting.FileSystemObject") Set Data=ObjFileSystem.OpenTextFile(Datei) Do until Data.AtEndOfStream Txt=Txt&Data.ReadLine&VbCR 'Gelesener Text zeilenweise hintereinander Loop Data.Close Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Ordner=Fso.GetFolder("C:\Tools") ' Ziel-Ordner Set Dat=Ordner.CreateTextFile("Versuch2.vbs") 'Name der neuen Datei Dat.WriteLine("Hoffentlich klappt's?") Dat.Write("Wird schon klappen!") ' Zusatztext Dat.WriteBlankLines(1) Dat.Write(Txt) ' Text aus Versuch1.vbs Dat.Close 033 Wochentag ermitteln zu einem Datum: *************************************** Datum=InputBox(VbCR&VbCR&"Geben Sie das Datum ein , z.B. 9.8.2004 !", _ "Wochentag - Berechnung") If Weekday(Datum)="1" then TagX="Sonntag" If Weekday(Datum)="2" then TagX="Montag" If Weekday(Datum)="3" then TagX="Dienstag" If Weekday(Datum)="4" then TagX="Mittwoch" If Weekday(Datum)="5" then TagX="Donnerstag" If Weekday(Datum)="6" then TagX="Freitag" If Weekday(Datum)="7" then TagX="Samstag" MsgBox VbCR&" Der "&Datum&VbCR&VbCR&VbCR&" ist ein : " _ &TagX&" ! "&VbCR&VbCR,VbExclamation,"Wochentag - Berechnung" ' s. a. 31 034 Schleife ( Loop, For - Next ): ********************************** Datei: Schleife.vbs ' Schleife ( Loop ) ' Dividend X dividiert durch Divisor Y MsgBox VbCR&"Jetzt wird 36 : 5 gerechnet"&VbCR Dividend="36" Divisor="7" Zahl=Dividend Anzahl=0 Do until Zahl<=0 ' oder: 'Do while not(Zahl<=0) 'Do while not Datei.AtEndOfStream 'Do until Datei.AtEndOfStream Zahl=Zahl-Divisor Anzahl=Anzahl+1 Loop Rest=Zahl+Divisor MsgBox VbCR&"Das Ergebnis ist "&Anzahl-1&VbCR&_ VbCR&"Der Rest ist "&Rest&VbCR ' Wenn die Rechnung aufgeht, ist Anzahl das Ergebnis ' Wenn die Rechnung nicht aufgeht, ist das Ergebnis=Anzahl-1 ' Wenn die Rechnung nicht aufgeht, ist der Rest=Zahl+Divisor ' oder anderes Bsp.: 'Bildernamen in den Unterordnern doppelt? Fehler="0" z=1 Do until z>4 If not Name(z)="0" then 'ReDim Preserve Bild(b) b="0" Set Data=Fso.GetFolder(Pfad).SubFolders For each Folder in Data '< xxxxxx Set Inhalt=Fso.GetFolder(Folder&"\"&Name(z)).Files For each File in Inhalt '< ------ File=Fso.GetFileName(File) b=1+b ReDim Preserve Bild(b) Bild(b)=File 'Bild schon da? y=1 Do until y=b If Bild(b)=Bild(y) then Fehler=1 y=y+1 Loop Next '< ------ Next '< xxxxxx End If z=z+1 Loop ' oder anderes Bsp.: ' Zahl in Teilquadrat nur in einer Spalte/Zeile 2 x möglich ? '*********************************************** A=1 Do until A>3 B=1 Do until B>3 z=1 Do until z>9 Fall="" Platz="" Hier="0" x=1 Do until x>3 y=1 Do until y>3 v=1 Do until v>Len(Kreuz(3*(A-1)+x,3*(B-1)+y)) If z=Int(Mid(Kreuz(3*(A-1)+x,3*(B-1)+y),v,1)) then Hier=1+Hier Platz=Platz&x&y End If v=v+1 Loop y=y+1 Loop x=x+1 Loop If Hier=2 or Hier=3 then Fall=A&B&z&Platz Pruefen0754 If Passrt=1 then Exit Sub End If z=z+1 Loop B=B+1 Loop A=A+1 Loop ' oder anderes Bsp.: 'Datei aufsetzen, loslassen, wird kopiert oder Zeichen einzeln in Zeilen gesetzt! Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Arg=Wscript.Arguments For i=0 to Arg.Count -1 Objekt=Arg(i) Next If Objekt="" then MsgBox VbCR&" Bitte eine Datei aufsetzen,"&_ VbCR&VbCR&" dadurch startet diese VBS-Datei ! "&VbCR If Objekt="" then WScript.Quit Set Data=Fso.CreateTextFile(Left(Objekt,InStrRev(Objekt,".")-1)&"_Neu.txt") Set File=Fso.OpenTextFile(Objekt) Do Txt=File.Read(1) 'bei Read(k) wird in k-er-Gruppen gelesen Data.WriteLine(Txt) 'bei Read(1) werden Zeichen einzeln in Zeile gesetzt 'Data.Write(Txt) 'bei Write statt WriteLine einfache Kopie Loop until File.AtEndOfStream ' Weiteres Bsp. s. 36 (Z u f a l l s-G e n e r a t o r) ' Weiteres Bsp. s. 83 (a l p h a b e t. S o r t i e r e n) 035 PopUp-Meldung, zeitl. festgelegte Zwischenmeldung: ****************************************************** ' Popup-Meldung erscheint hier 5 Sek lang: Set WshShell=WScript.CreateObject("WScript.Shell") WshShell.Popup VbCR&" X wurde erledigt! ",5, _ " Zwischenmeldung",VbCritical Titel=" Zwischenmeldung" UV=VbCR&VbCR Wss.Popup UV&UV&VbTab&_ "Bitte den 1. Bildordner aussuchen !"&_ " "&_ UV&UV,5,Titel,VbInformation '30 s-Schalt-Fenster mit angezeigter Restzeit Set WshShell=WScript.CreateObject("WScript.Shell") UV=VbCR&VbCR Zeit1=Timer Zeit2="0" Do until Zeit2>0 Zeit2=Timer-30-Zeit1 Zeit=CInt(30-(Timer-Zeit1)) Ask=WshShell.Popup (UV&UV&_ "Noch ist das Sudoku - Rätsel ungelöst !"&UV&_ "Gleich wird systemat. Probieren versucht !"&UV&_ "Das kann aber sehr viele Minuten dauern !"&UV&_ "Wenn nicht gewünscht "" Nein "" tippen ! "&_ UV&VbCR&"Noch "&Zeit&" Sek. ! ! !"&UV&UV,2,Titel,48+4+0) '48 für "Achtung" '4 für VbYesNo '0 für "Ja" als Default If Ask>0 then Zeit2=1 Loop 036 Zufalls - Generator: ************************ 'Randomize 3 ' Initialisiert Zufallszahlengenerator mit 3 als Startwert Rnd -3 ' Beginnt mit -3 als Startwert ' Sowohl die Zahl als auch der Befehl "Randomize" sind unnötig Do until Antwort=VbNo ' oder Antwort="7" Wert=Int((6*Rnd)+1) ' Erzeugt eine Zufallszahl zwischen 1 und 6. MsgBox VbTab&Wert,, " Würfelspiel " Antwort=MsgBox(" Noch einmal würfeln? ",VbYesNo," Würfelspiel") Loop 'Bilder mit Nummer ins Dictionary Set Ordner=Fso.GetFolder(Archiv).Files i=0 For each File in Ordner Dict.Add i,File.Path i=i+1 Next 'Bild auslosen, speichern If i>0 then Randomize Schirm=Int(Rnd*Dict.Count) ' auch Fix( ) möglich Fso.Copyfile Dict(Schirm),Platz&Bild End If 037 Stopp - Uhr: **************** Datei: StoppUhr.vbs ' Problem ! : Der Rechner läuft während der Messung in Volllast! Set Fso = WScript.CreateObject("Scripting.FileSystemObject") If Fso.FileExists("Ende.txt") then MsgBox"Löschen Sie die Datei ""Ende.txt""" If Fso.FileExists("Ende.txt") then WScript.Quit MsgBox" Die Stop-Uhr zu beenden, müssen Sie die "&VbCR& _ "vorbereitete Datei ""Ende.txt"" in den Ordner kopieren "&VbCR& _ " Mit dem Befehl "" OK "" startet die Messung "&VbCR,,"" Beginn=Timer n=0 Do n=n+1 If Fso.FileExists("Stop.txt") then Exit Do Ende=Timer Loop Msgbox "Die Zeit betrug "&Ende - Beginn&" sec" 038 Timer: ********** ' Der Timer nennt die seit 0 Uhr vergangenen Sekunden, die Differenzen ' eignen sich daher für Zeit-Messungen. Falls eine Messung durchgeführt wurde, ' muss Stoppen.vbs gelöscht werden. Beginn=Timer Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set WshShell=WScript.CreateObject ("WScript.Shell") Set Data=Fso.OpenTextFile(WScript.ScriptName,8,true) Set Data=Fso.OpenTextFile(WScript.ScriptName & ".txt", 8, true) Data.WriteBlankLines(1) Data.WriteLine("Start = "&""""& Beginn&"""" ) Data.WriteLine("MsgBox Timer - Start") Data.Close Set Data=Nothing Fso.MoveFile"Timer.vbs.txt","Stoppen.vbs" 039 Dateien öffnen: ******************* Set WshShell=WScript.CreateObject("WScript.Shell") Datei="C:\Tools\CopyData\Data\Copy.vbs" WSHShell.Run"Notepad """&Datei&""" " ,,true ' Die Leerstelle hinter Notepad muss sein ! 'oder: Set WshShell=WScript.CreateObject ("WScript.Shell") WSHShell.Run"Notepad """&"C:\Tools\CopyData\Data\Copy.vbs"&""" ",,true 's.a. 2 und 3 040 Datei-Namen oder Verzeichnis isolieren u. ä.: ************************************************* Set Fso=WScript.CreateObject("Scripting.FileSystemObject") ' Verzeichnisse abhängen bei def. Datei, aus C:\Ab\Excel.vbs wird "Excel.vbs" Datei=Fso.GetFileName(Datei) ' Endung, z.B. VBS, erkennen: Endg=Right(Fso.GetFileName("C:\Ab\Excel.vbs"),3) ' oder ' Dateiendung suchen: Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Extens=LCase(Fso.GetExtensionName("C:/Spiele/Sudoku/Rätsel/Probe/Sudo147.TXT")) MsgBox Extens,," Dateiendung suchen " ' Verzeichnisse nennen zu Datei, z.B. aus C:\Ab\Excel.vbs wird "C:\Ab" Datei=Fso.GetParentFolderName(Datei) ' Verzeichnisse u. Endung streichen zu Datei, aus C:\Ab\Excel.vbs wird "Excel" Datei=Fso.GetBaseName(Datei) ' Datei/Ordner(!) ohne Verzeichnisse nennen, aus C:\Ab\Test.vbs wird "Test.vbs" Datei=Fso.GetFileName(WScript.ScriptFullName) ' Verzeichnisse nennen zu Datei, z.B. aus C:\Ab\Copy.vbs wird "C:\Ab" Datei=Fso.GetParentFolderName(WScript.ScriptFullName) 'Besser: Verzeichnis auch für Stammverzeichnisse richtig finden: 'Replace(Datei,Fso.GetFileName(Datei),""), ergibt aber : "C:\Ab\" !!! ' Stammverzeichnisse abtrennen, z.B. aus C:\Ab\Copy.vbs wird "Ab\Copy.vbs" Versuch=Mid(Datei,4) ' Rest ab 4.Stelle ' Aktuelle Datei und ihren vollen Namen ausgeben MsgBox WScript.ScriptName&" | "&WScript.ScriptFullName 041 Variable, Befehle daran ausführen: ************************************** Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Befehl="1" 'Bei Setzung muss Zahl in " " Ziel="E:\Ab\Sicher1" Ziel1=Fso.GetParentFolderName(""&Ziel&"") 'oder Ziel1=Fso.GetParentFolderName(Ziel) If Befehl=1 then MsgBox ""&Ziel&"" ' oder MsgBox Ziel 'Bei Übertragung von Zahlen aus Sub- oder Function-Befehlen kann die Zahl 'ungenau werden und muss wieder gerundet werden ! ! ! If Int(Befehl)=1 then ... 042 Datei aufsetzen und Teile erkennen lassen: ********************************************** 'Name aufgesetzter Dateien oder Ordner wird ermittelt und angezeigt: Set Arg=Wscript.Arguments '(Folgendes läuft nicht, wenn nichts aufgesetzt) 'Arg.Count ist Zahl aufgesetzter Dateien, mind. 1 'Da VBS immer mit 0 anfängt, i bis Arg.Count-1 laufen lassen: For i=0 to Arg.Count-1 'oder: 'For i=1 to Arg.Count Dat=Arg.Item(0) 'aufgesetzte Datei benennen 'kürzer: ' Dat=Arg(0) WScript.Echo Arg(0) 'aufgesetzte Datei wird angezeigt in MsgBox Next If Dat="" then 'nach MsgBox schließen MsgBox VbCR&" Bitte eine Datei aufsetzen,"&_ VbCR&VbCR&" dadurch startet diese VBS-Datei ! "&VbCR:WScript.Quit End If 'Es reicht auch ganz allein: '(ergibt aber Fehler, wenn nichts aufgesetzt wird) Set Arg=Wscript.Arguments Dat=Arg(0) Oder noch : ----------- 'In DeChfHtm.htm : WShShell.Run "C:\Tools\Chiffre\Data\DeChfHtm.vbs"&" "&Word&" "&Name&" "&Grad 'In DeChfHtm.vbs : 'Passwort, Name, Grad als Arg(i) Set Arg=Wscript.Arguments For i=0 to Arg.Count -1 Next Teile=i-1 Word=Arg(Teile-2) Name=Arg(Teile-1) Grad=Arg(Teile) 'Leerstellen u. "" können nicht übertragen werden u. wurden vorher umgewandelt 'in Chr(31) bzw. Chr(30): Passwort wieder mit problemat. Leerstellen u. "" ! Laenge=Len(Word) i=1 Do until i=Laenge+1 ReDim Preserve Wrt(i) Wrt(i)=Mid(Word,i,1) If Wrt(i)=Chr(31) then Wrt(i)="""" If Wrt(i)=Chr(30) then Wrt(i)=" " i=i+1 Loop Word="" i=1 Do until i=Laenge+1 Word=Word&Wrt(i) i=i+1 Loop Wort=Word MsgBox "|"&Word&"|"&Name&"|"&Grad&"|" WScript.Quit 043 Ordner - Unterordner - Kette anlegen: ***************************************** ' Falls ein Ordner nicht existiert, wird er geschaffen( bis zu 6 Unterordner): ' z.B. : Ziel0="E:\Sicher1\Sicher2\Sicher3\Sicher4\Sicher5\Sicher6\" Ziel0="E:\Sicher1\Sicher2\Sicher3\Sicher4\Sicher5\Sicher6\" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Ziel=Ziel0 Do until Ziel="" Ziel7=Ziel6 Ziel6=Ziel5 Ziel5=Ziel4 Ziel4=Ziel3 Ziel3=Ziel2 Ziel2=Ziel1 Ziel1=Ziel Ziel=Fso.GetParentFolderName(Ziel) Loop Ziele=Ziel2 Do until Ziele="" If not(Fso.FolderExists(Ziele)) and not Ziele="" then _ Set TextStream=Fso.CreateFolder(Ziele) Ziele=Ziel3 Ziel3=Ziel4 Ziel4=Ziel5 Ziel5=Ziel6 Ziel6=Ziel7 Ziel7="" Loop 044 Zeit - Differenzen, Tage zählen: ************************************ ' Der wievielte Tag des Jahres liegt vor? Jahr=2004 Tage=DateDiff("y","31.12.2003","11.2."&Jahr) 'Tage=DateDiff("y","5.2.2004","11.11.2004") 'Abstand in Tagen MsgBox Tage ' Wann z. B. 20000 Tage alt ? Titel=" Datum zu Tageszahl berechnen ! " Ask1=InputBox (VbCR&VbCR&VbCR&VbCR&VbTab&" Bitte das Anfangsdatum angeben !"&_ VbCR&VbCR&VbCR&VbCR&VbCR,Titel) If Ask1="" then WScript.Quit Ask2=InputBox (VbCR&VbCR&VbCR&VbCR&VbTab&" Bitte die Tageszahl angeben !"&_ VbCR&VbCR&VbCR&VbCR&VbCR,Titel) If Ask2="" then WScript.Quit Tage=DateDiff("y",Ask1,Date) 'Abstand in Tagen zwischen "Ask1" und heute MsgBox VbCR&VbCR&VbCR&" Der Zeitraum bis heute beträgt in Tagen "&_ VbCR&VbCR&" "&Tage&VbCR&VbCR&VbCR,,Titel TageN=Ask2-Tage DateN=Date+TageN Wort="sind" If DateN0 then WScript.Quit Set All=Nothing On Error GoTo 0 'Ignorieren der Fehler aufheben ! MsgBox VbCR&VbCR&VbTab&Pfad&" "&VbCR&VbCR 050 Windows beenden: ******************** ' Für Win 9X und ME Set WshShell=WScript.CreateObject("WScript.Shell") ' Neustart: 'WshShell.Run"RunDll Shell32.Dll,ShExitWindowsEx 7" ' Ausschalten: 'WshShell.Run"RunDll Shell32.Dll,ShExitWindowsEx 13" s.a. 116 051 Registry, dort Befehle einfügen: ************************************ ' A C H T U N G ! ! ! '****************************************** ' Diese Datei ist gefährlich (?) und schreibt in die Registratur !!! ' Von Hand aber zu korrigieren über "Start\Ausführen" mit dem Befehl "Regedit" ' Dort in "HKEY_CURRENT_USER\ . . . " (s.u.) im Menu mit "Bearbeiten/Ändern" wieder ändern ! UV=VbCR&VbCR Ask=MsgBox(UV&VbCR&"Diese Datei greift in die Registratur ein ! ! ! "&_ UV&"Öffnen Sie ggf. mit "" NotePad.exe "" die Datei !"&_ UV&"Das Desktop-Bild wird auf ""Kein Bild"" gesetzt !"&_ UV&" Wollen Sie weiter machen ?"&UV&VbCR, _ VbYesNo+VbCritical," ! ! ! Achtung ! ! !") If Ask=VbNo then WScript.Quit Set Obs=CreateObject("WScript.Shell") ' Objekt definieren für die Arbeit des Programmes 'Obs.RegWrite"HKCU\Software\Microsoft\Internet Explorer\Desktop\General\Wallpaper", _ ' "C:\Tools\Desktop\Desktop.jpg" ' oder 'Obs.RegWrite"HKCU\Software\Microsoft\Internet Explorer\Desktop\General\Wallpaper","" 'oder: '***** Set Regist=CreateObject("WScript.Shell") 'Schreiben in die Registry 'In Registry schreiben: 'Für Win98 und Win ME: 'If not Fso.FolderExists(Dat3) then 'Ort="HKCU\Software\Microsoft\Internet Explorer\Desktop\General\Wallpaper" 'Regist.RegWrite Ort,"C:\Tools\Desktop\Desktop.jpg" 'End If 'Für Win XP: 'If Fso.FolderExists(Dat3) then 'Regist.RegWrite "HKCU\Control panel\Desktop\Wallpaper", _ ' "C:\Tools\Desktop\Desktop.jpg" 'End If 'Wichtig: '******** 'Hinter Wallpaper kein "\" setzen !!! - Es wird sonst ein Unter-Ordner "Wallpaper" unter '"General" gesetzt und der Key "Standard" mit Wert: "C:\Tools\Desktop\Desktop.jpg" belegt 'Nur wie hier geschrieben, wird der Key "Wallpaper" mit Wert "C:\Tools\Desktop\Desktop.jpg" 'oder "" definiert! "" bedeutet kein Bild ! 052 Der Ort der Win - Version ist: ********************************** ' 1 Set WshShell=WScript.CreateObject("WScript.Shell") WinDir=WshShell.ExpandEnvironmentStrings("%WinDir%") MsgBox WinDir&"\",," Das Betriebssystem ist auf . . . " ' oder ' 2 Set WSHShell=WScript.CreateObject("WScript.Shell") Set Env =WSHShell.Environment("Process") MsgBox Env("WinDir")&"\",," Das Betriebssystem ist auf . . . " ' oder ' 3 Set WshShell=WScript.CreateObject("WScript.Shell") WinDir=Left(WshShell.SpecialFolders("Desktop"), _ InStrRev(WshShell.SpecialFolders("Desktop"),"\") -1) MsgBox WinDir&"\",," Das Betriebssystem ist auf . . . " ' hängt letzten Ordner ab, bloß warum? s.a. 5 ' oder über "Fonts" ' 4 Set WshShell=WScript.CreateObject("WScript.Shell") WinDir=Left(WshShell.SpecialFolders("Fonts"), _ InStrRev(WshShell.SpecialFolders("Fonts"),"\") -1) MsgBox WinDir&"\",," Das Betriebssystem ist auf . . . " 'oder ' 5 Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set WshShell=WScript.CreateObject("WScript.Shell") WinDir=WshShell.SpecialFolders("Fonts") WinDir=Fso.GetParentFolderName(WinDir) MsgBox WinDir&"\",," Das Betriebssystem ist auf . . . " 053 Der Typ der Win - Version ist: ********************************** Set Wss=WScript.CreateObject("WScript.Shell") On Error Resume Next 'Fehlermeldung unterdrücken 'Liest in Win98 / ME : OpSys=Wss.RegRead _ ("HKLM\Software\Microsoft\Windows\CurrentVersion\Productname") 'Liest in Win XP : OpSys=Wss.RegRead _ ("HKLM\Software\Microsoft\Windows NT\CurrentVersion\Productname") On Error GoTo 0 'Fehlermeldung wieder zulassen MsgBox VbCR&VbCR&VbTab&OpSys&" "&_ VbCR&VbCR,," Das System ist . . ." 054 Herauslesen vom Anfang oder Ende einer Variablen: ***************************************************** Set WshShell=WScript.CreateObject("WScript.Shell") Txt=Left(WSHShell.ExpandEnvironmentStrings("%WinDir%"),3) '3 für 3 Zeichen, auch mit Right erlaubt! MsgBox Txt,,"Festplatte der Win - Version ist . . ." 055 Temp. Internet - Dateien löschen: ************************************* Set WshShell=WScript.CreateObject("WScript.Shell") Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set ObjFileSystem=CreateObject("Scripting.FileSystemObject") WinDir=WshShell.ExpandEnvironmentStrings("%WinDir%") Titel=" Temporäre Internet - Dateien löschen " Txt1=VbCR&VbCR&"Die temporären Internet-Dateien löschen ?"&VbCR&VbCR Ask=MsgBox(Txt1,VbOkCancel+VbQuestion,Titel) If Ask=VbCancel then WScript.Quit ' Damit ggf. Dateien zu löschen sind und das Programm nicht blockiert! Fso.CopyFile"C:\Tools\CookTemp\Data\Abcd.txt",WinDir& _ "\Local Settings\Temporary Internet Files\" Fso.CopyFile"C:\Tools\CookTemp\Data\Abcd.txt", _ WinDir&"\Temporäre Internetdateien\" File=WinDir&"\Local Settings\Temporary Internet Files\*.*" Fso.DeleteFile(File),True File=WinDir&"\Temporäre Internetdateien\*.*" Fso.DeleteFile(File),True WScript.CreateObject("WScript.Shell"). _ Run"C:\Tools\CookTemp\Data\Del_IE5.bat",,True ' Content.IE5 ist mit VBS unangreifbar MsgBox VbCR&" Die temp. Internet - Dateien wurden gelöscht !" _ &VbCR,VbOKOnly,Titel WScript.Quit ' dazu als Dos-Datei Del_IE5.bat : Echo off IF EXIST %WINDIR%\COMMAND\DELTREE.EXE DELTREE /Y %WinDir%\Tempor~1\Content.IE5 IF NOT EXIST %WINDIR%\COMMAND\DELTREE.EXE RMDIR /Q /S s.n.Zeile %WinDir%\Tempor~1\Content.IE5 Del /Y %WinDir%\Tempor~1\Content.IE5\*.* Cls 056 Sub - Befehl: ***************** s. auch Function . . . . If Ask=VbCancel then Ende ' soll in "Sub Ende" weiter arbeiten Ende ' allein, ohne if .. , auch möglich im Programmablauf . . . . . . . . Sub Ende . . . . 'ggf. auch WScript.Quit End Sub ' aus dem Sub-Bereich sind wieder weitere Sub-Aufrufe möglich If Passrt=1 then Neudef Sub Neudef 'Aus diesem Bereich weitere Sub-Aufrufe: Zeilspalt Quadrat Belegng End Sub 057 Zeichenketten untersuchen: ****************************** 'Variablen-Kette von links, rechts abzählen, Zeichen in Mitte suchen usw. Eingabe="x1234y123456789123z1234" MsgBox Eingabe MsgBox "Länge: "&Len(Eingabe) ' Zählt Länge der Eingabe Versuch1=Left(Eingabe,5) ' Nennt die linken 5 Stellen Versuch2=Mid(Eingabe,6) ' Nennt Rest mit 6. Stelle beginnend Versuch3=Mid(Eingabe,6,2) ' Nennt mit 6. Zeichen beginnend 2 Zeichen Versuch4=Right(Eingabe,5) ' Nennt die rechten 5 Stellen MsgBox "ersten 5 Stellen : "&Versuch1 MsgBox "Rest von 5. Stelle an : "&Versuch2 MsgBox "2 Zeichen mit 6. Stelle beginnend : "&Versuch3 MsgBox "letzten 5 Stellen : "&Versuch4 Test1=InStr(Eingabe,3) ' nennt an welcher Stelle die 3 zuerst erscheint Test2=InStrRev(Eingabe,3) ' nennt an welcher Stelle die 3 zuletzt erscheint 'Bei manchen zu suchenden Zeichen sind "" zu setzen! MsgBox "Stelle der ersten ""3"" : "&Test1 MsgBox "Stelle der letzten ""3"" : "&Test2 058 Startmenü um verschiedene Programme zu starten: *************************************************** Set Wss=CreateObject ("WScript.Shell") Input=InputBox ("Welches Programm soll gestartet werden?"&VbCR&VbCR& _ "1 = Notepad"&VbCR&"2 = Excel"&VbCR&"3 = Winword","Programmauswahl") Select case Input Case "1" Wss.Run("%WinDir%\notepad.exe") Case "2" Wss.Run "Excel" Case "3" Wss.Run "WinWord" Case else MsgBox " Ungeeignete Eingabe!" End Select 059 Datei vollständig zeilenweise auslesen: ******************************************* Datei="C:\Ablage\Test.txt" Set Datei=ObjFileSystem.OpenTextFile(Datei) i=1 Do until Datei.AtEndOfStream ReDim Preserve Zeile(i) Zeile(i)=Datei.ReadLine i=i+1 Loop MsgBox VbCRLF&" Es sind "&i-1&" Zeilen und "&VbCR&VbCR&_ " die 7. ist "&Zeile(7)&VbCR 060 Datei, Hilfsdatei dazu erzeugen: ************************************ ' Diese Hilfsdatei wird im gleichen Verzeichnis erzeugt Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Data=Fso.OpenTextFile(WScript.ScriptName&".txt",8,true) '"8,true" falls nicht da 'oder kurz neu schaffen: 'Set Data=Fso.CreateTextFile(WScript.ScriptName&".txt") Txt=" Test " Data.WriteLine(" ") Data.WriteLine(Txt&" 1") Data.WriteLine(" ") Data.Write(Txt&" 2") Data.WriteBlankLines(5) Data.Write(Txt&" 3") Data.Close 061 Datei in Einzelzeilen auslesen: *********************************** Set ObjFileSystem=CreateObject("Scripting.FileSystemObject") Lesen="C:\Ablage\Test.txt" Set Datei=ObjFileSystem.OpenTextFile(Lesen) ReDim Preserve Zeile(1) ReDim Preserve Zeile(3) Zeile(1)=Datei.ReadLine Zeile(3)=Datei.ReadLine Datei.Close Set Datei=Nothing Txt1=Zeile(1) Txt2=Zeile(3) MsgBox Txt2 062 Datei, Zeichen darin suchen: ******************************** Schreibt Zeichen vor dem # in 1. Zeile, die danach in die 2. Zeile Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Data=Fso.OpenTextFile(WScript.ScriptName&".txt",8,true) Eingabe="123#45" Symb="#" Do until Len(Eingabe)=0 Txt=Left(Eingabe,1) If not Txt=Symb then Data.Write(Txt) If Txt=Symb then Data.WriteLine("") Eingabe=Right(Eingabe,Len(Eingabe)-1) Loop Data.WriteBlankLines(5) Data.Close 063 Datei anlegen: ****************** 'Zu einer Datei Txt-Datei mit gleichem Inhalt anlegen, s.a. 60 Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Datei="C:\Ab\Test.vbs" Dat=Fso.GetBaseName("C:\Ab\Test.vbs")&"-Neu.txt" Set File=Fso.OpenTextFile(Dat,2,true) File.Close Fso.CopyFile Datei,Fso.GetBaseName("C:\Ab\Test.vbs")&"-Neu.txt" 'oder Text hinzu schreiben,s.32 'oder ganz neu anlegen: Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Data=Fso.CreateTextFile("C:\Ablage\Versuch.txt") 'Der Pfad "Ablage" muss existieren ! 064 Function anwenden und Arrey - Speicherung: ********************************************** 'Function ist Sub verwandt 'Aufgesetzte Dateien zeilenweise nach 1. Zeichen alphabetisch ordnen Set WshShell=WScript.CreateObject("WScript.Shell") Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Arg=Wscript.Arguments For i=0 to Arg.Count -1 If i=0 then Dat=Arg.Item(i) Next Set File1=Fso.OpenTextFile(Dat,1,true) i=0 Do until File1.AtEndOfStream ReDim Preserve ArrTest(i) ArrTest(i)=File1.ReadLine i=i+1 Loop ArrSort=Sort(ArrTest) Stamm=Fso.GetParentFolderName(Dat) Dat=Fso.GetBaseName(Dat)&"-Sort.txt" Dat=Stamm&"\"&Dat Set File2=Fso.OpenTextFile(Dat,2,true) For i=0 to UBound(ArrTest) File2.WriteLine(i+1&VbTab&ArrTest(i)) Next WshShell.Run"Notepad """&Dat&"""" Function Sort(ArrSort) For i=0 to UBound(ArrSort) For k=i+1 to UBound(ArrSort) If UCase(arrSort(i))>UCase(ArrSort(k)) then Sort=ArrSort(i) ArrSort(i)=ArrSort(k) ArrSort(k)=Sort End if Next Next End Function ' oder anderes Bsp.: ' ********************** 'AskFeld in InputBox ermittelt, kann "nächste" oder zweistellige Eingabe 'sein. Klären, ob Eingabe korrekt, nur über Function oder Sub möglich, 'da der Fefehl "Asc" bei "" zu Fehlermeldung führt ' Bsp.: AskFeld="20" 'muss von 11 bis 99 sein, ohne Nullen! 'Zahlen korrekt? If Len(AskFeld)=2 then AskFd '************** Function AskFd If not (Asc( Left(AskFeld,1))>48 and Asc( Left(AskFeld,1))<58) _ or not (Asc( Right(AskFeld,1))>48 and Asc( Right(AskFeld,1))<58) then MsgBox VbCR&VbCR&VbCR&" Falsche Eingabe ! "&_ VbCR&VbCR&VbCR,VbCritical,Titel WScript.Quit End If End Function '************** 065 Eingabe wird gemäß dem Zeichen " # " gesplittet: **************************************************** Symb="#" Eingabe="123#456#789#101112#345" MsgBox VbCR&VbCR&Eingabe&VbCR&VbCR,," Eingabe ist z. B." Test=Split(Eingabe,Symb) MsgBox VbCR&VbCR&Test(0)&" "&Test(1)&" "&Test(2)&" "&Test(3)&" "&_ Test(4)&VbCR&VbCR,," aufgeteilt:" ' oder 'Eingabe mit max. 4 Teilen: Eingabe=InputBox (VbCR&VbCR&VbCR&_ "Es waren höchstens 4 Unter - Ordner möglich ,"& VbCR&VbCR&_ "diese wurden mit dem Zeichen "" # "" getrennt !"& VbCR&VbCR&_ "Überprüfen Sie die Namen der Unter - Ordner :"& VbCR&VbCR&_ VbCR&VbCR,Titel,"Original#Zwischen#Bearbtng") If Eingabe="" then WScript.Quit ' Abbruch, wenn "Cancel"("") 'Eingabe aufspalten in max. 4 Teile: ReDim Preserve Name(4) Name(1)="0" Name(2)="0" Name(3)="0" Name(4)="0" 'Aufspaltung in Ort( ) Ort=Split(Eingabe,"#") 'Vorhandene Eingaben auswählen ReDim Preserve Ort(4) If not Ort(0)="" then Name(1)=Ort(0) If not Ort(1)="" then Name(2)=Ort(1) If not Ort(2)="" then Name(3)=Ort(2) If not Ort(3)="" then Name(4)=Ort(3) 'Eingaben zur Sicherheit melden Meld1=Name(1) Meld2=Name(2) Meld3=Name(3) Meld4=Name(4) If Meld2="0" then Meld2="" If Meld3="0" then Meld3="" If Meld4="0" then Meld4="" MsgBox VbCR&VbCR&VbCR&VbTab&_ "Waren folgende Unter - Ordner angelegt ? "&_ VbCR&VbCR&VbTab&Meld1&VbCR&VbCR&VbTab&Meld2&VbCR&VbCR&VbTab&Meld3&VbCR&VbCR&_ VbTab&Meld4&VbCR&VbCR,," Unterordner bilden !" 'Wichtig: bei mehreren Zeichen, z.B. VbCR keine "" setzen 066 Datei, alle Zeichen je in eine Zeile setzen: ************************************************ Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Dat1="C:\Tools\Chiffre\Data\Code.txt" Dat2="C:\Tools\Chiffre\Data\Datei.txt" Set File=Fso.OpenTextFile(Dat1) Set Data=Fso.CreateTextFile(Dat2) i=1 Do until File.AtEndOfStream Txt=File.Read(1) Data.WriteLine(Txt) i=i+1 Loop Data.Close File.Close 067 Shredder: ************* 'Zu löschende Datei aufsetzen, loslassen, wird unwiederbringlich gelöscht!! Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Arg=Wscript.Arguments For i=0 to Arg.Count -1 Objekt=Arg(i) Next If Objekt="" then MsgBox VbCR&" Bitte eine Datei aufsetzen,"&_ VbCR&VbCR&" dadurch startet diese VBS-Datei ! "&VbCR If Objekt="" then WScript.Quit 'Link?! If Right(Objekt,3)="lnk" or Right(Objekt,3)="Lnk" or Right(Objekt,3)="LNK"then _ Ask=MsgBox(VbCR&VbCR&" Die zu löschende Datei ist nur ein Link !"&_ VbCR&VbCR&"Wollen Sie wirklich nur dieses Link löschen "&_ VbCR&VbCR&" und nicht die eigentliche Datei selbst?"&_ VbCR&VbCR&" Sonst mit "" Nein "" Löschen beenden !"&_ VbCR&VbCR,VbYesNo+VbDefaultButton2+VbCritical," Shredder !" ) If (Right(Objekt,3)="lnk" or Right(Objekt,3)="Lnk" or Right(Objekt,3)="LNK") and _ Ask<>vbYes then WScript.Quit 'Datei 5x überschreiben, löschen Text="Die Datei wurde beim Löschen mindestens 5-mal überschrieben!" Frage=MsgBox(VbCR&" Wollen Sie die hier aufgesetzte Datei "&_ VbCR&VbCR&" "" "&Objekt&" "" "&" unwiederbringlich löschen ?"&_ VbCR&VbCR,VbCritical+VbYesNo," Loeschen !") If Frage=VbNo then WScript.Quit i=1 Do until i=6 Set Data=Fso.CreateTextFile(Objekt) k=1 Do until k=201 Data.WriteLine(Text) k=k+1 Loop Data.Close i=i+1 Loop Set Data=Fso.CreateTextFile(Objekt) Data.WriteLine(Text) Data.Close Fso.DeleteFile(Objekt),true 068 Kleine oder große Buchstaben erzeugen: ****************************************** Name1=LCase("Test-Wort") 'erzeugt kleine Buchstaben bei "Test-Wort" Name2=UCase("Test-Wort") 'erzeugt große Buchstaben bei "Test-Wort" MsgBox VbCR&VbCR&""" Test-Wort "" klein geschrieben : "&_ VbCR&VbCR&Name1&VbCR&VbCR&"und groß geschrieben :"&VbCR&VbCR&Name2&VbCR&VbCR 069 Variable in neue Anwendung mitnehmen: ***************************************** ' Variablen aus dieser Datei können in die nächste, aufgerufene ' übertragen werden. Wort=InputBox(VbCR&_ "Bitte ein Passwort eingeben ! Es muss mindestens"&VbCR&VbCR&_ "8 Zeichen haben ! Alle Zeichen sind zulässig !"&VbCR&VbCR) If Len(Wort)<8 then MsgBox VbCR&"Passwort fehlt oder zu kurz ! "&VbCR&VbCR, _ VbCritical," Abbruch ! " If Len(Wort)<8 then WScript.Quit Name=InputBox(VbCR&_ "Bitte zu entschlüsselnde Datei nennen !"&VbCR&VbCR) If Name="" then WScript.Quit Set WshShell=CreateObject("WScript.Shell") Set Fso=WScript.CreateObject("Scripting.FileSystemObject") 'Bsp. einer zu startenden zweiten Datei, an derem Anfang die übernommenen 'Variablen aufgesammelt werden müssen: 'Dieser Anfang muss bei bereits existierender Datei vorhanden sein, 'oder er muss an den Anfang geschrieben werden wie hier: Set Data=Fso.CreateTextFile("C:\Ab\Testen.vbs") Data.WriteLine("Set Arg=WScript.Arguments") Data.WriteLine("For i=0 to Arg.Count -1") Data.WriteLine("If i=0 then Wort=Arg.Item(i)") Data.WriteLine("If i=1 then Name=Arg.Item(i)") Data.WriteLine("Next") Data.WriteLine("") Data.WriteLine("Wort="&""""&Wort&"""") 'In Datei zur Demonstration einfügen, 'bleibt eigentlich ja geheim ! Data.WriteLine("Name="""&Name&"""") 'oder kürzer ! Data.WriteLine("") Data.WriteLine("MsgBox Wort&"" ""&Name")'Anzeige zur Demonstration Data.Close 'Hinter dem Startbefehl werden die Variablen übertragen und am 'Anfang der zu startenden Datei aufgesammelt, s. Beispiel o.: WShShell.Run "C:\Ab\Testen.vbs"&" "&Wort&" "&Name Oder 'Aufgesetzte Datei wird ermittelt Titel=" Datei unwiederbringlich löschen !" Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Arg=Wscript.Arguments For i=0 to Arg.Count -1 Objekt=Arg(i) Next 'Der Anhang &" "&Objekt bedeutet, dass aufgesetzte Datei 'an "Shred.exe" zum Löschen übergeben wird WScript.CreateObject("WScript.Shell")._ Run"C:\Tools\Chiffre\Data\Shred.exe"&" "&Objekt Oder 'Beim 2. Durchlauf die Wünsche aus dem 1. Durchlauf aufsammeln: Wunsch="" 'gleich zu äußernden Wunsch zunächst leer setzen, 'um den Anfang von "Un_Inst.vbs" zu steuern 'Die Rück-Übertragung der gleich zu äußernden Wünsche beim 2. 'Durchlauf einlesen: Set Arg=Wscript.Arguments For i=1 to Arg.Count Next Teile=i 'Zahl der Informationen im Eingangsbefehl 'Wurde ein Befehl, und welcher mitgegeben? If Teile=2 then Wunsch=Arg(0) '************************************************************** 'Nur beim 1. Durchlauf abarbeiten ! '********************************** If Wunsch="" then UV=VbCR&VbCR Ask=MsgBox(UV&UV&" Beim Befehl "" Abbrechen "" wird abgebrochen !"&_ UV&" Wollen Sie dieses Programm völlig löschen ?"&_ UV&" Falls nicht so gewünscht, bitte "" Nein "" tippen ! "&_ UV&" Die Schirmbild - Dateien bleiben dann erhalten !"&UV&UV,_ VbYesNoCancel+VbDefaultButton3+VbCritical,Titel) If Ask="2" then MsgBox UV&UV&VbTab&_ " Dann bleibt alles ! "&_ UV&UV,,Titel:WScript.Quit If Ask="6" then Loesch="1" If Ask="7" then Loesch="0" 'Evtl. temp. Ordner für ausgelagerte "Un_Inst.vbs" anlegen: If not Fso.FolderExists("C:\Tmp") then Fso.CreateFolder("C:\Tmp") Fso.CopyFile "C:\Tools\Desktop\Un_Inst.vbs","C:\Tmp\" 'Im 1. Durchlauf die ausgelagerte "Un_Inst.vbs" aufrufen und '"Loesch" - Wunsch mitgeben: Wss.Run "C:\Tmp\Un_Inst.vbs"&" "&Loesch WScript.Quit End If 070 Variablenliste Dat(k) für k=1 bis 7 anlegen *********************************************** Data="C:\Tools\Chiffre\" i=1 Do until i=8 k=i Do until k=i+1 ReDim Preserve Dat(k) If k=1 then Dat(1)=Data&"Code\Original.txt" If k=2 then Dat(2)=Data&"Code\Offen.txt" If k=3 then Dat(3)=Data&"Code\Original.lnk" If k=4 then Dat(4)=Data&"Code\Offen.lnk" If k=5 then Dat(5)=Data&"Data\Shred.exe" If k=6 then Dat(6)=Data&"Data\Shredder.vbs" If k=7 then Dat(7)=Data&"Lies.txt" k=i+1 Loop i=i+1 Loop MsgBox Dat(1)&" "&Dat(2)&VbCR&VbCR&" "&Dat(3)&" "&" "&Dat(4)&_ VbCR&VbCR&" "&Dat(5)&" "&" "&Dat(6)&VbCR&VbCR&" "&Dat(7) 071 Laufwerke, höchste aktive feststellen: ****************************************** Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set DriveList=Fso.Drives For each i in DriveList if 1=i.DriveType then Text1="Wechsel-LW ist"&" "&i.DriveLetter&":\ " if 2=i.DriveType then Text2="Festplatte ist "&" "&i.DriveLetter&":\ " ' if 3=i.DriveType then Text3="Netz-LW. "&" "&i.DriveLetter&":\ " if 4=i.DriveType then Text4="CD - ROM ist "&" "&i.DriveLetter&":\ " ' if 5=i.DriveType then Text5="RAM-LW. "&" "&i.DriveLetter&":\ " next MsgBox VbCR&" Das jeweils höchste aktive Laufwerk ist :"&VbCR&_ VbCR&VbCR&" "&Text2&VbCR&VbCR&_ " "&Text4&VbCR&VbCR&_ " "&Text1&VbCR&VbCR, _ ," Höchstes aktives Laufwerk " 'Weitere Laufwerke liegen sinngemäß daneben, Diskette immer A:\, 'Festplatten C:\ usw. bis zur genannten, CD-ROM liegen zwischen letzter Fest- 'platte und dem genannten CD-ROM, Wechsel-Laufwerke liegen zwischen genanntem 'CD-ROM und dem genannten Wechsel-Laufwerke. 072 Variablen in Text übertragen: ********************************* ' Die Variablen Name und Grad in eine Datei übertragen ... Data.WriteLine("Chiffriert als """&Name&""""&"("&".txt"&")"&_ " im Grad "&Grad&" mit Chiffre5.2 !") ... 073 Trimmen einer Variablen: **************************** Wort=" Test " Ltrim(Wort)="Test " ' Leerstellen links streichen Rtrim(Wort)=" Test" ' Leerstellen rechts streichen Trim(Wort)= "Test" ' Leerstellen beidseits streichen 074 Modulo-Funktion bei Zahlen: ******************************* ' Zahlen werden dividiert und der Rest angegeben: Asci(i)=Asci(i) Mod 72 ' ergibt 0 bis 71 MsgBox 111 Mod 37 ' ergibt 0, da 11:37=3 Rest 0 075 Join-Befehl zum Aneinanderfügen von z.B. aller Zfll(i): *********************************************************** '72-Block bilden und Zeichen zusammenfügen Randomize 'willkürl. Start i=1 Do until i=73 ReDim Preserve Zfll(i) Zfll(i)=Int(87*Rnd+34) '0-86 ziehen -> Zufallszahlen 34-120 Zfll(i)=Chr(Zfll(i)) i=i+1 Loop Zufall=Join(Zfll,"") ' Alle Zfll(i) werden hintereinander geschrieben ' Durch den Befehl ...,"" werden die Zufallszeichen ohne Lücke gesetzt, ' bei ...,"#") wird # dazwischen gesetzt MsgBox Zufall 076 CDBL, Streichen von Punkten: ******************************** Nr="1..2.3.....4...5....6.......7...8" Nr=Right(cdbl(Nr),5) 'Streichen der Punkte! MsgBox Nr 077 Dateienanzahl im Ordner zählen! *********************************** 'Arbeitsprogramm bestimmen Set Fso=WScript.CreateObject("Scripting.FileSystemObject") 'Ordner festlegen Ordner=InputBox(VbCR&VbCR&VbCR&" Bitte Ordner angeben," _ &VbCR&VbCR&" dessen Dateien zu zählen sind"&VbCR&VbCR&VbCR,, _ "C:\Spiele\Sudoku\Raetsel\Probe") If Ordner="" then WScript.Quit 'Warnmeldung, wenn Ordner nicht da If not Fso.FolderExists(Ordner) then MsgBox VbCR&VbCR&VbCR&VbCR&" Ordner """&Ordner&_ """ existiert nicht ! "&VbCR&VbCR&VbCR&VbCR, _ VbCritical," Dateienzahl im Ordner zählen" WScript.Quit End If 'Inhalt des Ordners anvisieren Set Inhalt=Fso.GetFolder(Ordner).Files 'Zahl der Dateien im Ordner feststellen ! MsgBox VbCR&VbCR&" "&Inhalt.Count&_ VbCR&VbCR,," Anzahl im Ordner" s.a. 113 078 Dateien des erfragten Ordner aufzählen, Liste schreiben: ************************************************************ 'Arbeitsprogramme bestimmen: Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Dict=CreateObject("Scripting.Dictionary") 'Ordner erfragen: Ordner=InputBox(VbCR&VbCR&VbCR&" Bitte Ordner angeben," _ &VbCR&VbCR&" dessen Dateien zu archivieren sind"&VbCR&VbCR&VbCR,, _ "C:\Spiele\Sudoku\Raetsel\Probe") If Ordner<>VbYes then WScript.Quit 'Warnmeldung, wenn Ordner nicht da If not Fso.FolderExists(Ordner) then MsgBox VbCR&VbCR&VbCR&VbCR&" Ordner """&Ordner&_ """ existiert nicht ! "&VbCR&VbCR&VbCR&VbCR, _ VbCritical," Dateien im Ordner archivieren" WScript.Quit End If 'Inhalt des Ordner anvisieren und die 'Dateien mit Nummern ins Dictionary stellen Set Inhalt=Fso.GetFolder(Ordner).Files i=0 For each File in Inhalt Dict.Add i,File i=i+1 Next Zahl=i 'Ordner vorm Dateinamen abtrennen i=0 Do until i=Zahl Dict(i)=Fso.GetFileName(Dict(i)) i=i+1 Loop 'Dateien im Ordner aufzählen: i=0 Do until i=Zahl MsgBox VbCR&" "&i+1&" / "&Dict(i)&" "&VbCR i=i+1 Loop 'Datei-Liste schreiben: Set Data=Fso.CreateTextFile("Liste.txt") Data.WriteLine("") Data.WriteLine("Ordner """&Ordner&""" enthält:") Data.WriteLine("") i=0 Do until i=Zahl Nr=i+1 Data.WriteLine(VbTab&Nr&" / "&Dict(i)) i=i+1 Loop Data.Close 079 VBS - Programm von innen beenden: ************************************* Titel=" B E E N D E N ! ! !" Txt=VbCR&VbCR&" Wollen Sie fortsetzen ? "&VbCR&VbCR Ask=MsgBox (Txt,VbCritical+VbYesNo+VbDefaultButton1,Titel) 'Klammern nötig im Vergleich zu einfacher MsgBox !!! Txt=VbCR&VbCR&" Das Programm wird beendet ! "&VbCR&VbCR If Ask<>VbYes then MsgBox Txt,,Titel WScript.Quit End If MsgBox VbCR&VbCR&" Es geht weiter ! "&_ VbCR&VbCR,,Titel 'oder auch kurz : Txt=VbCR&VbCR&" Das Programm auf 2. Weg beeenden ! "&VbCR&VbCR If Ask=VbYes then MsgBox Txt,,Titel:WScript.Quit MsgBox VbCR&VbCR&" Test, ob 2. Möglkt. abschaltet! "&VbCR&VbCR s.a. 114 080 Arrey anlegen: ****************** 'Ggf. am Anfang setzen, falls Sub- oder Function-Befehle: Dim Quad() ReDim Preserve Quad(3,3) ' Array mit 3 x 3 Feldern Quad(1,1)=Feld(1,1)&Feld(1,2)&Feld(1,3)&Feld(2,1)&Feld(2,2)&_ Feld(2,3)&Feld(3,1)&Feld(3,2)&Feld(3,3) ' usw. ' oder 'Array mit 9x3x3 Belegungen: 'Ggf. am Anfang setzen: Dim Ort() ReDim Preserve Ort(9,3,3) n=1 Do until n>9 a=1 Do until a>3 b=1 Do until b>3 Ort(n,a,b)="0" ' usw. ' oder 'Vorhandene Zahlen: i=1 Do until i>9 ReDim Preserve Zeich(i) Zeich(i)=Int(Mid(Quad(x,y),i,1)) i=i+1 Loop 081 Schalt-Fenster für 16 s mit eingeblendeter Restzeit ******************************************************* Set WshShell=WScript.CreateObject("WScript.Shell") Zeit1=Timer Do until Zeit2>0 Zeit2=Timer-16-Zeit1 Zeit=CInt(16-(Timer-Zeit1)) UV=VbCR&VbCR Ask=WshShell.Popup (VbCR&_ UV&"Die Zweier - Probe fand eine Lösung !"&UV&_ "Es wird jetzt in sämtlichen Feldern mit "&UV&_ "2 oder 3 Möglichkeiten geprüft, ob"&UV&_ "das Rätsel mehr als eine Lösung hat !"&UV&_ " Soll weiter geprüft werden ?"&UV&VbCR&_ "Noch "&Zeit&" Sek. ! ! !"&UV,2,Titel,48+4+0) '16 für 16 Sek. '48 für "Achtung" '4 für VbYesNo '0 für "Ja" als Default If Ask=7 then WScript.Quit 'Exit Sub If Ask=6 then Zeit2=1 'Weiter! Loop MsgBox " Also weiter ! ! ! " 082 Datum der Dateien eines Ordners anzeigen: ********************************************* MsgBox VbCR&VbCR&VbCR&VbCR&_ " Das Datum der Dateien eines Ordners wird gezeigt "&_ VbCR&VbCR&VbCR&VbCR Set Fso=WScript.CreateObject("Scripting.FileSystemObject") 'Ordner aussuchen: Set Shl=CreateObject("Shell.Application") Set ObF=Shl.BrowseForFolder(0,StrPrompt,BrowseInfo,Root) On Error Resume Next Err.Clear Pfad=ObF.Self.Path If Err.Number<>0 then WScript.Quit On Error GoTo 0 'Ignorieren der Fehler aufheben ! 'Datum aller "i" Dateien des ausgesuchten Ordners Set Data=Fso.GetFolder(Pfad).Files For each i in Data 'Datum steht an ersten 10 Stellen MsgBox VbCR&VbCR&VbTab&i&VbCR&VbCR&VbTab&_ "stammt vom : "&_ VbCR&VbCR&VbTab&Left(i.DateLastModified,10)&VbCR&VbCR&VbCR Next 083 Dateien alphabetisch sortieren, auf und ab: *********************************************** '.... 'Bild(x) alphabetisch aufwärts sortieren: For i=1 to Zahl For k=i+1 to Zahl If Bild(i)>Bild(k) then xy=Bild(i) Bild(i)=Bild(k) Bild(k)=xy End if Next Next '.... 'Abwärts sortieren: For i=1 to Zahl For k=i+1 to Zahl If A(i)" IE.Height="0" 'Muss sein, damit IE verborgen! IE.Width="0" IE.Visible=True ReDim Preserve Wahl(x) Wahl(0)="0" x=1 Do until Ende="1" ReDim Preserve Wahl(x) With IE.Document.All.Files .Click Wahl(x)= .Value End With If Wahl(x)=Wahl(x-1) then Ende="1" If Wahl(1)="" then IE.Quit Set IE=Nothing WScript.Quit End If x=x+1 Loop Zahl=x-2 'Zahl der ausgesuchten Dateien IE.Quit Set IE=Nothing If Wahl(1)<>"" then MsgBox VbCR&VbCR&VbTab&Wahl(Zahl)&" / "&Zahl&" "&_ VbCR&VbCR,," Letzte Datei und Anzahl der Dateien" 087 Dateien - Kette browsen: **************************** 'Datei - Kette von 1. bis einer letzten Datei heraussuchen ! Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set IE=CreateObject("InternetExplorer.Application") Titel=" Kette von Dateien festlegen !" Ask=MsgBox (VbCR&VbCR&VbCR&_ "Eine fortlaufende Kette von Dateien wird festgelegt : "&_ VbCR&VbCR&"Legen Sie dafür die 1. Datei fest und klicken ""OK"" ,"&_ VbCR&VbCR&"danach eine letzte Datei und klicken wieder ""OK"" !"&_ VbCR&VbCR&" Wollen Sie die Kette festlegen ?"&_ VbCR&VbCR&VbCR,VbInformation+VbYesNo,Titel) If Ask=7 then WScript.Quit 'Internet-Explorer als Hilfsmittel aufrufen: IE.Navigate("About:Blank") IE.Document.Write "" IE.Height="0" 'Muss sein, damit IE verborgen! IE.Width="0" IE.Visible=True '1. und letzte Datei festlegen: x=1 Do until x>2 With IE.Document.All.Files .Click If x=1 then Wahl1= .Value If x=2 then Wahl2=Fso.GetFileName(.Value) End With If Wahl1="" then IE.Quit Set IE=Nothing WScript.Quit End If x=x+1 Loop IE.Quit Set IE=Nothing 'Ordner und Dateien benennen: Wahl0=Fso.GetParentFolderName(Wahl1) 'ausgewählter Ordner Wahl1=Fso.GetFileName(Wahl1) '1. Datei, letzte ist Wahl2 'Datei(y) für y=1 bis y=Zahl sind die Dateien der Kette y=0 Set Inhalt=Fso.GetFolder(Wahl0).Files For each File in Inhalt File=Fso.GetFileName(File) If (File>=Wahl1 and File<=Wahl2) then '1. bis letzte Datei suchen y=1+y ReDim Preserve Datei(y) Datei(y)=Wahl0&"\"&File End If Next 'Zahl der Dateien: Zahl=y 'Dateien ausgeben: z=1 Do until z>Zahl MsgBox VbCR&VbCR&VbCR&VbTab&_ "Die "&z&" . te Datei in der Datei - Kette ist :"& _ " "&VbCR&VbCR&VbTab&Datei(z)&VbCR&VbCR&VbCR,,Titel z=z+1 Loop 088 MsgBox, Kennzahlen, Rückgabewerte ************************************* VbOKOnly 0 Nur Schaltfläche OK anzeigen. VbOKCancel 1 Anzeigen OK und Abbrechen. VbAbortRetryIgnore 2 Anzeigen Abbrechen, Wiederholen und Ignorieren. VbYesNoCancel 3 Anzeigen Ja, Nein und Abbrechen. VbYesNo 4 Anzeigen Ja und Nein. VbRetryCancel 5 Anzeigen Wiederholen und Abbrechen. VbCritical 16 Anzeigen des Stopp-Symbols. VbQuestion 32 Anzeigen des Fragezeichen-Symbols. VbExclamation 48 Anzeigen des Symbols Warnung. VbInformation 64 Anzeigen des Symbols Information. VbDefaultButton1 0 Erste Schaltfläche ist Voreinstellung. VbDefaultButton2 256 Zweite Schaltfläche ist Voreinstellung. VbDefaultButton3 512 Dritte Schaltfläche ist Voreinstellung. VbDefaultButton4 768 Vierte Schaltfläche ist Voreinstellung. VbApplicationModal 0 Anwendungsgebunden. Der Benutzer muss auf das Meldungsfeld reagieren, bevor er die Arbeit mit der aktuellen Anwendung fortsetzen kann. VbSystemModal 4096 Systemgebunden. Alle Anwendungen werden unter- brochen, bis Benutzer auf Meldungsfeld reagiert. MsgBox " Test ,48+4+0" 'als Beispiel '48 für "Achtung" '4 für VbYesNo '0 für "Ja" als Default Rückgabe ("Wert"e ) auf Fragen in der MsgBox: Beenden 3 Wiederholen 4 Ignorieren 5 Ja 6 Nein 7 (If Wert=7 then . . . (oder Name der MsgBox)) 089 Programm startet voreingestellte Programme ********************************************** Set Wss=CreateObject("WScript.Shell") Input=InputBox("Welches Programm soll gestartet werden?"&VbCRLF&VbCRLF&_ "1 = Taschenrechner"&VbCRLF&"2 = Notepad"&VbCRLF&"3 = Excel"&VbCRLF&_ "4 = Winword"&VbCRLF&"5 = WordPro"&VbCRLF&"6 = StarOffice","Programmauswahl") Select Case Input Case "1" Wss.Run("%WinDir%\calc.exe") Case "2" Wss.Run("%WinDir%\notepad.exe") Case "3" Wss.Run "Excel" Case "4" Wss.Run "WinWord" Case "5" Wss.Run "WordPro" Case "6" Wss.Run "SOffice" Case else MsgBox " Ungeeignete Eingabe!" End Select 090 Replace - Befehl ******************** 'Teil einer Variablen gegen einen anderen ersetzen VBS="Chiffre.vbs starten!" MsgBox VBS VBS=Replace(VBS," starten!","") 'Groß- und Kleinschreibung wichtig! 'Zahl der Leerstellen muss genau stimmen! '2. Teil wird gegen 3. Teil ausgetauscht! 'Hier wird der mittl. Teil weggenommen! MsgBox VBS VBS=Replace(VBS,".vbs","") MsgBox VBS 'Jetzt wieder anfügen: VBS=VBS&".vbs" MsgBox VBS VBS=VBS&" starten" MsgBox VBS 091 Set ..., Set Arg=WScript.Arguments usw. ******************************************* Set Fso=CreateObject("Scripting.FileSystemObject") 'Fso, Fobj, Scr, CreatObj, ... 'oder auch: 'Set Fso=WScript.CreateObject("Scripting.FileSystemObject") If Fso.FileExists("C:\Ablage\Lies.txt") then MsgBox " Test " 'Fso.CopyFile(Objekt),Ziel 'Fso.DeleteFile(Objekt) Set WShl=WScript.CreateObject("WScript.Shell") 'alles möglich, nur nicht Wsh WShl.Run "Notepad """&"C:\Ablage\Lies.txt"&"""" 'Aufgesetzte Datei erkennen: Set Fso=WScript.CreateObject("Scripting.FileSystemObject") 'oder kurz: 'Set Fso=CreateObject("Scripting.FileSystemObject") Set Arg=WScript.Arguments For i=0 to Arg.Count -1 Dat=Arg(i) Next MsgBox Dat WScript.Quit ' ***************************************************** 'Ordner aussuchen: Set Shl=CreateObject("Shell.Application") Set ObF=Shl.BrowseForFolder(0,StrPrompt,BrowseInfo,Root) On Error Resume Next Err.Clear Pfad=ObF.Self.Path If Err.Number<>0 then WScript.Quit Set All=Nothing '< ======================== On Error GoTo 0 'Ignorieren der Fehler aufheben ! ' ******************************************* ' Obige Setzungen müssen geschlossen werden, damit die nächste ' möglich wird. Ohne " Set All=Nothing " läuft ab hier nichts ! ??? ' ******************************************* Set FsF=Fso.GetFolder(Pfad) Set Inhalt1=FsF.SubFolders 'Unter-Ordner auflisten Set Inhalt2=FsF.Files 'Dateien auflisten Set Data=Fso.CreateTextFile(Fso.GetParentFolderName _ (WScript.ScriptFullName)&"\"&"Liste.txt",true) If Inhalt1.Count>0 then Data.WriteLine("") Data.WriteLine("Folgende Unterordner sind in "" "&Pfad&" "" :") For each SubFld in Inhalt1 SubFldName=SubFld.Name Data.WriteLine(SubFldName) Next End If If Inhalt2.Count>0 then Data.WriteLine("") Data.WriteLine("Folgende Dateien sind in "" "&Pfad&" "" :") For each Datei in Inhalt2 DateiName=Datei.Name Data.WriteLine(DateiName) Next End If Data.Close '< ============================= ' ******************************************* ' Mit " Data.Close " das Txt-Dokument schließen, um es weiter zu behandeln, ' wie z.B. kopieren oder mit "Notepad" öffnen oder gar am Schluss zu löschen ' ******************************************* If (Inhalt2.Count=0 and Inhalt2.Count=0) then MsgBox VbCR&VbCR&"Das Verzeichnis ist leer ! "&VbCR&VbCR, _ VbExclamation," Verzeichnis leer !" else WshShell.Run "Notepad """&Fso.GetParentFolderName(WScript.ScriptFullName)&_ "\"&"Liste.txt"&"""" End If WScript.Sleep 10000 ' 10 s warten Fso.DeleteFile Fso.GetParentFolderName(WScript.ScriptFullName)&"\"&"Liste.txt" 092 Read(6), ReadLine ********************* 'Zeilenanfänge einer Liste auslesen und ausgeben in neue Datei Test.txt 'in 6-er-Gruppen lesen - oder alles lesen Set WshShell=WScript.CreateObject("WScript.Shell") Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Data=CreateObject("Scripting.FileSystemObject") Datei="C:\Ablage\Claudia.txt" 'Datei="C:\Tools\Geb_Tage\Txt\Liste.txt" ' *** auszulesende Liste *** Set File1=Data.OpenTextFile(Datei) i=1 Do until File1.AtEndOfStream ReDim Preserve Zeile(i) ReDim Preserve Zeil (i) ' Zeile(i)=File1.Read(6) '6 Stellen lesen. Ohne nächste Zeile wäre alles in '6-er-Blöcken, jeder in einer Zeile! Zeil(i)=File1.ReadLine 'Alles lesen, wird jedoch nicht mehr beachtet! i=i+1 Loop File1.Close Set File1=Nothing Datei="Test.txt" Set File2=Fso.OpenTextFile(Datei,2,true) '2 heißt neu anlegen For i=1 to UBound(Zeile) 'Mit Zeil u. Zeil(i) wird Text gelesen und kopiert File2.WriteLine(Zeile(i)) Next File2.Close Set File2=Nothing WshShell.Run "Notepad """&Datei&""" " 093 Int, Fix, CInt, round, abs ****************************** Pi="3,14159" Pi=Round(Pi,2) MsgBox Pi 'oder ' Zahl="-5,50" ' MsgBox CInt(Zahl) ' ergibt -6 s.u. ' "Int" nimmt die ganze Zahl darunter ' Int(5,9999) = 5 ' Int(-5,9999)=-6 ' "Fix" schneidet die Dezimalen ab ' Fix(5,9999) = 5 ' Fix(-5,9999)=-5 ' "CInt" rundet, wobei 2,5 abgerundet, 3,5 aufgerundet wird! : ' Die nächste gerade Zahl wird genommen, wenn die Zahl in der Mitte liegt! ' CInt(5,5) = 6 ' CInt(-5,5)=-6 ' "Round" verkürzt auf angegebene Dezimalenzahl ' Pi=3.14159 'oder: ' Pi="3,14159" 'ohne das " : Pi=3,14159 ergibt Fehler!(?), Pi=3.14159 keinen ' Pi=Round(Pi,2) ' verwendet nur 2 Dezimalen, d.h. ergibt 3,14 ' "abs" ergibt den Betrag einer Zahl ' abs(-2,5)=2,5 094 CPU, daraus Dauer abschätzen ******************************** Zahl="100001" Dim Hertz,Dauer UV=VbCR&VbCR If Zahl>100000 then 'Sub-Programm zur Prüfung der benötigten Zeit starten ZeitDauer Ask=MsgBox (UV&VbCR&_ " Wegen der Größe der Zahl kann die Suche sehr lange "&_ " "&UV&_ " dauern ! Bis "&Zahl&" dauert es bei Ihren ~ "&_ Hertz&" MHz"&UV&" ca. "&_ Dauer&" "&Einheit&" ! Wollen Sie trotzdem weiter machen ?"&_ UV&VbCR,VbCritical+VbYesNo,Titel) If Ask<>VbYes then WScript.Quit End If ' ********** Sub ZeitDauer 'Dauer der Primzahlsuche vorausschätzen 'CPU testen mit Zählschleife: Zeit1=Timer 'Zeit vorher (Timer gibt bisherige Zeit ab 0 Uhr in Sek.) i=1 Do until i=1000001 i=i+1 Loop Zeit2=Timer 'Zeit nachher Zeit3=Zeit2-Zeit1 Hertz=Int(("2,7"/Zeit3)*850) Hertz=Hertz-(Hertz Mod 10) 'auf 10-er abrunden Takt=Hertz/850 'Vergleich mit meinen 850 MHz 'Zahl der Verdoppl. von 100000 aus berechnen Faktor=Zahl/100000 i=1 Do until Int(Faktor)=1 Faktor=Faktor/2 i=i+1 Loop Exponent=(i-1)+(Faktor-1) 'Dauer der Berechnung ist bei jeder Verdoppl. ca. 3,6-fache Zeit Einheit="Min." Dauer=0.6*3.6^Exponent '0,6 hat sich bewährt als Anfang Dauer=Dauer/Takt 'Umrechnung auf andere CPU Dauer=Round(Dauer,2) 'bis auf 2 Dezimalen verkürzen If Dauer<1 then Dauer=Dauer*60 Einheit="Sek." End If If Dauer>10 then Dauer=Int(Dauer) 'Dezimalen ganz abschneiden If Dauer>50 then Dauer=Dauer-(Dauer Mod 5) 'Über 50 Min. abrunden auf 5 Min. If Dauer>100 then Dauer=Dauer-(Dauer Mod 10) 'Über 100 abrunden auf 10 Min. End Sub 095 "On Error Resume Next" - Fehlermeldung ausschalten / einschalten ******************************************************************** "On Error Resume Next" ist im weiteren Programm ein "Freibrief" gegen Fehler, d.h. diese werden nicht mehr angezeigt, bis dieser mit: "On Error GoTo 0" wieder annulliert wird! 'Beispiele: 'If k*l>(x-1)*100000 then Numb(k*l-(x-1)*100000)="" 'Diese ständige Prüfung verlangsamt ? 'Also besser ? On Error Resume Next Numb(k*l-(x-1)*100000)="" 'Zu kleine Zahlen werden dann ignoriert 'oder: On Error Resume Next 'Ab hier geht es bei Fehlern einfach weiter MskBox " Test " 'Fehler wird also ignoriert !!! MsgBox " Test " 'Ab hier den "Freibrief" wieder annullieren: On Error GoTo 0 MskBox " Test " 'Fehler wird wieder angezeigt !!! 'Fehler anzeigen oder zum Schalten benutzen: MsgBox Err If Err<>0 then Fehler="1" ... If Fehler="1" then ... 096 Laufwerke ermitteln *********************** Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Set Drives=Fso.Drives 'Kennnummern der Laufwerke sind: '1 ist Wechsel-LW( Diskette oder Stick) '2 ist Festplatte, auch externe '3 ist Netz-LW. '4 ist CD-ROM '5 ist RAM-LW. 'Vorhandene LW mit Buchstaben ermitteln: Txt=VbCR&" " For each i in Drives If 2=i.DriveType then MsgBox Txt&i.DriveLetter&VbCR,," Festplatte ist : " If 4=i.DriveType then MsgBox Txt&i.DriveLetter&VbCR,," C D - ROM ist : " If 1=i.DriveType then MsgBox Txt&i.DriveLetter&VbCR,," Wechsel - LW ist : " Next 097 CD - Rom öffnen ******************* Set CDR=WScript.CreateObject("WmPlayer.ocx") CDR.CdRomCollection.Item(0).Eject 'Oder Item(1) bei 2. CD-Rom 098 Bremse, die Programm anhält, bis alter Vorgang erledigt: ************************************************************ ..... Install 'Programm installieren, ist aber Dos-Programm, dessen Ende unklar: Ende 'also Bremse nötig, die erst gelöst wird, wenn Dos-Programm fertig! ..... ' Sub - Programme : ' ******************** Sub Install WS.Run "Sudoku\Programm\Inst.bat" End Sub ' ******************** Sub Ende 'Mit Schaltdatei "C:\Spiele\Sudoku\Tmp" prüfen, ob Dos-Installation fertig! Schluss="0" i=1 Do until Schluss=1 k=1 Do until k=3000 or Schluss=1 If Fso.FolderExists("C:\Spiele\Sudoku\Tmp") then Schluss=1 If Schluss=1 then Exit Sub k=k+1 Loop i=i+1 Loop If Schluss=1 then Exit Sub End Sub 'oder kürzer, falls Befehl "true" anwendbar: ..... 'Dos-Programm, dessen Ende unklar: 'also Bremse nötig, die erst gelöst wird, wenn Dos-Programm fertig! WS.Run "Sudoku\Programm\Inst.bat",,true 'true heisst, dass Ende abgewartet wird ..... 099 Ordner beim Hochfahren löschen: *********************************** Set Wss=CreateObject("WScript.Shell") Set Fso=WScript.CreateObject("Scripting.FileSystemObject") 'Probe-Ordner anlegen If not Fso.FolderExists("C:\Programme\BspProgramm") then _ Fso.CreateFolder("C:\Programme\BspProgramm") 'Für WinXP: If Fso.FolderExists(Dat3) then Wss.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\RunOnce\RmDir", _ "RmDir /S /Q C:\Programme\BspProgramm" End If 'Für Win98 und Win ME: If not Fso.FolderExists(Dat3) then Wss.RegWrite "HKEY_USERS\.Default\Software\Microsoft\Windows\CurrentVersion\RunOnce\RmDir", _ "RmDir /S /Q C:\Programme\BspProgramm" End If 100 SendKey / Tastenbefehle in Vbs umsetzen: ******************************************** UMSCHALTTASTE + STRG ^ ALT % Windowstaste ("Start") "^{ESC}" Set Wss=WScript.CreateObject("WScript.Shell") 'Wss.Sendkeys "~{n}" '1. Datei mit "n" im Verzeichnis wird aufgerufen 'Wss.Sendkeys "ad" '1. Datei mit "ad" im Verzeichnis wird aufgerufen 'Wss.Sendkeys "{ENTER}" 'und hiermit gestartet 'Wss.Sendkeys "^{Esc}" 'Ruft "Start" auf 'Wss.Sendkeys "+{home}" 'markiert alles links oberhalb 'Wss.Sendkeys "~{home}" 'ruft Programm links oben auf 'Wss.Sendkeys "%{F4}" 'Fenster schließen 'Wss.Sendkeys "%{Esc}" 'Fenster minimieren 'Wss.Sendkeys "{F5}" 'aktualisieren, wenn zuvor der Desktop angeklickt 'wurde, so wird dieser samt Bild aktualisiert! 'Wss.Sendkeys "+{F10}" 'Menü-Leiste aufrufen 'Geht in Sytemsteuerung, Bildschirm aktualisieren: Wss.Sendkeys "^{Esc}" '"Start" aufrufen WScript.Sleep 200 Wss.Sendkeys "e" '"Systemsteuerung" im Menü anlaufen WScript.Sleep 200 Wss.Sendkeys "~" 'Systemsteuerung aufrufen WScript.Sleep 200 Wss.Sendkeys "an" '"An"zeige aufrufen WScript.Sleep 200 Wss.Sendkeys "~" '"Ok" sagen WScript.Sleep 200 Wss.Sendkeys "left" 'Nach links, "OK", gehen WScript.Sleep 200 Wss.Sendkeys "~" '"Ok" sagen 'Oder auch: '********** 'Im Desktop auf freie Stelle klicken ! Wss.Sendkeys "+{F10}" WScript.Sleep 500 Wss.Sendkeys "{UP}" WScript.Sleep 500 Wss.Sendkeys "~" WScript.Sleep 500 Wss.Sendkeys "~" 101 Start einer Datei aus richtigem Ordner? ******************************************* Sicherheitsmaßnahme, falls von falscher Stelle aufgerufen! 'Prüfen, ob Start aus WinDir, sonst Abbruch: AktVerz=Replace(WScript.ScriptFullName,WScript.ScriptName,"") Verz=Left(AktVerz,Len(WinDir)) 'Vergleich mit kleinen Buchstaben! : If not LCase(Verz)=LCase(WinDir) then WScript.Quit 102 Aktuelles Verzeichnis ermitteln: ************************************ 'Aktuelles Verzeichnis der gestarteten Datei ist: AktVerz=Replace(WScript.ScriptFullName,WScript.ScriptName,"") '(Im vollständigen Namen wird die reine Datei leer gesetzt!) 'Ergebnis mit "\" am Ende ! MsgBox AktVerz 'oder: Set Fso=WScript.CreateObject("Scripting.FileSystemObject") AktVerz=Fso.GetParentFolderName(WScript.ScriptFullName) 'Ergebnis normalerweise ohne "\" am Ende ! 'Bei Hauptverzeichnis einer Partition mit !!! '===> 1. Lösung sicherer ! MsgBox AktVerz 103 Beenden eines Programmes aus der Taskleiste, mit DOS !!! : ************************************************************** Set Wss=WScript.CreateObject("WScript.Shell") Progr="Open" UV=VbCR&VbCR 'Vorher am Besten alles maximieren! If Wss.AppActivate(Progr) then Wss.Sendkeys "{ENTER}" WScript.Sleep 800 Wss.Sendkeys "%{F4}",true else MsgBox UV&VbCR&" In der Programmleiste des PC existiert"&_ " "&UV&" keinerlei Programm mit dem Namen :"&_ UV&VbCR&VbTab&" "&Progr&UV&VbCR,VbCritical End If '*************************************** 'Jetzt der völlig aus der Rolle fallende Sonderfall " MS-DOS ": Set Wss=WScript.CreateObject("WScript.Shell") Programm="MS-Dos-Eingabeaufforderung" i=1 Do until Wss.AppActivate(Programm)="False" If Wss.AppActivate(Programm) then Wss.Sendkeys "{ENTER}" WScript.Sleep 500 Wss.Sendkeys "%{ }" Wss.Sendkeys "L" End If i=i+1 Loop 104 Alles minimieren: ********************* 'Alles minimieren: '***************** Set Wss=WScript.CreateObject("WScript.Shell") Set ShellApp=CreateObject("Shell.Application") ShellApp.ToggleDesktop Set ShellApp=Nothing 'Andere Lösung: '************** 'Set ShellApp = CreateObject("Shell.Application") 'ShellApp.MinimizeAll 'Set ShellApp = Nothing 'Alles minimieren, letztes Objekt löschen: '***************************************** 'Set ColExpl=GetObject("winmgmts:\\.\Root\cimv2").ExecQuery("SELECT Name from Win32_Process where Name=""Explorer.exe"" ") 'For each StrExpl in ColExpl:StrExpl.Terminate:Next 105 Desktopbild aktualisieren: ****************************** 'In Win ME: '********** 'Desktop aktualisieren, dazu wird auf den Desktop zugegriffen: Befehl="""C:\Tools\Desktop\Desktop anzeigen.scf""" 'warum """ ??? - Wenn Leerstellen in Datei sind ! ! ! Wss.Run Befehl WScript.Sleep 500 Wss.Sendkeys "{F5}" 'In Win XP schwieriger '********************* 'Alles minimieren: Set Wss=WScript.CreateObject("WScript.Shell") Set ShellApp=CreateObject("Shell.Application") ShellApp.ToggleDesktop Set ShellApp=Nothing 'Andere Lösung für das Minimieren: 'Set ShellApp = CreateObject("Shell.Application") 'ShellApp.MinimizeAll 'Set ShellApp = Nothing WScript.Sleep 750 Wss.Sendkeys "{F5}" 'Erreichten Desktop aktualisieren WScript.Sleep 750 Wss.Sendkeys "+{F10}" 'Desktop-Menü aufrufen WScript.Sleep 500 Wss.Sendkeys "{Up}" 'untersten Punkt markieren WScript.Sleep 500 Wss.Sendkeys "~" 'aufrufen (hier "Anzeige") WScript.Sleep 500 Wss.Sendkeys "~" 'Mit "OK" aktualisieren 'Anderer Weg in XP: '****************** Set Wss=WScript.CreateObject("WScript.Shell") Wss.Sendkeys "^{Esc}" '"Start" aufrufen WScript.Sleep 300 Wss.Sendkeys "e" '"Systemsteuerung" im Menü anlaufen WScript.Sleep 300 Wss.Sendkeys "~" 'Systemsteuerung aufrufen WScript.Sleep 300 Wss.Sendkeys "an" '"An"zeige anwählen WScript.Sleep 300 Wss.Sendkeys "~" 'diese aufrufen WScript.Sleep 300 Wss.Sendkeys "~" '"Ok" zur Aktualisierung sagen 'Offene Systemsteuerung schließen: If Wss.AppActivate("Systemsteuerung") then WScript.Sleep 300 Wss.Sendkeys "%{F4}" End If 106 Ermittelt und schließt alle aktiven Programme der Taskleiste: ***************************************************************** Läuft nur in Win XP Set Wss=CreateObject("WScript.Shell") Set Netw=CreateObject("WScript.Network") Usr=Netw.UserName Set cProc=GetObject _ ("winmgmts:{impersonationLevel=impersonate}!\\" _ &".\root\cimv2").ExecQuery("Select * from Win32_Process") 'Leerstellen neben "*" sind nötig !!! Titel=" Alle Programme der Taskleiste schließen !" UV=VbCR&VbCR 'Programme der Taskleiste mit Nr. auslesen: '****************************************** Alles=VbCR&"Von "" "&Usr&_ " "" aktivierte Programme sind : "&UV ReDim Preserve Progr(20) '20 müsste genug sein ! Zahl="0" For each oProc in cProc Return1=oProc.GetOwner(sProcUser) If sProcUser=Usr then Return2=Wss.AppActivate(oProc.ProcessId) Wss.Sendkeys("%") 'Färbung der Taskleiste verhindern If Return2 then Zahl=1+Zahl Progr(Zahl)=LCase(oProc.Name) Alles=Alles&LCase(oProc.Name)&VbCR 'oProc.Terminate 'Alles schließen ! ! ! 'If oProc.Name="WScript.exe" then oProc.Terminate End If End If Next 'Auf Wunsch alles schließen! '*************************** Alles=Alles&VbCR&"Wollen Sie alle diese schließen ?"&UV Ask=MsgBox(Alles,VbOkCancel+VbDefaultButton1+VbQuestion,Titel) Txt=UV&VbCR&VbTab&_ " Na gut , . . . dann halt nicht ! "&UV If Ask=2 then MsgBox Txt&VbCR,,Titel:WScript.Quit For each oProc in cProc Return1=oProc.GetOwner(sProcUser) If sProcUser=Usr then Return2=Wss.AppActivate(oProc.ProcessId) If Return2 then oProc.Terminate 'Alles schließen ! ! ! End If End If Next 107 Bestimmtes Programm schließen: ********************************** (schnellere Variante) Set Wss=WScript.CreateObject("WScript.Shell") Wss.Run "WMPlayer" WScript.Sleep 2000 Zeit1=Timer Set Wmi=GetObject("Winmgmts:") Set System=Wmi.InstancesOf("Win32_Process") For each Process in System If LCase(Process.name)=LCase("WmPlayer.exe") then Process.Terminate (0) End if Next Zeit2=Timer Zeit=Zeit2-Zeit1 MsgBox Zeit,," Zeit zum Schließen " s.a. 114 108 Bild- und Faxanzeige erzwingen als Programm: ************************************************ Set Wss=WScript.CreateObject("WScript.Shell") '"Uhr.wmf" muss unbedingt mit der "Bild- und Faxanzeige aufgerufen werden! Also: '******************************************************************************* Wss.Run "C:\WINDOWS\system32\rundll32.exe "&_ "C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen "&_ "C:\Programme\Schmelz.W\Stundenschlag\Uhr.wmf" WScript.Quit 109 Datei-Informationen *********************** Set Fso = CreateObject("Scripting.FileSystemObject") Set File = Fso.GetFile("E:\Ab\08_Korfu\Test\P1000110.JPG") WScript.Echo File.Name 'Name der Datei WScript.Echo File.Size 'Größe der Datei in Bytes WScript.Echo File.DateCreated 'Datum der Kopie des Bildes in den Ordner WScript.Echo File.DateLastModified 'Datum der Bildaufnahme, wenn unverändert WScript.Echo File.DateLastAccessed 'Datum des letzten Zugriffes auf das Bild 110 RAM-Daten und CPU-Daten mit Auslastung ermitteln: ***************************************************** Set CpuSet=GetObject("Winmgmts:").InstancesOf("Win32_Processor") Set Wmg=GetObject ("Winmgmts:").ExecQuery("Select"&_ " * from Win32_OperatingSystem") Set Wss=WScript.CreateObject("WScript.Shell") UV=VbCR&VbCR On Error Resume Next '********************************************** 'Den freien Speicher ermitteln: '****************************** For each Objekt in Wmg FreiRam=Objekt.FreePhysicalMemory Next Zahl1=Round(FreiRam/2^10,0) If Len(Zahl1)=3 then Zahl1=Zahl1&" " If Len(Zahl1)=2 then Zahl1=Zahl1&" " 'Den Gesamtspeicher ermitteln: '***************************** Set Obj=GetObject("Winmgmts:\\"&StrComputer) Set ObjSet=Obj.InstancesOf("Win32_LogicalMemoryConfiguration") For each Object in ObjSet Zahl=FormatNumber(Object.TotalPhysicalMemory) Next Zahl2=Round(Zahl/2^10,0) If Len(Zahl2)=3 then Zahl2=Zahl2&" " 'vierstellig machen 'Prozentuale freie Anteile des Speichers berechnen: '************************************************** Zahl3=Round(((Zahl2-Zahl1)/Zahl2)*100,1) Zahl3=100-Zahl3 If Len(Zahl3)=2 then Zahl3=Zahl3&",0" 'vierstellig machen! If Len(Zahl3)=1 then Zahl3=Zahl3&",00" 'Ergebnisse ausgeben: '******************** MsgBox UV&" Im RAM - Speicher sind "&_ Zahl2-Zahl1&" von "&Zahl2&" MB belegt ! "&UV&_ " ==> "&Zahl3&_ " % des gesamten Speichers sind noch frei !"&UV '********************************************** 'CPU-Frequenz und Name suchen: '***************************** CheckKey="HKLM\Hardware\Description\"&_ "System\CentralProcessor\0\~MHz" Wert0=Wss.RegRead(CheckKey) 'Doppel-Prozessor? CheckKey="HKLM\Hardware\Description\"&_ "System\CentralProcessor\1\~MHz" Wert1=Wss.RegRead(CheckKey) CheckKey="HKLM\Hardware\Description\"&_ "System\CentralProcessor\0\ProcessorNameString" CpuName=Wss.RegRead(CheckKey) 'Falls Doppel-Prozessor vorliegt: If not Wert1="" then Wert0=" 2 x "&Wert0&" ( Core 2 CPU )" 'Ergebnisse ausgeben: '******************** MsgBox UV&" Die Frequenz der CPU in MHz und der CPU - Name:"&_ UV&Wert0&" "&CpuName&UV 'Momentane Auslastung der CPU in Prozent: '**************************************** Doppel="0" For each Cpu in CpuSet If CpuSet.Count>1 then Last=Last+Cpu.LoadPercentage 'Doppel-CPU Doppel="1" else Last=Cpu.LoadPercentage 'Einzel-CPU End If Next If Doppel="1" then Last=Last/2 'Ergebnisse ausgeben: '******************** '(Leerstellen bei Last nötig!?) If Doppel="0" then MsgBox UV&" Die momentane CPU-Auslastung ist: "& Last &" % "&UV End If If Doppel="1" then MsgBox UV&" Die Auslastung der Doppel-CPU z.Zt.: "& Last &" % "&UV End If 111 Festplatte "X:\" analysieren, ob genügend Platz übrig: ********************************************************** Ziel=Left(Pfad,2) 'Die Ziel-Festplatte ermitteln Set Lwk=Fso.Drives For each k in Lwk If k=Ziel then If k.FreeSpace0 then For each Obj in ObjSet Obj.Terminate Next End If End Sub '************************************************** Sub Save Key="HKey_Current_User\Software\Microsoft\Windows"&_ "\CurrentVersion\Explorer\Streams\Desktop" Wss.Run "%WINDIR%\RegEdit.exe /E "&SaveIcon&" """&_ Key&"""",0,False End Sub 113 Dateien / UnterOrdner in einem Ordner zählen: ************************************************* Set Fso=WScript.CreateObject("Scripting.FileSystemObject") Pfad="C:\Ablage" Set Data=Fso.GetFolder(Pfad) Zahl=Data.Files.Count 'hier SubFolders setzen If Zahl="0" then MsgBox UV&UV&"Der Ordner "&Pfad&" ist leer !"&_ " "&UV&UV,VbCritical," ":WScript.Quit End If Oder: Set Data=Fso.GetFolder(Pfad).Files 'hier SubFolders setzen Zahl="0" For each i in Data Zahl=1+Zahl Next 114 Vbs-Programm, bestimmtes laufendes von außen schließen: *********************************************************** Prgrm="""C:\Windows\System32\WScript.exe"" "&_ """C:\Programme\Schmelz.W\StundenSchlag\StundenSchlag.vbs""" Set ObjWmg=GetObject("WinmGmts:{ImpersonationLevel="&_ "Impersonate}!\\.\Root\Cimv2") Set ColProc=ObjWmg.ExecQuery("Select * from "&_ "Win32_Process where name like '"&"%Script.exe%"&"'") '********************************************************* 'Muss Left(Obj.CommandLine,90)=Prgrm nehmen, da eine Leer- 'stelle und manchmal noch ominöse Zahlen anhängen !!!??? : '********************************************************* For each Obj in ColProc If Left(Obj.CommandLine,90)=Prgrm then Obj.Terminate() Next 115 Windows-Version, Ort und Eigentümer für XP (ME) ermitteln: ************************************************************** Set Wss=CreateObject ("WScript.Shell") UV=VbCR&VbCR CheckKey="HKLM\Software\Microsoft\Windows NT\"&_ "CurrentVersion\ProductName" Version=Wss.RegRead(CheckKey) CheckKey="HKLM\Software\Microsoft\Windows NT\"&_ "CurrentVersion\SystemRoot" Ort=Wss.RegRead(CheckKey) CheckKey="HKLM\Software\Microsoft\Windows NT\"&_ "CurrentVersion\RegisteredOwner" Name=Wss.RegRead(CheckKey) 'Falls keine Version gefunden, mit ME versuchen: '*********************************************** If Version="" then CheckKey="HKLM\Software\Microsoft\Windows\"&_ "CurrentVersion\Productname" Version=Wss.RegRead(CheckKey) End If 'Windows - Version festlegen: '**************************** Win=LCase(Mid(Version,19,2))' me, xp, vi ist möglich! If Win="me" then CheckKey="HKLM\Software\Microsoft\Windows\"&_ "CurrentVersion\SystemRoot" Ort=Wss.RegRead(CheckKey) CheckKey="HKLM\Software\Microsoft\Windows\"&_ "CurrentVersion\RegisteredOwner" Name=Wss.RegRead(CheckKey) End If MsgBox UV&VbTab&Version&" "&_ UV&VbTab&Ort&UV&VbTab&Name&UV,," Version, Ort, Name" 116 Laufwerk - Buchstabe, nächster freier: ****************************************** 'Alle USB - Laufwerke müssen abgenommen werden! Set Fso=CreateObject("Scripting.FileSystemObject") Set Lwk=Fso.Drives For each i in Lwk If i.DriveType=2 then Buchstabe=i.DriveLetter Next Buchstabe=Right(Buchstabe,1) 'Buchstabe steht ganz rechts Zahl=Asc(Buchstabe) 'Nummer des letzten Laufwerks Buchstabe=Chr(1+Zahl) 'Buchstabe des freien Laufwerks MsgBox Buchstabe 117 Win XP : Schluss, Neustart oder Standby: ******************************************** Set Wss=CreateObject ("WScript.Shell") UV=VbCR&VbCR Txt="Dieses Programm löscht sämtliche? zur Zeit in"&UV&_ "der Taskleiste angezeigte Programme ! - Und"&UV&_ "fährt anschließend den Computer herunter !"&UV&_ "Bei "" 1 "" Neustart, bei "" 0 "" Herunterfahren !"&UV&_ """ 2 "" meldet den momentanen Benutzer ab !"&UV&_ VbCR&""" 3 "" : PC geht nur in den ""Standby""-Modus !" Wunsch=InputBox (UV&VbCR&Txt&UV&UV,Titel,"3") If Wunsch="" then WScript.Quit 'Abbruch, wenn verlangt! Set Owm=GetObject("Winmgmts:{ImpersonationLevel=Impersonate,"&_ "(ShutDown)}!\\.\Root\Cimv2") For each Obj in Owm.ExecQuery("Select * from Win32_OperatingSystem") Set ObOs=Obj Next Const Ewx_LogOff=0 'Benutzer abmelden / Ewx ist ExitWindowsEx Const Ewx_ShutDown=1 'Herunterfahren Const Ewx_Reboot=2 'Neustart If Wunsch="0" then ObOs.Win32ShutDown Ewx_ShutDown If Wunsch="1" then ObOs.Win32ShutDown Ewx_Reboot If Wunsch="2" then ObOs.Win32ShutDown Ewx_LogOff 'Sonderfall "Standby": '********************* If Wunsch="3" then Wss.Sendkeys "^{ESC}" WScript.Sleep 750 Wss.Sendkeys "a" WScript.Sleep 1250 Wss.SendKeys "S" 'wie "S"tandby WScript.Sleep 750 Wss.SendKeys "{Enter}" End If 118 Elemente abwärts sortieren, dabei Doppeltes aussortieren: ************************************************************* Dim Zahl, A() 'Ich nenne die Elemente A(i) und die Elementezahl 10 Zahl="10" 'Beispiele: ReDim Preserve A(Zahl) A(1)="5" A(2)="9" A(3)="7" A(4)="3,3" A(5)="7" A(6)="5" A(7)="6" A(8)="5,5" A(9)="5" A(10)="8" 'Abwärts sortieren: For i=1 to Zahl For k=i+1 to Zahl If A(i)<=A(k) then xy=A(i) A(i)=A(k) A(k)=xy End If Next Next 'Abwärts sortierte Zahlen, mit doppelten anzeigen: MsgBox VbCR&A(1)&"|"&A(2)&"|"&A(3)&"|"&A(4)&"|"&A(5)&"|"&A(6)&_ "|"&A(7)&"|"&A(8)&"|"&A(9)&"|"&A(10)&VbCR&VbCR 'Gleiches aussondern: For i=1 to Zahl For k=i+1 to Zahl Do until A(k)Len(Zeile(i))-Len(Wort)+1 If LCase(Mid(Zeile(i),k,Len(Wort)))=Lcase(Wort) then If Len(Hier)>0 then Hier=Hier&"|"&i If Hier="" then Hier=i Zahl=Zahl+1 'Wie oft "Wort" gefunden ? End If k=k+1 Loop Next MsgBox Hier&" / "&Zahl 122 Einzelbefehle und Tips: *************************** ... &time& setzt die Uhrzeit dahinter &date& setzt das Datum dahinter &now& Datum und Uhrzeit dahinter setzen &timer& Sek.-Zahl seit 0 Uhr, Differenz interessant &vbTab& setzt Leerstellenkette best. Länge TextStream.WriteLine("...") schreibt eine Zeile TextStream.Write("...") beginnt Zeile oder fügt an, wenn "Write" stand &Chr(10) Zeilenvorschub &VbCR Zeilenvorschub, reicht in VBS, sonst VbCRLF ""&VbCR ergibt Leerzeile ( Nichts und Zeilenvorschub ) &Chr(30) setzt Endbalken . . . VbCR _ lange Zeilen trennen mit " _" (kein _ allein!) nicht erlaubt bei TextStream. o. Data., Write ! . . . &_ nach "&" ist Leerstelle unnötig (Divisor+Neu)*2>=Divisor Größen-Vergleich bei mir unmöglich!? scheint bei Variablen beidseits unmöglich (Divisor+Neu)*2-Divisor>=0 dies statt dessen arbeitet korrekt ! Fso.GetFolder("C:\Tools\Data") Vor, nach Dateien keine Leerstellen in "" !!! X +"5" hängt Ziffer 5 an X , auch bei Dezimalzahlen! Zahl(1)+Zahl(2) nur bei CInt(Zahl(1))+... Addition . . , , true führt Run-Befehl o.a. durch, geht erst dann weiter! . . , true löscht restlos - ohne den Papierkorb Variablen, die mit Dim am Skriptbeginn gesetzt werden, stehen allen Teilen zur Verfügung, z.B. Dim Ende,Fehler,Kreuz(),Bild() In Skriptteilen ( z.B. Sub !) festgelegte Variablen sind nur dort verfügbar, also Dim ... am Skript-Anfang verwenden, s.o.