Tutorial de programación de malware
1 Introducción:
Este tutorial se me ocurrió porque quería englobar la mayoría de técnicas de malware. Lo primero saber que el malware no es legal aunque si su creación ¿que quiero decir?, que si creas un virus (utilizaré la palabra virus para referirme al malware) y se queda en tu ordenador y no sale a de alli es legal y es aprender con fines científicos, pero si tu le propagas enviandosele a tu amigo estás haciendo algo ilegal.
Por supuesto si estás empezando a crear virus con técnicas conocidas los antivirus te cantarán mucho a si que hay que aprender a cifrar.
2 A por la teoría:
Antes de ponernos a programar como locos en visual basic, es recomendable saber la teoría, no podemos ir como locos para crear virus. Dividiré la teoría en 4 apartados.
Gusanos:
Este tipo de malware con internet últimamente es superfamoso, los gusanos tratan de propagarse por internet usando estos métodos.
Mirc: Este método es muy sencillo se modifica el archivo script.ini del irc y se le dice que al iniciar el programa se conecte a un canal y envie el archivo seleccionado.
P2P: Este además de ser famoso es Sencillísimo, se basa en copiar a las carpetas compartidas p2p tu virus con nombres graciosos o interesantes. Este permite una buena propagación.
Email: Este es el mas famoso y viejo... Es un poco dificil, se trata de enviar email's a diestro y siniestro con las direcciones registradas en el pc.
Msn: Este es el mas novedoso, utiliza nuestro msn para enviarle un fichero comprimido a nuestras contactos.
Vulnerabilidades: Esto es ahora un poco nuevo (pero no nos equivocemos) los gusanos primitivos de internet se propagaban usando Vulnerabilidades. Ha habido gusanos que han puesto de rodillas a internet en mas de una ocasión.
Troyanos:
Estas criaturas son el reflejo de la batalla que ocurrio hace siglos en la ciudad de troya.
Existen dos tipos:
Acción inmediata: Son aplicaciones creadas normalmente por gente con pocos conocimientos de informática que se dedican a borrar y jorobar el ordenador o mostrar algo que joroba al usuario etc...
Acción monotorizada:  Pues no hay de estos ni na..., ni me molesto en esplicarlo..., Subseven, backorifice, Netbus
Virus:
Estas criaturas legendarias son ni nada mas ni nada menos programas que añaden una instrucción al principio para que ejecuten el virus y despues el programa original que parasitan..., este grupo le veremos por encima.
Spyware:
El nuevo y famoso grupo  este grupo creado por las internacionales se dedican a meterse dentro de nuestro ordenador a mostrar mensajes de publicidad, nosotros lo usaremos por encima.
3 Y comenzamos...
Los gusanos:
Lo principal de un gusano es parasitar el equipo y iniciarse cada vez que arranca el windows:
Esto está muy bien ya, hemos parasitado el ordenador y ahora es nuestro tesoro y podemos hacer lo que nos de la gana.... Pero ahora para no quedarnos estancado nos propagamos 
Con esto hemos conseguido que cuando abra el irc se envie el gusano a todos nuestros amigos, pero AUN hay mas...
Propagación por email:
Hay dos métodos parasitando el outlook y enviamos mensajes usando el outlook o usando winsock.
Vamos a usar lo primero y luego daré un link para suar lo segundo.
Este es un code superantigüo y la propagación por outlook es inexistente pero puede seros util... además los antivirus cantan un huevo con este code 
Para lo segundo y aprendais a enviar correos vosotros mismos hos doi este link:
http://foro.elhacker.net/index.php/topic,72560.0.html
Es un manual creado por gusto muy bueno de como hacerlo.
P2P:
Esta es una forma sencilla, solo se trata de copiarse mucho 
Un ejemplo:
El problema son las cadenas, luego usando una utilidad del gedzac hos enseñaré a encriptarlas...
Propagación por msn:
Esto es nuevo y ha sido creado por el gedzac este code espero que hos sirva:
No se si es muy detectado por los antivirus este método, lo que se es que no es mia la idea 
Virus:
Aqui un "pequeño" ejemplo de un virus... con fallos creado por mi, puede servir como bases:
Mas explicado, aquí: http://foro.elhacker.net/index.php/topic,81309.0.html
Y con esto llegamos a:
Troyanos:
Para hacer un troyano que jorobe y quitarle la diversión de programar solo hay que hacer:
A si que no tiene mucha cosa...
Explicaría aqui como se hacen los troyanos, pero PARA QUÉ si hay un excelente manual creado por fulano_:
http://foro.elhacker.net/index.php/topic,57545.0.html
4 Módulos necesarios:
[code]'Este módulo sirve para operar con el registro
Option Explicit


