Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Calling SHGetKnownFolderPath in VFP 2

Status
Not open for further replies.
RobSpencer

RobSpencer

Programmer
Dec 5, 2013
19
AU
In thread184-1539853 Olaf listed links to the Microsoft documentation page for SHGetKnownFolderPath but I can't work out how to call it as the first parameter is a reference to a GUID. It's the only function I know that will give me access to the full array of pre-defined folders in Windows 8.1 (eg Skydrive Pictures and Camera Roll).

Has anyone got this to work in VFP?

Rob Spencer
Caliptor Pty Ltd
 
Sort by date Sort by votes
What I need is a working declare statement and maybe an example :)

This is my most recent try...

Code: 
#define k_FID_CAMERAROLL	"{AB5FB87B-7CE2-4F83-915D-550846C9537B}"
#define k_FID_DESKTOP		"{B4BFCC3A-DB2C-424C-B029-7FE99A87C641}"
#define k_FID_DOCUMENTS		"{FDD39AD0-238F-46AF-ADB4-6C85480369C7}"
#define k_FID_PICTURES		"{33E28130-4E1E-4676-835A-98395C3BC3BB}"
#define k_FID_SKYCAMERAROLL	"{767E6811-49CB-4273-87C2-20F355E1085B}"
#define k_FID_SKYDOCUMENTS	"{24D89E24-2F19-4534-9DDE-6A6671FBB8FE}"
#define k_FID_SKYPICTURES	"{339719B5-8C47-4894-94C2-D8F77ADD44A6}"

declare short FormatMessage ;
     in win32api ;
     integer dwFlags ,;
     integer lpvSource,;
     integer dwMsgId,;
     integer dwLangId,;
     STRING @lpBuffer,;
     integer nSize,;
     integer  Argument

declare short SHGetKnownFolderPath ;
	in shell32.dll ;
	string @ cRFID,;
	integer dwFlags,;
	integer hToken,;
	string @ ppszPath

cDefFoldID= k_FID_DESKTOP
cInBuff= space(512)
nResult= SHGetKnownFolderPath(@cDefFoldID, 0x2000 + 0x4000, 0, @cInBuff)
if m.nResult # 0
	nSize= FormatMessage(0x1000, 0, m.nResult, 0, @cInBuff, len(cInBuff), 0)
	? left(m.cInBuff, m.nSize)
endif

This outputs "The system cannot find the file specified." which I doubt is because I don't have one as I can get the desktop folder from WScript.Shell object.

Hope you can help. I was hoping you'd see this Olaf :)

Rob Spencer
Caliptor Pty Ltd
 
Upvote 0 Downvote
Rob,

There's an example of a fully-working function, along with a list of the GUIDs, here:

Finding the paths to Windows' special folders in VFP

However, the list of GUIDs doesn't mention the Windows 8-specific folders, such as CameraRoll as far as I can see.

Mike
P.S. Welcome to the forum.


__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads
 
Upvote 0 Downvote
I've found a list that does include the new folders like SkyDrive and CameraRoll. See:


I see now that the article I referenced in my previous post uses a different set of API calls, and a different set of IDs (but it still works).

Mike


__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads
 
Upvote 0 Downvote
Nice Rob,

don't forget the mention of CoTaskMemFree.

The SHGetKnownFolderPath just allocates a few bytes, and you may never had any problems with non freed orphaned memory, but it's a potential risc.
The way you defined the API call you never know the address of cInBuff to be able to free it. Indeed VFP copies the string from where the OS API function stores it to the cInBuff memory allocated by VFP and you never get the address. Instead you would define the parameter as LONG and either make use of SYS(2600) or RtlMoveMemory.

Bye, Olaf.
 
Upvote 0 Downvote
Thanks Mike. I looked at your code and it is an easier way of doing it than I was using so I've modified my code. Using your method I avoid having to use sys(2600) (Thanks Olaf for pointing it out though :))

Sadly it doesn't help me as I still get the same result :(

The new version of that function SHGetKnownFolderIDList() also takes a REFKNOWNFOLDERID which is a reference to a KNOWNFOLDERID. Most of the entries that I'm interested in don't have CSIDL equivalents so I can't use the older form of the call.

