18/11/2009, 12:53
|
| | | Fecha de Ingreso: octubre-2009
Mensajes: 10
Antigüedad: 15 años, 5 meses Puntos: 0 | |
| Respuesta: Problema al traducir a visual 2008
Hola ya he resuelto ese problema. El proposito de sValue es crear un buffer de tamaño adecuado para leer una clave del registro. Este es el codigo que he puesto:
strBuf = New String(Chr(0), lDataBufSize)
El problema viene en la siguiente linea al hacer uso por segunda vez de la funcion RegQueryValue por segunda vez:
lResult = RegQueryValueEx(Keyhand, strValue, Nothing, Nothing, strBuf, _ lDataBufSize)
Aqui el problema es que me da este error: "Attempted to read or write protected memory. This is often an indication that other memory is corrupt."
Por lo que he observado, en ese punto lDataBufSize tiene valor 27 y si le paso a RegQueryValue un valor de lDataBufSize igual o superior a 27 me salta el error mencionado, sin embargo si es menor FUNCIONA pero la funcion devuelve el valor ERROR_MORE_DATA (234) indicando que ese valor es insuficiente para almacenar informacion en strBuf. Por mas vueltas que le doy no logro entender por que hace esto  .
Mas informacion acerca de RegQueryValueEx: msdn.microsoft.com/en-us/library/ms724911%28VS.85%29.aspx
Este es el código con el que estoy trabajando (las lineas donde esta el problema estan marcadas con /*************/)
Código:
' Registry API prototypes
'UPGRADE_ISSUE: No se admite la declaración de un parámetro 'As Any'. Haga clic aquí para obtener más información: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"'
Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Integer, ByVal dwIndex As Integer, ByVal lpName As String, ByRef lpcbName As Integer, ByVal lpReserved As Integer, ByVal lpClass As String, ByRef lpcbClass As Integer, ByRef lpftLastWriteTime As Integer) As Integer
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Integer) As Integer
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Integer, ByVal lpSubKey As String, ByRef phkResult As Integer) As Integer
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Integer, ByVal lpSubKey As String) As Integer
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Integer, ByVal lpValueName As String) As Integer
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Integer, ByVal lpSubKey As String, ByRef phkResult As Integer) As Integer
'UPGRADE_ISSUE: No se admite la declaración de un parámetro 'As Any'. Haga clic aquí para obtener más información: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"'
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Integer, ByVal lpValueName As String, ByVal Reserved As Integer, ByVal dwType As Integer, ByRef lpData As Integer, ByVal cbData As Integer) As Integer
Public Const REG_SZ As Short = 1 ' Unicode nul terminated string
Public Const REG_DWORD As Short = 4 ' 32-bit number
Public sKeys As Collection
Public Function GetString(ByRef hKey As Integer, ByRef strPath As String, ByRef strValue As String) As Object
Dim lValueType As Integer
Dim r As Object
Dim Keyhand As Integer
Dim datatype As Integer
Dim lResult As Integer
Dim strBuf As String
Dim lDataBufSize As Integer
Dim intZeroPos As Short
'UPGRADE_WARNING: No se puede resolver la propiedad predeterminada del objeto r. Haga clic aquí para obtener más información: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
r = RegOpenKey(hKey, strPath, Keyhand)
'ByVal hKey As Integer, ByVal lpSubKey As String, ByRef phkResult As Integer) As Integer
'UPGRADE_WARNING: No se puede resolver la propiedad predeterminada del objeto lValueType. Haga clic aquí para obtener más información: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
lResult = RegQueryValueEx(Keyhand, strValue, 0, lValueType, Nothing, lDataBufSize)
'(ByVal hKey As Integer, ByVal lpValueName As String, ByVal lpReserved As Integer, ByRef lpType As Integer, ByRef lpData As String, ByRef lpcbData As Integer) As Integer
'UPGRADE_WARNING: No se puede resolver la propiedad predeterminada del objeto lValueType. Haga clic aquí para obtener más información: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
If lValueType = REG_SZ Then
/*************/
strBuf = New String(Chr(0), lDataBufSize)
MsgBox(strBuf.Length)
lResult = RegQueryValueEx(Keyhand, strValue, Nothing, Nothing, strBuf, 0)
/*************/
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr(0))
If intZeroPos > 0 Then
GetString = Left(strBuf, intZeroPos - 1)
Else
GetString = strBuf
End If
End If
End If
End Function
Public Function DeleteKey(ByVal hKey As Integer, ByVal StrKey As String) As Object
Dim r As Integer
r = RegDeleteKey(hKey, StrKey)
End Function
Public Sub GetKeyNames(ByVal hKey As Integer, ByVal strPath As String)
Dim Cnt, TKey As Integer 'Cnt es un contador para acceder a la subclaves, empieza como 0 y se incrementa hasta que se llegue al final
Dim StrBuff, StrKey As String
RegOpenKey(hKey, strPath, TKey)
Do
StrBuff = New String(vbNullChar, 255) 'A pointer to a buffer that receives the name of the subkey, including the terminating null character
'RegEnumKeyEx devuelve el valor ERROR_SUCCESS que equivale a 0 cuando tiene exito. Si falla devuelve un codigo de error
If RegEnumKeyEx(TKey, Cnt, StrBuff, 255, 0, vbNullString, 0, 0) <> 0 Then Exit Do
Cnt = Cnt + 1
StrKey = Left(StrBuff, InStr(StrBuff, vbNullChar) - 1)
sKeys.Add(StrKey)
Loop
End Sub
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
String, ByVal vValue As Object) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ
sValue = cch.ToString 'String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Nothing
End If
' For DWORDS
Case REG_DWORD
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
End Module
'
|