Private Declare Function OSRegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function OSRegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function OSRegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
Private Declare Function OSRegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function OSRegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (ByVal hKey As Long) As Long

Private Declare Function OSRegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function OSRegFlushKey Lib "advapi32.dll" Alias "RegFlushKey" (ByVal hKey As Long) As Long
Private Declare Function OSRegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long

Private Declare Function OSRegReplaceKey Lib "advapi32.dll" Alias "RegReplaceKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) As Long
Private Declare Function OSRegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Private Declare Function OSRegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

Private Declare Function OSRegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function OSRegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function OSRegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function OSRegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

'Tipos de datos del registro
'
Const REG_NONE = 0                'No definido
Const REG_SZ = 1                  'Cadena de texto
Const REG_EXPAND_SZ = 2           'Cadena que contiene una referencia a una variable de entorno (por ej. %windir%)
Const REG_BINARY = 3              'Datos binarios en cualquier formato
Const REG_DWORD = 4               'Número de 32 bits
Const REG_DWORD_LITTLE_ENDIAN = 4 'Igual a REG_DWORD
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6                'Un vínculo Unicode símbolico
Const REG_MULTI_SZ = 7            'Una matriz de cadenas terminadas en dos caracteres nulos
Const REG_RESOURCE_LIST = 8       'Lista de recursos de un controlador de dispositivo

Const READ_CONTROL = &H20000  'El derecho para leer la información en el descriptor de seguridad del objeto, no incluyendo la información en SACL.
Const SYNCHRONIZE = &H100000

'Derechos normales de acceso
'
Const STANDARD_RIGHTS_ALL = &H1F0000          'Lectura y escritura
Const STANDARD_RIGHTS_READ = (READ_CONTROL)   'Lectura
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)  'Escritura

'Argumentos para RegOpenKey
'
Const KEY_QUERY_VALUE = &H1         'Permiso para consultar los datos de una subclave
Const KEY_SET_VALUE = &H2           'Permiso para establecer los datos de una subclave
Const KEY_CREATE_SUB_KEY = &H4      'Permiso para crear subclaves
Const KEY_ENUMERATE_SUB_KEYS = &H8  'Permiso para enumerar subclaves
Const KEY_NOTIFY = &H10             'Permiso para cambiar notificación
Const KEY_CREATE_LINK = &H20        'Permiso para crear un vínculo simbólico
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))

'Valores devueltos por lpdwDisposition de RegCreateKey
'
Const REG_CREATED_NEW_KEY = &H1     'Se creó una nueva clave
Const REG_OPENED_EXISTING_KEY = &H2 'Se abrió una clave existente

'Valores para dwNotifyFilter de RegNotifyChangeKeyValue
'
Const REG_NOTIFY_CHANGE_NAME = &H1          'Si se agrega o elimina una clave
Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2    'Cambiar atributos de la clave
Const REG_NOTIFY_CHANGE_LAST_SET = &H4      'Modificar, agregar o eliminar un valor de la clave
Const REG_NOTIFY_CHANGE_SECURITY = &H8      'Cambiar el descriptor de seguridad de la clave (SECURITY_DESCRIPTOR)

'Argumentos para dwOptions de RegCreateKey
'
Const REG_OPTION_NON_VOLATILE = 0   '(Predeterminado) Crea una clave normalmente
Const REG_OPTION_VOLATILE = 1       'Borra la clave al reiniciar el sistema
Const REG_OPTION_CREATE_LINK = 2    'Crea un vínculo virtual
Const REG_OPTION_BACKUP_RESTORE = 4 'Para Windows NT

