AssocQueryString fails on XP Pro

[paulbent]

I've been using this function for about 3 years and it's been fine on W98, ME, NT4 and W2000 but fails on XP Pro:

Const ASSOCF_INIT_NOREMAPCLSID = &H1	'do not remap clsids to progids
Const ASSOCF_INIT_BYEXENAME = &H2	'executable is being passed in
Const ASSOCF_OPEN_BYEXENAME = &H2		'executable is being passed in
Const ASSOCF_INIT_DEFAULTTOSTAR = &H4		'treat "*" as the BaseClass
Const ASSOCF_INIT_DEFAULTTOFOLDER = &H8	'treat "Folder" as the BaseClass
Const ASSOCF_NOUSERSETTINGS = &H10		'dont use HKCU
Const ASSOCF_NOTRUNCATE = &H20	'dont truncate the return string
Const ASSOCF_VERIFY = &H40		'verify data is accurate (DISK HITS)
Const ASSOCF_REMAPRUNDLL = &H80		'actually gets info about rundlls target if applicable
Const ASSOCF_NOFIXUPS = &H100		'attempt to fix errors if found
Const ASSOCF_IGNOREBASECLASS = &H200		'dont recurse into the baseclass

Const ASSOCSTR_COMMAND = 1	'return the shell\verb\command string
Const ASSOCSTR_EXECUTABLE = 2	'return the the executable part of command string

Const E_POINTER = &H80004003

Declare Function AssocQueryString Lib "shlwapi.dll" Alias "AssocQueryStringA" _
(ByVal flags As Long, ByVal lstr As Long, ByVal pszAssoc As String, ByVal pszExtra As String, _
ByVal pszOut As String, ByVal pcchOut As Long) As Long
'_________________________

Public Function fGetAppPath(Byval strExt As String) As String
	
	'--- Given a file extension, returns the path to the file's executable
	
	'--- Parameters
	'	[In]
	'		strExt: the file extension
	
	'--- Return value
	'	the path to an executable or an empty string if an error occurs
	
	Dim lngRtn As Long				'API function return value
	Dim lngBuffLen As Long			'Length of buffer to receive the exe name
	Dim strAppPath As String			'Buffer to receive the exe name
	Dim lngFlags As Long				'Parameters for API function
	
	'Check strTgt isn't empty
	If strExt = vbNullString Then
		fGetAppPath = vbNullString
		Exit Function
	End If
	
	'Set the flags
	lngFlags =  ASSOCF_NOTRUNCATE Or ASSOCF_REMAPRUNDLL
	'Init the file extension
	strExt = "." & strExt & Chr$(0)
	
	'Size the buffer for the return value
	strAppPath = Space(255)
	lngBuffLen = 255
	
	'Get the exe path
	lngRtn = AssocQueryString(lngFlags, ASSOCSTR_EXECUTABLE, strExt, "", strAppPath, lngBuffLen)
	'Check the result
	Select Case lngRtn
	Case 0
		'Success, do nothing
	Case E_POINTER
		'Buffer was too small resize it
		strAppPath = Space(lngBuffLen)
		lngRtn = AssocQueryString(lngFlags, ASSOCSTR_EXECUTABLE, strExt, "", strAppPath, lngBuffLen)
	Case Else
		'An error occurred - exit
		fGetAppPath = ""
		Exit Function
	End Select
	
	'Strip the terminating null char and remaining spaces
	fGetAppPath = Left$(strAppPath, Instr(1, strAppPath, Chr$(0)) -1)
	
End Function

The call to AssocQueryString returns -2147024894 on XP Pro. I've searched the latest MSDN CD for this error but there's nothing relevant to AssocQueryString.

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[TXWizard]

