Zum Inhalt springen

Visual Basic Script (VBS): Beispiele

Links hinzufügen
Aus Wikibooks

>> Zurück zum Inhaltsverzeichnis


Registry-Schlüssel erstellen

[Bearbeiten]
Dim ObjShell
Dim ShellObject
Set ShellObject = CreateObject("WScript.Shell")
Set ObjShell = ShellObject.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Test")
If ObjShell = "" then
    ShellObject.Popup "Wert existiert nicht und wird hinzugefügt","4",""
    ShellObject.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "C:\test.vbs"
else
     ShellObject.Popup "Wert existiert","3",""
end if

Dieses Script fügt einen Wert/Schlüssel hinzu, wenn er nicht schon existiert.

Computer neu starten

[Bearbeiten]
Dim ObjShell
Set ObjShell = CreateObject("WScript.Shell")
ObjShell = msgbox("Wollen Sie den Computer herunterfahren ?", +vbYesNo+vbExclamation, "")
If ObjShell = vbYes then
 Set ShellObject = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}").ExecQuery("select * from Win32_OperatingSystem where Primary=true")
 For Each sys In ShellObject
  Sys.Win32Shutdown 6
 Next
End if

Dieses Script startet den Computer auf Wunsch neu.

Als alternative kann man auch mit der WshShell das Kommando "manuell" starten. 

Dim best, Shell
Set Shell = WScript.CreateObject("WScript.Shell")
best = MsgBox("Möchten Sie den Computer neu starten?", 4, "Neu starten?")
If best = "7" Then
 WScript.Quit
Else
 Shell.run "shutdown.exe -r -t 10"
End If

Countdown

[Bearbeiten]
Dim ObjShell
Set ObjShell = CreateObject("WScript.Shell")
ObJShell.Popup "15","1",""
ObJShell.Popup "14","1",""
ObJShell.Popup "13","1",""
ObJShell.Popup "12","1",""
ObJShell.Popup "11","1",""
ObJShell.Popup "10","1",""
ObJShell.Popup "9","1",""
ObJShell.Popup "8","1",""
ObJShell.Popup "7","1",""
ObJShell.Popup "6","1",""
ObJShell.Popup "5","1",""
ObJShell.Popup "4","1",""
ObJShell.Popup "3","1",""
ObJShell.Popup "2","1",""
ObJShell.Popup "1","1",""

Dieses Script erzeugt einen 15-Sekunden Countdown. Was nach den 15 Sekunden passieren soll, kann man dann noch hinzufügen.

Kürzere Version mit Variablen: 

a = 15
Dim ObjShell
Set ObjShell = CreateObject("WScript.Shell")
Do
  ObJShell.Popup a,"1",""
  a = a - 1
Loop until a = 0

E-Mail versenden

