Member_2_1348041
asked on
Piddle!
VB6
Hi experts.
Given a path I would like to be able to retrieve the Pidl
Whoa! Stop! Not so fast!
I've heard of SHSimpleIDListFromPath, and of SHILCreateFromPath
Those are fine and dandy, except, all they give you is a pointer - a Long.
I need more than just a long. I need to get my grubby little hands on all them lurvely bytes. If I KNEW that the number of bytes was fixed I could do something with a copymem. But I don't know that, and I don't get any definitive answers anywhere.
But I can't figure out how to get from having the pointer to establishing what all those bytes are. I didn't find anything helpful on t'internet.
Cheers
Hi experts.
Given a path I would like to be able to retrieve the Pidl
Whoa! Stop! Not so fast!
I've heard of SHSimpleIDListFromPath, and of SHILCreateFromPath
Those are fine and dandy, except, all they give you is a pointer - a Long.
I need more than just a long. I need to get my grubby little hands on all them lurvely bytes. If I KNEW that the number of bytes was fixed I could do something with a copymem. But I don't know that, and I don't get any definitive answers anywhere.
But I can't figure out how to get from having the pointer to establishing what all those bytes are. I didn't find anything helpful on t'internet.
Cheers
ASKER
forget it. That is clearly a red herring. Back to Square One
the double 00 00 is where the string ends. C string notation.
ASKER
Except there are a lot of 00 00s in the middle of the Pidls I found. I think there might be one within each Item ID?
yes, exactly.
so, you need to "split" the result by the "00 00", and the full result is ended by "00 00 00 00"
so, you need to "split" the result by the "00 00", and the full result is ended by "00 00 00 00"
ASKER
No, that doesn't seem to be it either. In the Pidl I am looking at there is a series of 19 consecutive "00"s embedded in the middle of the Pidl (that rhymes!)
You'd think that given a Long handle for a Pidl ... surely there would be a simple API call that would give you the length in bytes somehow? Or am I being naive? I've been known to be naive in the past so it is a strong possibility.
Once I have the pointer to the first byte, and the length in bytes it should be a simple CopyMem into a byte array that has been suitably initialised?
You'd think that given a Long handle for a Pidl ... surely there would be a simple API call that would give you the length in bytes somehow? Or am I being naive? I've been known to be naive in the past so it is a strong possibility.
Once I have the pointer to the first byte, and the length in bytes it should be a simple CopyMem into a byte array that has been suitably initialised?
ok, let's see: why do you need that PIDL, actually?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hello angelIII, egl1044,
Ok, let me elaborate a bit on the background of this request.
In Microsoft Office it is possible to change the default "places" that appear in the toolbar on the left in the Save As or Open dialogs. This corresponds with a Registry key:
HKEY_CURRENT_USER\Software \Microsoft \Office\11 .0\Common\ Open Find\Places\UserDefinedPla ces
Each path is represented by a "PlaceN" subkey, starting with "Place0", then "Place1" etc.
In that key there is a Name value and a Pidl value. The Pidl value is REG_BINARY. There are also some DWORD values but I won't go into those.
You can easily try this yourself. Go into, say, "Word", and go Save As, browse to a folder, and then in the Save As dialog click on Tools and go Add to My Places. After that you can see it in your own registry.
The problem is this: we want to create a bit of software that monitors a particular folder. Then, whenever a document is dropped into that folder, it will notice, and launch an action. Now then, as soon as this monitor program is launched, and it is running in the background, I want to add the folder that we are monitoring to "My Places". And when the monitor program is closed I want to revert back to normal.
I therefore need to add it programmatically. Now I *KNOW* that you can get away with just writing the Name and a Path variable, and the first time you use Save As in an MS Office product it will do the conversion from Path to Pidl in the background. I do know that. So I could just leave it at that. But I'm a geek and I want to know how it's done.
It's very easy to read the Pidl out of the registry, and use SHGetPathFromIDList to convert it to the actual Path in string format. All I need to do is read the data into a byte array, and pass the VarPtr to byte 0 as the first parameter. Robert's your mother's brother.
But if I wanted to WRITE a Pidl to the registry, this isn't good enough. SHSimpleIDListFromPath, and  SHILCreateFromPath don't produce Byte Arrays, they produce only a pointer (which, btw, doesn't appear to work for me either, it always seems to come back as 0 - and any documentation on t' web hints at these functions being deprecated? So what is current then?)
The pointer would be grand if only I knew how many bytes to retrieve. But I don't. So I'm stuck.
Cheers
Pino
Ok, let me elaborate a bit on the background of this request.
In Microsoft Office it is possible to change the default "places" that appear in the toolbar on the left in the Save As or Open dialogs. This corresponds with a Registry key:
HKEY_CURRENT_USER\Software
Each path is represented by a "PlaceN" subkey, starting with "Place0", then "Place1" etc.
In that key there is a Name value and a Pidl value. The Pidl value is REG_BINARY. There are also some DWORD values but I won't go into those.
You can easily try this yourself. Go into, say, "Word", and go Save As, browse to a folder, and then in the Save As dialog click on Tools and go Add to My Places. After that you can see it in your own registry.
The problem is this: we want to create a bit of software that monitors a particular folder. Then, whenever a document is dropped into that folder, it will notice, and launch an action. Now then, as soon as this monitor program is launched, and it is running in the background, I want to add the folder that we are monitoring to "My Places". And when the monitor program is closed I want to revert back to normal.
I therefore need to add it programmatically. Now I *KNOW* that you can get away with just writing the Name and a Path variable, and the first time you use Save As in an MS Office product it will do the conversion from Path to Pidl in the background. I do know that. So I could just leave it at that. But I'm a geek and I want to know how it's done.
It's very easy to read the Pidl out of the registry, and use SHGetPathFromIDList to convert it to the actual Path in string format. All I need to do is read the data into a byte array, and pass the VarPtr to byte 0 as the first parameter. Robert's your mother's brother.
But if I wanted to WRITE a Pidl to the registry, this isn't good enough. SHSimpleIDListFromPath, and  SHILCreateFromPath don't produce Byte Arrays, they produce only a pointer (which, btw, doesn't appear to work for me either, it always seems to come back as 0 - and any documentation on t' web hints at these functions being deprecated? So what is current then?)
The pointer would be grand if only I knew how many bytes to retrieve. But I don't. So I'm stuck.
Cheers
Pino
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Yes, that's what I said :-)
What I'd like to do is replace the bit where you set the "Path" value with one where you write the actual Pidl
I know, I know. I'm a geek.
However, I think I may have made a bit of progress. I just found out a couple of small things:
Firstly, there is an ILCreateFromPath function that appears to be current. It, too returns a Long.
Secondly, the reason the functions were returning 0 is due to the format of the string. I should convert the string to Unicode. Doing that gets it to return data no problem.
Finally, there is an ILGetSize function. I think that with that I can get what I need.
Watch this space, I'll let you know what I find.
Pino
What I'd like to do is replace the bit where you set the "Path" value with one where you write the actual Pidl
I know, I know. I'm a geek.
However, I think I may have made a bit of progress. I just found out a couple of small things:
Firstly, there is an ILCreateFromPath function that appears to be current. It, too returns a Long.
Secondly, the reason the functions were returning 0 is due to the format of the string. I should convert the string to Unicode. Doing that gets it to return data no problem.
Finally, there is an ILGetSize function. I think that with that I can get what I need.
Watch this space, I'll let you know what I find.
Pino
ASKER
ok
First of all, as an aside and off topic for this particular thread, I used a Registry class that I found on the web. It does the job most of the time, BUT it has a bug in setting a registry value of type REG_BINARY. You pass in a byte array for that, and it calculated the size as Ubound - LBound [shock, horror] - 1
That should be PLUS 1, of course. A byte array Dim-ed as (1 to 5) has 5 elements, i.e. 5 - 1 + 1, and not 3 as it calculated as 5 - 1 - 1. It makes no difference whether it is a 0-based array either. An array Dim-ed (0 to 4) still has 4 - 0 + 1 = 5 elements, and not 4 - 0 - 1 = 3 !
Annoying when you have to fix bugs like that :-)
First of all, as an aside and off topic for this particular thread, I used a Registry class that I found on the web. It does the job most of the time, BUT it has a bug in setting a registry value of type REG_BINARY. You pass in a byte array for that, and it calculated the size as Ubound - LBound [shock, horror] - 1
That should be PLUS 1, of course. A byte array Dim-ed as (1 to 5) has 5 elements, i.e. 5 - 1 + 1, and not 3 as it calculated as 5 - 1 - 1. It makes no difference whether it is a 0-based array either. An array Dim-ed (0 to 4) still has 4 - 0 + 1 = 5 elements, and not 4 - 0 - 1 = 3 !
Annoying when you have to fix bugs like that :-)
' #VBIDEUtils#************************************************************
' * Programmer Name : Steve McMahon
' * Web Site : http://www.dogma.demon.co.uk/
' * E-Mail : steve@dogma.demon.co.uk
' * Date : 25/09/98
' * Time : 14:49
' * Module Name : class_Registry
' * Module Filename : Registry.cls
' **********************************************************************
' * Comments : This class is an easy, self-contained way to get
' * complete access to the Windows registry.
' * Simple methods allow you to create, enumerate and delete keys
' * and values in the registry, without restriction.
' * You can even read/write binary data to the registry.
' *
' * Example :
' * get a String Value from the Registry
' * Dim clsRegistry As New class_Registry
' * With clsRegistry
' * .ClassKey = HKEY_LOCAL_MACHINE
' * .SectionKey = "Software\PrintPreview"
' * .ValueKey = "Version"
' * .ValueType = REG_SZ
' * sTip = .Value
' * End With
' *
' * Save a Form's position to the Registry
' * Dim clsRegistry As New class_Registry
' * With clsRegistry
' * .ClassKey = HKEY_CURRENT_USER
' * ' You don't need to check if this key already exists
' * ' - the class will create it for you
' * .SectionKey = "Software\" & App.EXEName & "\" & frmThis.name
' * .ValueKey = "Maximized"
' * .ValueType = REG_DWORD
' * .Value = (frmThis.WindowState = vbMaximized)
' * If (frmThis.WindowState <> vbMaximized)
' * .ValueKey = "Left"
' * .Value = frmThis.Left
' * .ValueKey = "Top"
' * .Value = frmThis.Top
' * .ValueKey = "Width"
' * .Value = frmThis.Width
' * .ValueKey = "Height"
' * .Value = frmThis.Height
' * End If
' * End With
' *
' **********************************************************************
Option Explicit
' *** Registry Specific Access Rights
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = &H3F
' *** Open/Create Options
Private Const REG_OPTION_NON_VOLATILE = 0&
Private Const REG_OPTION_VOLATILE = &H1
' *** Key creation/open disposition
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2
' *** masks for the predefined standard access types
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
' *** Define severity codes
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234 ' *** dderror
Private Const ERROR_NO_MORE_ITEMS = 259
' *** Structures Needed For Registry Prototypes
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
' *** Registry Function Prototypes
Private Declare Function RegOpenKeyEx Lib "Advapi32" 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 RegSetValueExStr Lib "Advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "Advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExByte Lib "Advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "Advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueExStr Lib "Advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "Advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExByte Lib "Advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, szData As Byte, ByRef lpcbData 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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition 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, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) 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 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, ByVal lpType As Long, ByVal lpData As Long, ByVal lpcbData As Long) As Long
Private Declare Function RegEnumValueLong 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 Long, lpcbData As Long) As Long
Private Declare Function RegEnumValueStr 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, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumValueByte 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 RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As Any) 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
' *** Other declares:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Public Enum ERegistryClassConstants
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
Public Enum ERegistryValueTypes
' *** Predefined Value Types
REG_NONE = (0) ' *** No value type
REG_SZ = (1) ' *** Unicode nul terminated string
REG_EXPAND_SZ = (2) ' *** Unicode nul terminated string w/enviornment var
REG_BINARY = (3) ' *** Free form binary
REG_DWORD = (4) ' *** 32-bit number
REG_DWORD_LITTLE_ENDIAN = (4) ' *** 32-bit number (same as REG_DWORD)
REG_DWORD_BIG_ENDIAN = (5) ' *** 32-bit number
REG_LINK = (6) ' *** Symbolic Link (unicode)
REG_MULTI_SZ = (7) ' *** Multiple Unicode strings
REG_RESOURCE_LIST = (8) ' *** Resource list in the resource map
REG_FULL_RESOURCE_DESCRIPTOR = (9) ' *** Resource list in the hardware description
REG_RESOURCE_REQUIREMENTS_LIST = (10)
End Enum
Private m_hClassKey As Long
Private m_sSectionKey As String
Private m_sValueKey As String
Private m_vValue As Variant
Private m_sSetValue As String
Private m_vDefault As Variant
Private m_eValueType As ERegistryValueTypes
Public Property Get KeyExists() As Boolean
' *** KeyExists = bCheckKeyExists( _
' *** m_hClassKey, _
' *** m_sSectionKey _
' *** )
Dim hKey As Long
If RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, 1, hKey) = ERROR_SUCCESS Then
KeyExists = True
RegCloseKey hKey
Else
KeyExists = False
End If
End Property
Public Function CreateKey() As Boolean
Dim tSA As SECURITY_ATTRIBUTES
Dim hKey As Long
Dim lCreate As Long
Dim e As Long
' *** Open or Create the key
e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
If e Then
Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to create registry Key: ' *** " & m_sSectionKey
Else
CreateKey = (e = ERROR_SUCCESS)
' *** Close the key
RegCloseKey hKey
End If
End Function
Public Function DeleteKey() As Boolean
Dim e As Long
e = RegDeleteKey(m_hClassKey, m_sSectionKey)
If e Then
Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to delete registry Key: ' *** " & m_hClassKey & "' *** ,Section: ' *** " & m_sSectionKey
Else
DeleteKey = (e = ERROR_SUCCESS)
End If
End Function
Public Function DeleteValue() As Boolean
Dim e As Long
Dim hKey As Long
e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ALL_ACCESS, hKey)
If e Then
Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to open key ' *** " & m_hClassKey & "' *** ,Section: ' *** " & m_sSectionKey & "' *** for delete access"
Else
e = RegDeleteValue(hKey, m_sValueKey)
If e Then
Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to delete registry Key: ' *** " & m_hClassKey & "' *** ,Section: ' *** " & m_sSectionKey & "' *** ,Key: ' *** " & m_sValueKey
Else
DeleteValue = (e = ERROR_SUCCESS)
End If
End If
End Function
Public Property Get Value() As Variant
Dim vValue As Variant
Dim cData As Long
Dim sData As String
Dim ordType As Long
Dim e As Long
Dim hKey As Long
e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
' *** ApiRaiseIf e
e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, 0&, cData)
If e And e <> ERROR_MORE_DATA Then
Value = m_vDefault
Exit Property
End If
m_eValueType = ordType
Select Case ordType
Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
Dim iData As Long
e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, iData, cData)
vValue = CLng(iData)
Case REG_DWORD_BIG_ENDIAN ' *** Unlikely, but you never know
Dim dwData As Long
e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, dwData, cData)
vValue = SwapEndian(dwData)
Case REG_SZ, REG_MULTI_SZ ' *** Same thing to Visual Basic
sData = String$(cData - 1, 0)
e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
vValue = sData
Case REG_EXPAND_SZ
sData = String$(cData - 1, 0)
e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
vValue = ExpandEnvStr(sData)
' *** Catch REG_BINARY and anything else
Case Else
Dim abData() As Byte
ReDim abData(cData)
e = RegQueryValueExByte(hKey, m_sValueKey, 0&, ordType, abData(0), cData)
vValue = abData
End Select
Value = vValue
End Property
Public Property Let Value(ByVal vValue As Variant)
Dim ordType As Long
Dim c As Long
Dim hKey As Long
Dim e As Long
Dim lCreate As Long
Dim tSA As SECURITY_ATTRIBUTES
' *** Open or Create the key
e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
If e Then
Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to set registry value Key: ' *** " & m_hClassKey & "' *** ,Section: ' *** " & m_sSectionKey & "' *** ,Key: ' *** " & m_sValueKey & "' *** to value: ' *** " & m_vValue & "' *** "
Else
Select Case m_eValueType
Case REG_BINARY
If (VarType(vValue) = vbArray + vbByte) Then
Dim ab() As Byte
ab = vValue
ordType = REG_BINARY
c = UBound(ab) - LBound(ab) + 1
e = RegSetValueExByte(hKey, m_sValueKey, 0&, ordType, ab(0), c)
Else
Err.Raise 26001
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN
If (VarType(vValue) = vbInteger) Or (VarType(vValue) = vbLong) Then
Dim i As Long
i = CLng(vValue)
ordType = REG_DWORD
e = RegSetValueExLong(hKey, m_sValueKey, 0&, ordType, i, 4)
End If
Case REG_SZ, REG_EXPAND_SZ
Dim s As String, iPos As Long
s = CStr(vValue)
ordType = REG_SZ
' *** Assume anything with two non-adjacent percents is expanded string
iPos = InStr(s, "%")
If iPos Then
If InStr(iPos + 2, s, "%") Then ordType = REG_EXPAND_SZ
End If
c = Len(s) + 1
e = RegSetValueExStr(hKey, m_sValueKey, 0&, ordType, s, c)
' *** User should convert to a compatible type before calling
Case Else
e = ERROR_INVALID_DATA
End Select
If Not e Then
m_vValue = vValue
Else
Err.Raise vbObjectError + 1048 + 26001, App.EXEName & ".cRegistry", "Failed to set registry value Key: ' *** " & m_hClassKey & "' *** ,Section: ' *** " & m_sSectionKey & "' *** ,Key: ' *** " & m_sValueKey & "' *** to value: ' *** " & m_vValue & "' *** "
End If
' *** Close the key
RegCloseKey hKey
End If
End Property
Public Function EnumerateValues(ByRef sKeyNames() As String, ByRef iKeyCount As Long) As Boolean
Dim lResult As Long
Dim hKey As Long
Dim sName As String
Dim lNameSize As Long
Dim sData As String
Dim lIndex As Long
Dim cJunk As Long
Dim cNameMax As Long
Dim ft As Currency
' *** Log "EnterEnumerateValues"
iKeyCount = 0
Erase sKeyNames()
lIndex = 0
lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
If (lResult = ERROR_SUCCESS) Then
' *** Log "OpenedKey:" & m_hClassKey & "," & m_sSectionKey
lResult = RegQueryInfoKey(hKey, "", cJunk, 0, cJunk, cJunk, cJunk, cJunk, cNameMax, cJunk, cJunk, ft)
Do While lResult = ERROR_SUCCESS
' *** Set buffer space
lNameSize = cNameMax + 1
sName = String$(lNameSize, 0)
If (lNameSize = 0) Then lNameSize = 1
' *** Log "Requesting Next Value"
' *** Get value name:
lResult = RegEnumValue(hKey, lIndex, sName, lNameSize, 0&, 0&, 0&, 0&)
' *** Log "RegEnumValue returned:" & lResult
If (lResult = ERROR_SUCCESS) Then
' *** Although in theory you can also retrieve the actual
' *** value and type here, I found it always (ultimately) resulted in
' *** a GPF, on Win95 and NT. Why? Can anyone help?
sName = Left$(sName, lNameSize)
' *** Log "Enumerated value:" & sName
iKeyCount = iKeyCount + 1
ReDim Preserve sKeyNames(1 To iKeyCount) As String
sKeyNames(iKeyCount) = sName
End If
lIndex = lIndex + 1
Loop
End If
If (hKey <> 0) Then
RegCloseKey hKey
End If
' *** Log "Exit Enumerate Values"
EnumerateValues = True
Exit Function
EnumerateValuesError:
If (hKey <> 0) Then
RegCloseKey hKey
End If
Err.Raise vbObjectError + 1048 + 26003, App.EXEName & ".cRegistry", Err.Description
Exit Function
End Function
Public Function EnumerateSections(ByRef sSect() As String, ByRef iSectCount As Long) As Boolean
Dim lResult As Long
Dim hKey As Long
Dim dwReserved As Long
Dim szBuffer As String
Dim lBuffSize As Long
Dim lIndex As Long
Dim lType As Long
Dim sCompKey As String
Dim iPos As Long
On Error GoTo EnumerateSectionsError
iSectCount = 0
Erase sSect
' ***
lIndex = 0
lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
Do While lResult = ERROR_SUCCESS
' *** Set buffer space
szBuffer = String$(255, 0)
lBuffSize = Len(szBuffer)
' *** Get next value
lResult = RegEnumKey(hKey, lIndex, szBuffer, lBuffSize)
If (lResult = ERROR_SUCCESS) Then
iSectCount = iSectCount + 1
ReDim Preserve sSect(1 To iSectCount) As String
iPos = InStr(szBuffer, Chr$(0))
If (iPos > 0) Then
sSect(iSectCount) = Left(szBuffer, iPos - 1)
Else
sSect(iSectCount) = Left(szBuffer, lBuffSize)
End If
End If
lIndex = lIndex + 1
Loop
If (hKey <> 0) Then
RegCloseKey hKey
End If
EnumerateSections = True
Exit Function
EnumerateSectionsError:
If (hKey <> 0) Then
RegCloseKey hKey
End If
Err.Raise vbObjectError + 1048 + 26002, App.EXEName & ".cRegistry", Err.Description
Exit Function
End Function
Public Sub CreateEXEAssociation(ByVal sExePath As String, ByVal sClassName As String, ByVal sClassDescription As String, ByVal sAssociation As String, Optional ByVal lDefaultIconIndex As Long = -1)
ClassKey = HKEY_CLASSES_ROOT
SectionKey = "." & sAssociation
ValueKey = ""
Value = sClassName
SectionKey = "." & sAssociation & "\shell\open\command"
ValueKey = ""
Value = sExePath & " ""%1"""
SectionKey = sClassName
ValueKey = ""
Value = sClassDescription
SectionKey = sClassName & "\shell\open\command"
ValueKey = sExePath & " ""%1"""
If lDefaultIconIndex > -1 Then
SectionKey = sClassName & "\DefaultIcon"
ValueKey = ""
Value = sExePath & "," & CStr(lDefaultIconIndex)
End If
End Sub
Public Property Get ValueType() As ERegistryValueTypes
ValueType = m_eValueType
End Property
Public Property Let ValueType(ByVal eValueType As ERegistryValueTypes)
m_eValueType = eValueType
End Property
Public Property Get ClassKey() As ERegistryClassConstants
ClassKey = m_hClassKey
End Property
Public Property Let ClassKey(ByVal eKey As ERegistryClassConstants)
m_hClassKey = eKey
End Property
Public Property Get SectionKey() As String
SectionKey = m_sSectionKey
End Property
Public Property Let SectionKey(ByVal sSectionKey As String)
m_sSectionKey = sSectionKey
End Property
Public Property Get ValueKey() As String
ValueKey = m_sValueKey
End Property
Public Property Let ValueKey(ByVal sValueKey As String)
m_sValueKey = sValueKey
End Property
Public Property Get Default() As Variant
Default = m_vDefault
End Property
Public Property Let Default(ByVal vDefault As Variant)
m_vDefault = vDefault
End Property
Private Function SwapEndian(ByVal dw As Long) As Long
CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1
CopyMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
CopyMemory SwapEndian, ByVal VarPtr(dw) + 3, 1
End Function
Private Function ExpandEnvStr(sData As String) As String
Dim c As Long, s As String
' *** Get the length
s = "" ' *** Needed to get around Windows 95 limitation
c = ExpandEnvironmentStrings(sData, s, c)
' *** Expand the string
s = String$(c - 1, 0)
c = ExpandEnvironmentStrings(sData, s, c)
ExpandEnvStr = s
End Function
Public Function GetRegistrySetting(nKeyRoot As ERegistryClassConstants, sKeyName As String, sSubKeyRef As String, sDefault As String, Optional vValueType As ERegistryValueTypes = REG_EXPAND_SZ) As String
' *** Return the value of a settings in the registry
ClassKey = nKeyRoot
SectionKey = sKeyName
ValueKey = sSubKeyRef
Default = sDefault
ValueType = vValueType
GetRegistrySetting = Value
End Function
Public Sub SetRegistrySetting(nKeyRoot As ERegistryClassConstants, sSubKeyRef As String, sKeyName As String, sValue As String, Optional vValueType As ERegistryValueTypes = REG_EXPAND_SZ)
' *** Set a value in the registry
ClassKey = nKeyRoot
SectionKey = sSubKeyRef
ValueKey = sKeyName
ValueType = vValueType
Value = sValue
End Sub
ASKER
Offending piece of code:
Public Property Let Value(ByVal vValue As Variant)
Dim ordType As Long
Dim c As Long
Dim hKey As Long
Dim e As Long
Dim lCreate As Long
Dim tSA As SECURITY_ATTRIBUTES
' *** Open or Create the key
e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
If e Then
Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to set registry value Key: ' *** " & m_hClassKey & "' *** ,Section: ' *** " & m_sSectionKey & "' *** ,Key: ' *** " & m_sValueKey & "' *** to value: ' *** " & m_vValue & "' *** "
Else
Select Case m_eValueType
Case REG_BINARY
If (VarType(vValue) = vbArray + vbByte) Then
Dim ab() As Byte
ab = vValue
ordType = REG_BINARY
'''AAARRGGHHH c = UBound(ab) - LBound(ab) - 1 '<--- EEEEEEEEEKKKK!!!!!! SHOULD BE:
c = UBound(ab) - LBound(ab) + 1 '<--- THAT's better.
e = RegSetValueExByte(hKey, m_sValueKey, 0&, ordType, ab(0), c)
Else
Err.Raise 26001
End If
ASKER
Other than that, all you need is these declarations:
Private Declare Function ILCreateFromPath Lib "shell32" (ByVal sPath As String) As Long
Private Declare Function ILGetSize Lib "shell32" (ByVal lPidl As Long) As Long
Private Declare Sub ILFree Lib "shell32" (ByVal lPidl As Long)
Private Declare Sub CopyMemLong _
Lib "kernel32" _
Alias "RtlMoveMemory" _
(ByVal Destination As Long, _
ByVal Source As Long, _
ByVal Length As Long)
ASKER
And other than that it's just a case of:
Dim lOut As Long
Dim lPidlLen As Long
Dim bytData() As Byte
'[...]
lOut = ILCreateFromPath(StrConv(msPersonalPath, vbUnicode))
lPidlLen = ILGetSize(lOut)
ReDim bytData(0 To lPidlLen - 1)
CopyMemLong VarPtr(bytData(0)), lOut, lPidlLen
ILFree lOut
objReg.ValueKey = "Pidl"
objReg.ValueType = REG_BINARY
objReg.Value = bytData
ASKER
Oops. Obviously msPersonalPath is a string that contains the Path.
ASKER
I've just split the points between you two. I know I figured it out myself but I'm not stingy. Enjoy.
Produced by Rozeboosje
25 February 2009
Thank you for watchiing
Re-boot your mind
Produced by Rozeboosje
25 February 2009
Thank you for watchiing
Re-boot your mind
ASKER
> watchiing
damn this bouncy keyboard :-)
damn this bouncy keyboard :-)
ASKER
Was that a coincidence, or could I use that information to establish where a Pidl ends?