flash.bas

OpenPlayer代码

Attribute VB_Name = "Flash"
Const PLAYER_SIZE = 98304

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          '版本
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
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"
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
 
 Dim i As Integer
 Dim Tmpstring As String
 
   '如果文件不存在，返回-1
   If Not ofso.FileExists(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
     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
     Get #lFileNumber, , bColorG
     Get #lFileNumber, , bColorB
  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

End Function

'====================================
'取得文件注释的内容:
'注释内容标识如下(放在电影后面):
'Short  Tag
'Field        Type        注释
'Tag          UB[16]      Tag id  即：SP "SP",取SuperPlayer 前两个字母
 
'结构如下：
'字段         类型        说明
'Tag          UB[8]       Tag id   Asc("A") 为作者(Author)  Asc("C") 为公司(Company)
'                                  Asc("N") 为说明(Note)    Asc("M") 为电影名(Movie)
'Length       UI32        Length of tag    字段的长度
'====================================
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                          '用来存放从文件读出的 SuperPlayer版本字段"V"的信息
Dim bMovieName() As Byte                    '用来存放从文件读出的 电影名字段"M"的信息
Dim lTagLen As Long                         '字段的长度,通过循环,通用于各ID
Dim i As Integer
Dim j As Integer
    If InStr(strFileName, Chr(0)) > 0 Then
       strFileName = Left(strFileName, InStr(strFileName, Chr(0)) - 1)
    End If
    getNote.strMovieName = "《" & Left(Mid(strFileName, InStrRev(strFileName, "\") + 1), Len(Mid(strFileName, InStrRev(strFileName, "\") + 1)) - 4) & "》"
    getNote.strAuthor = "未知"
    getNote.strCompany = "未知"

 On Error GoTo err
    '如果文件不存在,则把strNote置为"找不到文件",其它置空""
    If Not ofso.FileExists(strFileName) Then
         getNote.strNote = "找不到文件" & strFileName
        Exit Function
    End If
    
  '取文件的长度
  lFSize = ofso.GetFile(strFileName).Size
  '开棺验尸
  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
        
        '取电影的长度，在文件的第5个字节，长为4个字节
        Get #lFileNumber, 5, lMSize
        '如果文件长度<电影长度,说明这个电影文件不是一个完整的文件(但这个文件还可以播放),可能是从Internet下载不完全或被破坏
        '说明这个文件没有注SuperPlayer写入的附加内容
        If lMSize >= lFSize Then
             Close #lFileNumber
             Exit Function
         End If
                  
         '读取SuperPlayer符加信息的ID,在电影长度(lMSize)+1的地方
         Get #lFileNumber, lMSize + 1, MyNote
         
         '如果不是SuperPlayer自定义的格式，就把后面的内容读出，作为注释的内容
         '并把作者、公司、版本置为空字符串
         '再把文件后面的的内容作为strNote信息(也许有可用的)