by Kaustubh Zoal (10 Submissions)
Category: Windows API Call/Explanation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 21st June 2002
Date Added: Mon 8th February 2021
Rating: (1 Votes)
This program clears the registry values for the RUN Command.
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Const EWX_LOGOFF = 0
Const EWX_FORCE = 4
Const RunMRUList = "abcdefghijklmnopqrstuvwxyz"
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
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 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 Sub Form_Unload(Cancel As Integer)
Clipboard.Clear
End Sub
Private Sub cmdAdd_Click()
Call AddNewKeyValue
If lstRunList.ListCount > 0 Then
cmdDsiplay.Enabled = True
cmdClearAll.Enabled = True
cmdDelete.Enabled = True
cmdCopy.Enabled = True
End If
End Sub
Private Sub cmdClearAll_Click()
lblMessage.Caption = "Please wait, deleting all values"
Call DeleteAllKeyValues
lblMessage.Caption = "0 Key values in registry."
lstRunList.Clear
If MsgBox("In order to refresh the cleared settings, you need to log of." & vbCrLf & _
"Do you want to logoff now? [Yes/No]" & vbCrLf & _
" Save all your work before clicking on YES", vbQuestion + vbYesNo, "Logoff User") = vbYes Then
Call ExitWindowsEx(EWX_LOGOFF, EWX_FORCE)
Else
cmdDsiplay.Enabled = False
cmdClearAll.Enabled = False
cmdDelete.Enabled = False
cmdCopy.Enabled = False
End If
End Sub
Private Sub cmdCopy_Click()
If lstRunList.ListIndex > 0 Then
Call Clipboard.SetText(lstRunList.List(lstRunList.ListIndex), 1)
lblMessage.Caption = lstRunList.List(lstRunList.ListIndex) & " copied in memory."
End If
End Sub
Private Sub cmdDelete_Click()
Call DeleteKey
lblMessage.Caption = IIf(lstRunList.ListCount <= 0, 0, lstRunList.ListCount) & " Key values found in registry."
If lstRunList.ListCount <= 0 Then
cmdDsiplay.Enabled = False
cmdClearAll.Enabled = False
cmdDelete.Enabled = False
cmdCopy.Enabled = False
End If
End Sub
Private Sub cmdDsiplay_Click()
Call GetValuefromRegistry
lblMessage.Caption = IIf(lstRunList.ListCount <= 0, 0, lstRunList.ListCount) & " Key values found in registry."
If lstRunList.ListCount > 0 Then
cmdDsiplay.Enabled = True
cmdClearAll.Enabled = True
cmdDelete.Enabled = True
cmdCopy.Enabled = True
End If
End Sub
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
'retrieve information about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Save a string to the key
RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
'close the key
RegCloseKey Ret
End Sub
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Set the key's value
RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(strData), 4
'close the key
RegCloseKey Ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Delete the key's value
RegDeleteValue Ret, strValue
'close the key
RegCloseKey Ret
End Sub
Private Function GetValuefromRegistry() As String
Dim iCharCount As Integer
iCharCount = 1
lstRunList.Clear
While iCharCount <> 26
Ret = GetString(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\RUNMRU", Mid(RunMRUList, iCharCount, 1))
If Ret <> "" Then
lstRunList.AddItem Left(Ret, Len(Ret) - 2)
lstRunList.ItemData(lstRunList.NewIndex) = Asc(Mid(RunMRUList, iCharCount))
End If
iCharCount = iCharCount + 1
Wend
End Function
Private Sub DeleteKey()
If lstRunList.ListIndex < 0 Then
MsgBox "Select the value you want to delete.", vbInformation, "Delete Key Value"
Exit Sub
End If
DelSetting HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\RUNMRU", Chr(lstRunList.ItemData(lstRunList.ListIndex))
MsgBox lstRunList.List(lstRunList.ListIndex) & " value was deleted successfully", vbInformation + vbOKOnly, "Delete Key Value"
lstRunList.RemoveItem lstRunList.ListIndex
lstRunList.Refresh
End Sub
Private Sub DeleteAllKeyValues()
Dim iCharCount As Integer
iCharCount = 1
While iCharCount <> 26
DelSetting HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\RUNMRU", Mid(RunMRUList, iCharCount, 1)
iCharCount = iCharCount + 1
Wend
MsgBox "All key values deleted.", vbInformation, "Delete All Key Values"
End Sub
Private Sub AddNewKeyValue()
Dim iCharCount As Integer
Dim sNewKeyValue As String
sNewKeyValue = InputBox("Enter the new value you want to add...", "Add new value", "")
If sNewKeyValue = "" Then Exit Sub
For iCharCount = 1 To 26
Ret = GetString(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\RUNMRU", Mid(RunMRUList, iCharCount, 1))
If Ret = "" Then
Call SaveString(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\RunMRU", Mid(RunMRUList, iCharCount, 1), sNewKeyValue & "\1")
Exit For
End If
Next iCharCount
MsgBox "New key value added.", vbInformation, "Add new key"
Call GetValuefromRegistry
End Sub