Again, I've included my reworked code (sorry, I've wrapped the error handler which makes it look more complicated but it isn't really).

Code: 
**********************************************
function getKnownFolderPath (cDefFoldID as string) as string
**********************************************
local ok, nOutBuff, cErrMsg, cOutStr

if vartype(__G_DLL_SHGETKNOWNFOLDERIDLIST_) = "U"
	declare long SHGetKnownFolderIDList ;
		in shell32.dll ;
		string @ cRFID,;
		long dwFlags,;
		long hToken,;
		long @ ppidl
	public __G_DLL_SHGETKNOWNFOLDERIDLIST_
endif

if vartype(__G_DLL_SHGETPATHFROMIDLIST_) = "U"
	declare short SHGetPathFromIDList ;
		in shell32.dll ;
		long ppidl, ;
		string @ cPath
	public __G_DLL_SHGETPATHFROMIDLIST_
endif

if vartype(__G_DLL_COTASKMEMFREE_) = "U"
	declare CoTaskMemFree ;
		in ole32.dll ;
		long pVoid
	public __G_DLL_COTASKMEMFREE_
endif

ok= .f.	&& Pessimist!
nOutBuff= 0
cErrMsg= checkSysError(SHGetKnownFolderIDList(@m.cDefFoldID, 0x2000 + 0x4000, 0, @nOutBuff))

if empty(m.cErrMsg)
	cOutStr= space(512)
	cErrMsg= checkSysError(SHGetPathFromIDList(m.nOutBuff, @cOutStr))
	if empty(m.cErrMsg)
		cOutStr= left(m.cOutStr, at(chr(0), m.cOutStr) - 1)
		ok= .t.
	endif
endif

if ! m.ok
	? m.cErrMsg
endif

* Clean up the memory used in the above calls
CoTaskMemFree(m.nOutBuff)

return iif(m.ok, m.cOutStr, "")
endfunc	&& getKnownFolderPath()

**********************************************
function checkSysError (nResult as integer) as string
**********************************************
local cMsg, cInBuff, nSize

if empty(m.nResult) or m.nResult = 1	&& covers missing parameter, 0 (S_OK) or 1 (S_FALSE)
	* It must have worked :)
	cMsg= ""
else
	if vartype(__G_DLL_FORMATMESSAGE_) = "U"
		declare long FormatMessage ;
			in win32api ;
			long dwFlags ,;
			long lpvSource,;
			long dwMsgId,;
			long dwLangId,;
			string @lpBuffer,;
			long nSize,;
			long Argument
		public __G_DLL_FORMATMESSAGE_
	endif
	cInBuff= space(1024)
	nSize= FormatMessage(0x1000, 0, m.nResult, 0, @cInBuff, len(m.cInBuff), 0)
	if m.nSize > 0
		cMsg= left(m.cInBuff, m.nSize)
	else
		cMsg= "Unknown error - code " + ltrim(str(m.nResult))
	endif
endif

return m.cMsg
endfunc	&& checkSysError()

* Sample call
? GetKnownFolderPath("{B4BFCC3A-DB2C-424C-B029-7FE99A87C641}")

The sample call should return my desktop folder but simply outputs "The system cannot find the file specified." which is odd.

I'm at a loss on what I'm doing wrong. Any help would be very gratefully accepted :)

Rob Spencer
Caliptor Pty Ltd
 
Upvote 0 Downvote
I think the solution is easy: You have to provide the GUID in binary form, not as hex string. I haven't tried, though.

When you create a guid you get a GUID in binary form and can format it in the hex form we all know, there also should be an inverse API call to take a formatted GUID string and return it in 16 byte binary form. Be warned: The byte order is not the same as in the hexstring, so a hex to binary conversion of the string without the curly braces and minuses won't work, you have to find the API call.

Bye, Olaf.
 
Upvote 0 Downvote
Thanks Olaf. One step closer but still no cigar!

Latest code listed below. I've converted the GUID string to UNICODE and null terminated it to get a successful CLSIDFromString() result. You'll notice that I've replaced the GUID parameter with a double in both of the first two calls. If I change both references to long, I get a "Declare DLL call caused an exception" when it runs the SHGetKnownFolderIDList() call. The nGUID parameter is negative (but I'm not sure that I care since I'm just passing on what I get given back by the previous call???? I only care because it crashes!). With the parameter declared as a double, I get a "The parameter is incorrect" result instead but at least that is a return code from the call.

