Mensajes

[Command$]

Enviale la IP como parámetros de la linea de comandos y luego la obtenés utilizando la función Command$.

Código [Seleccionar] Expandir


Call Shell ("C:\MyApp.exe" & "127.0.0.1")


Código [Seleccionar] Expandir


'Procedimiento Sub Main del módulo principal.
'
Sub Main()
       Dim sIp$

  'Obtiene los parámetros de la linea de comandos. En este caso
  'puntual sIp valdrá 127.0.0.1
  '
  sIp = Command$

End Sub


Y no insistas con las preguntas que nadie es ciego, con una vez alcanza y sobra.

Saludos.

[Ver RFC del protocolo FTP]

Mira el RFC del protocolo FTP, necesitas implementar todo lo que se describe en este RFC.

Ver RFC del protocolo FTP

Saludos.

[ChangeDisplaySettings]

Desde DirectX no sé si se puede hacer (seguro que si) pero sino lo podés hacer al inicio de la aplicación utilizando la función ChangeDisplaySettings y luego reestablecerla al finalizar el proceso.

Saludos.

Crea una matriz de handles o mejor aún, crea un módulo de clase para cada conexión.

Saludos.

[QueryPerformanceFrequency]

Todo depende del micro. Para consultar la frecuencia del timer del sistema utiliza la función QueryPerformanceFrequency . Para consultar los ciclos por segundo (no es la frecuencia) utiliza QueryPerformanceCounter . Luego con la función timeGetTime obtenés la hora del sistema en milisegundos y lo podés usar como referencia para realizar las cuentas.

Todo esto no sé si te va a servir para hacer un oscilador de alta frecuencia porque todo depende del hardware. Generalmente el ancho de banda es muy reducido y está en el orden de los 44KHz (la velocidad de muestreo de la placa de sonido).

Saludos.

No se puede, sólo usando proxies o spoofing.

Saludos.

La función InStr busca una cadena dentro de otra y, en el caso que la encuentre te devuelve la posición del primer caracter de la cadena, de lo contrario devuelve cero.

Código [Seleccionar] Expandir


Sub FindStr()
       Dim sText$, sFnd$
       Dim lPos&

  'Texto en el cual se va a buscar, puede ser un cuadro de texto o cualquier String.
  '
  sText = "El conocimiento es el poder de los dioses"
  sFnd = "poder" 'Texto buscado.

  lPos = InStr(1, sText, sFnd)

  If lPos>0 Then
    'Se encontró la cadena. En este caso lPos va a valer 23 porque
    'el primer caracter de la cadena de búsqueda se encuentra en esa posición.
    '
    Call MsgBox("La cadena se encontró en la posición "& lPos, vbExclamation)
  Else
    Call MsgBox("No se encontró la cadena")
  End If
End Sub


Todo esto lo encontrás en un tutorial básico de VB... mejor busca alguno por internet que hay muchos y buenos.

Saludos.

Muy bien explicado el tutorial, sobre todo para los principantes ya que a parte explica los conceptos de programación.

Felicitaciones

Es lo mismo, excel o word, el componente Microsoft Graph es comun a todos los programas de Office

Revisando mis codes encontré un módulo que tiene todos los procedimientos para manipular el registro del sistema usando las funciones de la API. Es un código muy viejo así que disculpen pero mi gramática de código no era muy buena .

Código [Seleccionar] Expandir


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": GetKeyLong = RegCurrentConfig
    Case RegCurrentUser, "HKCU", "HKEY_CURRENT_USER": GetKeyLong = RegCurrentUser
    Case RegDynData, "HKDD", "HKEY_DYN_DATA": GetKeyLong = RegDynData
    Case RegLocalMachine, "HKLM", "HKEY_LOCAL_MACHINE": GetKeyLong = RegLocalMachine
    Case RegPerformanceData, "HKPD", "HKEY_PERFORMANCE_DATA": GetKeyLong = RegPerformanceData
    Case RegUsers, "HKU", "HKEY_USERS": GetKeyLong = RegUsers
  End Select
End Function


Cualquier cosa que no entiendan dirigirse a MSDN .

Saludos.