I came here looking for working examples. Finding yours, I changed the arguments I was using to match yours, since I was getting zero, but also no data (a null-filled buffer and a value of zero for pcchOut. With those changes, I am also getting -2147024894 on XP Pro with Service Pack 1.

Have you made any progress on this?

I am considering calling the IQueryAssociations interface directly. If I do so and succeed, I'll be happy to port the code to VB and share it with you. I'm working in WinBatch at the moment, but I also have Visual Basic 6 and Office XP Developer.

 

[paulbent]

No I didn't get any further with AssocQueryString. I've been using another function, FindExecutable. It's more long winded because you have to create a file with the desired extension but it works!

Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(Byval lpFile As String, Byval lpDirectory As String, Byval lpResult As String) As Long

Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (Byval nBufferLength As Long, _
Byval lpBuffer As String) As Long

Declare Function GetTempFileName Lib "kernel32" _
Alias "GetTempFileNameA" (Byval lpszPath As String, _
Byval lpPrefixString As String, Byval wUnique As Long, _
Byval lpTempFileName As String) As Long
'__________________________________
Function fGetAppPath(strExt As String) As String

 '--- Returns the path to an executable or an empty string if an error occurs

 '--- Input
 ' strExt is the three character file extension associated with the executable

 Dim vntTmpData As Variant  'Data written to temp file
 Dim lngRtn As Long   'API function return
 Dim hFile As Integer  'Handle to temp file
 Dim strPath As String  'Path to Windows Temp folder
 Dim strTmpFile1 As String  'Temp file name
 Dim strTmpFile2 As String  'Temp file with associated extension
 Dim strAppFile As String  'Buffer to return application filename
 
 'Check the passed in extension is not null
 If strExt = vbNullString Then
  Exit Function
 End If

 'Size the buffer for the temp folder path
 strPath = Space(255)
 'Get the path to the temp folder
 lngRtn = GetTempPath(255, strPath)
 'Check the result
 Select Case lngRtn
 Case 0
  'An error occurred - exit
  Exit Function
 Case 1 To 255
  'The path was returned OK - do nothing
 Case Is > 255
  'The buffer wasn't long enough and lngRtn contains the required size
  strPath = Space(lngRtn + 1)
  lngRtn = GetTempPath(lngRtn + 1, strPath)
 End Select
 'Remove the null terminating char and any trailing spaces
 strPath = Left$(strPath, lngRtn)

 'Size the buffer for the temp file name
 strTmpFile1 = Space(255)
 'Create a temp file
 lngRtn = GetTempFileName(strPath, strExt, 0, strTmpFile1)
 'Check the result
 If lngRtn = 0 Then
  'An error occurred - exit
  Exit Function
 Else
  'The temp was created OK, remove the terminating null char and spaces
  strTmpFile1 = Left$(strTmpFile1, Instr(1, strTmpFile1, Chr$(0)) - 1)
 End If

 'Write some data to the temp file
 hFile = Freefile
 vntTmpData = "It is safe to delete this temporary file"
 Open strTmpFile1 For Binary As hFile
 Put #hFile, , vntTmpData
 Close hFile

 'Copy the temp file to our target extension
 strTmpFile2 = Left$(strTmpFile1, Instr(1, strTmpFile1, ".tmp")) & strExt
 Filecopy strTmpFile1, strTmpFile2

 'Size the buffer for the path to the executable
 strAppFile = Space(255)
 'Get the path to the associated executable
 lngRtn = FindExecutable(strTmpFile2, vbNullString, strAppFile)
 'Check the result
 If lngRtn > 32 Then
  'The function succeeded, remove the terminating null char and spaces
  fGetAppPath = Left$(strAppFile, Instr(1, strAppFile, Chr$(0)) -1)
 End If

 'Delete the temp files
 Kill strTmpFile1
 Kill strTmpFile2

End Function

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[TXWizard]

I know all about FindExecutable, and have used both the 16 and 32 bit versions of that function for years. Like you, I was looking for a way around its limitation. As it happens, I have a file of the correct type in the package for which I am writing an installer. I'm writing an installer for an Excel add-in.