1 <%
2 ' -------------------------------------------------------------------
3 ' Klasse gibt Dateiinfos zu folgenden Dateitypen zurück:
4 ' BMP, GIF, JPG, PNG, AVI, MOV, MPG/MPEG, SWF
5 ' -------------------------------------------------------------------
6 Class clsImage
7 Private mStrBinaryData
8 Private mLngWidth
9 Private mLngHeight
10 Private mStrType
11 Private mStrContentType
12 Private mLngSize
13 Private mStrPath
14
15 Private Sub Class_Initialize()
16 mStrBinaryData = ChrB(0)
17 mLngWidth = -1
18 mLngHeight = -1
19 mLngSize = -1
20 mStrPath = "Undefined"
21 mStrType = "Unknown"
22 mStrContentType = "application/octet-stream"
23 End Sub
24
25 Public Sub Read(ByVal pStrFilePath)
26
27 ' Reset
28 mStrBinaryData = ""
29 mLngWidth = -1
30 mLngHeight = -1
31 mLngSize = -1
32 mStrType = "Unknown"
33 mStrContentType = "application/octet-stream"
34
35 If InStr(1, pStrFilePath, ":\") = 0 Then
36 pStrFilePath = Server.MapPath(pStrFilePath)
37 End If
38
39 mStrPath = pStrFilePath
40
41 Dim lObjFSO
42 Dim lObjFile
43 Set lObjFSO = Server.CreateObject("Scripting.FileSystemObject")
44
45 If lObjFSO.FileExists(pStrFilePath) Then
46 Set lObjFile = lObjFSO.OpenTextFile(pStrFilePath)
47 If Not lObjFile.AtEndOfStream Then
48 mStrBinaryData = ChrB(Asc(lObjFile.Read(1)))
49 While Not lObjFile.AtEndOfStream
50 mStrBinaryData = mStrBinaryData & ChrB(Asc(lObjFile.Read(1)))
51 Wend
52 End If
53 lObjFile.Close
54 Call ReadDimensions()
55 End If
56
57 Set lObjFSO = Nothing
58
59 End Sub
60
61 Public Property Let DataStream(ByRef pStrBinaryData)
62 mStrPath = "DataStream"
63 mStrBinaryData = pStrBinaryData
64 Call ReadDimensions()
65 End Property
66
67 Public Property Get DataStream()
68 DataStream = mStrBinaryData
69 End Property
70
71 Public Property Get Width()
72 Width = mLngWidth
73 End Property
74
75 Public Property Get Height()
76 Height = mLngHeight
77 End Property
78
79 Public Property Get ImageType()
80 ImageType = mStrType
81 End Property
82
83 Public Property Get ContentType()
84 ContentType = mStrContentType
85 End Property
86
87 Public Property Get Size()
88 Size = mLngSize
89 End Property
90
91 Public Property Get Path()
92 Path = mStrPath
93 End Property
94
95 Private Sub ReadDimensions()
96
97 mLngWidth = -1
98 mLngHeight = -1
99 mLngSize = LenB(mStrBinaryData)
100 mStrType = "Unknown"
101 mStrContentType = "application/octet-stream"
102
103 ' I refer to Ascii data as Binary data or "BIN" in this script.
104
105 Dim lBinGIF ' Signature of GIF
106 Dim lBinJPG ' Signature of JPG
107 Dim lBinBMP ' Signature of BMP
108 Dim lBinPNG ' Signature of PNG
109 Dim lBinAVI ' Signature of AVI
110 Dim lBinSWF ' Signature of SWF
111
112 Dim lBinMOV ' Signature of MOV
113 Dim lBinMPG ' Signature of MPG
114
115 lBinGIF = ChrB(Asc("G")) & ChrB(Asc("I")) & ChrB(Asc("F"))
116 lBinJPG = ChrB(Asc("J")) & ChrB(Asc("F")) & ChrB(Asc("I")) & ChrB(Asc("F"))
117 lBinBMP = ChrB(Asc("B")) & ChrB(Asc("M"))
118 lBinPNG = ChrB(&h89) & ChrB(Asc("P")) & ChrB(Asc("N")) & ChrB(Asc("G"))
119 lBinAVI = ChrB(Asc("R")) & ChrB(Asc("I")) & ChrB(Asc("F")) & ChrB(Asc("F"))
120 lBinSWF = ChrB(Asc("F")) & ChrB(Asc("W")) & ChrB(Asc("S"))
121 lBinMOV = ChrB(Asc("t")) & ChrB(Asc("k")) & ChrB(Asc("h")) & ChrB(Asc("d"))
122 lBinMPG = ChrB(0) & ChrB(0) & ChrB(1) & ChrB(179)
123
124 ' GIF File
125 If InStrB(1, mStrBinaryData, lBinGIF) = 1 Then
126 mStrType = "GIF"
127 mStrContentType = "image/gif"
128
129 mLngWidth = CLng("&h" & HexAt(8) & HexAt(7))
130 mLngHeight = CLng("&h" & HexAt(10) & HexAt(9))
131 ' JPEG file
132 ElseIf InStrB(1, mStrBinaryData, lBinJPG) = 7 Then
133 Dim lBinPrefix
134 Dim lLngStart
135
136 mStrType = "JPG"
137 mStrContentType = "image/jpeg"
138
139 ' Prefix found before image dimensions
140 lBinPrefix = ChrB(&h00) & ChrB(&h11) & ChrB(&h08)
141
142 ' Find the last prefix (so we don't confuse it with data)
143 lLngStart = 1
144 Do
145 If InStrB(lLngStart, mStrBinaryData, lBinPrefix) + 3 = 3 Then Exit Do
146 lLngStart = InStrB(lLngStart, mStrBinaryData, lBinPrefix) + 3
147 Loop
148 ' If a prefix was found
149 If Not lLngStart = 1 Then
150 mLngWidth = CLng("&h" & HexAt(lLngStart+2) & HexAt(lLngStart+3))
151 mLngHeight = CLng("&h" & HexAt(lLngStart) & HexAt(lLngStart+1))
152 End If
153 ' Bitmap File
154 ElseIf InStrB(1, mStrBinaryData, lBinBMP) = 1 Then
155 mStrType = "BMP"
156 mStrContentType = "image/bmp"
157 mLngWidth = CLng("&h" & HexAt(22) & HexAt(21) & HexAt(20) & HexAt(19))
158 mLngHeight = CLng("&h" & HexAt(26) & HexAt(25) & HexAt(24) & HexAt(23))
159 ' PNG File
160 ElseIf InStrB(1, mStrBinaryData, lBinPNG) = 1 Then
161 mStrType = "PNG"
162 mStrContentType = "image/png"
163 mLngWidth = CLng("&h" & HexAt(17) & HexAt(18) & HexAt(19) & HexAt(20))
164 mLngHeight = CLng("&h" & HexAt(21) & HexAt(22) & HexAt(23) & HexAt(24))
165 ' AVI File
166 ElseIf InStrB(1, mStrBinaryData, lBinAVI) = 1 Then
167 Dim lBinAVIH, bpAVIH
168 lBinAVIH = ChrB(Asc("a")) & ChrB(Asc("v")) & ChrB(Asc("i")) & ChrB(Asc("h"))
169 bpAVIH = InStrB(1, mStrBinaryData, lBinAVIH)
170 If bpAVIH > 1 Then
171 bpAVIH = bpAVIH + 40
172 mStrType = "AVI"
173 mStrContentType = "video/avi"
174 mLngWidth = CLng("&h" & HexAt(bpAVIH + 3) & HexAt(bpAVIH + 2) & HexAt(bpAVIH + 1) & HexAt(bpAVIH))
175 mLngHeight = CLng("&h" & HexAt(bpAVIH + 7) & HexAt(bpAVIH + 6) & HexAt(bpAVIH + 5) & HexAt(bpAVIH + 4))
176 End If
177 ' Shockwave Flash File
178 ElseIf InStrB(1, mStrBinaryData, lBinSWF) = 1 Then
179 mStrType = "SWF"
180 mStrContentType = "application/x-shockwave-flash"
181 ' Get FrameSize. Note: According to specification, NBits will
182 ' always be 15. This parser assumes that X and Y minimums are
183 ' always 0, or rather, b000000000000000, and that numbers are
184 ' expressed in 20 twips/pixel. The FrameSize RECT utilizes 9
185 ' bytes, starting at position 9.
186 ' This segment has been coded to handle dynamic NBit values, and
187 ' should technically handle the max size of 31 in the future.
188 Dim lBinSWFNBits
189 Dim lBinSWFXMin
190 Dim lBinSWFXMax
191 Dim lBinSWFYMin
192 Dim lBinSWFYMax
193 Dim lBinSWFTBytes
194 Dim lBinSWFVal
195 ' Determine NBits size (should be 15)
196 lBinSWFNBits = AscB(RShift(ChrB(CLng("&h" & HexAt(9))), 3))
197 lBinSWFTBytes = ((5 + lBinSWFNBits) / 8)
198 If ((5 + lBinSWFNBits) Mod 8) > 0 Then
199 lBinSWFTBytes = lBinSWFTBytes + 1
200 End If
201 ' Determine number of bytes needed to total to the bits
202 lBinSWFTBytes = fix(((lBinSWFNBits * 4) + 5) / 8)
203 If (((lBinSWFNBits * 4) + 5) Mod 8) > 0 Then
204 lBinSWFTBytes = lBinSWFTBytes + 1
205 End If
206 ' Read in all the bits needed.
207 lBinSWFVal = MidB(mStrBinaryData, 9, lBinSWFTBytes)
208 ' Determine Y-Maximum
209 lBinSWFVal = RShift(lBinSWFVal, (lBinSWFTBytes * 8) - ((lBinSWFNBits * 4) + 5))
210 lBinSWFYMax = ATOI(RShift(MidB(LShift(MidB(lBinSWFVal, (LenB(lBinSWFVal) - 4) + 1, 4), 1), (LenB(LShift(MidB(lBinSWFVal, (LenB(lBinSWFVal) - 4) + 1, 4), 1)) - 4) + 1, 4), 1)) And ((2 ^ lBinSWFNBits) - 1)
211 ' Determine Y-Minimum
212 lBinSWFVal = RShift(lBinSWFVal, lBinSWFNBits)
213 lBinSWFYMin = ATOI(RShift(MidB(LShift(MidB(lBinSWFVal, (LenB(lBinSWFVal) - 4) + 1, 4), 1), (LenB(LShift(MidB(lBinSWFVal, (LenB(lBinSWFVal) - 4) + 1, 4), 1)) - 4) + 1, 4), 1)) And ((2 ^ lBinSWFNBits) - 1)
214 ' Determine X-Maximum
215 lBinSWFVal = RShift(lBinSWFVal, lBinSWFNBits)
216 lBinSWFXMax = ATOI(RShift(MidB(LShift(MidB(lBinSWFVal, (LenB(lBinSWFVal) - 4) + 1, 4), 1), (LenB(LShift(MidB(lBinSWFVal, (LenB(lBinSWFVal) - 4) + 1, 4), 1)) - 4) + 1, 4), 1)) And ((2 ^ lBinSWFNBits) - 1)
217 ' Determine X-Minimum
218 lBinSWFVal = RShift(lBinSWFVal, lBinSWFNBits)
219 lBinSWFXMin = ATOI(RShift(MidB(LShift(MidB(lBinSWFVal, (LenB(lBinSWFVal) - 4) + 1, 4), 1), (LenB(LShift(MidB(lBinSWFVal, (LenB(lBinSWFVal) - 4) + 1, 4), 1)) - 4) + 1, 4), 1)) And ((2 ^ lBinSWFNBits) - 1)
220 ' Now calculate the Width and Height in pixels
221 mLngWidth = ((lBinSWFXMax - lBinSWFXMin) + 1) \ 20
222 mLngHeight = ((lBinSWFYMax - lBinSWFYMin) + 1) \ 20
223 ' MPEG File
224 ElseIf InStrB(1, mStrBinaryData, lBinMPG) > 0 Then
225 mStrType = "MPG"
226 mStrContentType = "video/mpeg"
227 Dim lBinMPGPos
228 Dim lBinMPGVal
229 lBinMPGPos = InStrB(1, mStrBinaryData, lBinMPG) + LenB(lBinMPG)
230 lBinMPGVal = MidB(mStrBinaryData, lBinMPGPos, 3)
231 mLngHeight = ATOI(lBinMPGVal) And ((2 ^ 12) - 1)
232 lBinMPGVal = RShift(lBinMPGVal, 12)
233 mLngWidth = ATOI(lBinMPGVal) And ((2 ^ 12) - 1)
234 ' Quicktime Movie File
235 ElseIf InStrB(1, mStrBinaryData, lBinMOV) > 0 Then
236 mStrType = "MOV"
237 mStrContentType = "video/quicktime"
238 Dim lBinMOVPos
239 lBinMOVPos = InStrB(1, mStrBinaryData, lBinMov) + LenB(lBinMov)
240 mLngWidth = ATOI(ReverseB(MidB(mStrBinaryData, lBinMOVPos + 77, 4)))
241 mLngHeight = ATOI(ReverseB(MidB(mStrBinaryData, lBinMOVPos + 77 + 4, 4)))
242 End If
243 ' Response.Write "<UL><LI>mStrType = " & mStrType & "<LI>mStrContentType = " & mStrContentType & "<LI>mLngWidth = " & mLngWidth & "<LI>mLngHeight = " & mLngHeight & "</UL>"
244 End Sub
245
246 Private Function HexAt(ByRef pLngPosition)
247 If pLngPosition > LenB(mStrBinaryData) Or pLngPosition <= 0 Then Exit Function
248 HexAt = Right("0" & Hex(AscB(MidB(mStrBinaryData, pLngPosition, 1))), 2)
249 End Function
250
251 ' --------------------------- MOVE TO COMMON FUNCTIONS ----------------------------
252
253 Private Function ReverseB(sValue)
254 Dim iCur, iLen, iRes : iRes = ""
255 iLen = LenB(sValue)
256 If (iLen < 1) Then
257 ReverseB = Null
258 Exit Function
259 End If
260 For iCur = 1 To iLen
261 iRes = iRes & MidB(sValue, iLen - iCur + 1, 1)
262 Next
263 ReverseB = iRes
264 End Function
265
266 Private Function ATOI(sValue)
267 Dim iCur, iLen, iVal, iRes : iRes = 0
268 iLen = LenB(sValue)
269
270 If (iLen > 4) Or (iLen < 1) Then
271 ATOI = Null
272 Exit Function
273 End If
274 For iCur = 1 To iLen
275 iVal = CLng(AscB(MidB(sValue, iLen - iCur + 1, 1)))
276 If iCur > 1 Then
277 iVal = iVal * (256 ^ (iCur - 1))
278 End If
279 iRes = iRes + iVal
280 Next
281 ATOI = iRes
282 End Function
283
284 Private Function LShift(sValue, iBits)
285 Dim i__BYTE : i__BYTE = 8
286 Dim sResult, sHold, iPartial
287 Dim iLen, iCur, sByte, iByte
288
289 ' Do nothing if no bit shift requested, or perform LShift.
290 If iBits = 0 Then
291 LShift = sValue
292 Exit Function
293 ElseIf iBits < 0 Then
294 LShift = RShift(sValue, Abs(iBits))
295 Exit Function
296 ElseIf LenB(sValue) < Fix(iBits / i__BYTE) Then
297 LShift = sValue
298 Exit Function
299 End If
300
301 ' Add whole bytes
302 iLen = Fix(iBits / i__BYTE)
303 sResult = sValue
304 If iLen > 0 Then
305 For iCur = 1 To iLen
306 sResult = sResult & ChrB(0)
307 Next
308 End If
309 iPartial = iBits Mod i__BYTE
310 If iPartial = 0 Then
311 LShift = sResult
312 Exit Function
313 End If
314 sHold = sResult
315 sResult = ""
316
317 ' Byte by Byte, shift remaining bits.
318 iLen = LenB(sHold)
319 For iCur = 1 To iLen
320 If iCur < iLen Then
321 sByte = MidB(sHold, iCur, 2)
322 iByte = (AscB(MidB(sByte, 1, 1)) * 256) + AscB(MidB(sByte, 2, 1))
323 Else
324 sByte = MidB(sHold, iCur, 1)
325 iByte = (AscB(sByte) * 256)
326 End If
327 ' Perform the shift
328 iByte = Fix(CLng(iByte) * (2 ^ iPartial))
329 ' Convert back to string
330 If iCur = 1 Then
331 ' 2 Left Most Bytes
332 sByte = String(Len(Hex(iByte)) Mod 2, "0") & Hex(iByte) & String(6,"0")
333 sByte = Left(sByte, Len(sByte) - 2)
334 sResult = sResult & ChrB(CLng("&h" & String(6, "0") & Left(sByte, 2)))
335 sResult = sResult & ChrB(CLng("&h" & String(6, "0") & Mid(sByte, 3, 2)))
336 Else
337 ' Middle Byte
338 sByte = Right(String(6