FileDialog.bas

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