1 <%
2 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
3 '::: :::
4 '::: This routine will attempt to identify any filespec passed :::
5 '::: as a graphic file (regardless of the extension). This will :::
6 '::: work with BMP, GIF, JPG and PNG files. :::
7 '::: :::
8 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
9 '::: Based on ideas presented by David Crowell :::
10 '::: (credit where due) :::
11 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
12 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
13 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
14 '::: blah blah blah blah blah blah blah blah blah blah blah blah :::
15 '::: blah blah blah blah blah blah blah blah blah blah blah blah :::
16 '::: blah blah Copyright *c* MM, Mike Shaffer blah blah :::
17 '::: blah blah ALL RIGHTS RESERVED WORLDWIDE blah blah :::
18 '::: blah blah Permission is granted to use this code blah blah :::
19 '::: blah blah in your projects, as long as this blah blah :::
20 '::: blah blah copyright notice is included blah blah :::
21 '::: blah blah blah blah blah blah blah blah blah blah blah blah :::
22 '::: blah blah blah blah blah blah blah blah blah blah blah blah :::
23 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
24
25
26 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
27 '::: :::
28 '::: This function gets a specified number of bytes from any :::
29 '::: file, starting at the offset (base 1) :::
30 '::: :::
31 '::: Passed: :::
32 '::: flnm => Filespec of file to read :::
33 '::: offset => Offset at which to start reading :::
34 '::: bytes => How many bytes to read :::
35 '::: :::
36 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
37 function GetBytes(flnm, offset, bytes)
38
39
40 Dim objFSO
41 Dim objFTemp
42 Dim objTextStream
43 Dim lngSize
44
45
46 on error resume next
47
48
49 Set objFSO = CreateObject("Scripting.FileSystemObject")
50
51
52 ' First, we get the filesize
53 Set objFTemp = objFSO.GetFile(flnm)
54 lngSize = objFTemp.Size
55 set objFTemp = nothing
56
57
58 fsoForReading = 1
59 Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)
60
61
62 if offset > 0 then
63 strBuff = objTextStream.Read(offset - 1)
64 end if
65
66
67 if bytes = -1 then ' Get All!
68
69
70 GetBytes = objTextStream.Read(lngSize) 'ReadAll
71
72
73 else
74
75
76 GetBytes = objTextStream.Read(bytes)
77
78
79 end if
80
81
82 objTextStream.Close
83 set objTextStream = nothing
84 set objFSO = nothing
85
86
87 end function
88
89
90
91
92 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
93 '::: :::
94 '::: Functions to convert two bytes to a numeric value (long) :::
95 '::: (both little-endian and big-endian) :::
96 '::: :::
97 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
98 function lngConvert(strTemp)
99 lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
100 end function
101
102
103 function lngConvert2(strTemp)
104 lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp,1)) * 256)))
105 end function
106
107
108
109
110 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
111 '::: :::
112 '::: This function does most of the real work. It will attempt :::
113 '::: to read any file, regardless of the extension, and will :::
114 '::: identify if it is a graphical image. :::
115 '::: :::
116 '::: Passed: :::
117 '::: flnm => Filespec of file to read :::
118 '::: width => width of image :::
119 '::: height => height of image :::
120 '::: depth => color depth (in number of colors) :::
121 '::: strImageType=> type of image (e.g. GIF, BMP, etc.) :::
122 '::: :::
123 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
124 function gfxSpex(flnm, width, height, depth, strImageType)
125
126
127 dim strPNG
128 dim strGIF
129 dim strBMP
130 dim strType
131 strType = ""
132 strImageType = "(unknown)"
133
134
135 gfxSpex = False
136
137
138 strPNG = chr(137) & chr(80) & chr(78)
139 strGIF = "GIF"
140 strBMP = chr(66) & chr(77)
141
142
143 strType = GetBytes(flnm, 0, 3)
144
145
146 if strType = strGIF then ' is GIF
147
148
149 strImageType = "GIF"
150 Width = lngConvert(GetBytes(flnm, 7, 2))
151 Height = lngConvert(GetBytes(flnm, 9, 2))
152 Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
153 gfxSpex = True
154
155
156 elseif left(strType, 2) = strBMP then ' is BMP
157
158
159 strImageType = "BMP"
160 Width = lngConvert(GetBytes(flnm, 19, 2))
161 Height = lngConvert(GetBytes(flnm, 23, 2))
162 Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
163 gfxSpex = True
164
165
166 elseif strType = strPNG then ' Is PNG
167
168
169 strImageType = "PNG"
170 Width = lngConvert2(GetBytes(flnm, 19, 2))
171 Height = lngConvert2(GetBytes(flnm, 23, 2))
172 Depth = getBytes(flnm, 25, 2)
173
174
175 select case asc(right(Depth,1))
176 case 0
177 Depth = 2 ^ (asc(left(Depth, 1)))
178 gfxSpex = True
179 case 2
180 Depth = 2 ^ (asc(left(Depth, 1)) * 3)
181 gfxSpex = True
182 case 3
183 Depth = 2 ^ (asc(left(Depth, 1))) '8
184 gfxSpex = True
185 case 4
186 Depth = 2 ^ (asc(left(Depth, 1)) * 2)
187 gfxSpex = True
188 case 6
189 Depth = 2 ^ (asc(left(Depth, 1)) * 4)
190 gfxSpex = True
191 case else
192 Depth = -1
193 end select
194
195
196
197
198 else
199
200
201 strBuff = GetBytes(flnm, 0, -1) ' Get all bytes from file
202 lngSize = len(strBuff)
203 flgFound = 0
204
205
206 strTarget = chr(255) & chr(216) & chr(255)
207 flgFound = instr(strBuff, strTarget)
208
209
210 if flgFound = 0 then
211 exit function
212 end if
213
214
215 strImageType = "JPG"
216 lngPos = flgFound + 2
217 ExitLoop = false
218
219
220 do while ExitLoop = False and lngPos < lngSize
221
222
223 do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
224 lngPos = lngPos + 1
225 loop
226
227
228 if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff,lngPos, 1)) > 195 then
229 lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
230 lngPos = lngPos + lngMarkerSize + 1
231 else
232 ExitLoop = True
233 end if
234
235
236 loop
237 '
238 if ExitLoop = False then
239
240
241 Width = -1
242 Height = -1
243 Depth = -1
244
245
246 else
247
248
249 Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
250 Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
251 Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
252 gfxSpex = True
253
254
255 end if
256
257
258 end if
259
260
261 end function
262
263
264
265
266
267
268 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
269 '::: Test Harness :::
270 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
271
272
273 ' To test, we'll just try to show all files with a .GIF extension in the root of C:
274
275
276 Set objFSO = CreateObject("Scripting.FileSystemObject")
277 Set objF = objFSO.GetFolder("c:\")
278 Set objFC = objF.Files
279
280
281 response.write "<table border=""0"" cellpadding=""5"">"
282
283
284 For Each f1 in objFC
285 if instr(ucase(f1.Name), ".GIF") then
286 response.write "<tr><td>" & f1.name & "</td><td>" & f1.DateCreated & _
287 "</td><td>" & f1.Size & "</td><td>"
288
289
290 if gfxSpex(f1.Path, w, h, c, strType) = true then
291 response.write w & " x " & h & " " & c & " colors"
292 else
293 response.write " "
294 end if
295
296
297 response.write "</td></tr>"
298
299
300 end if
301
302
303 Next
304
305
306 response.write "</table>"
307
308
309 set objFC = nothing
310 set objF = nothing
311 set objFSO = nothing
312
313
314 %>