FileDialog.bas

   1 Attribute VB_Name = "FileDialog"
   2 Option Explicit
   3
   4 Public NullPtr As String
   5
   6 Type OPENFILENAME
   7     lStructSize As Long
   8     hwndOwner As Long
   9     hInstance As Long
  10     Filter As String
  11     CustomFilter As String
  12     nMaxCustFilter As Long
  13     FilterIndex As Long
  14     FileName As String
  15     MaxFileSize As Long
  16     FileTitle As String
  17     MaxFileTitleSize As Long
  18     InitDir As String
  19     DialogTitle As String
  20     Flags As Long
  21     nFileOffset As Integer
  22     nFileExtension As Integer
  23     DefaultExt As String
  24     lCustData As Long
  25     lpfnHook As Long
  26     lpTemplateName As String
  27 End Type
  28
  29 Type BROWSEINFO
  30     hwndOwner As Long
  31     pidlRoot As Long
  32     DisplayName As String
  33     Title As String
  34     Flags As Long
  35     lpfn As Long
  36     lParam As Long
  37     iImage As Long
  38 End Type
  39
  40 Declare Function CommDlgExtendedError Lib "Comdlg32.dll" () As Long
  41 Declare Function GetOpenFileName Lib "Comdlg32.dll" _
  42     Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Boolean
  43 Declare Function GetSaveFileName Lib "Comdlg32.dll" _
  44     Alias "GetSaveFileNameA" (lpofn As OPENFILENAME) As Boolean
  45 Declare Function SHBrowseForFolder Lib "Shell32.dll" _
  46     (lpbi As BROWSEINFO) As Long
  47 Declare Function SHGetPathFromIDList Lib "Shell32.dll" ( _
  48     pidl As Long, _
  49     ByRef pszPath As Byte) As Boolean
  50
  51 Public Const OFN_READONLY             As Long = &H1
  52 Public Const OFN_OVERWRITEPROMPT      As Long = &H2
  53 Public Const OFN_HIDEREADONLY         As Long = &H4
  54 Public Const OFN_NOCHANGEDIR          As Long = &H8
  55 Public Const OFN_SHOWHELP             As Long = &H10
  56 Public Const OFN_ENABLEHOOK           As Long = &H20
  57 Public Const OFN_ENABLETEMPLATE       As Long = &H40
  58 Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
  59 Public Const OFN_NOVALIDATE           As Long = &H100
  60 Public Const OFN_ALLOWMULTISELECT     As Long = &H200
  61 Public Const OFN_EXTENSIONDIFFERENT   As Long = &H400
  62 Public Const OFN_PATHMUSTEXIST        As Long = &H800
  63 Public Const OFN_FILEMUSTEXIST        As Long = &H1000
  64 Public Const OFN_CREATEPROMPT         As Long = &H2000
  65 Public Const OFN_SHAREAWARE           As Long = &H4000
  66 Public Const OFN_NOREADONLYRETURN     As Long = &H8000
  67 Public Const OFN_NOTESTFILECREATE     As Long = &H10000
  68 Public Const OFN_NONETWORKBUTTON      As Long = &H20000
  69 Public Const OFN_NOLONGNAMES          As Long = &H40000        ' force no long names for 4.x modules
  70 Public Const OFN_EXPLORER             As Long = &H80000        ' new look commdlg
  71 Public Const OFN_NODEREFERENCELINKS   As Long = &H100000
  72 Public Const OFN_LONGNAMES            As Long = &H200000       ' force long names for 3.x modules
  73 Public Const OFN_ENABLEINCLUDENOTIFY  As Long = &H400000       ' send include message to callback
  74 Public Const OFN_ENABLESIZING         As Long = &H800000
  75
  76 Public Const BIF_RETURNONLYFSDIRS   As Long = &H1     ' For finding a folder to start document searching
  77 Public Const BIF_DONTGOBELOWDOMAIN  As Long = &H2     ' For starting the Find Computer
  78 Public Const BIF_STATUSTEXT         As Long = &H4
  79 Public Const BIF_RETURNFSANCESTORS  As Long = &H8
  80 Public Const BIF_EDITBOX            As Long = &H10
  81 Public Const BIF_VALIDATE           As Long = &H20    ' insist on valid result (or CANCEL)
  82
  83 Public Const BIF_BROWSEFORCOMPUTER  As Long = &H1000  ' Browsing for Computers.
  84 Public Const BIF_BROWSEFORPRINTER   As Long = &H2000  ' Browsing for Printers
  85 Public Const BIF_BROWSEINCLUDEFILES As Long = &H4000  ' Browsing for Everything
  86
  87 Function GetPathFromID(ByVal dwID As Long) As String
  88 Dim buffer(1 To 260) As Byte
  89 GetPathFromID = NullPtr
  90 If SHGetPathFromIDList(ByVal dwID, buffer(1)) Then
  91     GetPathFromID = StrConv(buffer, vbUnicode)
  92     StripNull GetPathFromID
  93 End If
  94 End Function
  95 Sub ReplaceChar(ByRef TextStr As String, ByVal Char As String, ByVal NewChar As String)
  96 If Len(Char) > 1 Then Char = Left$(Char, 1)
  97 If Len(NewChar) > 1 Then NewChar = Left$(NewChar, 1)
  98 Dim cNum As Long, cNum2 As Long
  99 For cNum = 1 To Len(TextStr)
 100     cNum2 = InStr(cNum, TextStr, Char)
 101     If cNum2 Then
 102         cNum = cNum2
 103         Mid$(TextStr, cNum, 1) = NewChar
 104     Else
 105         Exit Sub
 106     End If
 107 Next cNum
 108 End Sub
 109 Sub StripNull(ByRef TextStr As String)
 110 Dim cNum As Long
 111 cNum = InStr(1, TextStr, Chr$(0))
 112 If cNum Then
 113     TextStr = Left(TextStr, cNum - 1)
 114 End If
 115 End Sub
 116 Sub StripNullMulti(ByRef TextStr As String)
 117 Dim cNum As Long, cNum2 As Long
 118 For cNum = 1 To Len(TextStr)
 119     cNum2 = InStr(cNum, TextStr, Chr$(0))
 120     If cNum2 Then
 121         cNum = cNum2
 122         cNum2 = InStr(cNum + 1, TextStr, Chr$(0))
 123         If cNum + 1 = cNum2 Or cNum2 = 0 Then
 124             TextStr = Left(TextStr, cNum - 1)
 125             Exit Sub
 126         End If
 127     Else
 128         Exit Sub
 129     End If
 130 Next cNum
 131 End Sub
 132 Sub InitFileDialog(ByRef lpFileDialog As OPENFILENAME)
 133 lpFileDialog.lStructSize = Len(lpFileDialog)
 134 lpFileDialog.hwndOwner = 0
 135 lpFileDialog.hInstance = 0
 136 lpFileDialog.Filter = NullPtr
 137 lpFileDialog.CustomFilter = NullPtr
 138 lpFileDialog.nMaxCustFilter = 0
 139 lpFileDialog.FilterIndex = 0
 140 lpFileDialog.FileName = NullPtr
 141 lpFileDialog.MaxFileSize = 260
 142 lpFileDialog.FileTitle = NullPtr
 143 lpFileDialog.MaxFileTitleSize = 260
 144 lpFileDialog.InitDir = NullPtr
 145 lpFileDialog.DialogTitle = NullPtr
 146 lpFileDialog.Flags = 0
 147 lpFileDialog.nFileOffset = 0
 148 lpFileDialog.nFileExtension = 0
 149 lpFileDialog.DefaultExt = NullPtr
 150 lpFileDialog.lCustData = 0
 151 lpFileDialog.lpfnHook = 0
 152 lpFileDialog.lpTemplateName = NullPtr
 153 End Sub
 154 Sub InitFolderDialog(ByRef lpFolderDialog As BROWSEINFO)
 155 lpFolderDialog.hwndOwner = 0
 156 lpFolderDialog.pidlRoot = 0
 157 lpFolderDialog.DisplayName = NullPtr
 158 lpFolderDialog.Title = NullPtr
 159 lpFolderDialog.Flags = 0
 160 lpFolderDialog.lpfn = 0
 161 lpFolderDialog.lParam = 0
 162 lpFolderDialog.iImage = 0
 163 End Sub
 164 Function ShowOpen(ByRef lpFileDialog As OPENFILENAME) As Boolean
 165 lpFileDialog.lStructSize = Len(lpFileDialog)
 166 ReplaceChar lpFileDialog.Filter, "|", Chr$(0)
 167 lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)
 168 If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _
 169     lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))
 170 If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _
 171     lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))
 172 ShowOpen = GetOpenFileName(lpFileDialog)
 173 lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)
 174 ReplaceChar lpFileDialog.Filter, Chr$(0), "|"
 175 If lpFileDialog.Flags And (OFN_ALLOWMULTISELECT Or OFN_EXPLORER) Then
 176     StripNullMulti lpFileDialog.FileName
 177     StripNullMulti lpFileDialog.FileTitle
 178 Else
 179     StripNull lpFileDialog.FileName
 180     StripNull lpFileDialog.FileTitle
 181 End If
 182 End Function
 183 Function ShowSave(ByRef lpFileDialog As OPENFILENAME) As Boolean
 184 lpFileDialog.lStructSize = Len(lpFileDialog)
 185 ReplaceChar lpFileDialog.Filter, "|", Chr$(0)
 186 lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)
 187 If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _
 188     lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))
 189 If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _
 190     lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))
 191 ShowSave = GetSaveFileName(lpFileDialog)
 192 lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)
 193 ReplaceChar lpFileDialog.Filter, Chr$(0), "|"
 194 StripNull lpFileDialog.FileName
 195 StripNull lpFileDialog.FileTitle
 196 End Function
 197 Function ShowFolder(ByRef lpFolderDialog As BROWSEINFO) As Long
 198 If Len(lpFolderDialog.DisplayName) <= 260 Then _
 199     lpFolderDialog.DisplayName = lpFolderDialog.DisplayName + String$(260 - Len(lpFolderDialog.DisplayName), Chr$(0))
 200 ShowFolder = SHBrowseForFolder(lpFolderDialog)
 201 StripNull lpFolderDialog.DisplayName
 202 End Function