مشکل رجستری در وژوال بیسیک 6
سلام دوستان من نیاز دارم کلید های زیر رو بسازم توی وژوال بیسیک 6 این کارو انجام میدم برنامه رو Run As هم میکنم کلید ها ساخته میشه ولی در مسیر دیگه ای این کار اتفاق میافته
این کلید ها رو در فایل .reg اجرا میکنم ساخته میشن ولی توی وژوال بیسیک 6 اشتباه میسازه مسیر HKEY_LOCAL_MACHINE رو تغییر میده به HKEY_CLASSES_ROOTکد HTML:[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}]@="CThemeResourceChangerObject Class""AppID"="{508AE86B-33BB-4F20-A7F1-7AC86F5DD375}" [HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}\InprocServer32]"ThreadingModel"="Apartment"@="C:\\Windows\\SkinePack\\Components\\ThemeResourceChanger.dll" [HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}\ProgID]@="ThemeResourceChanger.CThemeChange.1" [HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}\Programmable]@="" [HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}\TypeLib]@="{CFA8AF78-B9E2-4C91-8DB7-2314C781E8A4}" [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\SharedTaskScheduler]"{F791A188-699D-4FD4-955A-EB59E89B1907}"="Theme Resource Changer"
این هم کد وژوال بیسیک
MyReg.WriteString HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID", "{F791A188-699D-4FD4-955A-EB59E89B1907}", "CThemeResourceChangerObject Class" MyReg.WriteString HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}", "AppID", "{508AE86B-33BB-4F20-A7F1-7AC86F5DD375}"
MyReg.WriteString HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}\InprocServer32", "ThreadingModel", "Apartment"
MyReg.WriteString HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}\InprocServer32", "", (Environ$("windir") & "\SkinePack\Components\ThemeResourceChanger.dl l")
MyReg.WriteString HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}\ProgID", "", "ThemeResourceChanger.CThemeChange.1"
MyReg.WriteString HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}\Programmable", "", ""
MyReg.WriteString HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\{F791A188-699D-4FD4-955A-EB59E89B1907}\TypeLib", "", "{CFA8AF78-B9E2-4C91-8DB7-2314C781E8A4}"
MyReg.WriteString HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explore r\SharedTaskScheduler", "{F791A188-699D-4FD4-955A-EB59E89B1907}", "Theme Resource Changer"
MyReg اسم کلاسی هست که فراخوانی میشه این هم کد کلاس
Private Type FILETIME dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal HKey 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 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 RegCreatekey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal HKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
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
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal HKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal HKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'Main Registry Keys
'------------------------------------------------------------------------
Public Enum HKey_Type
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKey_CURRENT_CONFIG = &H80000005
HKey_DYN_DATA = &H80000006
End Enum
'Secuirty Constants
'------------------------------------------------------------------------
Const KEY_ALL_ACCESS = &HF003F
Const KEY_QUERY_VALUE = &H1
Const KEY_WRITE = &H106
Dim R As Long
Public Function KeyExist(Key As HKey_Type, sSubKey As String) As Boolean
Dim HKey As Long
R = RegOpenKeyEx(Key, sSubKey, 0, KEY_QUERY_VALUE, HKey)
Debug.Print HKey
If R = ERROR_NONE Then
KeyExist = True
Else
KeyExist = False
End If
RegCloseKey HKey
End Function
Public Function CreateKey(Key As HKey_Type, sSubKey As String) As Boolean
Dim HKey As Long
R = RegCreatekey(Key, sSubKey, HKey)
If R <> ERROR_NONE Then
CreateKey = False
Else
R = RegCloseKey(HKey)
CreateKey = True
End If
End Function
Public Function DeleteKey(Key As HKey_Type, SubKey As String) As Boolean
R = RegDeleteKey(Key, SubKey)
If R = ERROR_NONE Then
DeleteKey = True
Else
DeleteKey = False
End If
End Function
Public Function WriteString(Key As HKey_Type, SubKey As String, sName As String, sData As String) As Boolean
Dim HKey As Long
Dim D As Long
Dim S As SECURITY_ATTRIBUTES
S.nLength = Len(S)
S.lpSecurityDescriptor = 0
S.bInheritHandle = 1
R = RegCreateKeyEx(Key, SubKey, 0, "", 0, KEY_WRITE, S, HKey, D)
If R <> ERROR_NONE Then
WriteString = False
Exit Function
End If
R = RegSetValueEx(HKey, sName, 0, REG_SZ, ByVal sData, Len(sData))
If R <> ERROR_NONE Then
WriteString = False
Exit Function
End If
R = RegCloseKey(HKey)
WriteString = True
End Function
Public Function ReadString(Key As HKey_Type, SubKey As String, sName As String, Optional sDefault As String = "") As String
Dim HKey As Long
Dim sBuffer As String
Dim slength As Long
Dim DataType As Long
R = RegOpenKeyEx(Key, SubKey, 0, KEY_ALL_ACCESS, HKey)
If R <> ERROR_NONE Then
ReadString = sDefault
Exit Function
End If
sBuffer = Space(255)
slength = 255
R = RegQueryValueEx(HKey, sName, 0, DataType, ByVal sBuffer, slength)
If R = ERROR_NONE Then
If DataType = REG_SZ Or DataType = REG_EXPAND_SZ Then
sBuffer = Left(sBuffer, slength - 1)
ReadString = sBuffer
Else
ReadString = sDefault
End If
Else
ReadString = sDefault
End If
R = RegCloseKey(HKey)
End Function
Public Function WriteDWord(Key As HKey_Type, SubKey As String, sName As String, lData As Long) As Boolean
Dim HKey As Long
Dim D As Long
Dim S As SECURITY_ATTRIBUTES
S.nLength = Len(S)
S.lpSecurityDescriptor = 0
S.bInheritHandle = 1
R = RegCreateKeyEx(Key, SubKey, 0, "", 0, KEY_WRITE, S, HKey, D)
If R <> ERROR_NONE Then
WriteDWord = False
Exit Function
End If
R = RegSetValueEx(HKey, sName, 0&, REG_DWORD, lData, 4)
If R = ERROR_NONE Then
WriteDWord = True
Else
WriteDWord = False
End If
R = RegCloseKey(HKey)
End Function
Public Function ReadDWord(Key As HKey_Type, SubKey As String, sName As String, Optional lDefault As Long = 0) As Long
Dim HKey As Long
Dim DataType As Long
Dim lBuffer As Long
R = RegOpenKeyEx(Key, SubKey, 0, KEY_ALL_ACCESS, HKey)
If R <> ERROR_NONE Then
ReadDWord = lDefault
Exit Function
End If
R = RegQueryValueEx(HKey, sName, 0, DataType, lBuffer, 4)
If R = ERROR_NONE Then
If DataType = REG_DWORD Then
ReadDWord = lBuffer
Else
ReadDWord = lDefault
End If
Else
ReadDWord = lDefault
End If
R = RegCloseKey(HKey)
End Function
Public Function WriteBinary(Key As HKey_Type, SubKey As String, sName As String, byData() As Byte) As Boolean
Dim HKey As Long
Dim D As Long
Dim S As SECURITY_ATTRIBUTES
S.nLength = Len(S)
S.lpSecurityDescriptor = 0
S.bInheritHandle = 1
R = RegCreateKeyEx(Key, SubKey, 0, "", 0, KEY_WRITE, S, HKey, D)
If R <> ERROR_NONE Then
WriteBinary = False
Exit Function
End If
R = RegSetValueEx(HKey, sName, 0&, REG_BINARY, byData(0), UBound(byData) + 1)
If R = ERROR_NONE Then
WriteBinary = True
Else
WriteBinary = False
End If
R = RegCloseKey(HKey)
End Function
Public Function ReadBinary(Key As HKey_Type, SubKey As String, sName As String, Optional byDefault As Variant = 0) As Variant
Dim HKey As Long
Dim DataType As Long
Dim Buffer() As Byte
Dim FerSize As Long
Dim DefArray(0) As Byte
DefArray(0) = 0
R = RegOpenKeyEx(Key, SubKey, 0, KEY_ALL_ACCESS, HKey)
If R <> ERROR_NONE Then
If VarType(byDefault) = vbArray + vbByte Then
ReadBinary = byDefault
Else
ReadBinary = 0
End If
Exit Function
End If
R = RegQueryValueEx(HKey, sName, 0&, DataType, ByVal 0&, FerSize)
If R = ERROR_NONE Then
If DataType = REG_BINARY Then
ReDim Buffer(FerSize - 1)
R = RegQueryValueEx(HKey, sName, 0&, DataType, Buffer(0), FerSize)
ReadBinary = Buffer
Else
If VarType(byDefault) = vbArray + vbByte Then
ReadBinary = byDefault
Else
ReadBinary = DefArray
End If
End If
Else
If VarType(byDefault) = vbArray + vbByte Then
ReadBinary = byDefault
Else
ReadBinary = DefArray
End If
End If
R = RegCloseKey(HKey)
End Function
مشکل اینه که مسیر رو اشتباه میره هر چقدر بگید از کلاس های متفاوت استفاده کردم همشون با این مشکل روبرو میشن انگار توی وژوال بیسیک نمیشه به کلید HKEY_LOCAL_MACHINE دسترسی داشته باشیم حالت 64 یا 32 بیتی هم چک میکنم باز هم میره توی مسیر HKEY_CLASSES_ROOT کلید هارو میسازه
کاری که من میخوام انجام بدم اینه که یک DLL رو به رجستری معرفی کنم وقتی با فایل .REG اجرا میکنم کلید ها ساخته میشه و فایل معرفی میشه و کار میکنه ولی توی وی بی اشتباه ساخته میشه آیا راهی هست؟
پاسخ با نقل قول