كار با ريجستري

[Restlesa]

سلام بر همگي دوستان برنامه نويس
در حال نوشت برنامه اي هستم كه بايد يك سري اطلاعات برنامه ام رو در ريجستري ذخيره كنم
از تابع SaveSetting‌ و GetSetting هم نمي خوام استفاده كنم
مي خوام يه كليد تو مسير دلخواه خودم درست كنم.
لطفا راهنماييم كنيد
با تشكر

[quiet_programmer]

با سلام.

برای کار کردن با رجیستری میتونی از کامپوننت زیر استفاده کنی. کار کردن باهاش خیلی راحته. فایل chm هم راهنماییت میکنه چطور ازش استفاده کنی. مثلا برای کاری که تو میخوای انجام بدی مثال زیر رو آورده
Reg1.hKey = HKEY_CURRENT_USER
Reg1.Path = "RegControl"
Reg1.CreateKey
Label1.Caption = Reg1.ErrorReturn

68281

[Restlesa]

ممنونم دوست عزيز
ولي من با استفاده از توابع API مي خوام اين كارو انجام بدم
در اين باره مي توني كمكي بهم بكني و يا سورسي بهم بدي ؟؟؟

[quiet_programmer]

از این ماژول استفاده کن

Option Explicit

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const ERROR_SUCCESS = 0&

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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) 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

Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_DWORD = 4
Dim r As Long
Dim lValueType As Long

Private Sub savekey(Hkey As Long, strPath As String)
Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub

Private Function getstring(Hkey As Long, strPath As String, strValue As String)

Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If
End If
End If
End Function


Private Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub

Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long

r = RegOpenKey(Hkey, strPath, keyhand)
' Get length/data type
lDataBufSize = 4

lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
getdword = lBuf
End If
End If

r = RegCloseKey(keyhand)
End Function

Private Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
r = RegCloseKey(keyhand)
End Function

Private Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
Dim r As Long
r = RegDeleteKey(Hkey, strKey)
End Function

Private Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function

[niko2008]

از این ماژول استفاده کن

Option Explicit

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const ERROR_SUCCESS = 0&

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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) 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

Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_DWORD = 4
Dim r As Long
Dim lValueType As Long

Private Sub savekey(Hkey As Long, strPath As String)
Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub

Private Function getstring(Hkey As Long, strPath As String, strValue As String)

Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If
End If
End If
End Function


Private Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub

Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long

r = RegOpenKey(Hkey, strPath, keyhand)
' Get length/data type
lDataBufSize = 4

lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
getdword = lBuf
End If
End If

r = RegCloseKey(keyhand)
End Function

Private Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
r = RegCloseKey(keyhand)
End Function

Private Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
Dim r As Long
r = RegDeleteKey(Hkey, strKey)
End Function

Private Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function

دوست عزیز میتونی یه مثال از این ماژول بنویسی؟
از تابع SaveSetting‌ و GetSetting هم یه توضیح در مورد عملکردش میخوام؟

[Restlesa]

ممنونم دوست عزیز همون چیزی بود که دنبالش می گشتم
ولی اگه یه توضیحی درباره ی عملکرد فانکش هایی که تعریف کردی بدی ممنونت میشم

[quiet_programmer]

با سلام.
دوستان توضیح ماژول خواسته بودن؟ چشم رو چشم.

خوب اول توابع API بعد توابع تعریف شده.

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
این تابع مسیری که توسط پارامتر Hkey و lpSubKey مشخص شده را باز میکند و یک دستگیره (handel) به آدرس مشخص شده داخل phkResult قرار میدهد.
بعد از استفاده از این تابع و با مشخص شدن handel مسیر برای حذف و اضافه و خواندن مقدار و ... از آن آدرس دیگر نیازی به آوردن آدرس دو باره نیست.
برای اینکه کار این تابع رو بخوبی درک کنید یه مثال میزنم از فایلها.
برای باز کردن یه فایل تو وبی باید یه شماره رو به فایل اختصاص بدیم مثلا 1#. بعد برای خوندن از فایل یا نوشتن فقط کافیه از 1# بخونیم یا بنویسیم.
مثلا input Line #1,St. تو این تابع هم phkResult نقش 1# رو داره.
حالا بعدا با مثال توضیح میدم منظورم چی بود.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
پارامتر Hkey هندل یک مسیر را گرفته و آن را میبندد. بعد از این دستور مقدار handel پاس شده به این تابع دیگر معتبر نخواهد بود.
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
کلیدی که توسط hkey و ipSubKey مشخص شده را حذف میکند.
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
این تابع یک value را حذف میکند. پارامتر اول Hnadel مسیر و پارامتر دوم نام مقدار را دریافت میکند.
خوب بهتر اینجا بگم که برای حذف یک مقدار نمیشه به تنهایی از این دستور استفاده کرد. بلکه اول باید اون مسیر دلخواه رو باز کنیم و یه هندل از اون مسیر رو بگیریم بعد مقدار رو حذف کنیم.
بخاطر این اینجا یه تابع تعریف شده به اسم DeleteValue که با گرفتن پارامترهای لازم برای حذف یک مقدار و با استفاده از سه تابع api یه مقدار رو حذف میکنه. حالا بعدا این تابع رو هم توضیح میدم.
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
این تابع محتویات یه مقدار رو میخونه.
Hkey: هندل آدرسی که مقدار داخل اون مسیر قرار داره رو مشخص میکنه.

