۱۴-آبان-۱۳۸۶, ۱۷:۴۰:۳۱
ميخواهم يك مقدار رشته اي را در يك ورودي موجود در رجيستري بنويسم ولي آنچه در اثر كد زير نوشته ميشود با چيزي كه من تايپ ميكنم فرق دارد؟ راهنمايي كنيد
با تشكر
هاشمي
09132356511
hashemi-te@esfahansteel.com
Option Explicit
Dim KeyName As String
Dim EntryName As String
Dim Subtree As Long
Private Sub Form_Load()
Subtree = HKEY_LOCAL_MACHINE
"KeyName = "SYSTEM\Setup
"EntryName = "CmdLine
End Sub
Private Sub ReadBtn_Click()
Dim hKey As Long
Dim lRetVal As Long
Dim vValue As Variant
Dim lValue As Long
(lRetVal = RegOpenKeyEx(Subtree, KeyName, 0, KEY_QUERY_VALUE, hKey
(lRetVal = QueryValueEx(hKey, EntryName, vValue
Me.ValueBox.Text = vValue
End Sub
()Private Sub WriteBtn2_Click
Dim lRetVal As Long
Dim hKey As Long
Dim EntryType As Long
Dim sValue As String
sValue = Me.ValueBox.Text
EntryType = REG_SZ
(lRetVal = RegOpenKeyEx(Subtree, KeyName, 0, KEY_ALL_ACCESS, hKey
(lRetVal = SetValueEx(hKey, EntryName, EntryType, sValue
( RegCloseKey (hKey
End Sub
الگوي توابع و ثابتها نيز در يك ماژول مشابه زير تعريف شده
Option Explicit
Public Const STANDARD_RIGHTS_ALL = &H1F0000
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 SYNCHRONIZE = &H100000
Public Const 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))
Public Const HKEY_CURRENT_USER = &H80000001
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_DWORD = 4 ' 32-bit number
Public Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
Public Const ERROR_NONE = 0
Public Const LongSize_onByte = 4
Public Const HKEY_LOCAL_MACHINE = &H80000002
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
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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.
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.
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Public Function SetValueEx(ByVal hKey As Long, ByVal EntryName As String, ByVal EntryType As Long, ByVal vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case EntryType
Case REG_SZ 'type of value is string
sValue = vValue
SetValueEx = RegSetValueEx(hKey, EntryName, 0, EntryType, sValue, Len(sValue))
'lValue = Asc(vValue)
'SetValueEx = RegSetValueEx(hKey, EntryName, 0, EntryType, lValue, 4)
Case REG_DWORD 'type of value is Double word
lValue = vValue
SetValueEx = RegSetValueEx(hKey, EntryName, 0, EntryType, lValue, 4)
Case Else
SetValueEx = RegSetValueEx(hKey, EntryName, 0, EntryType, vValue, 4)
End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Variant
Dim cch As Long
Dim lrc As Long
Dim EntryType As Long
Dim lValue As Long
Dim sValue As String
lrc = RegQueryValueExNULL(lhKey, szValueName, 0, EntryType, 0, cch)
Select Case EntryType
Case REG_SZ: 'For strings
sValue = String(cch, 2)
lrc = RegQueryValueExString(lhKey, szValueName, 0, EntryType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
Case REG_DWORD: 'For DWORDS
lrc = RegQueryValueExLong(lhKey, szValueName, 0, EntryType, 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
با تشكر
هاشمي
09132356511
hashemi-te@esfahansteel.com
Option Explicit
Dim KeyName As String
Dim EntryName As String
Dim Subtree As Long
Private Sub Form_Load()
Subtree = HKEY_LOCAL_MACHINE
"KeyName = "SYSTEM\Setup
"EntryName = "CmdLine
End Sub
Private Sub ReadBtn_Click()
Dim hKey As Long
Dim lRetVal As Long
Dim vValue As Variant
Dim lValue As Long
(lRetVal = RegOpenKeyEx(Subtree, KeyName, 0, KEY_QUERY_VALUE, hKey
(lRetVal = QueryValueEx(hKey, EntryName, vValue
Me.ValueBox.Text = vValue
End Sub
()Private Sub WriteBtn2_Click
Dim lRetVal As Long
Dim hKey As Long
Dim EntryType As Long
Dim sValue As String
sValue = Me.ValueBox.Text
EntryType = REG_SZ
(lRetVal = RegOpenKeyEx(Subtree, KeyName, 0, KEY_ALL_ACCESS, hKey
(lRetVal = SetValueEx(hKey, EntryName, EntryType, sValue
( RegCloseKey (hKey
End Sub
الگوي توابع و ثابتها نيز در يك ماژول مشابه زير تعريف شده
Option Explicit
Public Const STANDARD_RIGHTS_ALL = &H1F0000
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 SYNCHRONIZE = &H100000
Public Const 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))
Public Const HKEY_CURRENT_USER = &H80000001
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_DWORD = 4 ' 32-bit number
Public Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
Public Const ERROR_NONE = 0
Public Const LongSize_onByte = 4
Public Const HKEY_LOCAL_MACHINE = &H80000002
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
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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.
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.
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Public Function SetValueEx(ByVal hKey As Long, ByVal EntryName As String, ByVal EntryType As Long, ByVal vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case EntryType
Case REG_SZ 'type of value is string
sValue = vValue
SetValueEx = RegSetValueEx(hKey, EntryName, 0, EntryType, sValue, Len(sValue))
'lValue = Asc(vValue)
'SetValueEx = RegSetValueEx(hKey, EntryName, 0, EntryType, lValue, 4)
Case REG_DWORD 'type of value is Double word
lValue = vValue
SetValueEx = RegSetValueEx(hKey, EntryName, 0, EntryType, lValue, 4)
Case Else
SetValueEx = RegSetValueEx(hKey, EntryName, 0, EntryType, vValue, 4)
End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Variant
Dim cch As Long
Dim lrc As Long
Dim EntryType As Long
Dim lValue As Long
Dim sValue As String
lrc = RegQueryValueExNULL(lhKey, szValueName, 0, EntryType, 0, cch)
Select Case EntryType
Case REG_SZ: 'For strings
sValue = String(cch, 2)
lrc = RegQueryValueExString(lhKey, szValueName, 0, EntryType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
Case REG_DWORD: 'For DWORDS
lrc = RegQueryValueExLong(lhKey, szValueName, 0, EntryType, 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