ab.com コミュニティ

'-------------------------------------------------------------------------------
'	IDListToPathStr, BrowseForFolder_Str

TypeDef UINT = DWord

Type SHITEMID
	cb As WORD
	abID[ELM(1)] As Byte
End Type

Type ITEMIDLIST
	mkid As SHITEMID
End Type

TypeDef PITEMIDLIST = *ITEMIDLIST

Function GetMaxPath(pv As VoidPtr) As DWord
	GetMaxPath = MAX_PATH
End Function

Function GetPathFromIDList(pv As VoidPtr, buf As *Byte, len As DWord) As DWord
	If len < MAX_PATH Then
		buf[0] = 0
		Exit Function
	End If
	SHGetPathFromIDList(pidlBrowse, buf)
	GetPathFromIDList = lstrlen(buf)
End Function

Function IDListToPathStr(pidl As *ITEMIDLIST) As String
	IDListToPathStr = GetString(
		VarPtr(dqi),
		AddressOf (GetMaxPath) As GetStr_GetLenProc,
		AddressOf (GetPathFromIDList) As GetStr_GetStrProc)
End Function

Function BrowseForFolder_Str(hwnd As HWND, pszTitle As BytePtr, flags As UINT) As String
	Dim bi As BROWSEINFO
	'BROWSEINFO構造体の初期化
	'ZeroMemory(VarPtr(bi), Len(bi))
	With bi
		.hwndOwner = hwnd
		.lpszTitle = pszTitle
		.ulFlags = flags
	End With

	'「フォルダの参照」ダイアログボックスを表示
	Dim pidlBrowse As *ITEMIDLIST
	pidlBrowse = SHBrowseForFolder(bi)

	If pidlBrowse Then
		BrowseForFolder_Str = IDListToPathStr(pidlBrowse)
		CoTaskMemFree(pidlBrowse)
	End If
End Function

Class DragQueryInfo
Public
	Sub DragQueryInfo(hDrop As HDROP, iFile As Long)
		This.hDrop = hDrop
		This.iFile = iFile
	End Sub

	hDrop As HDROP
	iFile As Long
End Class

Function DragQueryFile_ForGetLen(ByRef dqi As DragQueryInfo) As DWord
	With dqi
		DragQueryFile_ForGetLen = DragQueryFile(.hDrop, .iFile, 0, 0)
	End With
End Function

Function DragQueryFile_ForGetStr(ByRef dqi As DragQueryInfo, buf As *Byte, len As DWord) As DWord
	With dqi
		DragQueryFile_ForGetStr = DragQueryFile(.hDrop, .iFile, buf, len + 1)
	End With
End Function

Function DragQueryFileStr(hDrop As HDROP, iFile As Long) As String
	If iFile >= 0 Then
		Dim dqi As DragQueryInfo(hDrop, iFile)
		DragQueryFileStr = GetString(VarPtr(dqi), AddressOf (DragQueryFile_ForGetLen), AddressOf (DragQueryFile_ForGetStr))
	End If
End Function