lpValueName: اسم مقداری که قراره خونده باشه رو میگیره.
lpReserved: رزرو شده با مقدار 0
lpType: نوع مقدار که میتونه یکی از مقادیر زیر باشه
REG_SZ
REG_DWORD
REG_QWORD
REG_BINARY
و ...
مقدار عددی REG_SZ برابر 1 و REG_DWORD برابر 4. بقیه رو هم میشه با استفاده از (من میگم) کلک رشتی بدست بدست آورد. حالا بعدا در ادامه بهش اشاره مکنم.
lpData: محتویات مقدار داخل این پارامتر قرار میگیرد.
lpcbData: اندازه lpcbData رو مشخص میکند.
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
این تابع یه value رو با lpData مقدار دهی میکنه.
پارامترها مشابه تابع قبلی.

توابع تعریف شده در ماژول:

Private Sub savekey(Hkey As Long, strPath As String)
این رویه یه Hkey میگیره و یه مسیر و با استفاده از توابع RegCreateKey کلید رو ایجاد میکنه و هندل مسیر داخل keyhand قرار میگره و چون دیگه هدف رویه(ایجاد کلید) به نتیجه رسید Keyhand رو با استفاده از تابع RegCloseKey غیر قابل دسترس میکنه.
Private Function getstring(Hkey As Long, strPath As String, strValue As String)
این تابع رو دوست عزیزمون خواسته بودن که توضیح بدم. این تابع کارش اینه که قراره یه مقدار از نوع REG_SZ که از نوع رشته ای هست رو بخونه.
اول پارامترها:
Hkey: ابر کلید که value داخل اونه رو دریافت میکنه.
strPath: آدرس ساب کی رو که value داخل اون ساب کی قرار داره رو دریافت میکنه.
strValue: اسم value که قراره محتویات اونو بخونه و بازگشت بده.
توضیح تابع:
RegOpenKey(Hkey, strPath, keyhand)
اول با استفاده از این دستور مسیر مورد نظر رو باز میکنه و هندل مسیر رو داخل keyhand قرار میده.
RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
با این دستور با یه تیر دوتا نشون میزنه. اول اینکه نوع value چیه(که قراره REG_SZ باشه) و دوم اینکه طول محتویات مقدار رو بدست بیاره.
به همین خاطر نوع value رو یه متغیر ارسال شده و بهجای Container عدد 0 ارسال شده.

داخل پرانتز: این دستور همون کلک رشیمونه برای تشخیص عدد اختصاص داده شده به نوع مقادیر. بعد از استفاده از این دستور مقداری که داخل lValueType قرار میگیره همون عدد اختصاص داده شده به نوع مقداره. امید وارم متوجه شده باشین که چه جوری باید از این کلک استفاده کنین برای بدست آوردن عدد اختصاص داده شده به مقادیر در غر این صورت بگین تا توضیح بیشتری بدم.
strBuf = String(lDataBufSize, " ")
به اندازه طول محتویات مقدار داخل strBuf رو با اسپیس پر میکنه.
RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
حالا اینجا محتویات value رو میخونه و داخل strBuf قرار میده.
intZeroPos = InStr(strBuf, Chr$(0))
اولین مکان از strBuf که برابر با chr(0)l رو پیدا میکنه.
getstring = Left$(strBuf, intZeroPos - 1)
از ایندکس یک strBuf تا اولین مکان chr(0)l رو میخونه و باز گشت میده.

Private Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
یک value با نوع REG_SZ رو مقدار دهی میکنه. دیگه فکر کنم نیازی به توضیح دادن نداشته باشه ولی اگه دوستا خواستن بگن تا ...
Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
این تابع محتویات یه value از نوع REG_WORD رو میخونه و بازگشت میده مشابه تابع GetStringه.
خسته نباشین. من دیگه خسته شدم. بقیه شم که دیگه آسونه. اینطور نیست؟
نحوه استفادش هم که جناب niko02008 خواسته بودن این شکلیه که اول اسم فانکش یا رویه رو میارین و بعد هم پارامترهش رو:لبخند:
مثلا:
savestring HKEY_CURRENT_USER, "software\Microsoft\Windows\ShellNoRoam\MUICache", "My Dynamic Program", App.Path & "\" & App.EXEName & ".exe"
یا
DeleteValue HKEY_CURRENT_USER, "software\Microsoft\Windows\ShellNoRoam\MUICache", "My Dynamic Program"