I have tried several other variations but nothing that I've tried has helped get any closer.

Code: 
**********************************************
function getKnownFolderPath (cDefFoldID as string) as string
**********************************************
local ok, nOutBuff, cErrMsg, cOutStr, cUCStr, nGUID

if vartype(__G_DLL_CLSIDFROMSTRING_) = "U"
	declare long CLSIDFromString ;
		in ole32.dll ;
		string cGUID, ;
		double @ nRFID
	public __G_DLL_CLSIDFROMSTRING_
endif

if vartype(__G_DLL_SHGETKNOWNFOLDERIDLIST_) = "U"
	declare long SHGetKnownFolderIDList ;
		in shell32.dll ;
		double nRFID,;
		long dwFlags,;
		long hToken,;
		long @ ppidl
	public __G_DLL_SHGETKNOWNFOLDERIDLIST_
endif

if vartype(__G_DLL_SHGETPATHFROMIDLISTW_) = "U"
	declare long SHGetPathFromIDListW ;
		in shell32.dll ;
		long ppidl, ;
		string @ cPath
	public __G_DLL_SHGETPATHFROMIDLISTW_
endif

if vartype(__G_DLL_COTASKMEMFREE_) = "U"
	declare CoTaskMemFree ;
		in ole32.dll ;
		long pVoid
	public __G_DLL_COTASKMEMFREE_
endif

ok= .f.	&& Pessimist!
nGUID= 0
cUCStr= strconv(m.cDefFoldID, 5) + chr(0)
cErrMsg= checkSysError(CLSIDFromString(m.cUCStr, @nGUID))

if empty(m.cErrMsg)
	nOutBuff= 0
	cErrMsg= checkSysError(SHGetKnownFolderIDList(m.nGUID, 0x2000 + 0x4000, 0, @nOutBuff))
endif

if empty(m.cErrMsg)
	cOutStr= space(512)
	cErrMsg= checkSysError(SHGetPathFromIDListW(m.nOutBuff, @cOutStr))
	if empty(m.cErrMsg)
		cOutStr= left(m.cOutStr, at(chr(0), m.cOutStr) - 1)
		ok= .t.
	endif
endif

if ! m.ok
	? m.cErrMsg
endif

* Clean up the memory used in the above calls
CoTaskMemFree(m.nOutBuff)

return iif(m.ok, m.cOutStr, "")
endfunc	&& getKnownFolderPath()

**********************************************
function checkSysError (nResult as integer) as string
**********************************************
local cMsg, cInBuff, nSize

if empty(m.nResult) or m.nResult = 1	&& covers missing parameter, 0 (S_OK) or 1 (S_FALSE)
	* It must have worked :)
	cMsg= ""
else
	if vartype(__G_DLL_FORMATMESSAGE_) = "U"
		declare long FormatMessage ;
			in win32api ;
			long dwFlags ,;
			long lpvSource,;
			long dwMsgId,;
			long dwLangId,;
			string @lpBuffer,;
			long nSize,;
			long Argument
		public __G_DLL_FORMATMESSAGE_
	endif
	cInBuff= space(1024)
	nSize= FormatMessage(0x1000, 0, m.nResult, 0, @cInBuff, len(m.cInBuff), 0)
	if m.nSize > 0
		cMsg= left(m.cInBuff, m.nSize)
	else
		cMsg= "Unknown error - code " + ltrim(str(m.nResult))
	endif
endif

return m.cMsg
endfunc	&& checkSysError()

