**************** 100分: 怎样打开注册表.读取软件的安装路径? 在线等待 **************

Question

==================================
怎样打开注册表.读取软件的安装路径?
小弟菜鸟.需要完全代码.
对者给分.
==================================

Answer 1

这得在程序中先有设定,即安装程序中有代码,读取用户安装过程中设定的路径,再保存到注册表中.再在你上面说的需要时,再读取出来.不少安装软件没有这个设定.vb操作的注册表位置比较固定,不太灵活,当然一般够用了.其方法是savesetting ,读取时用getsetting.如果要改安装程序,把用户的安装路径存到注册表中,可在用户选完路径点"安装"的按钮下加类似这样的一行savesetting "tt1","tt2","tt3",lujing这样,就可以得到安装路径了:getlujing=getsetting("tt1","tt2","tt3")
如果要更灵活地操纵注册表,可以引用API,请参阅相关文献了.

Answer 2

'This program needs 3 buttons
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx 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 RegSetValueEx 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
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    'retrieve nformation about the key
    lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = REG_SZ Then
            'Create a buffer
            strBuf = String(lDataBufSize, Chr$(0))
            'retrieve the key's content
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
                'Remove the unnecessary chr$(0)'s
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        ElseIf lValueType = REG_BINARY Then
            Dim strData As Integer
            'retrieve the key's value
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = strData
            End If
        End If
    End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    'Open the key
    RegOpenKey hKey, strPath, Ret
    'Get the key's content
    GetString = RegQueryStringValue(Ret, strValue)
    'Close the key
    RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    'Save a string to the key
    RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
    'close the key
    RegCloseKey Ret
End Sub
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    'Set the key's value
    RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(strData), 4
    'close the key
    RegCloseKey Ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    'Delete the key's value
    RegDeleteValue Ret, strValue
    'close the key
    RegCloseKey Ret
End Sub
Private Sub Command1_Click()
    Dim strString As String
    'Ask for a value
    strString = InputBox("Please enter a value between 0 and 255 to be saved as a binary value in the registry.", App.Title)
    If strString = "" Or Val(strString) > 255 Or Val(strString) < 0 Then
        MsgBox "Invalid value entered ...", vbExclamation + vbOKOnly, App.Title
        Exit Sub
    End If
    'Save the value to the registry
    SaveStringLong HKEY_CURRENT_USER, "Team", "BinaryValue", CByte(strString)
End Sub
Private Sub Command2_Click()
    'Get a string from the registry
    Ret = GetString(HKEY_CURRENT_USER, "Team", "BinaryValue")
    If Ret = "" Then MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title: Exit Sub
    MsgBox "The value is " + Ret, vbOKOnly + vbInformation, App.Title
End Sub
Private Sub Command3_Click()
    'Delete the setting from the registry
    DelSetting HKEY_CURRENT_USER, "Team", "BinaryValue"
    MsgBox "The value was deleted ...", vbInformation + vbOKOnly, App.Title
End Sub
Private Sub Form_Load()
    Command1.Caption = "Set Value"
    Command2.Caption = "Get Value"
    Command3.Caption = "Delete Value"
End Sub

Answer 3

先谢谢大哥了 :) 
---------------------------------------------
-lidaixiang(smartyufu) ( ) 信誉：98    Blog -
---------------------------------------------
我不是要读自己的软件的路径.是已经安装在我电脑上的所以软件的安装路径,
有办法没?
-----------------------------------------
-GoldFox(金色狐狸) ( ) 信誉：99    Blog -
-----------------------------------------
     有没有加过注释的哦.太难懂了...

Answer 4

给你一个注册表操作的类,编译成dll文件后通用API模块代码------Option ExplicitPublic 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_DYN_DATA = &H80000006Public Const REG_SZ = 1                         ' Unicode nul terminated stringPublic Const ERROR_SUCCESS = 0&
Public Const ERROR_BADDB = 1009&
Public Const ERROR_BADKEY = 1010&
Public Const ERROR_CANTOPEN = 1011&
Public Const ERROR_CANTREAD = 1012&
Public Const ERROR_CANTWRITE = 1013&
Public Const ERROR_REGISTRY_RECOVERED = 1014&
Public Const ERROR_REGISTRY_CORRUPT = 1015&
Public Const ERROR_REGISTRY_IO_FAILED = 1016&
Public Const ERROR_NOT_REGISTRY_FILE = 1017&
Public Const ERROR_KEY_DELETED = 1018&
Public Const ERROR_NO_LOG_SPACE = 1019&
Public Const ERROR_KEY_HAS_CHILDREN = 1020&
Public Const ERROR_CHILD_MUST_BE_VOLATILE = 1021&
Public Const ERROR_RXACT_INVALID_STATE = 1369&'自定义常量
Public Const REGAGENT_NOKEY = -1002
Public Const REGAGENT_NOSUBKEY = -1003Public Declare Function RegCreateKey Lib "advapi32.dll" _
                        Alias "RegCreateKeyA" _
                        (ByVal hKey As Long, _
                        ByVal lpSubKey As String, _
                        phkResult As Long) As Long
                        