[Bearbeiten]
Dim ObjEMail
Set ObjEMail = CreateObject("CDO.Message")
ObjEMail.From = "Absenderadresse"
ObjEMail.To = "Zielempfänger"
ObjEMail.Subject = "HI"
ObjEMail.Textbody = "HI"
ObjEMail.Configuration.Fields.Item _
("http://schemas.micros
ObjEMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
ObjEMail.Configuration.Fields.Update
ObjEMail.Send

Dieses Script sendet eine E-Mail an einen Empfänger.
Funktioniert aus Kompatiblitätsgründen nicht immer

CD/DVD-Laufwerke öffnen

[Bearbeiten]
Set oWMP = CreateObject("WMPlayer.OCX.7")
Set colCDROMs = oWMP.cdromCollection
if colCDROMs.Count >= 1 then
 For i = 0 to colCDROMs.Count - 1
  colCDROMs.Item(i).Eject
 Next 'cdrom
End if

Dieses Script öffnet alle vorhandenen CD-Laufwerke.

Benutzer- und Computernamen ausgeben

[Bearbeiten]
dim Network
set Network = CreateObject("WScript.Network")
MsgBox "" & Network.UserName
MsgBox "" & Network.ComputerName

Dieses Script gibt mithilfe des WScript.Networks-Objekts den Namen des Computers und des Benutzers aus.

Cäsar-Verschlüsselung

[Bearbeiten]
dim text,rot,code,tmp
text = Inputbox("Text eingeben","Caesar")
If text = "" Then WScript.Quit
rot = InputBox("Rotation eingeben","Caesar")
 
for i=1 to Len(text)
 tmp = Asc(Mid(text,i,1))
 if tmp >= 65 and tmp <= 90 then 'ASCII 65 bis 90 = a-z
  tmp = tmp + rot
  if tmp > 90 then
   tmp = tmp - 90 + 64
  end if
 elseif tmp >= 97 and tmp <= 122 then 'ASCII 97 bis 122 = A-Z
  tmp = tmp + rot
  if tmp > 122 then
   tmp = tmp - 122 + 96
  end if
 end if
 code = code + Chr(tmp)
next
 
MsgBox code,0,"Caesar"

Dieses Programm ist ein Code für die Cäsar Verschlüsselung, Umlaute und Sonderzeichen werden nicht verändert.

siehe auch  Caesar-Verschlüsselung

Eine Textdatei erstellen

[Bearbeiten]
Dim Dateisystem, Textdatei
Set Dateisystem = CreateObject("Scripting.FileSystemObject")
Set Textdatei = Dateisystem.CreateTextFile("C:\Dokumente und Einstellungen\User\Eigene Dateien\Textdatei.txt")
Textdatei.Write "Erste Zeile" & vbCrLf & "ZweiteZeile" & vbCrLf & "Schluss"
Textdatei.Close

Dieses Skript erstellt mit dem FileSystemObject die Texdatei "C:\Dokumente und Einstellungen\User\Eigene Dateien\Textdatei.txt" mit folgendem Inhalt: 

Erste Zeile
Zweite Zeile
Schluss

Eine Textdatei öffnen

[Bearbeiten]
Dim Dateisystem, Textdatei, Text
Set Dateisystem = CreateObject("Scripting.FileSystemObject")
Set Textdatei = Dateisystem.OpenTextFile("C:\Dokumente und Einstellungen\User\Eigene Dateien\Textdatei.txt")
Text = Textdatei.ReadAll

Dieses Skript liest mit dem FileSystemObject die Textdatei "C:\Dokumente und Einstellungen\User\Eigene Dateien\Textdatei.txt" in die Variable "Text" aus. Wichtig hierbei ist, dass die Methode "ReadAll" für ein Textdokument nur einmal aufgerufen wird, da sonst ein Fehler entsteht.

Einen Ton ausgeben

[Bearbeiten]
Dim Shell, Ton
Set Shell = WScript.CreateObject("WScript.Shell")
Ton = chr(007)
Shell.Run "cmd /c @echo " & Ton, 0

Dieses Skript startet mit der WshShell die Eingabeaufforderung mit dem Befehl einen Ton auszugeben. Dies kann nützlich sein, wenn der Benutzer auf etwas aufmerksam gemacht werden soll.

Sprachausgabe

[Bearbeiten]
Dim Sapi
Set Sapi = Wscript.CreateObject("SAPI.SpVoice")
Sapi.speak "abcdefg"

Dieses Skript lässt VBScript sprechen.

Eine Website öffnen

[Bearbeiten]
Dim ieobj, a
set ieobj = createobject("internetexplorer.application")
ieobj.visible=true
a = inputbox("Website:", "", "www.google.de")
ieobj.navigate "" & a & ""
msgbox"Zum schließen hier klicken", vbcritical, "Schließen"
ieobj.visible=false

Dieses Skript öffnet eine gewünschte Website.

Eingabeaufforderung in rot öffnen

[Bearbeiten]
Set objShell = CreateObject("WScript.Shell")
objShell.Run "cmd"
Wscript.Sleep 100
objShell.SendKeys "color 4"
objShell.SendKeys "{ENTER}"
Wscript.Sleep 100
objShell.SendKeys "cls"
objShell.SendKeys "{ENTER}"

Dieses Skript öffnet die Eingabeaufforderung (cmd.exe) in rotem Layout. Ein anderer Farbcode wäre z.B. color 17, der cmd blau mit weißer Schrift erscheinen lässt. Für mehr Informationen über den in dem Skript verwendeten Befehl SendKeys siehe hier.

Einarmiger Bandit

[Bearbeiten]
m = 10000

x = MsgBox("Herzlich Willkommen zu Casino.vbs!" & vbCrLf & "Ihr aktuelles Geld: 10 000 $",1+48,"Virtual Casino")
If x=1 then
	Do
		y = MsgBox("'OK' drücken, um zu drehen" & vbCrLf & "Kostet 100$",1+64,"Money:" & m & "$")
		If y = 1 then
			m = m-100
			a = Int((RND*10)+1)
			b = Int((RND*10)+1)
			c = Int((RND*10)+1)
			MsgBox a & "|" & b & "|" & c,0,"Einarmiger Bandit"
			If a = b then
				If b = c then
					m = m+600
					MsgBox "Gratuliere! +600$!" & vbCrLf & m & "$"
					v = MsgBox("Nochmal?",4)
					If v = 6 then
						f = 100
					else
						f = 1
					end if
				else
					g = MsgBox("Leider nicht! :-(" & vbCrLf & "Nochmal?" & vbCrLf & m & "$",4)
					If g = 6 then
						If m=0 then
							MsgBox "Du hast leider kein Geld mehr!!"
							f = 1
						else
							f = 100
						end if
					else
						f = 1
					end if
				end if				
			else
					g = MsgBox("Leider nicht! :-(" & vbCrLf & "Nochmal?" & vbCrLf & m & "$",4)
					If g = 6 then
						If m=0 then
							MsgBox "Du hast leider kein Geld mehr!!"
							f = 1
						else
							f = 100
						end if
					else
						f = 1
					end if
			end if
		else
			f = 1
		end if
	loop until f=1
else
	f = 1
end if

Eine Nachricht an dem angegebenen Dateipfad als *.txt: 

s = MsgBox("Bevor Sie gehen," & vbCrLf & "wollen Sie eine Nachricht an den Entwickler hinterlassen?",4+32)
If s=6 then 
	k = InputBox("Nachricht an Entwickler:" & vbCrLf & "Nachricht darf die Symbole \ / : * ? < > |  nicht enthalten","Casino.vbs","Hier Text eingeben..")
	Dim p, u
	Set p = CreateObject("Scripting.FileSystemObject")
	Set u = p.CreateTextFile("C:\Dokumente und Einstellungen\User\Eigene Dateien\" & k & ".txt")
	u.Write k
	u.Close
end if

Mögliche Ende: 

h = MsgBox("Auf Wiedersehen! Kommen Sie nochmal hierher?",4+32,"Casino.vbs")
If h = 6 then
	MsgBox "Dann! Bis bald!"
else
	MsgBox "Es tut mir leid, wenn das Spiel Ihnen nicht gefallen hatte.. _
	und Sie deshalb nicht wiederkommen wollen. :-(", 0+48,"Entwickler"
end if
Abgerufen von „https://de.wikibooks.org/w/index.php?title=Visual_Basic_Script_(VBS):_Beispiele&oldid=978808“