SHGetKnownFolderPath関数をVb6から使用する方法

Question

現在、既存のVb6プロジェクトにWindows 7のサポートを追加しています.Vistaで始まるWindowsバージョンではサポートされていないSHGetFolderPathを使用して特別なフォルダパスを見つける問題が発生しました。私はSHGetKnownFolderPathを使用すべきであることを知っていますが、VB6でSHGetKnownFolderPath APIコールを使用して実装した良い例は見つかりません。

Answer 1

使いやすいShell object Microsoftはこのオブジェクトとの互換性に注意していないため、後でバインドすることをお勧めします。

Const ssfCOMMONAPPDATA = &H23 
Const ssfLOCALAPPDATA = &H1c 
Const ssfAPPDATA = &H1a 
Dim strAppData As String 

strAppData = _ 
    CreateObject("Shell.Application").NameSpace(ssfAPPDATA).Self.Path 

Answer 2

コードを使用して、モジュールWINAPI32.bas

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _ 
        (ByVal hwndOwner As Long, ByVal nFolder As Long, _ 
        pidl As ITEMIDLIST) As Long 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ 
         (ByVal pidl As Long, ByVal pszPath As String) As Long 
Private Type SHITEMID 
    cb As Long 
    abID As Byte 
End Type 
Private Type ITEMIDLIST 
    mkid As SHITEMID 
End Type 

の上部にAPI呼び出しを宣言以下、この記事vba/vb6 は、新しい公開機能を追加しました：

Public Function SHGetSpecialFolderLocationVB(ByVal lFolder As Long) As String 
    Dim lRet As Long, IDL As ITEMIDLIST, sPath As String 

    lRet = SHGetSpecialFolderLocation(100&, lFolder, IDL) 
    If lRet = 0 Then 
     sPath = String$(512, chr$(0)) 
     lRet = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) 
     SHGetSpecialFolderLocationVB = Left$(sPath, InStr(sPath, chr$(0)) - 1) 
    Else 
     SHGetSpecialFolderLocationVB = vbNullString 
    End If 
End Function 

は、新たな機能を追加しましたWindowsのバージョンがVista以上であることを確認する

Public Function IsVistaOrHigher() As Boolean 
    Dim osinfo As OSVERSIONINFO 
    Dim retvalue As Integer 
    Dim bVista As Boolean 

    bVista = False 

    osinfo.dwOSVersionInfoSize = 148 
    osinfo.szCSDVersion = Space$(128) 
    retvalue = GetVersionExA(osinfo) 

    If osinfo.dwPlatformId = 2 Then 
     If osinfo.dwMajorVersion >= 6 Then 
      bVista = True 
     End If 
    End If 
    IsVistaOrHigher = bVista 
End Function 

SHGetFolderPathを呼び出す前のメソッドを変更しました

Public Function SHGetFolderPathVB(ByVal lFolder As Long) As String 
    Dim path As String 
    If IsVistaOrHigher() Then 
     SHGetFolderPathVB = SHGetSpecialFolderLocationVB(lFolder) 
    Else 
     path = Space$(MAX_PATH) 
     SHGetFolderPath 0, lFolder, 0, SHGFP_TYPE_CURRENT, path 
     SHGetFolderPathVB = Left(path, InStr(path, vbNullChar) - 1) 
    End If 
End Function 

素晴らしいです！

Answer 3

shfolder.dllからSHGetFolderPathを使用するだけVistaとWin7の下に正常に動作します：

Private Declare Function SHGetFolderPath Lib "shfolder" Alias "SHGetFolderPathA" (ByVal hWnd As Long, ByVal csidl As Long, ByVal hToken As Long, ByVal dwFlags As Long, ByVal szPath As String) As Long 

次に、これらのCSIDL_Xxx定数に列挙型を宣言します。

Public Function GetSpecialFolder(ByVal eType As MySpecialFolderType) As String 
    GetSpecialFolder = String(1000, 0) 
    Call SHGetFolderPath(0, eType, 0, 0, GetSpecialFolder) 
    GetSpecialFolder = Left$(GetSpecialFolder, InStr(GetSpecialFolder, Chr$(0)) - 1) 
End Function