Sorry to still be asking for help :( I should be able to sort this out for myself given the advice I've received so far.

Thanks again for your help.

Rob Spencer
Caliptor Pty Ltd
 
Upvote 0 Downvote
16 byte is too long for a long, you have to keep that at String. Just because it's binary now, it's not a number, not an int, not a long, not a double, it's 16 bytes memory, and that as transported by a string, also in many, many other API function calls.

In regard to the output I still got only "C" as a first result, but that's because you use the UNICODE variant SHGetPathFromIDListW, in VFP use SHGetPathFromIDListA. You're cuting off at the first chr(0), but chr(0) are just normal for Unicode strings, normal letters cause each second byte of the unicode string to be chr(0).

Overall I changed your code and this works on Win7 (it's the temp path for CD burning data), you might put in a Win8 or Win 8.1 GUID to see yourself, if you get these paths, too, now.

Code: 
? getKnownFolderPath('{9E52AB10-F80D-49DF-ACB8-4330F5687855}')

**********************************************
function getKnownFolderPath (cDefFoldID as string) as string
**********************************************
local ok, nOutBuff, cErrMsg, cOutStr, cUCStr, nGUID

if vartype(__G_DLL_CLSIDFROMSTRING_) = "U"
	declare long CLSIDFromString ;
		in ole32.dll ;
		string cGUID, ;
		string @ cCLSID
	public __G_DLL_CLSIDFROMSTRING_
endif

if vartype(__G_DLL_SHGETKNOWNFOLDERIDLIST_) = "U"
	declare long SHGetKnownFolderIDList ;
		in shell32.dll ;
		string cbCLSID,;
		long dwFlags,;
		long hToken,;
		long @ ppidl
	public __G_DLL_SHGETKNOWNFOLDERIDLIST_
endif

if vartype(__G_DLL_SHGETPATHFROMIDLISTA_) = "U"
	declare long SHGetPathFromIDListA ;
		in shell32.dll ;
		long ppidl, ;
		string @ cPath
	public __G_DLL_SHGETPATHFROMIDLISTA_
endif

if vartype(__G_DLL_COTASKMEMFREE_) = "U"
	declare CoTaskMemFree ;
		in ole32.dll ;
		long pVoid
	public __G_DLL_COTASKMEMFREE_
endif

ok= .f.	&& Pessimist!
cbGUID= Space(16)
cUCStr= strconv(m.cDefFoldID, 5) + chr(0)
cErrMsg= checkSysError(CLSIDFromString(m.cUCStr, @cbGUID))

if empty(m.cErrMsg)
	nOutBuff= 0
	cErrMsg= checkSysError(SHGetKnownFolderIDList(m.cbGUID, 0x2000 + 0x4000, 0, @nOutBuff))
endif

if empty(m.cErrMsg)
	cOutStr= space(512)
	cErrMsg= checkSysError(SHGetPathFromIDListA(m.nOutBuff, @cOutStr))
	if empty(m.cErrMsg)
		*cOutStr= left(m.cOutStr, at(chr(0), m.cOutStr) - 1)
		ok= .t.
	endif
endif

if ! m.ok
	? m.cErrMsg
endif

* Clean up the memory used in the above calls
CoTaskMemFree(m.nOutBuff)

return iif(m.ok, m.cOutStr, "")
endfunc	&& getKnownFolderPath()

**********************************************
function checkSysError (nResult as integer) as string
**********************************************
local cMsg, cInBuff, nSize

if empty(m.nResult) or m.nResult = 1	&& covers missing parameter, 0 (S_OK) or 1 (S_FALSE)
	* It must have worked :)
	cMsg= ""
else
	if vartype(__G_DLL_FORMATMESSAGE_) = "U"
		declare long FormatMessage ;
			in win32api ;
			long dwFlags ,;
			long lpvSource,;
			long dwMsgId,;
			long dwLangId,;
			string @lpBuffer,;
			long nSize,;
			long Argument
		public __G_DLL_FORMATMESSAGE_
	endif
	cInBuff= space(1024)
	nSize= FormatMessage(0x1000, 0, m.nResult, 0, @cInBuff, len(m.cInBuff), 0)
	if m.nSize > 0
		cMsg= left(m.cInBuff, m.nSize)
	else
		cMsg= "Unknown error - code " + ltrim(str(m.nResult))
	endif
endif

return m.cMsg
endfunc	&& checkSysError()

See for yourself what I changed, I haven't marked it, sorry, I was too lazy. It's several places.

Bye, Olaf.
 
Upvote 0 Downvote
In regard to CLSIDFromString usage, also see You don't need to add chr(0) as terminator to a unicode string. By the way also not to other strings. In most cases parameters are defined string VFP making the real API call adds a chr(0) anyway.

Taken from news2news:
Code: 
DO declare
 
LOCAL cGUID, cGUIDString, cGUID1
cGUID = REPLICATE(CHR(0), 16)  && 128 bits
 
IF CoCreateGuid(@cGUID) = 0
    cGUIDString = StringFromGUID(cGUID)
    ? cGUID
    ? cGUIDString
 
    * converting from String back to GUID
    cGUID1 = REPLICATE(CHR(0), 16)

    * Olaf Doschke: Here you see how they called CLSIDFromString, also using STRCONV(...,5) for unicode, but not +chr(0)
    = CLSIDFromString(STRCONV(cGUIDString,5), @cGUID1)
    ? cGUID1
ENDIF
* end of main
 
FUNCTION StringFromGUID(cGUID)
    LOCAL cBuffer, nBufsize
    nBufsize=128
    cBuffer = REPLICATE(CHR(0), nBufsize*2)
    = StringFromGUID2(cGUID, @cBuffer, nBufsize)
    cBuffer = SUBSTR(cBuffer, 1, AT(CHR(0)+CHR(0), cBuffer))
RETURN STRCONV(cBuffer, 6)
 
PROCEDURE declare
    DECLARE INTEGER CoCreateGuid IN ole32 STRING @pguid
 
    DECLARE INTEGER CLSIDFromString IN ole32;
        STRING lpsz, STRING @pclsid
 
    DECLARE INTEGER StringFromGUID2 IN ole32;
        STRING rguid, STRING @lpsz, INTEGER cchMax
Bye, Olaf.
 
Upvote 0 Downvote
Hi Olaf,

Thanks so much. Yes, the use of the SHGetPathFromIDListW version of the function was a left-over from some "clutching at straws" and it should have simply been the basic version. The information about the added chr(0) came from and in fact the behaviour I've found is that it is required. Without it, I was able to run it once but not multiple times (I'd get "Invalid class string" errors from subsequent calls).

