تغییر ریجستری با vb

[winxp]

سلام دوستان خوبم

یه سوال سخت

میخوام با vb یه برنامه بنویسم که بیاد ایو مسیر رو روی ریجستری اعمال کنه

فقط اگه توستشن جواب بدین کامل بگین چی کار کنم

این کد

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Explorer\Shell Icons]
"3"="d:\\icon\\folder.ico"

در حقیقت من میخوام یه برنامه بنویسم که توش یه browse داره و وقتی browse میزنی پنجره باز میشه که ایکون مورد نظر رو انتخاب کنین

شما ایکون رو انتخاب کرده و ok میکنید

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

حالا من میخوام کد رو توی apply بزارم ولی نمیدونم چه جوری باید بزارم

بعد از apply زدن باید برین از display قسمت settings color quality رو از 32 به 16 تغییر داده و دوباره به 32 برگردونین تا تغییرات کاملا اعمال بشه

اگه بتونین این قسمت اخر رو هم به صورت برنامه در بیارین دیگه خیلی هنر کردین که کاربر نره دستی 32 رو به 16 تغییر بده

امیدوارم زیاد سخت نبوده باشه

منتظرم

[ileaw]

اينو جوابت دادم تا مثل اوناي كه مثل بوغ از كنار هر سوالي رد مي شن نباشم

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, ByVal lpData As String, ByVal cbData As Long) As Long
Const ERROR_SUCCESS = 0&
Const DisplayErrorMsg = False
'************************
Function GetMainKeyHandle(MainKeyName As String) As Long
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006

Select Case MainKeyName
Case "HKEY_CLASSES_ROOT"
GetMainKeyHandle = HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_USER"
GetMainKeyHandle = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
GetMainKeyHandle = HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
GetMainKeyHandle = HKEY_USERS
Case "HKEY_PERFORMANCE_DATA"
GetMainKeyHandle = HKEY_PERFORMANCE_DATA
Case "HKEY_CURRENT_CONFIG"
GetMainKeyHandle = HKEY_CURRENT_CONFIG
Case "HKEY_DYN_DATA"
GetMainKeyHandle = HKEY_DYN_DATA
End Select
End Function

Private Sub ParseKey(Keyname As String, Keyhandle As Long)

rtn = InStr(Keyname, "\") 'return if "\" is contained in the Keyname
If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" Then 'if the is a "\" at the end of the Keyname then
MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + Keyname 'display error to the user
Exit Sub 'exit the procedure
ElseIf rtn = 0 Then 'if the Keyname contains no "\"
Keyhandle = GetMainKeyHandle(Keyname)
Keyname = "" 'leave Keyname blank
Else 'otherwise, Keyname contains "\"
Keyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1)) 'seperate the Keyname
Keyname = Right(Keyname, Len(Keyname) - rtn)
End If
End Sub
Function SetStringValue(SubKey As String, Entry As String, Value As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open the key
If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
rtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal Value, Len(Value)) 'write the value
If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value
If DisplayErrorMsg = True Then 'if the user wants errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
rtn = RegCloseKey(hKey) 'close the key
Else 'if there was an error opening the key
If DisplayErrorMsg = True Then 'if the user wants errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
End If
End Function


خوب حالا خيلي ساده تو دكمه Apply خط زير را مي نويسي

SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Explorer\Shell Icons", "3", "d:\\icon\\folder.ico"

واسه تاييد كامل هم از كاربر مي خواي لوگ آف يا ري استارت كنه ممكنه اگه Explorer رو هم ببندي دوباره باز كني بس باشه:2:

[winxp]

سلام ileaw جان

خیلی خیلی خیلی ممنون و سپاسگذارم

واقعا لطف کردی

اگه برا کامپیوترت مشکلی پیش اومد تو بخش کامپیوتر جبران میکنم که ان شاالله مشکلی براش پیش نیاد

اما برنامه ی شما
اون همه برنامه که بالا نوشتین برای چی بوده ؟

مثلا این فایل advapi32.dll" رو برا چی خواستین

و تو قسمت تابع ها چرا به همه ی قسمت های ریجستری فراخوانی داشتین
مثلا

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006

اگه همون دستور اخر رو بنویسم برا دکمه ی apply کار نمیکنه , این دستور رو میگم

SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Cur r entVersion\Explorer\Shell Icons", "3", "d:\\icon\\folder.ico

همین دستورها رو اگه برای دکمه ی apply بنویسم جواب نمیده ؟

ممنون میشم همینارو هم جواب بدین

متشکرم

موفق باشین

[winxp]

سلام دوباره

برنامه رو اجرا کردم ولی این error رو میده

