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, cNum2 As Long
 111 For cNum = 1 To Len(TextStr)
 112     cNum2 = InStr(cNum, TextStr, Chr$(0))
 113     If cNum2 Then
 114         cNum = cNum2
 115         cNum2 = InStr(cNum + 1, TextStr, Chr$(0))
 116         If cNum + 1 = cNum2 Or cNum2 = 0 Then
 117             TextStr = Left(TextStr, cNum - 1)
 118             Exit Sub
 119         End If
 120     Else
 121         Exit Sub
 122     End If
 123 Next cNum
 124 End Sub
 125 Sub InitFileDialog(ByRef lpFileDialog As OPENFILENAME)
 126 lpFileDialog.lStructSize = Len(lpFileDialog)
 127 lpFileDialog.hwndOwner = 0
 128 lpFileDialog.hInstance = 0
 129 lpFileDialog.Filter = NullPtr
 130 lpFileDialog.CustomFilter = NullPtr
 131 lpFileDialog.nMaxCustFilter = 0
 132 lpFileDialog.FilterIndex = 0
 133 lpFileDialog.FileName = NullPtr
 134 lpFileDialog.MaxFileSize = 260
 135 lpFileDialog.FileTitle = NullPtr
 136 lpFileDialog.MaxFileTitleSize = 260
 137 lpFileDialog.InitDir = NullPtr
 138 lpFileDialog.DialogTitle = NullPtr
 139 lpFileDialog.Flags = 0
 140 lpFileDialog.nFileOffset = 0
 141 lpFileDialog.nFileExtension = 0
 142 lpFileDialog.DefaultExt = NullPtr
 143 lpFileDialog.lCustData = 0
 144 lpFileDialog.lpfnHook = 0
 145 lpFileDialog.lpTemplateName = NullPtr
 146 End Sub
 147 Sub InitFolderDialog(ByRef lpFolderDialog As BROWSEINFO)
 148 lpFolderDialog.hwndOwner = 0
 149 lpFolderDialog.pidlRoot = 0
 150 lpFolderDialog.DisplayName = NullPtr
 151 lpFolderDialog.Title = NullPtr
 152 lpFolderDialog.Flags = 0
 153 lpFolderDialog.lpfn = 0
 154 lpFolderDialog.lParam = 0
 155 lpFolderDialog.iImage = 0
 156 End Sub
 157 Function ShowOpen(ByRef lpFileDialog As OPENFILENAME) As Boolean
 158 lpFileDialog.lStructSize = Len(lpFileDialog)
 159 ReplaceChar lpFileDialog.Filter, "|", Chr$(0)
 160 lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)
 161 If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _
 162     lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))
 163 If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _
 164     lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))
 165 ShowOpen = GetOpenFileName(lpFileDialog)
 166 lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)
 167 ReplaceChar lpFileDialog.Filter, Chr$(0), "|"
 168 StripNull lpFileDialog.FileName
 169 StripNull lpFileDialog.FileTitle
 170 End Function
 171 Function ShowSave(ByRef lpFileDialog As OPENFILENAME) As Boolean
 172 lpFileDialog.lStructSize = Len(lpFileDialog)
 173 ReplaceChar lpFileDialog.Filter, "|", Chr$(0)
 174 lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)
 175 If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _
 176     lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))
 177 If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _
 178     lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))
 179 ShowSave = GetSaveFileName(lpFileDialog)
 180 lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)
 181 ReplaceChar lpFileDialog.Filter, Chr$(0), "|"
 182 StripNull lpFileDialog.FileName
 183 StripNull lpFileDialog.FileTitle
 184 End Function
 185 Function ShowFolder(ByRef lpFolderDialog As BROWSEINFO) As Long
 186 If Len(lpFolderDialog.DisplayName) <= 260 Then _
 187     lpFolderDialog.DisplayName = lpFolderDialog.DisplayName + String$(260 - Len(lpFolderDialog.DisplayName), Chr$(0))
 188 ShowFolder = SHBrowseForFolder(lpFolderDialog)
 189 StripNull lpFolderDialog.DisplayName
 190 End Function