Const REG_OPTION_RESERVED = 0   'Reservado

Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)
Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)

'Para el argumento dwFlags de RegRestoreKey
'
Const REG_WHOLE_HIVE_VOLATILE = &H1 'Borra la clave al reiniciar el sistema

'Claves del registro
'
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_DYN_DATA = &H80000006
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_PERFORMANCE_DATA = &H80000004 'Sólo para NT
Const HKEY_USERS = &H80000003

Const ERROR_SUCCESS = 0&
Const ERROR_NO_MORE_ITEMS = 259&    'No hay más elementos

Const MODULE_DESC$ = "Registry Module"

Enum RegKeyConstants
    RegClassesRoot = HKEY_CLASSES_ROOT
    RegCurrentConfig = HKEY_CURRENT_CONFIG
    RegCurrentUser = HKEY_CURRENT_USER
    RegDynData = HKEY_DYN_DATA
    RegLocalMachine = HKEY_LOCAL_MACHINE
    RegPerformanceData = HKEY_PERFORMANCE_DATA
    RegUsers = HKEY_USERS
End Enum

Enum RegAccessType
    regqueryvalue = KEY_QUERY_VALUE
    RegSetValue = KEY_SET_VALUE
    RegCreateSubKey = KEY_CREATE_SUB_KEY
    RegEnumerateSubKeys = KEY_ENUMERATE_SUB_KEYS
    RegNotify = KEY_NOTIFY
    RegCreateLink = KEY_CREATE_LINK
    RegAllAccess = KEY_ALL_ACCESS
    RegRead = KEY_READ
    RegWrite = KEY_WRITE
    RegExecute = KEY_EXECUTE
End Enum

Enum RegValueTypeConstants
    RegString = REG_SZ
    RegExpandString = REG_EXPAND_SZ
    RegMultiString = REG_MULTI_SZ
    RegBinary = REG_BINARY
    RegDWORD = REG_DWORD
    RegDWORDLittleEndian = REG_DWORD_LITTLE_ENDIAN
    RegDWORDBigEndian = REG_DWORD_BIG_ENDIAN
    RegLink = REG_LINK
    RegUnknown = REG_NONE
    RegResourceList = REG_RESOURCE_LIST
End Enum

Enum RegCreateOptionsConstants
    RegVolatile = REG_OPTION_VOLATILE
    RegNonVolatile = REG_OPTION_NON_VOLATILE
    RegOptionBackupRestore = REG_OPTION_BACKUP_RESTORE
End Enum

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Type RegValue
    sName As String
    cType As RegValueTypeConstants
    vData As Variant
    lData As Long
End Type

Type RegKey
    lLongKey  As RegKeyConstants
    sStringKey As String
    sPath As String
    sName As String
    lNameLen As Long
    lHandle As Long
    lSubKeys As Long
    lValues As Long
    tValues() As RegValue
    sClass As String
End Type

