mStrType = "SWF"
mStrContentType = "application/x-shockwave-flash"
' Get FrameSize. Note: According to specification, NBits will
' always be 15. This parser assumes that X and Y minimums are
' always 0, or rather, b000000000000000, and that numbers are
' expressed in 20 twips/pixel. The FrameSize RECT utilizes 9
' bytes, starting at position 9.
' This segment has been coded to handle dynamic NBit values, and
' should technically handle the max size of 31 in the future.
Dim lBinSWFNBits
Dim lBinSWFXMin
Dim lBinSWFXMax
Dim lBinSWFYMin
Dim lBinSWFYMax
Dim lBinSWFTBytes
Dim lBinSWFVal
' Determine NBits size (should be 15)
lBinSWFNBits = AscB(RShift(ChrB(CLng("&h" & HexAt(9))), 3))
lBinSWFTBytes = ((5 + lBinSWFNBits) / 8)
If ((5 + lBinSWFNBits) Mod 8) > 0 Then
lBinSWFTBytes = lBinSWFTBytes + 1
End If
' Determine number of bytes needed to total to the bits
lBinSWFTBytes = fix(((lBinSWFNBits * 4) + 5) / 8)
If (((lBinSWFNBits * 4) + 5) Mod 8) > 0 Then
lBinSWFTBytes = lBinSWFTBytes + 1
End If
' Read in all the bits needed.
lBinSWFVal = MidB(mStrBinaryData, 9, lBinSWFTBytes)
' Determine Y-Maximum
lBinSWFVal = RShift(lBinSWFVal, (lBinSWFTBytes * 8) - ((lBinSWFNBits * 4) + 5))
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)
' Determine Y-Minimum
lBinSWFVal = RShift(lBinSWFVal, lBinSWFNBits)
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)
' Determine X-Maximum
lBinSWFVal = RShift(lBinSWFVal, lBinSWFNBits)
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)
' Determine X-Minimum
lBinSWFVal = RShift(lBinSWFVal, lBinSWFNBits)
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)
' Now calculate the Width and Height in pixels
mLngWidth = ((lBinSWFXMax - lBinSWFXMin) + 1) \ 20
mLngHeight = ((lBinSWFYMax - lBinSWFYMin) + 1) \ 20
' MPEG File
ElseIf InStrB(1, mStrBinaryData, lBinMPG) > 0 Then
mStrType = "MPG"
mStrContentType = "video/mpeg"
Dim lBinMPGPos
Dim lBinMPGVal
lBinMPGPos = InStrB(1, mStrBinaryData, lBinMPG) + LenB(lBinMPG)
lBinMPGVal = MidB(mStrBinaryData, lBinMPGPos, 3)
mLngHeight = ATOI(lBinMPGVal) And ((2 ^ 12) - 1)
lBinMPGVal = RShift(lBinMPGVal, 12)
mLngWidth = ATOI(lBinMPGVal) And ((2 ^ 12) - 1)
' Quicktime Movie File
ElseIf InStrB(1, mStrBinaryData, lBinMOV) > 0 Then
mStrType = "MOV"
mStrContentType = "video/quicktime"
Dim lBinMOVPos
lBinMOVPos = InStrB(1, mStrBinaryData, lBinMov) + LenB(lBinMov)
mLngWidth = ATOI(ReverseB(MidB(mStrBinaryData, lBinMOVPos + 77, 4)))
mLngHeight = ATOI(ReverseB(MidB(mStrBinaryData, lBinMOVPos + 77 + 4, 4)))
End If
End Sub
Private Function HexAt(ByRef pLngPosition)
If pLngPosition > LenB(mStrBinaryData) Or pLngPosition <= 0 Then Exit Function
HexAt = Right("0" & Hex(AscB(MidB(mStrBinaryData, pLngPosition, 1))), 2)
End Function
' --------------------------- MOVE TO COMMON FUNCTIONS ----------------------------
Private Function ReverseB(sValue)
Dim iCur, iLen, iRes : iRes = ""
iLen = LenB(sValue)
If (iLen < 1) Then
ReverseB = Null
Exit Function
End If
For iCur = 1 To iLen
iRes = iRes & MidB(sValue, iLen - iCur + 1, 1)
Next
ReverseB = iRes
End Function
Private Function ATOI(sValue)
Dim iCur, iLen, iVal, iRes : iRes = 0
iLen = LenB(sValue)
If (iLen > 4) Or (iLen < 1) Then
ATOI = Null
Exit Function
End If
For iCur = 1 To iLen
iVal = CLng(AscB(MidB(sValue, iLen - iCur + 1, 1)))
If iCur > 1 Then
iVal = iVal * (256 ^ (iCur - 1))
End If
iRes = iRes + iVal
Next
ATOI = iRes
End Function
Private Function LShift(sValue, iBits)
Dim i__BYTE : i__BYTE = 8
Dim sResult, sHold, iPartial
Dim iLen, iCur, sByte, iByte
' Do nothing if no bit shift requested, or perform LShift.
If iBits = 0 Then
LShift = sValue
Exit Function
ElseIf iBits < 0 Then
LShift = RShift(sValue, Abs(iBits))
Exit Function
ElseIf LenB(sValue) < Fix(iBits / i__BYTE) Then
LShift = sValue
Exit Function
End If
' Add whole bytes
iLen = Fix(iBits / i__BYTE)
sResult = sValue
If iLen > 0 Then
For iCur = 1 To iLen
sResult = sResult & ChrB(0)
Next
End If
iPartial = iBits Mod i__BYTE
If iPartial = 0 Then
LShift = sResult
Exit Function
End If
sHold = sResult
sResult = ""
' Byte by Byte, shift remaining bits.
iLen = LenB(sHold)
For iCur = 1 To iLen
If iCur < iLen Then
sByte = MidB(sHold, iCur, 2)
iByte = (AscB(MidB(sByte, 1, 1)) * 256) + AscB(MidB(sByte, 2, 1))
Else
sByte = MidB(sHold, iCur, 1)
iByte = (AscB(sByte) * 256)
End If
' Perform the shift
iByte = Fix(CLng(iByte) * (2 ^ iPartial))
' Convert back to string
If iCur = 1 Then
' 2 Left Most Bytes
sByte = String(Len(Hex(iByte)) Mod 2, "0") & Hex(iByte) & String(6,"0")
sByte = Left(sByte, Len(sByte) - 2)
sResult = sResult & ChrB(CLng("&h" & String(6, "0") & Left(sByte, 2)))
sResult = sResult & ChrB(CLng("&h" & String(6, "0") & Mid(sByte, 3, 2)))
Else
' Middle Byte
sByte = Right(String(6, "0") & String(Len(Hex(iByte)) Mod 2, "0") & Hex(iByte), 6)
sResult = sResult & ChrB(CLng("&h" & String(6, "0") & Mid(sByte, 3, 2)))
End If
Next
LShift = sResult
End Function