Current News Archived News Search News Discussion Forum Old Forum Install Programs More Downloads... Troubleshooting Source Code Format Specs. Misc. Information Non-SF Stuff Links Small banner for links to this site: |
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
|