1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
Attribute VB_Name = "Other"
'
' BrowseForFolder comes from codeguru
' GetExecutable comes from VBWorld
' TrimAll comes from freevbcode
'
' Suport for the browse directory dialog
'
Public Enum eBIF
BIF_RETURNONLYFSDIRS = &H1
BIF_DONTGOBELOWDOMAIN = &H2
BIF_STATUSTEXT = &H4
BIF_RETURNFSANCESTORS = &H8
BIF_BROWSEFORCOMPUTER = &H1000
BIF_BROWSEFORPRINTER = &H2000
End Enum
Private Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
'
' Support for the find executable
'
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory _
As String, ByVal lpResult As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal _
lpszPath As String, ByVal lpPrefixString _
As String, ByVal wUnique As Long, ByVal _
lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal _
nBufferLength As Long, ByVal lpBuffer As _
String) As Long
'
' high level interfaces
'
Public Function BrowseForFolder(ByVal hwndOwner As Long, _
ByVal sPrompt As String, _
Optional ByVal lFlags As eBIF = BIF_RETURNONLYFSDIRS) As String
'
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BROWSEINFO
With udtBI
.hwndOwner = hwndOwner
.lpszTitle = sPrompt & ""
.ulFlags = BIF_RETURNONLYFSDIRS
End With
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(260, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
Else
'Cancel is clicked
sPath = ""
End If
BrowseForFolder = sPath
End Function
Public Function GetExecutable(ByVal Extension As String) As String
Dim Path As String
Dim FileName As String
Dim nRet As Long
Const MAX_PATH As Long = 260
'Create a tempfile
Path = String$(MAX_PATH, 0)
If GetTempPath(MAX_PATH, Path) Then
FileName = String$(MAX_PATH, 0)
If GetTempFileName(Path, "~", 0, FileName) Then
FileName = Left$(FileName, _
InStr(FileName, vbNullChar) - 1)
'Rename it to use supplied extension
Name FileName As Left$(FileName, _
InStr(FileName, ".")) & Extension
FileName = Left$(FileName, _
InStr(FileName, ".")) & Extension
'Get name of associated EXE
Path = String$(MAX_PATH, 0)
Call FindExecutable(FileName, vbNullString, Path)
GetExecutable = Left$(Path, InStr(Path, vbNullChar) - 1)
'Clean up
Kill FileName
End If
End If
End Function
Public Function GetFileExtension(ByVal FilePath As String) As String
Dim Pos As Integer
Pos = InStrRev(FilePath, "\")
If Pos <> 0 Then
FilePath = Right$(FilePath, Len(FilePath) - Pos)
End If
Pos = InStrRev(FilePath, ".")
If Pos <> 0 Then
GetFileExtension = Right$(FilePath, Len(FilePath) - Pos)
Else
GetFileExtension = ""
End If
End Function
Public Function GetFileName(ByVal FilePath As String) As String
Dim Pos As Integer
Dim apos As Integer
Pos = InStrRev(FilePath, "\")
apos = InStrRev(FilePath, ".")
GetFileName = Mid(FilePath, _
IIf(Pos = 0, 1, Pos + 1), _
IIf(apos = 0, Len(FilePath), apos - Pos - 1))
End Function
Public Function TrimAll(ByVal TextIN As String, Optional NonPrints As Boolean) As String
TrimAll = Trim(TextIN)
If NonPrints Then
Dim x As Long
' remove all non-printable characters
While InStr(TrimAll, vbCrLf) > 0
TrimAll = Replace(TrimAll, vbCrLf, " ")
Wend
While InStr(TrimAll, vbTab) > 0
TrimAll = Replace(TrimAll, vbTab, " ")
Wend
For x = 0 To 31
While InStr(TrimAll, Chr(x)) > 0
TrimAll = Replace(TrimAll, Chr(x), " ")
Wend
Next x
For x = 127 To 255
While InStr(TrimAll, Chr(x)) > 0
TrimAll = Replace(TrimAll, Chr(x), " ")
Wend
Next x
End If
While InStr(TrimAll, String(2, " ")) > 0
TrimAll = Replace(TrimAll, String(2, " "), " ")
Wend
End Function
|
