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