khomar
جمعه 22 دی 1385, 00:42 صبح
این کد برنامه های add remove program رو نشون می ده اما نمی دونم چرا جواب نمی ده جاهایی که به نظر خودم باعث می شه جواب نگیرم رو قرمز رنگ کردم تا نظر بقیه دوستان چی باشه مرسی
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1
Const REG_DWORD = 4
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstal l"
'Const gREGVALSYSINFOLOC = "displayname"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstal l"
Const gREGVALSYSINFO = "displayname"
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_OUTOFMEMORY = 14&
Const ERROR_INVALID_PARAMETER = 87&
Const ERROR_ACCESS_DENIED = 5&
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 RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long
Dim rk As Long
Dim hKey As Long
Dim hDepth As Long
Dim KeyValType As Long
Dim tmpVal As String
Dim KeyValSize As Long
rk = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If (rk <> ERROR_SUCCESS) Then GoTo GetKeyError
tmpVal = String$(1024, 0)
KeyValSize = 1024
tmpVal = String$(1024, 0)
KeyValSize = 1024
rk = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize)
If (rk <> ERROR_SUCCESS) Then GoTo GetKeyError
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
tmpVal = Left(tmpVal, KeyValSize - 1)
Else
tmpVal = Left(tmpVal, KeyValSize)
End If
Select Case KeyValType
Case REG_SZ
KeyVal = tmpVal
Case REG_DWORD
For i = Len(tmpVal) To 1 Step -1
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
Next
KeyVal = Format$("&h" + KeyVal)
End Select
GetKeyValue = True
rk = RegCloseKey(hKey)
Exit Function
GetKeyError:
KeyVal = ""
GetKeyValue = False
'gAPIDisplayError
rk = RegCloseKey(hKey)
End Function
'Imports Microsoft.Win32
Sub gAPIDisplayError(Code&)
Select Case Code&
Case ERROR_BADDB
MsgBox "Corrupt Registry Database!"
Case ERROR_BADKEY
MsgBox "Key name is bad"
Case ERROR_CANTOPEN
MsgBox "Cannot Open Key"
Case ERROR_CANTREAD
MsgBox "Cannot Read Key"
Case ERROR_CANTWRITE
MsgBox "Cannot Write Key"
Case ERROR_ACCESS_DENIED
MsgBox "Access to Registry Denied"
Case ERROR_OUTOFMEMORY
MsgBox "Out of memory"
Case ERROR_INVALID_PARAMETER
MsgBox "Invalid Parameter"
Case Else
MsgBox "Undefined key error code!"
End Select
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rk As Long
Dim SysInfoPath As String
' Try To Get System Info Program Path\Name From Registry...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
Else
GoTo SysInfoErr
End If
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub
Private Sub Command1_Click()
'Dim names() As String
StartSysInfo
'names = rk.RegQueryValueEx()
' For i = 0 To i Step 1
' StartSysInfo
' If i < names.Length Then
' List1.List = RegQueryValueEx()
'List1.List = StartSysInfo
' Next i
End Sub
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1
Const REG_DWORD = 4
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstal l"
'Const gREGVALSYSINFOLOC = "displayname"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstal l"
Const gREGVALSYSINFO = "displayname"
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_OUTOFMEMORY = 14&
Const ERROR_INVALID_PARAMETER = 87&
Const ERROR_ACCESS_DENIED = 5&
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 RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long
Dim rk As Long
Dim hKey As Long
Dim hDepth As Long
Dim KeyValType As Long
Dim tmpVal As String
Dim KeyValSize As Long
rk = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If (rk <> ERROR_SUCCESS) Then GoTo GetKeyError
tmpVal = String$(1024, 0)
KeyValSize = 1024
tmpVal = String$(1024, 0)
KeyValSize = 1024
rk = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize)
If (rk <> ERROR_SUCCESS) Then GoTo GetKeyError
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
tmpVal = Left(tmpVal, KeyValSize - 1)
Else
tmpVal = Left(tmpVal, KeyValSize)
End If
Select Case KeyValType
Case REG_SZ
KeyVal = tmpVal
Case REG_DWORD
For i = Len(tmpVal) To 1 Step -1
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
Next
KeyVal = Format$("&h" + KeyVal)
End Select
GetKeyValue = True
rk = RegCloseKey(hKey)
Exit Function
GetKeyError:
KeyVal = ""
GetKeyValue = False
'gAPIDisplayError
rk = RegCloseKey(hKey)
End Function
'Imports Microsoft.Win32
Sub gAPIDisplayError(Code&)
Select Case Code&
Case ERROR_BADDB
MsgBox "Corrupt Registry Database!"
Case ERROR_BADKEY
MsgBox "Key name is bad"
Case ERROR_CANTOPEN
MsgBox "Cannot Open Key"
Case ERROR_CANTREAD
MsgBox "Cannot Read Key"
Case ERROR_CANTWRITE
MsgBox "Cannot Write Key"
Case ERROR_ACCESS_DENIED
MsgBox "Access to Registry Denied"
Case ERROR_OUTOFMEMORY
MsgBox "Out of memory"
Case ERROR_INVALID_PARAMETER
MsgBox "Invalid Parameter"
Case Else
MsgBox "Undefined key error code!"
End Select
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rk As Long
Dim SysInfoPath As String
' Try To Get System Info Program Path\Name From Registry...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
Else
GoTo SysInfoErr
End If
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub
Private Sub Command1_Click()
'Dim names() As String
StartSysInfo
'names = rk.RegQueryValueEx()
' For i = 0 To i Step 1
' StartSysInfo
' If i < names.Length Then
' List1.List = RegQueryValueEx()
'List1.List = StartSysInfo
' Next i
End Sub