Как использовать функцию SHGetKnownFolderPath из Vb6 - PullRequest
Новая
       52

Как использовать функцию SHGetKnownFolderPath из Vb6

2 голосов
/ 11 апреля 2011

В настоящее время я добавляю поддержку Windows 7 в существующий проект Vb6, и у меня возникла проблема с поиском специальных путей к папкам с помощью SHGetFolderPath, который не поддерживается в версиях Windows, начиная с Vista.Я знаю, что должен использовать SHGetKnownFolderPath, но не могу найти хороший пример реализации API-вызова SHGetKnownFolderPath в VB6.

Ответы [ 3 ]

4 голосов
/ 11 апреля 2011

Легче использовать объект Shell Позднее связывание рекомендуется, потому что Microsoft не позаботилась о совместимости с этим объектом. 

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

strAppData = _ 
    CreateObject("Shell.Application").NameSpace(ssfAPPDATA).Self.Path
2 голосов
/ 12 апреля 2011

Использование SHGetFolderPath из shfolder.dll просто отлично работает под 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
2 голосов
/ 11 апреля 2011

Используя код следующей этой статьи VBA / VB6 Объявление вызова API в верхней части модуля 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

Добавлена ​​новая публичная функция: 

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

Отлично работает!

...