اگه میشه راهنمایی کنین ماله چیه

Compile error : Constans , fixed-length string , arrays,user-defined type and declare statements not allowed as publis members of object modules

ممنون و متشکر

منتظر راهنماییهاتون هستم

[Payman_62]

سلام.
ویندوز جان به این تاپیک سر بزن.

برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید
من ساخت کلید و ولیو و جستجو و ... تو رجیستری رو توضیح دادم. اگه کارت راه نیفتاد بگو تا کمکت کنم.
ضمنا تو اون مسیری که دادی کلید shellicon تو سیستم من وجود نداشت. اگه تو سیستم تو هم وجود نداشته باشه باید اول کلیدش رو بسازی بعد ولیو رو ست کنی.
ضمنا برای نوشتن تو local machin دسترسی در سطح ادمین نیاز هست.

[ileaw]

اون فايل دي DLL ي كه مي گي در حقيقت اصل ماجراست
چون اون دستوراتي كه گفتم در دكمه به كار مي بري مال خود ويژوال بيسيك نيستن براي كار با رجيسري خود وي بي هم دستور داره ولي خيلي پيش پا افتاده ولي حد اقل اين امكان و ميده كه مثل خيلي از برنامه ها و زبان هاي ديگه از دستورات تعريف شده در فايل هاي DLL استفاده كنه نه شما بايد تمام اون كدي كه من نوشتم حتماٌ بنويسي

در ضمن خطاي شما به اين دليل هست كه كد هام منو بايد داخل يك ماژول بريزي بعد از در داخل كد دكمه ات دستور آخري را وارد كني

در ضمن همش نياز هست

SetStringValue اين دستور خود وي بي نيست
و در قسمت پايين تعريف شده


اگه نياز به توضيح بيشتر بود بگو ،بگم

در ضمن اگه تو هم مشكلي واسه كامپيوترت پيش اومد كه نياد و از همه جا موندي به خودم بگو


Function SetStringValue(SubKey As String, Entry As String, Value As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open the key
If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
rtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal Value, Len(Value)) 'write the value
If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value
If DisplayErrorMsg = True Then 'if the user wants errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
rtn = RegCloseKey(hKey) 'close the key
Else 'if there was an error opening the key
If DisplayErrorMsg = True Then 'if the user wants errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
End If
End Function

كه داخل اين تابع هم تابع هاي كه از فايل DLL صدا زده شده به كار رفته كه اصلاٌ ربطي به وي بي نداره

حتماٌ بجز خط آخري رو داخل يه ماژول بريزي

[winxp]

سلام

ببینین , من تونستم برنامه رو بنویسم و این کار هارو انجام دادم

رفتم از project روی add madule کلیک کردم و یه ماژول ساخته شد , بعد رفتم داخل ماژول همون کدها غیر از خط اخر رو past کردم ولی وقتی برنامه رو اجرا میکردم این error رو میداد

Compile error : Constans , fixed-length string , arrays,user-defined type and declare statements not allowed as publis members of object modules

خلاصه با کلی ور رفتن گفتم بزار این خط اول رو پاک کنم
کدوم خط ؟
وقتی یه ماژول میسازی اولین خطش نوشته
Option Explicit
من هم بعد از این خط کد ها رو past کردم و اون error بالا رو میداد
اینو که حذف کردم دیگه error نداد
یعنی داخل ماژول رو که select all میکردم و copy و past میکردم اینجا , این میشد نتیجه


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, ByVal lpData As String, ByVal cbData As Long) As Long
Const ERROR_SUCCESS = 0&
Const DisplayErrorMsg = False

Function GetMainKeyHandle(MainKeyName As String) As Long
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006

Select Case MainKeyName
Case "HKEY_CLASSES_ROOT"
GetMainKeyHandle = HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_USER"
GetMainKeyHandle = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
GetMainKeyHandle = HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
GetMainKeyHandle = HKEY_USERS
Case "HKEY_PERFORMANCE_DATA"
GetMainKeyHandle = HKEY_PERFORMANCE_DATA
Case "HKEY_CURRENT_CONFIG"
GetMainKeyHandle = HKEY_CURRENT_CONFIG
Case "HKEY_DYN_DATA"
GetMainKeyHandle = HKEY_DYN_DATA
End Select
End Function

Private Sub ParseKey(Keyname As String, Keyhandle As Long)

