یک مشکل با ایجاد کلید و حذف آن در رجیستری(فقط خانم ها کلیک)
سلام دوستان من یه برنامه نوشتم که باید یه کلیدی در رجیستری ایجاد و حذف کنه ولی اینکارو نمی کنه خطا هم نمی ده اگه کسی میدونه مشکلش کجاست ممنون میشم پاسخ بده
اینم سورس کد برنامه:
Private Const ERROR_SUCCES = 0&
Private Const REG_OPTION_VOLATILE = 1
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HYEY_DYN_DATA = &H80000006
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const KEY_WRITE = &H20006
Private Const KEY_READ = &H20019
Private Const KEY_ALL_ACCESS = &HF003F
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Type SECURITY_ATTRIBUTES
nLength As Long
IpSecurityDescriptor As Long
blnheritHandle As Long
End Type
Private 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
'Open
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal hKey As Long, _
ByVal lpValueName As String) As Long
'delete
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
'close
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" 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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Sub Command1_Click()
Dim subky As String
Dim retval As Long
Dim hKey As Long
Dim buffer As Long
Dim secattr As SECURITY_ATTRIBUTES
subkey = "Software\Microsoft\Windwos\CurrentVersion\Pol icie s\Explorer"
secattr.nLength = Len(secattr)
secattr.IpSecurityDescriptor = 0
secattr.blnheritHandle = 1
retval = RegCreateKeyEx(HKEY_CURRENT_USER, subkey, 0, "", 0, KEY_WRITE, secattr, hKey, ByVal 0&)
If retval <> 0 Then
Exit Sub
End If
buffer = &H1
RegSetValueEx hKey, "NoDrives", 0, REG_BINARY, buffer, Len(buffer)
RegCloseKey hKey
Text1.Text = "NoDrives-->=open"
End Sub
Private Sub Command2_Click()
Dim subky As String
Dim retval As Long
Dim hKey As Long
subkey = "Software\Microsoft\Windwos\CurrentVersion\Pol icie s\Explorer"
retval = RegOpenKeyEx(HKEY_CURRENT_USER, subkey, 0, KEY_ALL_ACCESS, hKey)
If retval = 0 Then
RegDeleteValue hKey, "NoDrives"
RegCloseKey hKey
Text1.Text = "NoDrives----->=Deleted"
End If
End Sub
جواب بصورت نقل قول
.gif "N Aggressive (17)")
خجالت آور است ...
نوشته شده توسط nk_hsn
