Commit | Line | Data |
b31da37a |
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 |