I've tidied up the code including some basic documentation and included it below.

Code: 
* Define constants to use with SHGetKnownFolderIDList routine
* Values copied from MSDN reference site (although not the names)
#define k_FID_CAMERAROLL	"{AB5FB87B-7CE2-4F83-915D-550846C9537B}"
#define k_FID_DESKTOP		"{B4BFCC3A-DB2C-424C-B029-7FE99A87C641}"
#define k_FID_DOCUMENTS		"{FDD39AD0-238F-46AF-ADB4-6C85480369C7}"
#define k_FID_PICTURES		"{33E28130-4E1E-4676-835A-98395C3BC3BB}"
#define k_FID_SKYCAMERAROLL	"{767E6811-49CB-4273-87C2-20F355E1085B}"
#define k_FID_SKYDOCUMENTS	"{24D89E24-2F19-4534-9DDE-6A6671FBB8FE}"
#define k_FID_SKYPICTURES	"{339719B5-8C47-4894-94C2-D8F77ADD44A6}"

? GetKnownFolderPath(k_FID_SKYDOCUMENTS)

**********************************************
function getKnownFolderPath (cDefFoldID as string, cErrMsg as string) as string
**********************************************
local nOutBuff, cOutStr, cbGUID

* Declare all the required system calls (protected for repeat calls)
if vartype(__G_DLL_CLSIDFROMSTRING_) = "U"
	declare long CLSIDFromString ;
		in ole32.dll ;
		string cInStr, ;
		string @ cGUID
	public __G_DLL_CLSIDFROMSTRING_
endif

if vartype(__G_DLL_SHGETKNOWNFOLDERIDLIST_) = "U"
	declare long SHGetKnownFolderIDList ;
		in shell32.dll ;
		string cGUID,;
		long dwFlags,;
		long hToken,;
		long @ ppidl
	public __G_DLL_SHGETKNOWNFOLDERIDLIST_
endif

if vartype(__G_DLL_SHGETPATHFROMIDLIST_) = "U"
	declare long SHGetPathFromIDList ;
		in shell32.dll ;
		long ppidl, ;
		string @ cPath
	public __G_DLL_SHGETPATHFROMIDLIST_
endif

