Einzelnen Beitrag anzeigen
Alt 09.08.2002, 00:16   #3
RStAstl
Veteran
 
Registriert seit: 17.09.2000
Beiträge: 224


Idee SHGetFolderPath

Es gibt seit W2K einen neue Funktion: SHGetFolderPath

Schreiben einer Windows XP-Anwendung, die Benutzer- und Anwendungsdaten unter dem korrekten Pfad speichert

HOWTO: Use the SHGetFolderPath Function from Visual Basic


Meine Implementierung (nach MS-Quelle)
Code:
Option Explicit

Public Const CSIDL_PERSONAL As Long = &H5       ' "Eigene Dateien"
Public Const CSIDL_FLAG_CREATE As Long = &H8000 ' Erzeugt den Ordner wenn er nicht existiert

Private Const S_OK As Long = &H0                ' Success
Private Const S_FALSE As Long = &H1             ' The Folder is valid, but does not exist
Private Const E_INVALIDARG As Long = &H80070057 ' Invalid CSIDL Value

Private Const SHGFP_TYPE_CURRENT = 0
Private Const MAX_PATH = 260

Private Declare Function SHGetFolderPath Lib "shfolder" _
    Alias "SHGetFolderPathA" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, _
    ByVal hToken As Long, ByVal dwFlags As Long, _
    ByVal pszPath As String) As Long

Public Function GetFolderPath(ByVal CSIDL As Long) As String
    Dim sPath As String
    Dim lRetVal As Long

    ' Fill our string buffer
    sPath = String(MAX_PATH, 0)

    lRetVal = SHGetFolderPath(0, CSIDL, 0, SHGFP_TYPE_CURRENT, sPath)

    Select Case lRetVal
    Case S_OK
        ' We retrieved the folder successfully
        
        ' All C strings are null terminated
        ' So we need to return the string upto the first null character
        GetFolderPath = Left(sPath, InStr(1, sPath, Chr(0)) - 1)
    Case S_FALSE
        ' The CSIDL in nFolder is valid, but the folder does not exist.
        ' Use CSIDL_FLAG_CREATE to have it created automatically
        Debug.Print "The folder does not exist"
    Case E_INVALIDARG
        ' nFolder is invalid
        Debug.Print "An invalid folder ID was specified"
    Case Else
        ' Auch das kommt vor!
        Debug.Print "Undefinierter Rückgabewert: "; lRetVal
    End Select
End Function

Mein Aufruf
Code:
Dim StrEigeneDateien As String

StrEigeneDateien = GetFolderPath(CSIDL_PERSONAL)

Seltsame Rückgabewerte
Bei einigen CSIDL's gibt es jedoch nicht die von MS angegebenen Rückgabewerte sondern einen anderen (bzw. mehrere andere).
Der Aufruf mit CSIDL 14 (dez.) / E (hex.) liefert z.B. den Rückgabewert -2147024894.
Doch Warum?
RStAstl ist offline   Mit Zitat antworten