rtn = InStr(Keyname, "\") 'return if "\" is contained in the Keyname
If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" Then 'if the is a "\" at the end of the Keyname then
MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + Keyname 'display error to the user
Exit Sub 'exit the procedure
ElseIf rtn = 0 Then 'if the Keyname contains no "\"
Keyhandle = GetMainKeyHandle(Keyname)
Keyname = "" 'leave Keyname blank
Else 'otherwise, Keyname contains "\"
Keyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1)) 'seperate the Keyname
Keyname = Right(Keyname, Len(Keyname) - rtn)
End If
End Sub
Function SetStringValue(SubKey As String, Entry As String, Value As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open the key
If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
rtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal Value, Len(Value)) 'write the value
If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value
If DisplayErrorMsg = True Then 'if the user wants errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
rtn = RegCloseKey(hKey) 'close the key
Else 'if there was an error opening the key
If DisplayErrorMsg = True Then 'if the user wants errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
End If
End Function



حالا برنامه اجرا میشه و من میتونم با زدن browse برم یه ایکون انتخاب کنم ولی وقتی apply میزنم باز error میده که عکسشو اینجا میزارم ببینین از چیه

[ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ]


این هم محتویات دستورهای apply و cansel و browse


Private Sub Command1_Click()
CommonDialog1.ShowOpen
CommonDialog1.Filter = "ico|*.ico"
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Explorer\Shell Icons", "3", "d:\\icon\\folder.ico"
End Sub


اینم عکس از panele سمت راست

[ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ]

و این هم عکس از شکل برنامه

[ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ]

راستی leav جان
اون مسیر shell icon هم در ریجستری باید ساخته بشه و بعدش کلید 3 ساخته بشه

امیدوارم error گرفته بشه

ممنون از لطفت که راهنمایی میکنی

منتظرم

[Payman_62]

سلام.
2 تا تابع برات نوشتم. برای ساخت کلید و ساخت ولیو. اگه اون تاپیکو با دقت میخوندی خودتم میتونستی بنویسی. بهترم یاد میگرفتی.
ضمنا کدهارو داخل تگ کد قرار بده بشه فهمید چی نوشتی.

برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید
مثال:

برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید
بازم میگم برای ساخت ولیو باید کلیدی که میخوای ولیو رو داخلش ست کنی ساخته شده باشه.

[ileaw]

بابا

كافي خط زير رو در اول هاي ماژول قرار بدي
Dim MainKeyHandle As Long

همين
در ظمن ممكنه باز هم پيغام خطا بده به جز اين خطا كه تصحيح مي كني هر خط ديگه كه پيغام خطا داد پاك مي كني به عنوان مثال خط زير احتمال زياد بهت خطا مي ده
MsgBox ErrorMsg(rtn)

دوست خوبمون هم كدهاشون بد نيست ولي دردسر زياد داره

[majid_kntu]

بابــــــــــــــــــا دردسر!

خيلي ببخشيدا!
برنامه نويس با دردسر كار نداره .....نتيجه كار مهمه!

[winxp]

بابا

كافي خط زير رو در اول هاي ماژول قرار بدي
Dim MainKeyHandle As Long

همين
در ظمن ممكنه باز هم پيغام خطا بده به جز اين خطا كه تصحيح مي كني هر خط ديگه كه پيغام خطا داد پاك مي كني به عنوان مثال خط زير احتمال زياد بهت خطا مي ده
MsgBox ErrorMsg(rtn)

دوست خوبمون هم كدهاشون بد نيست ولي دردسر زياد داره

سلام ileaw جان

خیلی خیلی خیلی ممنون بایت برنامه ی قشنگت
خیلی خیلی خوب بود
دستت درد نکنه

الان چند ا دیگه سوال دارم
یکی این که کد ساختن کلید Shell icons رو برام بزار و بگو کجا اضافه کنم و این که من هنوز brows نزاشتم و میخوام icon رو از هر جا میخوام انتخاب کنم ولی این میاد ار درایو d:\icon\folder انتخاب میکنه
باید چی کار کنم که وقتی browse زدم و ایکون رو انتخاب کردم , مسیر icone انتخاب شده در دستور apply ذخیره بشه ؟

شرمنده من این قد گیر دادم به این , همین برنامه رو بنویسم دیگه کاری با این قسمت ندارم و خودم میرم کتاب بگیرم مطلالعه کنم , الان امتحانات شروع شده نمیشه زیاد وقت گذاشت ولی برنامه رو که کامل کردم با اسم ileav و خودم میزارم همین جا

از peyman جان هم ممنون بابت راهنماییهاشون

ممنون و متشکر
منتظرم
:11:

[ileaw]

فكر كنم ويندوز به طور پيش فرض اينو داشته باشه آخه من كه به طور پيش فرض داشت
ولي صبر كن مي نويسم دوباره واسه ايميلت مي فرستم
اون دكمه انتخاب هم واست مي گذارم:8: