flash.bas

OpenPlayer代码

Attribute VB_Name = "Flash"


Public Type FLASHHEADER
    intIsFlashMovie As Integer  '是否是SWF文件,或者发生错误
    lMHeight As Long          '电影的高      Pix
    lMWidth As Long           '电影的宽      Pix
    bColorR As Byte           '背景颜色的R值 Number
    bColorG As Byte           '背景颜色的G值 Number
    bColorB As Byte           '背景颜色的B值 Number
    intMTotalFrames As Integer    '电影的总帧数 Frames
    lMSize As Long            '电影的大小  ByteNumber
    intMRate As Integer       '电影的速度  FPS
    bMVersion As Byte         '制作电影的Flash版本
End Type
Public Type FLASHNOTE
    strAuthor As String       '作者
    strCompany As String      '公司
    strMovieName As String    '作品名
    strNote As String         '其它注释内容
    strVer As String          'OpenPlayer版本
End Type

'==================================
'二进制转为十进制函数
'用法 Long  bin2dec(strBin as String)
'返回：  二进制的十进制 长整数（Long）
'错误：  返回-1
'==================================
Public Function Bin2Dec(strBin As String) As Long
On Error GoTo Err:
   Dim lDec As Long
   Dim lCount As Long
   Dim i As Long
      
      lDec = 0
      If strBin = "" Then strBin = "0"
      
      lCount = Len(strBin)
      For i = 1 To lCount
          lDec = lDec + CInt(Left(strBin, 1)) * 2 ^ (Len(strBin) - 1)
          strBin = Right(strBin, Len(strBin) - 1)
          DoEvents
      Next
   Bin2Dec = lDec
   Exit Function
Err:
   Bin2Dec = -1
   CreateErrorReport ("Bin2Dec")
End Function

'==================================
'十进制转为二进制函数
'用法 String  Dec2Bin(Bdec as Byte)
'返回：  十进制的二进制 字符串(String)
'错误：  返回"0"
'==================================
Public Function Dec2Bin(bDec As Byte) As String
On Error GoTo Err:
  Dim strBin As String
   
   If bDec > 255 Then
      Dec2Bin = "-1"
      Exit Function
   End If
   
   
   strBin = ""
   
    '转为字符串
    While bDec > 0
           strBin = bDec Mod 2 & strBin
          bDec = Fix(bDec / 2)
          DoEvents
     Wend
     '补零足8位
     If Len(strBin) < 9 Then
         While Len(strBin) < 8
            strBin = "0" & strBin
         Wend
     End If
   Dec2Bin = strBin
Exit Function
Err:
   Dec2Bin = "0"
   CreateErrorReport ("Dec2Bin")
End Function


'=========================================
'取Flash文件的头部结构
'用法：
'  Dim FH As FlashHeader
'  FH = getFlashHeader(strFlashFileName)
'返回:
'成功：FlashHeader结构        FH.intIsFlashMovie=1
'错误：文件找不到             FH.intIsFlashMovie=-1
'      不是FlashMovie文件     FH.intIsFlashMovie=0
'      未知错误:              FH.intIsFlashMovie=2
'=========================================
Public Function getFlashHeader(strFileName As String) As FLASHHEADER
    On Error GoTo Err:
    'Dim oFSO As New FileSystemObject            '创建新文件对象，下面对文件的操作
    Dim lFileNumber As Long                      '文件号
    Dim b(20) As Byte
    Dim strSWFSignature As String * 3            'SWF的签名
    Dim intTagSize As Integer                    '标签块的大小
    Dim lMWidth As Long                          '电影的宽
    Dim lMHeight As Long                         '电影的高
    Dim bMVersion As Byte
    Dim bColorR As Byte                          '背景颜色的R值 Number
    Dim bColorG As Byte                          '背景颜色的G值 Number
    Dim bColorB As Byte                          '背景颜色的B值 Number
    Dim intMTotalFrames As Integer               '电影的总帧数 Frames
    Dim lMSize As Long                           '电影的大小  ByteNumber
    Dim intMRate(1)  As Byte                     '电影的速度  FPS 帧每秒
    Dim nBites As Integer                        '一个Tag的大小,表示一个Tag占有的Bit位数
    
    Dim i As Integer
    Dim Tmpstring As String
 
    '如果文件不存在，返回-1
    'If Not oFSO.FileExists(strFileName) Then
    If Dir(strFileName) = "" Then
        getFlashHeader.intIsFlashMovie = -1
        Exit Function
    End If
    'Set oFSO = Nothing
    
     '打开文件
    lFileNumber = FreeFile
    Open strFileName For Binary As #lFileNumber
         '读取签名
         Get #lFileNumber, , strSWFSignature
         '如果不是SWF文件，返回
         If strSWFSignature <> "FWS" Then
            getFlashHeader.intIsFlashMovie = 0
            Close #lFileNumber
            Exit Function
         End If
         
         Get #lFileNumber, , bMVersion      '版本
         Get #lFileNumber, , lMSize         '电影大小
         Get #lFileNumber, , b()
         
        '第九位的开始(二进制码)的前5比特为这个标签的nBites
        '结构如下
        'Field      Type                Comment
        'Nbits      nBits = UB[5]       Bits in each rect value field
        'Xmin       SB[nBits]           X minimum position for rect
        'Xmax       SB[nBits]           X maximum position for rect
        'Ymin       SB[nBits]           Y minimum position for rect
        'Ymax       SB[nBits]           Y maximum position for rect
        '我不知道怎样去前5个Bits的内容（通过And 和 Or可以的），所以我选把那那些内容读出来，
        '转为二进制字符串,取前5个,再转为数字,
         nBites = Bin2Dec(Left(Dec2Bin(b(0)), 5))
         intTagSize = (nBites * 4 + 5) \ 8 + 1
         '动画的大小在关闭文件之后再计算
         
         Get #lFileNumber, 9 + intTagSize, intMRate         '速率
         Get #lFileNumber, , intMTotalFrames                '总帧数
         Get #lFileNumber, 9 + intTagSize + 6, bColorR      '背景颜色R
         Get #lFileNumber, , bColorG                        '背景颜色G
         Get #lFileNumber, , bColorB                        '背景颜色B
    Close #lFileNumber
    '取电影的原始高度
    '转为二进制字符串
    Tmpstring = ""
    For i = 0 To intTagSize - 1
        Tmpstring = Tmpstring & Dec2Bin(b(i))
    Next
    '宽：(第六个比特+nBites)开始,nBites长)\20
    getFlashHeader.lMWidth = Bin2Dec(Mid(Tmpstring, 6 + nBites, nBites)) \ 20
    '高：(第六个比特+nBites*3)开始,nBites长)\20
    getFlashHeader.lMHeight = Bin2Dec(Mid(Tmpstring, 6 + nBites * 3, nBites)) \ 20
    
    
    getFlashHeader.intIsFlashMovie = 1
    getFlashHeader.bMVersion = bMVersion
    getFlashHeader.lMSize = lMSize
    getFlashHeader.intMRate = intMRate(0) * 255 + intMRate(1)
    getFlashHeader.intMTotalFrames = intMTotalFrames
    getFlashHeader.bColorR = bColorR
    getFlashHeader.bColorG = bColorG
    getFlashHeader.bColorB = bColorB
 
Exit Function
Err:
   getFlashHeader.intIsFlashMovie = 2
   CreateErrorReport ("getFlashHeader")
End Function

'====================================
'取得文件注释的内容:
'注释内容结构如下(放在电影后面):
'Field        Type                     注释
'Tag          UB[16](16Bit)            Tag id  即：SP "SP",取OpenPlayer 前两个字母
'结构如下：
'字段         类型        说明
'Tag          UB[8](8Bit)              SubTag id   Asc("A") 为作者(Author)  Asc("C") 为公司(Company)
'                                       Asc("N") 为说明(Note)    Asc("M") 为作品名(Movie)
'Length       UI32(32Bit)              Length of tag    字段的长度
'====================================
'返回:FLASHNOTE结构
'参数:strFileName,动画的路径
'用法:
'Dim strFileName As String
'strFileName = "C:\Program Files\小鱼儿工作室\OpenPlayer\About.swf"
'Dim myFlashNote As FLASHNOTE
'myFlashNote = getNote(strFileName)
'    With myFlashNote
'      Debug.Print "           作者:" & .strAuthor
'      Debug.Print "           公司:" & .strCompany
'      Debug.Print "         作品名:" & .strMovieName
'      Debug.Print "   其它注释内容:" & .strNote
'      Debug.Print " OpenPlayer版本:" & .strVer
'    End With
'====================================
Public Function getNote(strFileName As String) As FLASHNOTE
    'Dim oFSO As New FileSystemObject           '创建文件对象
    Dim lMSize As Long                          '电影的长度
    Dim lFSize As Long                          '文件的长度
    Dim lFileNumber As Long                     '文件号,打开文件用到
    Dim strSWFSignature As String * 3           'SWF的签名
    Dim b() As Byte                             '临时数组,用来存储从文件读出的内容
    Dim MyNote As String * 2                    '用来存放附加信息的 ID
    Dim bMyNote As Byte                         '用来存放从文件字段 ID
    Dim bAuthor() As Byte                       '用来存放从文件读出的 作者字段"A"的信息
    Dim bCompany() As Byte                      '用来存放从文件读出的 作者公司字段"C"的信息
    Dim bNote() As Byte                         '用来存放从文件读出的 附加注释字段"N"的信息
    Dim bVer() As Byte                          '用来存放从文件读出的 OpenPlayer版本字段"V"的信息
    Dim bMovieName() As Byte                    '用来存放从文件读出的 作品名字段"M"的信息
    Dim lTagLen As Long                         '字段的长度,通过循环,通用于各ID
    Dim i As Integer
    Dim j As Integer
    
    getNote.strMovieName = "《" & Left(getBaseName(strFileName), InStrRev(getBaseName(strFileName), ".") - 1) & "》"
    getNote.strAuthor = "未知"
    getNote.strCompany = "未知"
    
     On Error GoTo Err
    '如果文件不存在,则把strNote置为"找不到文件",其它置空""
    'If Not oFSO.FileExists(strFileName) Then
    If Dir(strFileName) = "" Then
        getNote.strNote = "找不到文件" & strFileName
        Exit Function
    End If
        
    '取文件的长度
    'lFSize = oFSO.GetFile(strFileName).Size
    lFSize = FileLen(strFileName)
      
    '开棺验尸
    lFileNumber = FreeFile
    Open strFileName For Binary As #lFileNumber
            Get #lFileNumber, , strSWFSignature             '读取签名,文件的前三个字节,为"FWS"
            
            '如果不是SWF文件...
            If strSWFSignature <> "FWS" Then
                 getNote.strNote = "不是SWF文件"
                 Close #lFileNumber
                 Exit Function
            End If