if vartype(__G_DLL_COTASKMEMFREE_) = "U"
	declare CoTaskMemFree ;
		in ole32.dll ;
		long pVoid
	public __G_DLL_COTASKMEMFREE_
endif

* Convert the string GUID to a binary version
cbGUID= space(16)
cErrMsg= checkSysError(CLSIDFromString(strconv(m.cDefFoldID, 5) + chr(0), @cbGUID))

if empty(m.cErrMsg)
	* Get back the folder path in a PIDL structure
	* Flags - 0x1000 -> KF_FLAG_NO_ALIAS - Expand any alias placeholders, eg. %USERPROFILE%
	*       - 0x4000 -> KF_FLAG_DONT_VERIFY - Don't check that the folder exists before returning the value
	nOutBuff= 0
	cErrMsg= checkSysError(SHGetKnownFolderIDList(m.cbGUID, 0x1000 + 0x4000, 0, @nOutBuff))
endif

if empty(m.cErrMsg)
	* Extract the path string from the PIDL structure
	cOutStr= space(512)
	cErrMsg= checkSysError(SHGetPathFromIDList(m.nOutBuff, @cOutStr))
endif

* Clean up the memory used in the above system calls
CoTaskMemFree(m.nOutBuff)

* Ensure any returned path has the trailing backslash
return iif(empty(m.cErrMsg), addbs(m.cOutStr), "")
endfunc	&& getKnownFolderPath()

**********************************************
function checkSysError (nResult as integer) as string
**********************************************
local cMsg, cInBuff, nSize

if empty(m.nResult) or m.nResult = 1	&& covers missing parameter, 0 (S_OK) or 1 (S_FALSE)
	* It must have worked :)
	cMsg= ""
else
	* Declare the required system call (protected for repeat calls)
	if vartype(__G_DLL_FORMATMESSAGE_) = "U"
		declare long FormatMessage ;
			in win32api ;
			long dwFlags ,;
			long lpvSource,;
			long dwMsgId,;
			long dwLangId,;
			string @lpBuffer,;
			long nSize,;
			long Argument
		public __G_DLL_FORMATMESSAGE_
	endif

	* Retrieve the system message
	* Flags - 0x1000 -> FORMAT_MESSAGE_FROM_SYSTEM Use the system message-table
	cInBuff= space(1024)
	nSize= FormatMessage(0x1000, 0, m.nResult, 0, @cInBuff, len(m.cInBuff), 0)
	if m.nSize > 0
		cMsg= left(m.cInBuff, m.nSize)
	else
		* No message came back - maybe it is a application specific message
		cMsg= "Unknown error - code " + ltrim(str(m.nResult))
	endif
endif

return m.cMsg
endfunc	&& checkSysError()

On my system it returns C:\Users\Rob\SkyDrive\Documents\ which is exactly what I was looking for. Hoping to use the application on a Surface Pro 2.

Thank you all so much for the help, especially Olaf :)

Rob Spencer
Caliptor Pty Ltd
 
Upvote 0 Downvote
Nice hint on the foxperts article.

I'm sure Christof is right. Indeed in this case you have a 16 byte buffer turning to 32 bytes unicode, and VFP adds a CHR(0), which makes it 33 bytes and an odd number of bytes is often bad, sometimes your total length should even be multiple of longs, multiples of 4 bytes, to have an aligned memory addres. Perhaps news2news should then update their routine.

Glad it works and thanks for sharing the brushed up version.

Bye, Olaf.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

A_Radiolog_inFoxPro
  • Solved
GETWORDCOUNT () IN VFP 6.0 ?
Replies
11
Views
701
StefanFoerner
StefanFoerner
infinetecode
  • Question
VFP Report : Dynamics
Replies
4
Views
279
Chris Miller
Chris Miller
RTD78
  • Question
VFP Form Refresh
Replies
2
Views
278
RTD78
RTD78
Sng1
  • Locked
  • Question
Fill Full page till footer space in detail in FRX Report in VFP
Replies
19
Views
730
mjcmkrsr
mjcmkrsr
sdocker
  • Locked
  • Question
InstallShield and VFP 9 Merge Modules.
Replies
11
Views
692
Chris Miller
Chris Miller

Part and Inventory Search

Sponsor

Back
Top