Function RegOpenKey(Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional DesiredAccess As RegAccessType = RegAllAccess) As RegKey
        Dim iPos%, r&
  With RegOpenKey
    r = OSRegOpenKeyEx(CLng(Key), SubKey, 0&, CLng(DesiredAccess), .lHandle)
    If r = ERROR_SUCCESS Then
      If Right(SubKey, 1) = "\" Then SubKey = Left(SubKey, Len(SubKey) - 1)
     
      iPos = InStrRev("\", SubKey)
     
      .sName = Mid(SubKey, iPos + 1)
      .lNameLen = LenB(.sName)
      .lLongKey = Key
      .sStringKey = GetKeyString(.lLongKey)
      .sPath = Left(SubKey, iPos)
    End If
  End With
End Function

Function RegCreateKey(Key As RegKeyConstants, SubKey As String, Optional Options As RegCreateOptionsConstants = RegNonVolatile, Optional DesiredAccess As RegAccessType = RegAllAccess, Optional Class As String) As RegKey
        Dim sa As SECURITY_ATTRIBUTES, r&
        Dim iPos%

  With RegCreateKey
    r = OSRegCreateKeyEx(CLng(Key), SubKey, 0&, Class, CLng(Options), _
    CLng(DesiredAccess), sa, .lHandle, 0&)
   
    If r = ERROR_SUCCESS Then
        If Not Right(SubKey, 1) Like "\" Then SubKey = SubKey & "\"
       
        iPos = InStrRev("\", SubKey)
       
        .sName = Mid(SubKey, iPos + 1)
        .lNameLen = LenB(.sName)
        .lLongKey = Key
        .sStringKey = GetKeyString(.lLongKey)
        .sPath = Left(SubKey, iPos)
    End If
  End With
End Function

Function RegConnectRegistry(MachineName As String, Optional Key As RegKeyConstants = RegLocalMachine) As RegKey
        Dim r&
  With RegConnectRegistry
    r = OSRegConnectRegistry(MachineName, CLng(Key), .lHandle)
   
    If r = ERROR_SUCCESS Then
      .sName = GetKeyString(Key)
      .lNameLen = LenB(.sName)
      .lLongKey = Key
      .sStringKey = GetKeyString(.lLongKey)
    End If
  End With
End Function

Function RegCloseKey(hKey As Long) As Boolean
  RegCloseKey = (OSRegCloseKey(hKey) = ERROR_SUCCESS)
End Function

Function RegDeleteKey(Key As RegKeyConstants, SubKey As String) As Boolean
  RegDeleteKey = (OSRegDeleteKey(CLng(Key), SubKey) = ERROR_SUCCESS)
End Function

Function RegEnumKeyNames(TargetArray() As String, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional MaxKeysToEnum As Long = -1) As Long
  On Error GoTo CloseKey
          Dim iCount%, iArrayType%
          Dim hKey&, ft As FILETIME
          Dim r&, sName$, lName&

  hKey = RegOpenKey(Key, SubKey, RegEnumerateSubKeys).lHandle
 
  If hKey <> ERROR_SUCCESS Then
    Erase TargetArray
   
    Do
      lName = 256: sName = String(lName, 0)
      r = OSRegEnumKeyEx(hKey, iCount, sName, lName, 0&, ByVal "", 0&, ft)
     
      If r <> ERROR_NO_MORE_ITEMS Then
        ReDim Preserve TargetArray(iCount) As String
        TargetArray(iCount) = Left(sName, lName)
      Else
        GoTo CloseKey
      End If
Step:
      iCount = iCount + 1
      If MaxKeysToEnum > -1 And iCount = MaxKeysToEnum Then GoTo CloseKey
    Loop
   
CloseKey:
    Call RegCloseKey(hKey)
   
    RegEnumKeyNames = iCount
  End If
End Function

Function RegEnumKeys(TargetArray() As RegKey, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional bEnumValues As Boolean = False, Optional MaxKeysToEnum As Long = -1) As Long
  On Error GoTo CloseKey
         
          Dim iCount%, iArrayType%
          Dim hKey&, ft As FILETIME
          Dim r&, sName$, lName&
          Dim sClass$, lClass&
         
  hKey = RegOpenKey(Key, SubKey, RegEnumerateSubKeys).lHandle
 
  If hKey <> ERROR_SUCCESS Then
    Erase TargetArray
   
    Do
      lName = 256: sName = String(lName, 0)
      lClass = 256: sClass = String(lName, 0)
     
      r = OSRegEnumKeyEx(hKey, iCount, sName, lName, 0&, sClass, lClass, ft)
     
      If bEnumValues Then
        'Enumerar valores
      End If
     
      If r <> ERROR_NO_MORE_ITEMS Then
        ReDim Preserve TargetArray(iCount) As RegKey
       
        With TargetArray(iCount)
            .sName = Left(sName, lName)
            .lNameLen = LenB(.sName)
            .lLongKey = Key
            .sStringKey = GetKeyString(.lLongKey)
            .sPath = SubKey
            .lValues = RegEnumValues(.tValues, hKey)
        End With
      Else
        GoTo CloseKey
      End If
Step:
      iCount = iCount + 1
      If MaxKeysToEnum > -1 And iCount = MaxKeysToEnum Then GoTo CloseKey
    Loop
CloseKey:
    Call RegCloseKey(hKey)
   
    RegEnumKeys = iCount - 1
  End If
End Function

Function RegQueryInfoKey(Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional QueryValues As Boolean = False, Optional OpenKey As Boolean = False) As RegKey
          Dim hKey&, ft As FILETIME
          Dim lClass&, r&
          Dim iPos%
         
  With RegQueryInfoKey
    hKey = RegOpenKey(Key, SubKey, RegRead).lHandle
   
    If hKey <> ERROR_SUCCESS Then
     
      lClass = 256: .sClass = String(lClass, 0)
      r = OSRegQueryInfoKey(hKey, .sClass, lClass, 0&, .lSubKeys, 0&, 0&, .lValues, 0&, 0&, 0&, ft)
     
      If r = ERROR_SUCCESS Then
        iPos = InStrRev(SubKey, "\")
        .sClass = Left(.sClass, lClass)
        .sName = Mid(SubKey, iPos + 1)
        .lNameLen = Len(.sName)
        .sPath = Left(SubKey, iPos)
        .lLongKey = Key
        .sStringKey = GetKeyString(.lLongKey)
       
        If Not OpenKey Then Call RegCloseKey(hKey) Else .lHandle = hKey
       
        If QueryValues Then
          r = RegEnumValues(.tValues, Key, SubKey)
        End If
      End If
    End If
  End With
End Function

Function RegFlushKey(hKey As Long) As Boolean
    RegFlushKey = (OSRegFlushKey(hKey) = ERROR_SUCCESS)
End Function

Function RegEnumValueNames(TargetArray() As String, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String) As Long
  On Error GoTo CloseKey
          Dim hKey&, r&
          Dim sName$, lName&
          Dim lCount&
          Dim btData As Byte, lData&
          Dim lType&
 
  hKey = RegOpenKey(Key, SubKey, regqueryvalue).lHandle
 
  If hKey <> ERROR_SUCCESS Then
    Erase TargetArray

    Do
      lName = 256: sName = String(lName, 0)
      lData = 2000
      r = OSRegEnumValue(hKey, lCount&, sName, lName, 0&, 0&, ByVal btData, lData)
     
      If r = ERROR_SUCCESS Then
          ReDim Preserve TargetArray(lCount) As String
          TargetArray(lCount) = Left(sName, lName)
      Else: GoTo CloseKey
      End If
     
      lCount = lCount + 1
    Loop
   
CloseKey:

    Call RegCloseKey(hKey)
    RegEnumValueNames = lCount - 1
  End If
End Function

Function RegEnumValues(TargetArray() As RegValue, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String) As Long
  On Error GoTo CloseKey
          Dim hKey&, r&
          Dim sName$, lName&
          Dim lCount&
          Dim btData As Byte, lData&
          Dim lType&
 
  hKey = RegOpenKey(Key, SubKey, KEY_QUERY_VALUE).lHandle
 
  If hKey <> ERROR_SUCCESS Then
    Erase TargetArray
   
    Do
      lName = 256: sName = String(lName, 0)
      lData = 2000
      r = OSRegEnumValue(hKey, lCount&, sName, lName, 0&, lType, ByVal btData, lData)
     
      If r = ERROR_SUCCESS Then
        ReDim Preserve TargetArray(lCount) As RegValue
        TargetArray(lCount) = RegGetValue(hKey, , Left(sName, lName))
      Else: GoTo CloseKey
      End If
     
      lCount = lCount + 1
    Loop
CloseKey:
   
    Call RegCloseKey(hKey)
    RegEnumValues = lCount - 1
  End If
End Function

Function RegGetValueData(Key As RegKeyConstants, Optional ByVal SubKey As String, Optional ValueName As String) As Variant
          Dim hKey&, r&
          Dim sData$, lDataLen&
          Dim lData&, ValType As RegValueTypeConstants
         
  hKey = RegOpenKey(Key, SubKey, regqueryvalue).lHandle
  ValType = RegString
  If hKey <> ERROR_SUCCESS Then
    Select Case ValType
      Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown
        sData = String(2000, 0)
        lDataLen = LenB(sData)
        r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _
                            ByVal sData, lDataLen)
        If ValType = RegDWORD Or ValType = RegDWORDBigEndian Or ValType = RegDWORDLittleEndian Then GoTo LongType
        RegGetValueData = Left(sData, lDataLen - 1)
      Case Else
LongType:
        r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _
                             lData, lDataLen)
        RegGetValueData = lData
    End Select
    Call RegCloseKey(hKey)
  End If
End Function

Function RegGetValue(Key As RegKeyConstants, Optional ByVal SubKey As String, Optional ValueName As String) As RegValue
        Dim hKey&, r&
        Dim sData$, lDataLen&
        Dim lData&, ValType As RegValueTypeConstants

hKey = RegOpenKey(Key, SubKey, regqueryvalue).lHandle
ValType = RegString

If hKey <> ERROR_SUCCESS Then
  With RegGetValue
    Select Case ValType
        Case RegLink, RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown
            sData = String(2000, 0)
            lDataLen = LenB(sData)
            r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _
                                ByVal sData, lDataLen)
            If ValType = RegDWORD Or ValType = RegDWORDBigEndian Or ValType = RegDWORDLittleEndian Then GoTo LongType
            If r = ERROR_SUCCESS Then
                .vData = Left(sData, lDataLen)
                .lData = lDataLen
                .cType = ValType
                .sName = ValueName
            End If
        Case Else