Public Declare Function RegDeleteKey Lib "advapi32.dll" _
                        Alias "RegDeleteKeyA" _
                        (ByVal hKey As Long, _
                        ByVal lpSubKey As String) As Long
                        
Public Declare Function RegDeleteValue Lib "advapi32.dll" _
                        Alias "RegDeleteValueA" _
                        (ByVal hKey As Long, _
                        ByVal lpValueName As String) As Long
                        
Public Declare Function RegQueryValueEx 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
                        
Public Declare Function RegSetValueEx 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.类模块代码--------------------Option ExplicitDim ptRegistryKey As String
Dim ptSubKey As String
Dim ptKeyValue As String
Dim plStatus As Long
''属性
Property Get RegistryKey() As String
RegistryKey = ptRegistryKey
End PropertyProperty Let RegistryKey(ByVal tRegistryKey As String)
ptRegistryKey = tRegistryKey
End PropertyProperty Get KeyValue() As String
KeyValue = ptKeyValue
End PropertyProperty Let KeyValue(ByVal tKeyValue As String)
ptKeyValue = tKeyValue
End PropertyProperty Get subKey() As String
subKey = ptSubKey
End PropertyProperty Let subKey(ByVal tsubKey As String)
ptSubKey = tsubKey
End PropertyProperty Get Status() As Long
Status = plStatus
End Property''方法
Public Sub CreateKey()
Dim lResult As Long
plStatus = 0
'make sure all required properties have been set
If Len(ptRegistryKey) = 0 Then
  plStatus = REGAGENT_NOKEY
  Exit Sub
End If
plStatus = RegCreateKey(HKEY_LOCAL_MACHINE, ptRegistryKey, lResult)
End SubPublic Sub DeleteKey()
Dim lKeyID As Long
plStatus = 0If Len(ptRegistryKey) = 0 Then
  plStatus = REGAGENT_NOKEY
  Exit Sub
End IfIf Len(ptSubKey) = 0 Then
  plStatus = REGAGENT_NOSUBKEY
  Exit Sub
End IfplStatus = RegCreateKey(HKEY_LOCAL_MACHINE, ptRegistryKey, lKeyID)
If plStatus = 0 Then plStatus = RegDeleteKey(lKeyID, ByVal ptSubKey)
End SubPublic Sub GetValue()
Dim lResult As Long
Dim lKeyID As Long
Dim tKeyValue As String
Dim lBufferSize As LongplStatus = 0If Len(ptRegistryKey) = 0 Then
  plStatus = REGAGENT_NOKEY
  Exit Sub
End IfIf Len(ptSubKey) = 0 Then
  plStatus = REGAGENT_NOSUBKEY
  Exit Sub
End IfplStatus = RegCreateKey(HKEY_LOCAL_MACHINE, ptRegistryKey, lKeyID)If plStatus <> 0 Then Exit SubplStatus = RegQueryValueEx(lKeyID, ptSubKey, &O0, REG_SZ, 0&, lBufferSize)If lBufferSize < 2 Then
  ptKeyValue = Empty
  Exit Sub
End IftKeyValue = String(lBufferSize + 1, " ")plStatus = RegQueryValueEx(lKeyID, ptSubKey, &O0, REG_SZ, ByVal tKeyValue, lBufferSize)ptKeyValue = Left$(tKeyValue, lBufferSize - 1)End SubPublic Sub SetValue()
Dim lKeyID As LongplStatus = 0If Len(ptRegistryKey) = 0 Then
  plStatus = REGAGENT_NOKEY
  Exit Sub
End IfIf Len(ptSubKey) = 0 Then
  plStatus = REGAGENT_NOSUBKEY
  Exit Sub
End IfplStatus = RegCreateKey(HKEY_LOCAL_MACHINE, ptRegistryKey, lKeyID)If plStatus <> 0 Then Exit SubIf Len(ptKeyValue) = 0 Then
  plStatus = RegSetValueEx(lKeyID, ptSubKey, 0&, REG_SZ, 0&, 0&)
Else
  plStatus = RegSetValueEx(lKeyID, ptSubKey, 0&, REG_SZ, ByVal ptKeyValue, Len(ptKeyValue) + 1)
End If
End SubPublic Sub DeleteValue()
Dim lKeyID As LongplStatus = 0If Len(ptRegistryKey) = 0 Then
  plStatus = REGAGENT_NOKEY
  Exit Sub
End IfIf Len(ptSubKey) = 0 Then
  plStatus = REGAGENT_NOSUBKEY
  Exit Sub
End IfplStatus = RegCreateKey(HKEY_LOCAL_MACHINE, ptRegistryKey, lKeyID)If plStatus = 0 Then
  plStatus = RegDeleteValue(lKeyID, ByVal ptSubKey)
End IfEnd Sub