Chip 2002 September/Chip_2002-09_cd1.bin/zkuste/vbasic/Data/Utils/XZipComp.exe/XceedEncoding.Cab/F112902_BrowseFolderModule.bas

BASIC Source File | 2001-04-06 | 5.4 KB | 139 lines

Attribute VB_Name = "BrowseFolderModule"
' Xceed Binary Encoding Library - Encoding Manager sample
' Copyright (c) 2001 Xceed Software Inc.
'
' [BrowseFolderModule.bas]
'
' This module contains code that implements the SHBrowseForFolder API.
'
' This file is part of the Xceed Binary Encoding Library sample applications.
' The source code in this file is only intended as a supplement to Xceed
' Binary Encoding Library's documentation, and is provided "as is", without
' warranty of any kind, either expressed or implied.

Option Explicit

Private Declare Function SHBrowseForFolder Lib "Shell32" _
                                  (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "Shell32" _
                                  (ByVal pidList As Long, _
                                  ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
                                  (ByVal lpString1 As String, ByVal _
                                  lpString2 As String) As Long

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

Public Declare Function GetLastError Lib "kernel32" () As Long


Private Const BIF_RETURNONLYFSDIRS = &H1      ' For finding a folder to start document searching
Private Const BIF_DONTGOBELOWDOMAIN = &H2     ' For starting the Find Computer
Private Const BIF_STATUSTEXT = &H4            ' Top of the dialog has 2 lines of text for BROWSEINFO.lpszTitle and one line if
                                              ' this flag is set.  Passing the message BFFM_SETSTATUSTEXTA to the hwnd can set the
                                              ' rest of the text.  This is not used with BIF_USENEWUI and BROWSEINFO.lpszTitle gets
                                              ' all three lines of text.
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_EDITBOX = &H10              ' Add an editbox to the dialog
Private Const BIF_VALIDATE = &H20             ' insist on valid result (or CANCEL)

Private Const BIF_NEWDIALOGSTYLE = &H40       ' Use the new dialog layout with the ability to resize
                                              ' Caller needs to call OleInitialize() before using this API

Private Const BIF_USENEWUI = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)

Private Const BIF_BROWSEINCLUDEURLS = &H80    ' Allow URLs to be displayed or entered. (Requires BIF_USENEWUI)

Private Const BIF_BROWSEFORCOMPUTER = &H1000  ' Browsing for Computers.
Private Const BIF_BROWSEFORPRINTER = &H2000   ' Browsing for Printers
Private Const BIF_BROWSEINCLUDEFILES = &H4000 ' Browsing for Everything
Private Const BIF_SHAREABLE = &H8000          ' sharable resources displayed (remote shares, requires BIF_USENEWUI)

Private Const MAX_PATH = 260

' message from browser
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_VALIDATEFAILEDA = 3   ' lParam:szPath ret:1(cont),0(EndDialog)
Private Const BFFM_VALIDATEFAILEDW = 4   ' lParam:wzPath ret:1(cont),0(EndDialog)

' message to browser
Private Const WM_USER = &H400
Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
Private Const BFFM_ENABLEOK = (WM_USER + 101)
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW = (WM_USER + 103)
Private Const BFFM_SETSTATUSTEXTW = (WM_USER + 104)

Private Type BrowseInfo
   hWndOwner      As Long
   pIDLRoot       As Long
   pszDisplayName As Long
   lpszTitle      As Long
   ulFlags        As Long
   lpfnCallback   As Long
   lParam         As Long
   iImage         As Long
End Type

Private m_sFolderSelected As String

Public Function BrowseFolder(ByVal hwnd As Long, _
                             ByVal sTitle As String, _
                             ByRef sFolder As String) As Boolean

    Dim lpIDList As Long
    Dim sBuffer As String
    Dim xBrowseInfo As BrowseInfo

    m_sFolderSelected = sFolder

    With xBrowseInfo
        .hWndOwner = hwnd
        .lpszTitle = lstrcat(sTitle, "")
        .lpfnCallback = Address(AddressOf BrowseCallbackProc)
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    lpIDList = SHBrowseForFolder(xBrowseInfo)

    If lpIDList Then
        sBuffer = Space(MAX_PATH)
        Call SHGetPathFromIDList(lpIDList, sBuffer)
        sFolder = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        m_sFolderSelected = sFolder
        BrowseFolder = True
    Else
        BrowseFolder = False
    End If

End Function

Private Function BrowseCallbackProc(ByVal hwnd As Long, _
                                    ByVal uMsg As Integer, _
                                    ByVal lParam As Long, _
                                    ByVal lpData As Long) As Integer

    Select Case uMsg
        Case BFFM_INITIALIZED
            Call SendMessage(hwnd, BFFM_SETSELECTIONA, 1, ByVal m_sFolderSelected)

        Case BFFM_SELCHANGED
            'Call SendMessage(hwnd, BFFM_ENABLEOK, 0, ByVal 0)
    End Select
    BrowseCallbackProc = 0

End Function

Private Function Address(lAddressIn As Long) As Long

    Address = lAddressIn

End Function