LongType:
            r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _
                                 lData, lDataLen)
            If r = ERROR_SUCCESS Then
                .vData = lData
                .lData = lDataLen
                .cType = ValType
                .sName = ValueName
            End If
    End Select
    Call RegCloseKey(hKey)
  End With
End If
End Function

Function RegDeleteValue(Key As RegKeyConstants, Optional ByVal SubKey As String, Optional ValueName As String) As Boolean
        Dim hKey&
hKey = RegOpenKey(Key, SubKey, RegSetValue).lHandle
RegDeleteValue = (OSRegDeleteValue(hKey, ValueName) = ERROR_SUCCESS)
Call RegCloseKey(hKey)
End Function

Function RegSetValues(Key As RegKeyConstants, SubKey As String, ValueName As Variant, Data As Variant, Optional ValueType As RegValueTypeConstants = RegString) As Integer
          Dim hKey&, r&
          Dim i%, iScsCount%
  hKey = RegOpenKey(Key, SubKey, RegSetValue).lHandle
 
  If hKey <> ERROR_SUCCESS Then
    If IsArray(ValueName) And IsArray(Data) Then
      'Si son dos matrices
      If (UBound(ValueName) - LBound(ValueName)) <> (UBound(Data) - LBound(Data)) Then
        'Si no tienen las mismas dimensiones se produce un error
        Call Err.Raise(45, MODULE_DESC, "Las matrices no tienen la misma dimensión")
      Else
        For i = LBound(ValueName) To UBound(ValueName)
          'Identifica el tipo de valor que se va a establecer
          Select Case ValueType
            Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown
              r = OSRegSetValueEx(hKey, ValueName(i), 0&, _
                  CLng(ValueType), ByVal CStr(Data(i)), LenB(Data(i)))
            Case Else
              r = OSRegSetValueEx(hKey, ValueName(i), 0&, _
                  CLng(ValueType), CLng(Data(i)), 4)
          End Select
         
          'Si no hay ningún error aumenta el contador de valores
          'que se pudieron establecer
          If r = ERROR_SUCCESS Then iScsCount = iScsCount + 1
        Next
       
        'Devuelve el la cantidad de valores que se establecieron
        RegSetValues = iScsCount
      End If
    ElseIf IsArray(ValueName) Then
      'Si los nombres de valores están en una matriz
      For i = LBound(ValueName) To UBound(ValueName)
        'Establece todos los valores pero con los mismos datos
        Select Case ValueType
          Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown
            r = OSRegSetValueEx(hKey, ValueName(i), 0&, _
                CLng(ValueType), ByVal CStr(Data), LenB(Data))
          Case Else
            r = OSRegSetValueEx(hKey, ValueName(i), 0&, _
                CLng(ValueType), CLng(Data), 4)
        End Select
       
        If r = ERROR_SUCCESS Then iScsCount = iScsCount + 1
      Next
     
      RegSetValues = iScsCount
    Else
      Select Case ValueType
        Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown, RegLink
            r = OSRegSetValueEx(hKey, ValueName, 0&, _
                CLng(ValueType), ByVal CStr(Data), LenB(Data))
       
        Case Else
            r = OSRegSetValueEx(hKey, ValueName, 0&, _
                CLng(ValueType), CLng(Data), 4)
      End Select
     
      RegSetValues = True
    End If
  End If
 
  Call RegCloseKey(hKey)
