Visual Basic'te Programınızı Denetim Masasında gözükmesini istiyorsanız aşağıdaki kodlar işinizi görecektir...
Option Explicit Private Declare Function RegCloseKey Lib "advapi32" ( _ ByVal hKey As Long) As Long Private Declare Function RegCreateKeyEx Lib "advapi32" _ 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, _ ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, _ ByRef phkResult As Long, _ ByRef lpdwDisposition As Long) As Long Private Declare Function RegOpenKeyEx Lib "advapi32" _ Alias "RegOpenKeyExA" ( _ ByVal hKey As Long, _ ByVal lpSubKey As String, _ ByVal ulOptions As Long, _ ByVal samDesired As Long, _ ByRef phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32" _ Alias "RegQueryValueExA" ( _ ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ ByRef lpType As Long, _ ByVal lpData As String, _ ByRef lpcbData As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32" _ 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 Private Declare Function RegSetValueExB Lib "advapi32.dll" _ Alias "RegSetValueExA" ( _ ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ ByVal dwType As Long, _ ByRef lpData As Byte, _ ByVal cbData 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 RegCreateKey Lib "advapi32.dll" _ Alias "RegCreateKeyA" ( _ ByVal hKey As Long, _ ByVal lpSubKey As String, _ phkResult As Long) As Long Const REG_SZ = 1 Const REG_EXPAND_SZ = 2 Const REG_BINARY = 3& Const REG_DWORD = 4 Const REG_OPTION_NON_VOLATILE = 0 Const READ_CONTROL = &H20000 Const KEY_QUERY_VALUE = &H1 Const KEY_SET_VALUE = &H2 Const KEY_CREATE_SUB_KEY = &H4 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const KEY_CREATE_LINK = &H20 Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL Const KEY_EXECUTE = KEY_READ Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL 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 ERROR_NONE = 0 Const ERROR_BADKEY = 2 Const ERROR_ACCESS_DENIED = 8 Const ERROR_SUCCESS = 0 Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Boolean End Type Dim hKey As Long, MainKeyHandle As Long Dim rtn As Long, lBuffer As Long, sBuffer As String Dim lBufferSize As Long Dim lDataSize As Long Dim ByteArray() As Byte Private Function UpdateKey(KeyRoot As Long, _ KeyName As String, _ SubKeyName As String, _ SubKeyValue As String) As Boolean Dim rc As Long Dim hKey As Long Dim hDepth As Long Dim lpAttr As SECURITY_ATTRIBUTES lpAttr.nLength = 50 lpAttr.lpSecurityDescriptor = 0 lpAttr.bInheritHandle = True rc = RegCreateKeyEx(KeyRoot, KeyName, 0, REG_SZ, _ REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _ hKey, hDepth) If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError If (SubKeyValue = "") Then SubKeyValue = " " End If rc = RegSetValueEx(hKey, SubKeyName, 0, REG_SZ, _ SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode))) If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError rc = RegCloseKey(hKey) UpdateKey = True Exit Function CreateKeyError: UpdateKey = False rc = RegCloseKey(hKey) End Function Private Function CreateKey(SubKey As String) Call ParseKey(SubKey, MainKeyHandle) If MainKeyHandle Then rtn = RegCreateKey(MainKeyHandle, SubKey, hKey) If rtn = ERROR_SUCCESS Then rtn = RegCloseKey(hKey) End If End If End Function Private Function DeleteKey(KeyName As String) Call ParseKey(KeyName, MainKeyHandle) If MainKeyHandle Then rtn = RegDeleteKey(MainKeyHandle, KeyName) End If End Function Private Function ErrorMsg(lErrorCode As Long) As String Select Case lErrorCode Case 1009, 1015 ErrorMsg = "The Registry Database is corrupt!" Case 2, 1010 ErrorMsg = "Bad Key Name" Case 1011 ErrorMsg = "Can't Open Key" Case 4, 1012 ErrorMsg = "Can't Read Key" Case 5 ErrorMsg = "Access to this key is denied" Case 1013 ErrorMsg = "Can't Write Key" Case 8, 14 ErrorMsg = "Out of memory" Case 87 ErrorMsg = "Invalid Parameter" Case 234 ErrorMsg = "There is more data than the buffer has been allocated to hold." Case Else ErrorMsg = "Undefined Error Code: " & Str$(lErrorCode) End Select End Function Private 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, "\") If Left(KeyName, 5) <> "HKEY_" Or Right(KeyName, 1) = "\" Then MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + KeyName Exit Sub ElseIf rtn = 0 Then Keyhandle = GetMainKeyHandle(KeyName) KeyName = "" Else Keyhandle = GetMainKeyHandle(Left(KeyName, rtn - 1)) KeyName = Right(KeyName, Len(KeyName) - rtn) End If End Sub Private Function SetBinaryValue(SubKey As String, Entry As String, _ Value As String, Optional ByVal DisplayErrorMsg As Boolean = True) Dim i As Long Call ParseKey(SubKey, MainKeyHandle) If MainKeyHandle Then rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) If rtn = ERROR_SUCCESS Then lDataSize = Len(Value) ReDim ByteArray(lDataSize) For i = 1 To lDataSize ByteArray(i) = Asc(Mid$(Value, i, 1)) Next rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, ByteArray(1), lDataSize) If Not rtn = ERROR_SUCCESS Then If DisplayErrorMsg = True Then MsgBox ErrorMsg(rtn) End If End If rtn = RegCloseKey(hKey) Else If DisplayErrorMsg = True Then MsgBox ErrorMsg(rtn) End If End If End If End Function Public Function CreateEntryToSystemPanel(GUID As String, _ Titel As String, _ ToolTipText As String, _ IconDatei As String, _ FileToOpen As String) UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID, "", Titel UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID, "InfoTip", ToolTipText UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID & "\DefaultIcon", "", IconDatei UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID & "\InProcServer32", "", "shell32.dll" UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID & "\InProcServer32", "ThreadingModel", "Apartment" UpdateKey HKEY_CLASSES_ROOT, "CLSID\" & GUID & "\Shell\Open\Command", "", FileToOpen Dim sKey As String sKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Exp lore r\" UpdateKey HKEY_LOCAL_MACHINE, sKey & "Desktop\NameSpace\" & GUID, "", "" UpdateKey HKEY_LOCAL_MACHINE, sKey & "ControlPanel\NameSpace\" & GUID, "", "" CreateKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\ShellFolder" SetBinaryValue "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\ShellFolder", _ "Attributes", Chr$(&H0) + Chr$(&H0) + Chr$(&H0) + Chr$(&H0) End Function Public Function DeleteEntryFromSystemPanel(GUID As String) Dim sKey As String sKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Exp lore r\" DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\DefaultIcon" DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\InProcServer32" DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\Shell\Open\Command" DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\ShellEx\PropertySheetHandlers\" & GUID & "" DeleteKey "HKEY_CLASSES_ROOT\CLSID\" & GUID & "\ShellFolder" DeleteKey "HKEY_LOCAL_MACHINE\" & sKey & "\Desktop\NameSpace\" & GUID DeleteKey "HKEY_LOCAL_MACHINE\" & sKey & "\ControlPanel\NameSpace\" & GUID End Function
Private Sub Command1_Click() '------------Denetim masasına giriş --------------- CreateEntryToSystemPanel "{9d6D8ED6-116D-4D4E-B1C2-87098DB509BA}", _ "dahi çocukk", _ "harikasın evlat", _ App.Path & "\" & "Yourapplication.exe,0", _ App.Path & "\" & "Yourapplication.exe -options" End Sub Private Sub Command2_Click() '---------------- denetim masasından silll ---------------- DeleteEntryFromSystemPanel "{9d6D8ED6-116D-4D4E-B1C2-87098DB509BA}" End Sub
İlk yorumu siz yazın !..