modbrowse.bas

大量优秀的vb编程

Attribute VB_Name = "modBrowse"
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Type BROWSEINFO
    hOwner 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
    cb As Long
    abID As Byte
End Type

Private Type ITEMIDLIST  'idl
    mkid As SHITEMID
End Type

'========================================================
'使用此函数可以出现一个对话框，
'并返回所选择的路径，若没有选择返回("")。
Function FPath$(nhWnd&, Title$)
    Dim bi As BROWSEINFO
    Dim idl As ITEMIDLIST
    Dim rtn&, pidl&, path$, pos%
  
    bi.hOwner = nhWnd&
  
    bi.pidlRoot = idl.mkid.cb
 
    bi.lpszTitle = Title$
  
    bi.ulFlags = &H1
  
    pidl& = SHBrowseForFolder(bi)
  
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
      
    pos% = InStr(path$, Chr$(0))
    ''
    FPath$ = Left(path$, pos - 1)
End Function
'========================================================


'========================================================
' 获取系统所有的根目录，并添加到下拉列表中。
Sub GetAllDrives(cImageCombo As ImageCombo)
    Dim LastItem As Integer
    Dim Drv As String, lResult As Long
    Dim DrvLetter As String, sBuffer As String
    Dim DrvType As Long
    
    Drv = String$(128, 0)
    lResult = GetLogicalDriveStrings(1024, Drv)

    Do While Left$(Drv, 1) <> Chr$(0)

        DrvLetter = UCase$(Left$(Drv, 3))
        Drv = Mid$(Drv, 5)

        DrvType = GetDriveType(DrvLetter)

        Select Case DrvType
            Case DRIVE_REMOVABLE
                 If DrvLetter = "A:\" Then
                     cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "35floppy"
                 ElseIf DrvLetter = "B:\" Then
                     cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "525floppy"
                 Else
                     cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "dirve2"
                 End If
            Case DRIVE_FIXED
                 
                 cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "drive1"
            
            Case DRIVE_REMOTE
                 
                 sBuffer = String$(255, 0)
                 lResult = WNetGetConnection(Left$(DrvLetter, 2), sBuffer, Len(sBuffer))
                 
                 If lResult = 0 Then
                    cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "dirvenet"
                 End If
                 
            Case DRIVE_CDROM
                 
                 cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "cddrive"
                 
            Case DRIVE_RAMDISK
                 
                 cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "dirve1"
                 
        End Select
    Loop
End Sub
'========================================================