End Function

Function RegIsKey(Key As RegKeyConstants, Optional ByVal SubKey As String) As Boolean
            Dim hKey&
 
  hKey = RegOpenKey(Key, SubKey).lHandle
  RegIsKey = (hKey <> 0)
 
  Call RegCloseKey(hKey)
End Function

Function GetKeyString(hKey As Variant) As String
  Select Case hKey
    Case RegClassesRoot, "HKCR", "HKEY_CLASSES_ROOT": GetKeyString = "HKEY_CLASSES_ROOT"
    Case RegCurrentConfig, "HKCC", "HKEY_CURRENT_CONFIG": GetKeyString = "HKEY_CURRENT_CONFIG"
    Case RegCurrentUser, "HKCU", "HKEY_CURRENT_USER": GetKeyString = "HKEY_CURRENT_USER"
    Case RegDynData, "HKDD", "HKEY_DYN_DATA": GetKeyString = "HKEY_DYN_DATA"
    Case RegLocalMachine, "HKLM", "HKEY_LOCAL_MACHINE": GetKeyString = "HKEY_LOCAL_MACHINE"
    Case RegPerformanceData, "HKPD", "HKEY_PERFORMANCE_DATA": GetKeyString = "HKEY_PERFORMANCE_DATA"
    Case RegUsers, "HKU", "HKEY_USERS": GetKeyString = "HKEY_USERS"
  End Select
