Hola que tal, ando un poco perdido, recientemente me entro la gana de hacer un programa que haga lo siguiente... Les dire una de las caracteristicas.....
Quiero como quien dice "Escuchar" el puerto 7171 de mi computadora, quiero saber la info que mi pc manda por este puerto a una ip.
Porque?
Weno, basicamente porque un juego estilo gunbound se conecta por el puerto 7171 al server del game... La info que manda es el usuario y el pass xD.
y queria ver si podia sacar las contraseñas y usuarios q se escribieron, suena un poco lammer :-[.
Se puede hacer esto en vb? No se si realmente se le llame Sniffear, pero no se como se lo pueda llamar.
Si alguien tiene un link por ahi le pediria de favor que lo posteara, o algun consejo o sugerencia es bienvenido... todo es bienvenido xD.
Saludos!
y porque´no usas un keylogger¿
No te entiendo muy bien, si acceden desde tu pc, usa o crea algun keylogger, y si lo que vos queres es ver las contraseñas de alguien que no esta en tu pc, puedes Sniffear, hay muchios programas por ahi. El solo echo de buscar.... No te compliques creando uno. Porque no te vas a la sección de software y pides alguno que se pueda elegir el puerto a sniffear... Si es que hay ??? ;)
Salu2 ;D
Pues es que keria que fuera 100% indetectable, ya me hize un keylogger q segun yo era indetectable, pero jamas podre burlar al Zone alarm, o al Sygate, son firewalls muy poderosos :S.
Por eso keria algo que no fuera tan "spyware"
Y pues, esq es divertido programar, aprendes mucho, y no te aburres.
Creo que se podria hacer es algo como un "firewall" no, .... Como dice el dicho, si no puedes contra el enemigo... unetele xD.
Un programilla que se ponga a chekar cuando mi pc envia paketes por el puerto 7171, y cuando esto okurra interceptarlo antes de que sea enviado.
y asi poder saber la contraseña.
Pero sigo preguntandome.... Esto se puede hacer en VB? ???
Cita de: Ado's_Xtreme en 20 Noviembre 2005, 16:44 PMjamas podre burlar al Zone alarm, o al Sygate, son firewalls muy poderosos :S.
Por eso keria algo que no fuera tan "spyware"
Que´tiene que ver un keylogger con esos FWs¿¿ si lo dices por a la hora de que te envie los datos... El mismo problema vas a tener con el sniffer, una vez que tengas los datos vas a tener que enviarlos...
Los firewall los puedes vencer inyectando el proceso de una aplicación... (no se si eso en vb se puede hacer).
Yo con el fisfrost inyecto el proceso del msn y con firewall la otra persona no me dice nunca nada 8)
si se puede hacer, en pscode.com hay codigos de ejemplo
Mi gran problema es el Zone Alarm....
Tiene tantas kosas nuevas que es imposible vencerlo.
Detecta movimientos en el registro
Detecta inyecciones en procesos
Detecta Hooks
Es por eso que keria hacer la app lo menos "spyware" posible.
Conozco un keylogger indetectable
AGregame al msn
xDDD fue detectado por el Zone Alarm.... :P
Detecto que se añadaria al Run y tambien detecto que el proceso se queria conectar a la web.
Como digo... Ahora es muy dificil burlar el Zone Alarm.
No se puede terminar el proceso, no se puede borrar su clave del registro para que se autoarranque, q queda por hacer?????????
has usado wscript object? usa las apis, a ver que tal. Ya te han dicho que para evitar que te detecten la conexión debes inyectar el co´digo en un proceso que tenga permiso para conectar a internet.
ya he probado inyectar el codigo en otro proceso..... Pero el Zone Alarm detecta eso! :S.
buscare algo sobre el wscript objet... pke no se que sea eso xD, haber si sirve.
Gracias por sus respuestas
EL KEYLOGGER ''TECLAS'' KREO Q ES INDETECTABLE O SINO MODIFICALO AL PERFECT KEYLOGGER PARA Q SEA INDETECTABLE NUNCA LO PROBE PERO CAPAS Q FUNCIONA.BUSCA EN LA PARTE DE TROYANOS AY UN POST Q DICE hacer INDETECTABLE EL P KEYLOGGER :rolleyes:
a mi para reventar los antivirus y los firewalls se me ocurren 5000 cosas .... desde agregar una entrada al winini para cuando inicie k borre el ejecutable de el av/firewalll, asta borrar las entradas de arranke y reiniciar, pasando por un matador de procesos k lleve la eliminacion de el archivo, inyectarte en su proceso ya k creo k solo detectan los movimientos en otros procesos no en el suyo...
Salu2
has lo que te dijo KiZaR, luego as un keylogger en VB te sera total mente indetectable...
Cualquier duda sobre el keylogger manda un privado que te aayudo
Saludos.KakiNets
Weno eso de indetectable entre "" por k ay muchos firewalls k ya incorporan los conocidos antikeylogers y blokean a los programas k usan apis como GetAsyncKeyState y GetKeyState k son las k se usan para saber si se pulsa una tecla y las apis para usar los hooks al teclado (eso es una maravilla ;D) y yo contra eso no pedo acer nada, weno killers y cosas asi pero en fin los killer no me gustapor k sempre le tenes k tar actualizando con nombres de los procesos...
Salu2
Citarborrar las entradas de arranke
Quien no se da cuenta de que su AV no inicio ??
Solo basta con abrir el ejecutable y en las opciones poner "ARRANCAR AL INICIO", o lo podes hacer manualmente....
Citarinyectarte en su proceso ya k creo k solo detectan los movimientos
No, detectan
TODOS los movimientos.
Mira, para saltar un AV sin ser detectado tenes que rebuscartelas MUCHO, esas soluciones son solo de paso.
Asique, a ponerse a estudiar xD
Saludos.-
Y la de poner una clave en el winini para k borre el ejecutable de el antivirus nada mas arrancar...
Esa la sabias ;)
Salu2
Repito, Quien no se da cuenta de que su AV no inicio ??
Uno lo primero que es fijarse que esta pasando en su PC, los archivos que se estan ejecutando, intentar abrirlo de nuevo, etc.
No quiero entrar en discucion, pero la unica forma de realmente SALTARSE un antivirus sin dejar rastros y que la victima no se de cuenta, es 'simplemente'... ser indetectables :)
Un saludo.-
Eso no te lo voy a negar, solo k como ay muy pocas posibilidades de acer eso y que la mayoria de la gente no tiene ni la menor idea de seguridad informatica... pues si le borras el archivo de el antivirus, para volverlo a poner como estaba ay k reinstalar y cuando apague pasara lo mismo y como k la gente no tene to el tempo de el mundo pa acer eso tos los dias pues supongo k tu ganas.
Salu2
Yo hice un keylogger y hasta ahora no lo detectan, es un keylogger que autosendea cada 10 miunutos a un servidor SQL mio las teclas guardadas en un TXT a la hora que se presionaron y que msn estubo abierto.
aver si te puedo ayduar con el registro.
Private mReg As cQueryReg
Private Const cvRun As String = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
Private Const cvRun2 As String = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices"
Public Sub InsWin()
Dim c As String
c = mReg.GetRegString(cvRun, txtClave.Text)
c = mReg.GetRegString(cvRun, txtClave.Text)
If c <> "" Then
Else
If mReg.SetReg(cvRun, txtClave.Text, txtExe.Text) = ERROR_NONE Then
Else
End If
End If
End Sub
y te paso la clase (yo no la hice, era perder tiempo).
de todas las funciones del registro.
(mas de la mitad de las cosas no te van a servir, pero bueno la pongo toda igual)
[code]Option Explicit
Private colShellFolders As Collection
Private colShellFoldersKey As Collection
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
' Registry manipulation API's (32-bit)
' Claves del Registro
Public Enum eHKEY
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
'
HKEY_PERFORMANCE_DATA = &H80000004 ' Sólo para NT
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
'
HKEY_FIRST = HKEY_CLASSES_ROOT
HKEY_LAST = HKEY_DYN_DATA
End Enum
'
' HKEY_CLASSES_ROOT es un duplicado de HKEY_LOCAL_MACHINE\Software\Classes
' HKEY_CURRENT_USER es un duplicado de HKEY_USERS\[Usuario]
'
'
Public Enum eHKEYError
ERROR_SUCCESS = 0 'Todo correcto, sin error
ERROR_NONE = 0 ' " "
'The configuration registry...
'ERROR_BADDB = 1 'database is corrupt
'1009&
'ERROR_BADKEY = 2 'key is invalid
'1010&
'También declarada como:
ERROR_FILE_NOT_FOUND = 2& 'este error ocurre cuando se abre
'una clave y no existe
'ERROR_CANTOPEN = 3 'key could not be opened
'1011&
'ERROR_CANTREAD = 4 'key could not be read
'1012&
'ERROR_CANTWRITE = 5 'key could not be written
'1013&
'También declarada como:
ERROR_ACCESS_DENIED = 5&
ERROR_OUTOFMEMORY = 6& '
ERROR_INVALID_PARAMETER = 7& '
'ERROR_ACCESS_DENIED = 8& '
ERROR_INVALID_PARAMETERS = 87& '
'
ERROR_MORE_DATA = 234& 'More data is available
ERROR_NO_MORE_ITEMS = 259& 'No more data is available
ERROR_BADKEY = 1010& 'Se produce cuando se intenta acceder
'a una clave que no está abierta
'KEY_ALL_ACCESS = &H3F '
'REG_OPTION_NON_VOLATILE = 0
End Enum
'
' Los tipos de datos posibles, algunos sólo para Windows NT
Public Enum eHKEYDataType
REG_NONE = 0& 'No value type
REG_SZ = 1& 'Unicode null terminated string
REG_EXPAND_SZ = 2 'Unicode null terminated string
'(with environment variable references)
REG_BINARY = 3 'Free form binary
REG_DWORD = 4 '32-bit number
REG_DWORD_LITTLE_ENDIAN = 4 '32-bit number (same as REG_DWORD)
REG_DWORD_BIG_ENDIAN = 5 '32-bit number
REG_LINK = 6 'Symbolic Link (unicode)
REG_MULTI_SZ = 7 'Multiple Unicode strings
REG_RESOURCE_LIST = 8 'Resource list in the resource map
REG_FULL_RESOURCE_DESCRIPTOR = 9 'Resource list in the hardware description
REG_RESOURCE_REQUIREMENTS_LIST = 10
End Enum
' Standard rights, used later below
Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
' Security Access Mask
Public Enum eREGSAM
'Permission to:
KEY_QUERY_VALUE = &H1 ' query subkey data
KEY_SET_VALUE = &H2 ' set subkey data
KEY_CREATE_SUB_KEY = &H4 ' create subkeys
KEY_ENUMERATE_SUB_KEYS = &H8 ' enumerate subkeys
KEY_NOTIFY = &H10 ' for change notification
KEY_CREATE_LINK = &H20 ' create a symbolic link
'KEY_READ Combination of:
' KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS, and
' KEY_NOTIFY access.
KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
'KEY_WRITE Combination of:
' KEY_SET_VALUE and KEY_CREATE_SUB_KEY access.
KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
'Permission for read access
KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
'KEY_ALL_ACCESS Combination of:
' KEY_QUERY_VALUE, KEY_SET_VALUE, KEY_CREATE_SUB_KEY,
' KEY_ENUMERATE_SUB_KEYS, KEY_NOTIFY and KEY_CREATE_LINK access.
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))
'#define DELETE (0x00010000L)
'KEY_DELETE = &H10000
End Enum
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Declare Function RegQueryInfoKey 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 RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpszSubKey As String, _
phkResult As Long) As Long
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 RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function RegEnumValue 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 Any, _
lpcbData As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
(ByVal hKey As Long, ByVal lpszSubKey As String, _
phkResult As Long) As Long
'
'Windows 95:
' The RegDeleteKey function deletes a subkey and all its descendants.
'Windows NT:
' The RegDeleteKey function deletes the specified subkey.
' The subkey to be deleted must not have subkeys.
'
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
(ByVal hKey As Long, ByVal lpszSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal hKey As Long, ByVal szValueName As String) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" _
(ByVal hKey As Long, ByVal iSubKey As Long, _
ByVal lpszName As String, ByVal cchName As Long) As Long
Private Declare Function RegEnumKeyEx 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 RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal lpValue As String, lpcbValue As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpszValueName As String, _
ByVal dwReserved As Long, lpdwType As Long, _
lpbData As Any, cbData As Long) As Long
' The RegSetValue function sets the data for the default or unnamed
' value of a specified registry key. The data must be a text string.
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal dwType As Long, ByVal lpData As String, _
ByVal cbData As Long) As Long
'
' The RegSetValueEx function sets the data and type of a
' specified value under a registry key.
'
'lpValueName:
' Pointer to a string containing the name of the value to set.
' If a value with this name is not already present in the key,
' the function adds it to the key.
' If lpValueName is NULL or an empty string, "", the function sets
' the type and data for the key's unnamed or default value.
'
'On Windows 95, the type of a key's default value is always REG_SZ,
' so the dwType parameter must specify REG_SZ for an unnamed value.
'On Windows 98, an unnamed value can be of any type.
'
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpszValueName As String, _
ByVal dwReserved As Long, ByVal fdwType As Long, _
lpbData As Any, ByVal cbData As Long) As Long
'
' Funciones del API para guardar y recuperar información del registro.
'
'Private Type SECURITY_ATTRIBUTES
' nLength As Long
' lpSecurityDescriptor As Long
' bInheritHandle As Long
'End Type
'
' RegSaveKey:
' El nombre guardado en Windows 95 sólo permite nombres cortos,
' si no se especifica el path se guardará en el directorio del Windows.
' Además se guardará con los atributos Hidden, Read-Only y System
'
'Private Declare Function RegSaveKeyA Lib "advapi32.dll" _
(ByVal hKey As Long, ByVal lpFile As String, _
lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function RegSaveKeyA Lib "advapi32.dll" _
(ByVal hKey As Long, ByVal lpFile As String, _
lpSecurityAttributes As Long) As Long
'RegLoadKey:
' En Windows 95 el nombre del fichero no permite nombres largos
'
Private Declare Function RegLoadKeyA Lib "advapi32.dll" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal lpFile As String) As Long
'
' Tener en cuenta el usuario actual (22/Jun/00)
' Gracias a Miquel Pop
'
' Funciones y vars para el trabajar con el usuario actual
Private sUser As String
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
Public Function CreateKey(ByVal sKey As String) As eHKEYError
' Crear una clave sin datos adicionales (04/Ago/99)
'
' Parámetros:
' sKey Clave a la que se asignará el valor
' Devuelve:
' El valor de error devuelto por el API
'
Dim lRet As eHKEYError
Dim hKey2 As Long
Dim hKey As Long
' Convertimos la clave indicada en un valor correcto,
' para el caso que se indique la clave raiz en sKey
hKey = ParseKey(sKey, hKey)
' Abrir la clave indicada
lRet = RegOpenKeyEx(hKey, sKey, 0&, KEY_WRITE, hKey2)
' Si da error, es que no existe esa clave
If lRet <> ERROR_SUCCESS Then
' Crear la clave
lRet = RegCreateKey(hKey, sKey, hKey2)
End If
Call RegCloseKey(hKey2)
CreateKey = lRet
End Function
Public Function ExistKey(ByVal sKey As String) As Boolean
' Comprobar si existe la clave indicada (04/Ago/99)
' Devolverá TRUE si la clave existe
Dim ret As eHKEYError
Dim hKey2 As Long
Dim hKey As eHKEY
hKey = HKEY_LOCAL_MACHINE
hKey = ParseKey(sKey, hKey)
' Abrir la clave indicada
ret = RegOpenKeyEx(hKey, sKey, 0&, KEY_READ, hKey2)
' Si todo va bien (se ha podido abrir la clave)
If ret = ERROR_SUCCESS Then
ExistKey = True
' Cerrar la clave abierta
Call RegCloseKey(hKey2)
Else
ExistKey = False
End If
End Function
Public Function ClassCLSID(ByVal sClass As String) As String
' Devuelve el Clsid de la clase indicada (05/Jul/99)
' El formato del parámetro debe ser Servidor.Clase
' Si no se ha encontrado la clase, devuelve una cadena vacía
'
Dim sClave As String
Dim sClsid As String
Const sRootKey As String = "HKEY_LOCAL_MACHINE\Software\Classes\"
' Obtener el Clsid
sClave = sRootKey & sClass & "\clsid"
sClsid = GetRegString(sClave)
ClassCLSID = sClsid
End Function
Public Function ClassTypeLib(ByVal sClass As String) As String
' Devuelve el TypeLib de la clase indicada (05/Jul/99)
' El formato del parámetro debe ser Servidor.Clase
' Si no se ha encontrado la clase, devuelve una cadena vacía
'
Dim sClave As String
Dim sClsid As String
Const sRootKey As String = "HKEY_LOCAL_MACHINE\Software\Classes\"
Dim sTypeLib As String
' Obtener el Clsid
sClave = sRootKey & sClass & "\clsid"
sClsid = GetRegString(sClave)
If Len(sClsid) Then
' Obtener el TypeLib
sClave = sRootKey & "CLSID\" & sClsid & "\TypeLib"
sTypeLib = GetRegString(sClave)
End If
ClassTypeLib = sTypeLib
End Function
'------------------------------------------------------------------------------
' Este código está 'copiado' de un ejemplo de David Janson
' Sólo es necesario para Windows NT, ya que win95 permite borrar todas
' las subclaves
'
' También hay que usarla en windows 98
'
'
' this gets a bit tricky since you can't delete a key that has subkeys.
' We have to do this recursively. This code ignores errors (such as security
' problems) when they occur.
'------------------------------------------------------------------------------
Private Function DeleteKeyNT(hParentKey As Long, szKey As String) As Long
Dim hKey As Long
Dim lRet As eHKEYError
Dim cSubKeys As Long
Dim cbMaxSubKeyLen As Long
Dim cbSubKeyLen As Long
Dim dwIndex As Long
Dim ft As FILETIME
Dim szTempSubKey As String
Dim szSubKey As String
' open the key to look for subkeys
lRet = RegOpenKeyEx(hParentKey, szKey, 0, KEY_ALL_ACCESS, hKey)
If Not lRet = ERROR_SUCCESS Then
' ERROR_ACCESS_DENIED (5)
DeleteKeyNT = lRet
Exit Function
End If
'lRet = RegQueryInfoKey(hKey, ByVal 0&, ByVal 0&, 0, _
cSubKeys, cbMaxSubKeyLen, _
ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, ft)
lRet = RegQueryInfoKey(hKey, vbNullString, 0&, 0, _
cSubKeys, cbMaxSubKeyLen, _
0&, 0&, 0&, 0&, 0&, ft)
If Not lRet = ERROR_SUCCESS Then
' ERROR_INVALID_PARAMETERS (87)
DeleteKeyNT = lRet
Call RegCloseKey(hKey)
Exit Function
End If
' if there are subkeys, then recursively delete them
If cSubKeys > 0 Then
dwIndex = cSubKeys - 1 ' start at the end
cbMaxSubKeyLen = cbMaxSubKeyLen + 1 ' +1 for the null terminator
szTempSubKey = String(cbMaxSubKeyLen, "*") ' buffer to get name back in
Do
'$(22/Ago/99)
' Multiplico por dos
cbSubKeyLen = cbMaxSubKeyLen * 2
'lRet = RegEnumKeyEx(hKey, dwIndex, szTempSubKey, cbSubKeyLen, 0, ByVal 0&, 0, ft)
lRet = RegEnumKeyEx(hKey, dwIndex, szTempSubKey, cbSubKeyLen, 0&, vbNullString, 0&, ft)
If lRet = ERROR_SUCCESS Then
szSubKey = Left(szTempSubKey, cbSubKeyLen)
Call DeleteKeyNT(hKey, szSubKey)
End If
dwIndex = dwIndex - 1 ' enumerate backwards
Loop While dwIndex >= 0
End If
' done enumerating subkeys. Close this key and delete it
Call RegCloseKey(hKey)
lRet = RegDeleteKey(hParentKey, szKey)
'If Not lRet = ERROR_SUCCESS Then
' Exit Sub
'End If
DeleteKeyNT = lRet
End Function
Public Function GetRegDWord(ByVal sKey As String, Optional ByVal sValue As String = "", Optional ByVal hKey As eHKEY = HKEY_CURRENT_USER, Optional ByVal bAsString As Boolean = False) As Variant
' Obtener un valor DWORD de una entrada del registro
'
' Parámetros de entrada:
' sKey SubClave del registro
' sValue Nombre de la entrada que queremos obtener
' hKey Clave principal del registro
' bAsString Mostrar en formato al estilo del RegEdit
' Devuelve:
' el contenido de esa clave o una valor cero
'
Dim ret As Long
Dim hKey2 As Long
Dim rDT As eHKEYDataType
Dim lSize As Long
Dim lDWord As Long
hKey = ParseKey(sKey, hKey)
' Abrir la clave indicada
ret = RegOpenKeyEx(hKey, sKey, 0&, KEY_READ, hKey2)
' Si todo va bien (se ha podido abrir la clave)
If ret = ERROR_SUCCESS Then
' Leer esa entrada y obtener el tipo de dato, longitud, etc.
ret = RegQueryValueEx(hKey2, sValue, 0&, rDT, 0&, lSize)
' Si es un valor DWORD
If rDT = REG_DWORD Then
' Leer los datos DWORD
ret = RegQueryValueEx(hKey2, sValue, 0&, rDT, lDWord, lSize)
End If
' Cerrar la clave abierta
RegCloseKey hKey2
End If
' Devolver el valor leído
If bAsString Then
' Al estilo de como se muestra con RegEdit
'GetRegDWord = "0x" & Format$(Hex$(lDWord), "00000000") & " (" & lDWord & ")"
GetRegDWord = "0x" & Right$("00000000" & Hex$(lDWord), 8) & " (" & lDWord & ")"
Else
GetRegDWord = lDWord
End If
End Function
Public Function GetReg(ByVal sKey As String, Optional ByVal sValue As String = "", Optional ByVal hKey As eHKEY = HKEY_CURRENT_USER, Optional ByVal bAsString As Boolean = False) As Variant
'--------------------------------------------------------------------------
' Obtener un valor de una entrada del registro
'
' Parámetros de entrada:
' sKey SubClave del registro
' Se puede especificar el nombre de la clave raiz
' que se convertirá al valor adecuado
' sValue Nombre de la entrada que queremos obtener
' hKey Clave principal del registro.
' Si en sKey se incluye, no es necesario especificarla
' Nota: este valor se obvia si se indica la raiz en sKey.
' bAsString Mostrarlo como una cadena, al estilo de RegEdit
' Devuelve:
' el contenido de esa clave o un valor vacío
'
' Revisado para usarlo con Windows NT (Win2000 Pro Beta 3) (12/Jun/99)
'--------------------------------------------------------------------------
Dim lRet As Long
Dim hKey2 As Long
Dim rDT As eHKEYDataType
Dim retDT As eHKEYDataType
Dim lSize As Long
Dim sData As String
Dim aData() As Byte
Dim lDWord As Long
Dim i As Long
Dim sTmp As String
hKey = ParseKey(sKey, hKey)
' Valores por defecto
ReDim aData(0)
lDWord = 0
sData = ""
' Abrir la clave indicada
'lRet = RegOpenKeyEx(hKey, sKey, 0&, KEY_QUERY_VALUE, hKey2)
lRet = RegOpenKeyEx(hKey, sKey, 0&, KEY_READ, hKey2)
' Si todo va bien (se ha podido abrir la clave)
If lRet = ERROR_SUCCESS Then
' Leer esa entrada y obtener el tipo de dato, longitud, etc.
lRet = RegQueryValueEx(hKey2, sValue, 0&, retDT, 0&, lSize)
Select Case retDT
Case REG_DWORD
lRet = RegQueryValueEx(hKey2, sValue, 0&, rDT, lDWord, lSize)
Case REG_EXPAND_SZ, REG_SZ, REG_MULTI_SZ
If lSize Then
sData = String$(lSize - 1, Chr$(0))
' Leer la cadena
'(el ByVal es porque está declarada como Any)---v
lRet = RegQueryValueEx(hKey2, sValue, 0&, rDT, ByVal sData, lSize)
End If
Case Else ' Tratarlos como REG_BINARY
If lSize Then
ReDim aData(lSize)
'Leer los datos binarios
lRet = RegQueryValueEx(hKey2, sValue, 0&, rDT, aData(0), lSize)
End If
End Select
' Cerrar la clave abierta
RegCloseKey hKey2
End If
' Devolver el valor leído
Select Case retDT
Case REG_DWORD
If bAsString Then
' Al estilo de como se muestra con RegEdit
'GetReg = "0x" & Format$(Hex$(lDWord), "00000000") & " (" & lDWord & ")"
GetReg = "0x" & Right$("00000000" & Hex$(lDWord), 8) & " (" & lDWord & ")"
Else
GetReg = lDWord
End If
Case REG_EXPAND_SZ, REG_SZ
GetReg = sData
Case REG_MULTI_SZ
' Múltiples cadenas, separadas por Chr$(0) (12/Jun/99)
' La cadena termina en el último Chr$(0)
' For i = Len(sData) To 1 Step -1
' If Mid$(sData, i, 1) = Chr$(0) Then
' sData = Left$(sData, i - 1)
' Exit For
' End If
' Next
' ' Sustituir los Chr$(0) por espacios
' For i = 1 To Len(sData)
' If Mid$(sData, i, 1) = Chr$(0) Then
' Mid$(sData, i, 1) = " "
' End If
' Next
'//////////////////////////////////////////////////////////////////////
'$TODO: (22/Nov/00)
' Separar cada cadena con un punto y coma
'//////////////////////////////////////////////////////////////////////
GetReg = RTrimZero(sData, True)
'--------------------------------------------------------------------------
' No poner Case Else, ya que al usar ahora KEY_READ, (09/Feb/01)
' si la clave no existe, devolver un valor vacio
'--------------------------------------------------------------------------
'Case Else ' REG_BINARY
Case REG_BINARY
If bAsString Then
' Al estilo de como se muestra con RegEdit
For i = 0 To UBound(aData) - 1
'sTmp = sTmp & Hex$(aData(i)) & " "
' Los números formateados a dos cifras (12/Oct/98)
'sTmp = sTmp & Format$(Hex$(aData(i)), "00") & " "
sTmp = sTmp & Right$("00" & Hex$(aData(i)), 2) & " "
Next
GetReg = sTmp
Else
GetReg = aData
End If
End Select
End Function
Public Function GetRegType(ByVal sKey As String, _
ByVal sValue As String, _
Optional ByVal hKey As eHKEY = HKEY_CURRENT_USER) As eHKEYDataType
'--------------------------------------------------------------------------
' Devuelve el tipo de datos de una entrada del registro (28/Dic/01)
'
' Parámetros de entrada:
' sKey SubClave del registro
' Se puede especificar el nombre de la clave raiz
' que se convertirá al valor adecuado
' sValue Nombre de la entrada que queremos obtener
' hKey Clave principal del registro.
' Si en sKey se incluye, no es necesario especificarla
' Nota: este valor se obvia si se indica la raiz en sKey.
' Devuelve:
' el tipo de datos del contenido de esa clave
'
' Revisado para usarlo con Windows NT (Win2000 Pro Beta 3) (12/Jun/99)
'--------------------------------------------------------------------------
Dim lRet As Long
Dim hKey2 As Long
Dim retDT As eHKEYDataType
Dim lSize As Long
'
hKey = ParseKey(sKey, hKey)
'
retDT = REG_NONE
'
' Abrir la clave indicada
lRet = RegOpenKeyEx(hKey, sKey, 0&, KEY_READ, hKey2)
'
' Si todo va bien (se ha podido abrir la clave)
If lRet = ERROR_SUCCESS Then
' Leer esa entrada y obtener el tipo de dato, longitud, etc.
lRet = RegQueryValueEx(hKey2, sValue, 0&, retDT, 0&, lSize)
' Cerrar la clave abierta
RegCloseKey hKey2
'
End If
GetRegType = retDT
End Function
Public Function GetRegBinary(ByVal sKey As String, Optional ByVal sValue As String = "", Optional ByVal hKey As eHKEY = HKEY_CURRENT_USER, Optional ByVal bAsString As Boolean = False) As Variant
' Obtener un valor binario de una entrada del registro
'
' Parámetros de entrada:
' sKey SubClave del registro
' sValue Nombre de la entrada que queremos obtener
' hKey Clave principal del registro
' bAsString Mostrarlo como una cadena, al estilo de RegEdit
' Devuelve:
' el contenido de esa clave o una valor cero
'
Dim ret As Long
Dim hKey2 As Long
Dim rDT As eHKEYDataType
Dim lSize As Long
Dim aData() As Byte
Dim i As Long
Dim sTmp As String
hKey = ParseKey(sKey, hKey)
ReDim aData(0)
' Abrir la clave indicada
'ret = RegOpenKeyEx(hKey, sKey, 0&, KEY_QUERY_VALUE, hKey2)
ret = RegOpenKeyEx(hKey, sKey, 0&, KEY_READ, hKey2)
' Si todo va bien (se ha podido abrir la clave)
If ret = ERROR_SUCCESS Then
' Leer esa entrada y obtener el tipo de dato, longitud, etc.
ret = RegQueryValueEx(hKey2, sValue, 0&, rDT, 0&, lSize)
' Si es un valor binario
If rDT = REG_BINARY Then
If lSize Then
ReDim aData(lSize)
' Leer los datos binarios
ret = RegQueryValueEx(hKey2, sValue, 0&, rDT, aData(0), lSize)
End If
End If
' Cerrar la clave abierta
RegCloseKey hKey2
End If
' Devolver el valor leído
If bAsString Then
' Al estilo de como se muestra con RegEdit
For i = 0 To UBound(aData) - 1
sTmp = sTmp & Hex$(aData(i)) & " "
Next
GetRegBinary = sTmp
Else
GetRegBinary = aData
End If
End Function
Public Function GetRegString(ByVal sKey As String, Optional ByVal sValue As String = "", Optional ByVal hKey As eHKEY = HKEY_CURRENT_USER) As String
' Obtener un valor cadena de una entrada del registro
'
' Parámetros de entrada:
' sKey Clave del registro
' sValue Nombre de la entrada que queremos obtener
' hKey Clave principal del registro
' Devuelve:
' el contenido de esa clave o una cadena vacía
'
Dim ret As Long
Dim hKey2 As Long
Dim rDT As eHKEYDataType
Dim sData As String
Dim lSize As Long
hKey = ParseKey(sKey, hKey)
' Abrir la clave indicada
'ret = RegOpenKeyEx(hKey, sKey, 0&, KEY_QUERY_VALUE, hKey2)
ret = RegOpenKeyEx(hKey, sKey, 0&, KEY_READ, hKey2)
' Si todo va bien (se ha podido abrir la clave)
If ret = ERROR_SUCCESS Then
' Leer esa entrada y obtener el tipo de dato, longitud, etc.
ret = RegQueryValueEx(hKey2, sValue, 0&, rDT, 0&, lSize)
' Si es una cadena o REG_EXPAND_SZ (28/Dic/01)
Select Case rDT
Case REG_SZ, REG_EXPAND_SZ
'If rDT = REG_SZ Then
If lSize Then
sData = String$(lSize - 1, Chr$(0))
' Leer la cadena
' (el ByVal es porque está declarada como Any)---v
ret = RegQueryValueEx(hKey2, sValue, 0&, rDT, ByVal sData, lSize)
End If
End Select
' Cerrar la clave abierta
RegCloseKey hKey2
End If
' Devolver el valor leído
GetRegString = sData
End Function
' Busca una entrada en el registro
Public Function QueryRegBase(ByVal sValue As String, _
Optional ByVal hKey As eHKEY = HKEY_CLASSES_ROOT _
) As String
' Devuelve el valor de la entrada del registro
' Esta función se usará para los valores por defecto
'
Dim sBuf As String
Dim buflen As Long
' Nos aseguramos que hKey tenga el valor correcto
Select Case hKey
'Case HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS
Case HKEY_FIRST To HKEY_LAST
' nada que hacer, todo correcto
Case Else
' Asignamos el valor por defecto
hKey = HKEY_CLASSES_ROOT
End Select
'On Local Error Resume Next
sBuf = String$(300, Chr$(0))
buflen = Len(sBuf)
' Buscar la entrada especificada y devolver el valor asignado
If RegQueryValue(hKey, sValue, sBuf, buflen) = ERROR_SUCCESS Then
If buflen > 1 Then
' El formato devuelto es ASCIIZ, así que quitar el último caracter
QueryRegBase = Left$(sBuf, buflen - 1)
Else
QueryRegBase = ""
End If
Else
QueryRegBase = ""
End If
'On Local Error GoTo 0
End Function
Private Function ParseKey(sKey As String, _
Optional ByVal hKey As eHKEY = HKEY_CURRENT_USER _
) As eHKEY
'--------------------------------------------------------------------------
' Esta función se usa internamente (privada) para convertir una cadena
' en la correspondiente clave raiz.
' El segundo parámetro es para poder usarlo en caso que se pase como
' parámetro, pero normalmente será totalmente opcional.
'
' En sKey se devolverá el valor de la clave una vez quitada la clave
' principal.
'
'--------------------------------------------------------------------------
' NOTA del 14/Oct/98
' En sKey se debe especificar el nombre de la clave raiz.
' La utilidad de esta función es que devuelve el valor de esa
' clave raiz y se usará en caso de que no sepamos que clave es.
' Si ya sabes el valor de la clave raiz, no es necesario que
' uses esta función.
'----------------------------------------------------------------------
Dim i As Long
Dim sRootKey As String
'
' Si tiene el separador del final, quitárselo (23/Nov/00)
sKey = Trim$(sKey)
If Right$(sKey, 1) = "\" Then
sKey = Left$(sKey, Len(sKey) - 1)
End If
' Comprobar si se indica la clave principal en sKey
i = InStr(sKey, "HKEY_")
If i Then
i = InStr(sKey, "\")
If i Then
sRootKey = Left$(sKey, i - 1)
sKey = Mid$(sKey, i + 1)
Else
sRootKey = sKey
sKey = ""
End If
' Por si se usan abreviaturas de las claves
ElseIf Left$(sKey, 5) = "HKCR\" Then
sRootKey = "HKEY_CLASSES_ROOT"
sKey = Mid$(sKey, 6)
ElseIf Left$(sKey, 5) = "HKCU\" Then
sRootKey = "HKEY_CURRENT_USER"
sKey = Mid$(sKey, 6)
ElseIf Left$(sKey, 5) = "HKLM\" Then
sRootKey = "HKEY_LOCAL_MACHINE"
sKey = Mid$(sKey, 6)
ElseIf Left$(sKey, 4) = "HKU\" Then
sRootKey = "HKEY_USERS"
sKey = Mid$(sKey, 5)
ElseIf Left$(sKey, 5) = "HKCC\" Then
sRootKey = "HKEY_CURRENT_CONFIG"
sKey = Mid$(sKey, 6)
ElseIf Left$(sKey, 5) = "HKDD\" Then
sRootKey = "HKEY_DYN_DATA"
sKey = Mid$(sKey, 6)
ElseIf Left$(sKey, 5) = "HKPD\" Then
sRootKey = "HKEY_PERFORMANCE_DATA"
sKey = Mid$(sKey, 6)
Else
' Nos aseguramos que kKey tenga el valor correcto
Select Case hKey
'Case HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CURRENT_CONFIG, HKEY_DYN_DATA
Case HKEY_FIRST To HKEY_LAST
'nada que hacer, todo correcto
Case Else
' Asignamos el valor por defecto
hKey = HKEY_CLASSES_ROOT
End Select
End If
' Si se ha indicado el nombre de la clave raiz
If Len(sRootKey) Then
Select Case sRootKey
Case "HKEY_CLASSES_ROOT"
hKey = HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_USER"
hKey = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
hKey = HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
hKey = HKEY_USERS
Case "HKEY_CURRENT_CONFIG"
hKey = HKEY_CURRENT_CONFIG
Case "HKEY_DYN_DATA"
hKey = HKEY_DYN_DATA
Case "HKEY_PERFORMANCE_DATA"
hKey = HKEY_PERFORMANCE_DATA
Case Else
hKey = HKEY_CLASSES_ROOT
End Select
End If
ParseKey = hKey
End Function
Public Function OpenKeyEx(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As eREGSAM, phkResult As Long) As Long
' Abre una clave del registro, en phkResult devuelve el handle de
' la clave abierta y se usará para los siguientes accesos.
'
' ulOptions es un valor reservado que debe ser 0&
'
' Esta función simplemente llama a la original del API
'
OpenKeyEx = RegOpenKeyEx(hKey, lpSubKey, 0&, samDesired, phkResult)
End Function
Public Function OpenKeyQuery(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As eREGSAM, phkResult As Long) As Long
' Los parámetros: ulOptions (un valor reservado que debe ser 0&)
' y samDesired, no se tienen en cuenta
' pero se dejan por compatibilidad de parámetros de RegOpenKeyEx
'
' Para usar otros valores de accesos, usar la función OpenKeyEx
'
' Esta función simplemente llama a la original del API
' Con las "peculiaridades" indicadas
'
OpenKeyQuery = RegOpenKeyEx(hKey, lpSubKey, 0&, KEY_QUERY_VALUE, phkResult)
End Function
Public Function EnumValueString(ByVal hKey As Long, ByVal dwIndex As Long, _
lpValueName As String, lpcbValueName As Long, _
lpReserved As Long, lpType As Long, lpData As String, _
lpcbData As Long) As Long
'
' Esta función simplemente llama a la original del API
' Sólo para tipos String
'
EnumValueString = RegEnumValue(hKey, dwIndex, _
lpValueName, lpcbValueName, _
lpReserved, lpType, ByVal lpData, _
lpcbData)
End Function
Public Function EnumValue(ByVal hKey As Long, ByVal dwIndex As Long, _
lpValueName As String, lpcbValueName As Long, _
lpReserved As Long, lpType As Long, lpData As Byte, _
lpcbData As Long) As Long
'
' Esta función simplemente llama a la original del API
' Usarla para tipos diferentes de String
'
EnumValue = RegEnumValue(hKey, dwIndex, _
lpValueName, lpcbValueName, _
lpReserved, lpType, lpData, _
lpcbData)
End Function
Public Function CloseKey(ByVal hKey As Long) As Long
' Cierra la clave abierta usando el handle hKey
'
' Esta función simplemente llama a la original del API
'
CloseKey = RegCloseKey(hKey)
End Function
Public Function QueryInfoKey(ByVal hKey As Long, lpcbMaxValueNameLen As Long) As Long
'
' Esta función simplemente llama a la original del API
'
Dim lpftLastWriteTime As FILETIME
QueryInfoKey = RegQueryInfoKey(hKey, 0&, 0&, 0&, 0&, 0&, 0&, 0&, _
lpcbMaxValueNameLen, 0&, 0&, lpftLastWriteTime)
End Function
Public Function EnumKeyEx(ByVal hKey As Long, ByVal dwIndex As Long, lpName As String, lpcbName As Long) As Long
'
' Esta función simplemente llama a la original del API
'
Dim lpftLastWriteTime As FILETIME
EnumKeyEx = RegEnumKeyEx(hKey, dwIndex, lpName, lpcbName, _
0&, 0&, 0&, lpftLastWriteTime)
End Function
Public Function ShellFolders(Optional bSoloClaves As Boolean = False, Optional Usuario As Boolean = True) As Variant
' Devolverá las claves de la clave Shell Folders
'
' El parámetro Usuario indica si se tendrá en cuenta el usuario actual
'
Dim sKey As String
Dim buf As String
Dim i As Long
Dim sValue As String
Dim iCount As Long
'
Dim colKeys() As String
Dim colShellFoldersKey As Collection
'
' Borrar el contenido de la colección
Set colShellFolders = Nothing
' Esta colección tendrá los paths, el índice será la clave
Set colShellFolders = New Collection
' En esta colección se guardarán las claves
' (sólo se usa por si se indica bSoloClaves=True)
Set colShellFoldersKey = New Collection
'==============================================================
'
'=== NOTA CACHONDA === por lo incomprensible...
' Es curioso, pero si utilizo estas intrucciones aquí
' el bucle For iCount=0 to 1 no acaba nunca
'
'==============================================================
'
'Para el directorio de windows
'buf = "WindowsDir"
'colShellFoldersKey.Add buf, buf
'colShellFolders.Add "Windows", buf
'
'Para el directorio de System
'buf = "SystemDir"
'colShellFoldersKey.Add buf, buf
'colShellFolders.Add "System", buf
'
'==============================================================
For iCount = 0 To 1
' Enumerar el contenido de Shell Folders
If iCount = 0 Then
'sKey = "HKEY_USERS\.Default\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
'
' Tener en cuenta el usuario actual (22/Jun/00)
' Gracias a Miquel Pop
'
If Usuario And sUser <> "" Then
sKey = "HKEY_USERS\" & sUser & "\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
Else
sKey = "HKEY_USERS\.Default\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
End If
Else
sKey = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion"
End If
' Usar la función EnumValues
If EnumValues(colKeys(), sKey) Then
For i = 1 To UBound(colKeys) Step 2
' colKeys(i) será el nombre de la clave
' colKeys(i + 1) será el valor o dato almacenado
If iCount = 0 Then
colShellFoldersKey.Add colKeys(i), colKeys(i)
colShellFolders.Add colKeys(i + 1), colKeys(i)
Else
If InStr(colKeys(i + 1), ":\") Then
colShellFoldersKey.Add colKeys(i), colKeys(i)
colShellFolders.Add colKeys(i + 1), colKeys(i)
End If
End If
Next
End If
Next
' Obtener el directorio de windows
buf = String$(300, Chr$(0))
i = GetWindowsDirectory(buf, Len(buf))
sValue = Left$(buf, i)
buf = "WindowsDir"
colShellFoldersKey.Add buf, buf
colShellFolders.Add sValue, buf
' Obtener el directorio de System
buf = String$(300, Chr$(0))
i = GetSy