Ir para conteúdo
Fórum Script Brasil
  • 0

erro com gravação no registro do windows na versão vista

Alex Mauricio

Perguntado por Alex Mauricio,

 Share

Pergunta

Alex Mauricio

Alex Mauricio

Postado
Postado (editado)

Boa noite pessoal. Como é comum, estou novamente com meus probleminhas.

Tenho uma aplicação pronta e que está funcionando corretamente. Porém, na empresa que utilizo, vai migrar todas as estações de trabalho para Windows Vista ou 7 (não está certo qual das 2 versões ainda).

Porém, eu me antecipei e fiz um teste e tive a desagradável surpresa que é o seguinte:

Toda vez que eu rodo a minha aplicação pela primeira vez, o sistema verifica se existe uma chave no registro e caso não abre um formulário de configuração.

Esse formulário deveria criar uma chave no registro do windows e salvar um valor.

Antes funcionava, agora quando mando gravar, não apresenta nenhum erro, porém não cria a chave e muito menos salva o valor. Segue o código abaixo referente ao botão GRAVAR CONFIGURAÇÕES e o código que está em um módulo. ( O CÓDIGO SUBLINHADO SÃO AS LINHAS QUE FAZ A GRAVAÇÃO NO REGISTRO).

CÓDIGO DO BOTÃO GRAVAR CONFIGURAÇÕES

Private Sub cmdGravarConfig_Click()
    On Error Resume Next
    Dim x, y As Integer
    x = 5
    y = 5
    
[u]    Call UpdateKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Empresa\SGCC\BdNovo", _
    "DbPath", txtConfigBanco.Text, REG_SZ)[/u]
    
[u]    Call UpdateKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Empresa\SGCC\BdAntigo", _
    "DbPath", txtConfigBancoAntigo.Text, REG_SZ)[/u]

    BancoDeDados.Close
    BancoDeDadosAntigo.Close
    
    Set BancoDeDados = OpenDatabase(txtConfigBanco.Text, False, False, ";PWD=" & Trim(Str(x + 4)) & _
    Trim(Str(x + 4)) & Trim(Str(x - 4)) & Trim(Str(x - 4)) & Trim(Str(x + 3)) & _
    Trim(Str(x + 3)) & Trim(Str(x - 3)) & Trim(Str(x - 3)) & Trim(Str(x + 2)) & _
    Trim(Str(x + 2)) & Trim(Str(x - 2)) & Trim(Str(x - 2)) & Trim(Str(x + 1)) & _
    Trim(Str(x + 1)) & Trim(Str(x - 1)) & Trim(Str(x - 1)) & Trim(Str(x)) & Trim(Str(x)))
    
    Set BancoDeDadosAntigo = OpenDatabase(txtConfigBancoAntigo.Text, False, False, ";PWD=" & Trim(Str(y + 4)) & _
    Trim(Str(y + 4)) & Trim(Str(y - 4)) & Trim(Str(y - 4)) & Trim(Str(y + 3)) & _
    Trim(Str(y + 3)) & Trim(Str(y - 3)) & Trim(Str(y - 3)) & Trim(Str(y + 2)) & _
    Trim(Str(y + 2)) & Trim(Str(y - 2)) & Trim(Str(y - 2)) & Trim(Str(y + 1)) & _
    Trim(Str(y + 1)) & Trim(Str(y - 1)) & Trim(Str(y - 1)) & Trim(Str(y)) & Trim(Str(y)))
    
    MsgBox "Banco de Dados Configurado com sucesso!", vbInformation + vbOKOnly
    
    If frmPrincipalMDI.Visible = True Then
        Unload Me
    ElseIf frmPrincipalMDI.Visible = False Then
        MsgBox "Reinicie o Sistema!", vbInformation + vbOKOnly
        End
    End If