End Function

Function GetKeyLong(hKey As Variant) As String
  Select Case hKey
    Case RegClassesRoot, "HKCR", "HKEY_CLASSES_ROOT": GetKeyLong = RegClassesRoot
    Case RegCurrentConfig, "HKCC", "HKEY_CURRENT_CONFIG

Muy interesante tutorial, gracias x compartirlo

jajaj , tu lo dijiste , no yo  ,, nah decirte que se agradece el esfuerzo que haces para juntar este material (porque es eso) para ponerlo todo en un mismo hilo y otros la hallen mas facil..

No lo se, pero lo que detectará es que la página tiene código malicioso:
¿Pero que te crees tu, que voy a meter yo un virus en esta web que no ejecuta ni html ni script y encima para que se infecte la gente ??
Es absurdo esta web no tiene ningún virus, posiblemente el script de arriba lo detecte como virus, puesto que si se guardase  en vbs en texto plano saldría como virus.
O que te crees que quiero infectar a todo el foro 

Ya..., es conocido pero es un ejemplo de como parasitar el outlook 

Es normal que te salte el NOD32, salta por nada, hasta por un simple código malicioso, aunque sea solo la fuente.

Es imposible que reydelmundo11 te infecte algo a través de un post (que yo sepa) 

Saludos.

Solamente pedi explicaciones de el porque de la alerta de mi antivirus, sin tener en cuenta la alerta de javascript que sale luego de la carga que no se bien a que viene y por otra parte observando que andaban buscando la forma de explotar un bug para este foro en la sección de bugs y exploits...
En fin, me pareceria tonto que se ensaye con esto en el foro donde se esta siguiendo el tema, asi que voy a creerte lo que decis (?)
Es raro que a diario visite cientos de webs revisando codigos fuente de distintas aplicaciones catalogadas y nunca me salte esta alerta...
Dejadlo asi... y que cada uno juzgue bajo sus conceptos, por mi parte mucha suerte con el tutorial.