|
481
|
Programación / Programación Visual Basic / Re: Ayua con winsock y multiconexiones !!
|
en: 31 Mayo 2005, 00:45 am
|
Enviale la IP como parámetros de la linea de comandos y luego la obtenés utilizando la función Command$. Call Shell ("C:\MyApp.exe" & "127.0.0.1")
'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.
|
|
|
485
|
Programación / Programación Visual Basic / Re: Microsegundos
|
en: 29 Mayo 2005, 19:35 pm
|
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.
|
|
|
487
|
Programación / Programación Visual Basic / Re: proyecto final,, ayudenme porfass.. coincidencias en un texto
|
en: 29 Mayo 2005, 00:38 am
|
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. 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.
|
|
|
490
|
Programación / Programación Visual Basic / Funciones para manipular el registro utilizando la API
|
en: 25 Mayo 2005, 12:41 pm
|
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 . 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.
|
|
|
|
|
|
|