-
I am killing some time by making a smallish little prog to assist me in cleaning my recent file list in VB6. Well, it delete's values fine. But, I also go threw and back up all the remaning value's in an array and then clear the whole file list so that I can re-enter the list in the proper number order. This works too, except the file paths end up being wrecked into some wierd ascii mess. Bellow is all the code for the app.
There are 2 command buttons and two list boxes
1st Command Button: cmdDel
2nd Command Button: cmdCncl
1st ListBox: lstRF_Num
2nd ListBox: lstRF
you can make the form and paste this code in or just look it over.....
Code:
Option Explicit
'For contacting information see other module
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 HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_DYN_DATA = &H80000006
Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_BINARY = 3 ' Free form binary
Private Const REG_DWORD = 4 ' 32-bit number
Private Const REG_NONE = 0
Private Const ERROR_SUCCESS = 0&
Private Const KEY_ALL_ACCESS = &HF003F
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_EXECUTE = &H20019
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_READ = &H20019
Private Const KEY_SET_VALUE = &H2
Private Const KEY_WRITE = &H20006
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 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 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 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 RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName 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 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 Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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 Sub DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegDeleteValue(hCurKey, strValue)
lRegResult = RegCloseKey(hCurKey)
End Sub
Private Sub ListRF()
Dim valuename As String
Dim valuelen As Long
Dim datatype As Long
Dim data(0 To 254) As Byte
Dim datalen As Long
Dim datastring As String
Dim hKey As Long
Dim index As Long
Dim c As Long
Dim Retval As Long
'Clear the listboxes
lstRF.Clear
lstRF_Num.Clear
' Open the registry key to enumerate the values of.
Retval = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Visual Basic\6.0\RecentFiles", 0, KEY_QUERY_VALUE, hKey) ' Check to see if an error occured.
If Retval <> 0 Then
Debug.Print "Registry key could not be opened -- aborting."
End ' abort the program
End If
' Begin enumerating the values. Get each one, displaying its name.
index = 0 ' initialize the counter
While Retval = 0 'Loop While successful
' Initialize the value name buffer.
valuename = Space(255) ' 255-space buffer
valuelen = 255 ' length of the string
datalen = 255 ' size of data buffer
' Get the next value to be enumerated
Retval = RegEnumValue(hKey, index, valuename, valuelen, 0, datatype, data(0), datalen)
If Retval = 0 Then ' if successful, display information
' Extract the useful information from the value name buffer and display it.
valuename = Left(valuename, valuelen)
lstRF_Num.AddItem valuename
' Determine the data type of the value and display it.
Select Case datatype
Case REG_SZ ' null-terminated string
' Copy the information from the byte array into the string.
' We subtract one because we don't want the trailing null.
datastring = Space(datalen - 1) ' make just enough room in the string
CopyMemory ByVal datastring, data(0), datalen - 1 ' copy useful data
lstRF.AddItem datastring
Case Else ' a data type this example doesn't handle
lstRF.AddItem "Unable to retrive data."
cmdDel.Enabled = False
End Select
End If
index = index + 1 ' increment the index counter
Wend ' end the loop
Call RegCloseKey(HKEY_CURRENT_USER)
End Sub
Private Sub ReNumKeys()
Dim SubKey As String
Dim Retval As Long
Dim hRegKey As Long
Dim i
Dim Str As String
Dim xyz() As String
SubKey = "Software\Microsoft\Visual Basic\6.0\RecentFiles"
ReDim xyz(1 To lstRF.ListCount) As String
'Make a copy of all the keys
For i = 0 To (lstRF.ListCount - 1)
lstRF.ListIndex = i
Str = lstRF.Text
xyz(i + 1) = Str
Next i 'i = 0 To (lstRF.ListCount - 1)
'loop through and delete the original keys
For i = 0 To (lstRF.ListCount - 1)
lstRF_Num.ListIndex = i
Call DeleteValue(HKEY_CURRENT_USER, "Software\Microsoft\Visual Basic\6.0\RecentFiles", lstRF_Num.Text)
Next i 'i = 0 To (lstRF.ListCount - 1)
'get the handle of the recent file list key
Retval = RegOpenKeyEx(HKEY_CURRENT_USER, SubKey, 0, KEY_WRITE, hRegKey)
'ReNumber and enter the keys
For i = 1 To UBound(xyz())
Retval = RegSetValueEx(hRegKey, i, 0, REG_SZ, xyz(i) & vbNullChar, Len(xyz(i)))
Next i 'i = 1 To UBound(xyz())
' Close the registry
Call RegCloseKey(HKEY_CURRENT_USER)
End Sub
Private Sub cmdCncl_Click()
Unload Me
End
End Sub
Private Sub cmdDel_Click()
DeleteValue HKEY_CURRENT_USER, "Software\Microsoft\Visual Basic\6.0\RecentFiles", lstRF_Num.Text
Dim x
x = lstRF.ListIndex
lstRF.RemoveItem (x)
lstRF_Num.RemoveItem (x)
ReNumKeys
ListRF
End Sub
Private Sub Form_Load()
ListRF
End Sub
Private Sub lstRF_Click()
lstRF_Num.ListIndex = lstRF.ListIndex
End Sub
Private Sub lstRF_Num_Click()
lstRF.ListIndex = lstRF_Num.ListIndex
End Sub
If anybody knows what the problem is please let me know.
Thanks
-
uhhhhhhhhhhhh
I'm starting to think you guys don't like me :(
Really, no body has any ideas
