XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Ordner: ChooseDir mit Ordnererstellung
DEF SHBrowseForFolder(1)   ! Shell32,SHBrowseForFolder
DEF SHGetPathFromIDList(2) !Shell32,SHGetPathFromIDListA
DEF &BIF_EDITBOX $10
DEF &BIF_BROWSEFORCOMPUTER $1000
DEF &BIF_BROWSEFORPRINTER $2000
DEF &BIF_BROWSEINCLUDEFILES $4000
DEF &BIF_BROWSEINCLUDEURLS&80
DEF &BIF_DONTGOBELOWDOMAIN $2
DEF &BIF_NEWDIALOGSTYLE $40
DEF &BIF_RETURNFSANCESTORS $8
DEF &BIF_RETURNONLYFSDIRS &1
DEF &BIF_SHAREABLE &8000
DEF &BIF_STATUSTEXT $4
DEF &BIF_USENEWUI $40
DEF &BIF_VALIDATE $20
Declare BrowseStyle&
BrowseStyle& = OR(OR(OR(OR(&BIF_RETURNONLYFSDIRS,&BIF_STATUSTEXT),&BIF_EDITBOX),&BIF_BROWSEINCLUDEFILES),&BIF_USENEWUI)
Declare Title$
Title$ = Wähle:
Declare ReturnBuffer#,pidl&
Dim ReturnBuffer#,260
Declare BROWSEINFO#
Dim BrowseInfo#,32
Long BROWSEINFO#,0=%hwnd
Long BROWSEINFO#,4=0
Long BROWSEINFO#,8=ReturnBuffer#
Long BROWSEINFO#,12=Addr(Title$)
Long BROWSEINFO#,16=BrowseStyle&
Long BROWSEINFO#,20=0
Long BROWSEINFO#,24=0
Long BROWSEINFO#,28=0
CLS
pidl& = SHBrowseForFolder(BROWSEINFO#)

If Neq(SHGetPathFromIDList(pidl&,ReturnBuffer#),0)

    Print String$(ReturnBuffer#,0)

Else

    Print

EndIf

Waitinput
Dispose ReturnBuffer#
Dispose BROWSEINFO#
End