End Sub
CÓDIGO QUE ESTÁ NO MÓDULO 
Option Explicit
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" 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, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Public Const REG_NOTIFY_CHANGE_LAST_SET = &H4
Public Const REG_NOTIFY_CHANGE_NAME = &H1
Public Const REG_NOTIFY_CHANGE_SECURITY = &H8
Public Const REG_OPENED_EXISTING_KEY = &H2
Public Const REG_OPTION_BACKUP_RESTORE = 4
Public Const REG_OPTION_CREATE_LINK = 2
Public Const REG_REFRESH_HIVE = &H2
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY
Public Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY
Public Const KEY_EXECUTE = KEY_READ
Public Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_NONE = 0
Public Const ERROR_BADKEY = 2
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_SUCCESS = 0
Public Function UpdateKey(KeyRoot As Long, KeyName As String, SubKeyName As String, SubKeyValue As String, KeyValueType As Long) As Boolean
    Dim rc As Long
    Dim hKey As Long
    Dim hDepth As Long
    Dim lpAttr As SECURITY_ATTRIBUTES
    lpAttr.nLength = 50
    lpAttr.lpSecurityDescriptor = 0
    lpAttr.bInheritHandle = True
    rc = RegCreateKeyEx(KeyRoot, KeyName, _
                        0, KeyValueType, _
                        REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
                        hKey, hDepth)
    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError
    If (SubKeyValue = "") Then SubKeyValue = " "
    rc = RegSetValueEx(hKey, SubKeyName, _
                       0, KeyValueType, _
                       SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError
    rc = RegCloseKey(hKey)
    UpdateKey = True
    Exit Function
CreateKeyError:
    UpdateKey = False
    rc = RegCloseKey(hKey)
End Function
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
    Dim i As Long
    Dim rc As Long
    Dim hKey As Long
    Dim hDepth As Long
    Dim sKeyVal As String
    Dim lKeyValType As Long
    Dim tmpVal As String
    Dim KeyValSize As Long
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
    tmpVal = String$(1024, 0)
    KeyValSize = 1024
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                         lKeyValType, tmpVal, KeyValSize)
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
    Select Case lKeyValType
    Case REG_SZ, REG_EXPAND_SZ, REG_LINK, REG_MULTI_SZ
        tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)
        sKeyVal = tmpVal
    Case REG_DWORD, REG_DWORD_BIG_ENDIAN
        tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)
        For i = Len(tmpVal) To 1 Step -1
            sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
        Next
        sKeyVal = Format$("&h" + sKeyVal)
    Case REG_BINARY
        sKeyVal = tmpVal
    End Select
    GetKeyValue = sKeyVal
    rc = RegCloseKey(hKey)
    Exit Function
GetKeyError:
    GetKeyValue = vbNullString
    rc = RegCloseKey(hKey)
End Function

Editado por Alex Mauricio
Link para o comentário
Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

  • 0
Alex Mauricio

Alex Mauricio

Postado
  • Autor
Postado

Boa noite pessoal.

Tenho uma aplicação e estou fazendo algumas modificações... no micro que estou desenvolvendo está funcionando perfeitamente, porém, em outros micros com o mesmo sistema operacional (windows xp) não está funcionando tão bem assim.

O erro é o seguinte, quando vou abrir a Aplicação aparece a seguinte mensagem...

"Compile Error:

Can't find project or library"

Caso de OK, ele aponta erro na função GetKeyValue e seleciona a String$ ( conforme selecionado em negrito).

Porque em uma máquina funciona e em outra não? (segue o código em anexo e esse código está em um módulo)

Obrigado

CÓDIGO QUE ESTÁ NO MÓDULO

Option Explicit
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" 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, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Public Const REG_NOTIFY_CHANGE_LAST_SET = &H4
Public Const REG_NOTIFY_CHANGE_NAME = &H1
Public Const REG_NOTIFY_CHANGE_SECURITY = &H8
Public Const REG_OPENED_EXISTING_KEY = &H2
Public Const REG_OPTION_BACKUP_RESTORE = 4
Public Const REG_OPTION_CREATE_LINK = 2
Public Const REG_REFRESH_HIVE = &H2
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY
Public Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY
Public Const KEY_EXECUTE = KEY_READ
Public Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_NONE = 0
Public Const ERROR_BADKEY = 2
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_SUCCESS = 0
Public Function UpdateKey(KeyRoot As Long, KeyName As String, SubKeyName As String, SubKeyValue As String, KeyValueType As Long) As Boolean
    Dim rc As Long
    Dim hKey As Long
    Dim hDepth As Long
    Dim lpAttr As SECURITY_ATTRIBUTES
    lpAttr.nLength = 50
    lpAttr.lpSecurityDescriptor = 0
    lpAttr.bInheritHandle = True
    rc = RegCreateKeyEx(KeyRoot, KeyName, _
                        0, KeyValueType, _
                        REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
                        hKey, hDepth)
    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError
    If (SubKeyValue = "") Then SubKeyValue = " "
    rc = RegSetValueEx(hKey, SubKeyName, _
                       0, KeyValueType, _
                       SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError
    rc = RegCloseKey(hKey)
    UpdateKey = True
    Exit Function
CreateKeyError:
    UpdateKey = False
    rc = RegCloseKey(hKey)
End Function

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
    Dim i As Long
    Dim rc As Long
    Dim hKey As Long
    Dim hDepth As Long
    Dim sKeyVal As String
    Dim lKeyValType As Long
    Dim tmpVal As String
    Dim KeyValSize As Long
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
[b]    tmpVal = String$(1024, 0)[/b]
    KeyValSize = 1024
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                         lKeyValType, tmpVal, KeyValSize)
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
    Select Case lKeyValType
    Case REG_SZ, REG_EXPAND_SZ, REG_LINK, REG_MULTI_SZ
        tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)
        sKeyVal = tmpVal
    Case REG_DWORD, REG_DWORD_BIG_ENDIAN
        tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)
        For i = Len(tmpVal) To 1 Step -1
            sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
        Next
        sKeyVal = Format$("&h" + sKeyVal)
    Case REG_BINARY
        sKeyVal = tmpVal
    End Select
    GetKeyValue = sKeyVal
    rc = RegCloseKey(hKey)
    Exit Function
GetKeyError:
    GetKeyValue = vbNullString
    rc = RegCloseKey(hKey)
End Function

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,2k
    • Posts
      652k
×
×
  • Criar Novo...