SHGetPathFromIDList-Funktion Diese Funktion extrahiert aus einer ITEMIDLIST-Struktur einen Pfadnamen eines lokalen Verzeichnisses.
Betriebssystem:  Win95, Win98, WinNT 4.0, Win2000, WinME	Views:  14.954

Deklaration:

Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" ( _
  ByVal pidl As Long, _
  ByVal pszPath As String) As Long

Beschreibung:
Diese Funktion extrahiert aus einer ITEMIDLIST-Struktur einen Pfadnamen eines lokalen Verzeichnisses. Die Funktion schlägt fehl, wenn der zu extrahierende Pfad nicht der eines lokalen Ordners oder Datei ist.

Parameter:

pidl	Erwartet die Speicheradresse (Pointer) zu einer ITEMIDLIST-Struktur (PIDL).
pszPath	Puffer mit "260" Leerstellen, der den Pfadnamen enthält.

Rückgabewert:
Bei erfolgreichem Funktionsaufruf wird ein Wert ungleich 0 zurückgegeben, andernfalls ist der Rückgabewert 0.

Beispiel:

' Fügen Sie nachfolgenden Code in ein Formular
' mit einem CommandButton (Command1) ein:
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias  "SHBrowseForFolderA" ( _
  lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias  "SHGetPathFromIDListA" ( _
  ByVal pidl As Long, _
  ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
 
Private Type BROWSEINFO
  hwndOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
 
Private Type SHITEMID
  cbSize As Integer
  abID As String * 256
End Type
 
Private Type ITEMIDLIST
  mkid As SHITEMID
End Type
 
' Nur Computer als Auswahl erlaubt. Wenn der Anwender andere 
' Ordner markiert, kann der OK-Schalter nicht ausgewählt 
' werden.
Private Const BIF_BROWSEFORCOMPUTER = &H1000
 
' Nur Drucker als Auswahl erlaubt. Wenn der Anwender andere 
' Ordner markiert, kann der OK-Schalter nicht ausgewählt 
' werden.
Private Const BIF_BROWSEFORPRINTER = &H2000
 
' Der Dialog zeigt neben den Ordnern auch Dateien.
Private Const BIF_BROWSEINCLUDEFILES = &H4000
 
' Der Dialog zeigt keine Netzwerkordner unterhalb der
' aktuellen Domain.
Private Const BIF_DONTGOBELOWDOMAIN = &H2
 
' Nur Dateisystemobjekte als Auswahl erlaubt. Wenn der 
' Anwender andere Ordner markiert, kann der OK-Schalter 
' nicht ausgewählt werden.
Private Const BIF_RETURNFSANCESTORS = &H8
 
' Nur Dateisystemordner als Auswahl erlaubt. Wenn der
' Anwender andere Ordner markiert, kann der OK-Schalter
' nicht ausgewählt werden.
Private Const BIF_RETURNONLYFSDIRS = &H1
 
' Der Dialog enthält eine Statuszeile. Die Rückruffunktion
' kann die Statuszeile ausfüllen
Private Const BIF_STATUSTEXT = &H4
 
' (Win 2000) Zeigt ein neuen Dialog an mit mehr
' benutzerfreundlichen Änderungen
Const BIF_USENEWUI = &H40
 
' (ab IE 4.0) Sendet an die Callback Funktion eine
' BFFM_VALIDATEFAILED Message, wenn in der Textbox eine falsche
' Eingabe gemacht wurde
Const BIF_VALIDATE = &H20

Private Sub Command1_Click()
  Dim BI As BROWSEINFO
  Dim Item As ITEMIDLIST
  Dim Retval As Long
  Dim RetStr As String * 256
 
  ' Dialog-Eigenschaften und Vorgabewerte setzen
  With BI
    .hwndOwner = Me.hwnd
    .pszDisplayName = Space(260)
    .lpszTitle = "Ordner, in dem die Datei gespeichert werden soll:"
    .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_VALIDATE Or _
      BIF_STATUSTEXT Or BIF_EDITBOX 
    .lpfn = GetAddress(AddressOf BCallbackProc)
  End With
 
  ' Dialog aufrufen
  Retval = SHBrowseForFolder(BI)
  If Retval = 0 Then
    MsgBox "Es ist ein Fehler aufgetreten oder Sie haben " & _
      " auf 'Abbrechen' geklickt."
    Exit Sub
  End If
 
  ' Ausgewählten Pfad ermitteln
  Retval = SHGetPathFromIDList(Retval, RetStr)
  If Retval = 0 Then
    MsgBox "Fehler beim Extrahieren des ausgewählten Pfades"
    Exit Sub
  End If
 
  MsgBox "Sie haben " & Left$(RetStr, InStr(1, RetStr, vbNullChar) - 1) & _
    " ausgewählt.", , "Ordner..."
 
  ' Ressourcen wieder freigeben
  CoTaskMemFree Retval
End Sub
 
 
' Den folgenden in ein Modul einfügen
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" ( _
  ByVal pidl As Long, _
  ByVal pszPath As String) As Long
 
' SendMessage SHBrowseForFolder-Messages
' --------------------------------------
 
' Enabled den OK-Button, wenn lParam ungleich 0 ist,
' andernfalls wird der Button Disabled
Private Const BFFM_ENABLEOK = &H465
 
' Setzt die Selektierung auf einen Verzeichnisbaumeintrag
' lParam gibt hierbei den Pfad an und wParam muss ungleich 0 sein
Private Const BFFM_SETSELECTION = &H466
 
' Setzt den Staustext des Dialogs.
' lParam gibt den auszugebenden Text an
Private Const BFFM_SETSTATUSTEXT = &H464
 
' Callback Ereignis-Messages
' --------------------------
 
' Dialog wurde initialisiert, lParam ist 0
Private Const BFFM_INITIALIZED = 1
 
' Benutzer hat ein anderen Verzeichnisbaumeintrag gewählt
Private Const BFFM_SELCHANGED = 2
 
' (ab IE 4.0) Benutzer hat eine falsche Angabe
' in der Textbox des Dialogs gemacht
Private Const BFFM_VALIDATEFAILED = 3

' Dient der Ermittlung der AddressOf-Funktionsadresse
' von BrowsCallBack
Public Function GetAddress(ByVal FuncAddress As Long) As Long
  GetAddress = FuncAddress
End Function

' Hier treffen die Ereignisse des Dialogs ein
Public Function BCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, _
  ByVal lParam As Long, ByVal lpData As Long) As Long
 
  Dim Retval As Long
  Dim TmpSelected As String * 260
  Static LastPath As String
 
  ' Ereignisse des Dialoges
  Select Case uMsg
    ' Dialog wird angezeigt
    Case BFFM_INITIALIZED
      ' Startordner festlegen
      SendMessage hwnd, BFFM_SETSELECTION, ByVal 1&, ByVal App.Path
 
    ' Benutzer wählt einen andern Ordner
    Case BFFM_SELCHANGED    
      ' Ausgewählten Eintrag ermitteln
      SHGetPathFromIDList lParam, TmpSelected
      LastPath = Left$(TmpSelected, InStr(1, TmpSelected, vbNullChar) - 1)
 
      ' Ausgewählten Ordner in der Statuszeile anzeigen
      SendMessage hwnd, BFFM_SETSTATUSTEXT, ByVal 0&, ByVal _
        "Sie haben " &  LastPath & " gewählt."
 
    ' ungültige Eingabe in der Textbox des Dialogs
    Case BFFM_VALIDATEFAILED
      ' Letzten ausgewählten Ordner selektieren
      SendMessage hwnd, BFFM_SETSELECTION, ByVal 1&, ByVal LastPath
  End Select
End Function