flash.bas

OpenPlayer代码

         If MyNote <> "SP" Then
UnKnow:
            ReDim b(lFSize - lMSize - 1)
            Get #lFileNumber, lMSize + 1, b()
            getNote.strAuthor = "未知"
            getNote.strCompany = "未知"
            getNote.strVer = "0"
            For i = 0 To UBound(b())
               If b(i) = 0 Then
                  b(i) = 32                   '对于 0 StrConv无法转为vbUnicode格式,且整个字串都不能转换!因此要将它转为空格(32)
               End If
            Next
            '转为Unicode并返回该值
            getNote.strNote = StrConv(b(), vbUnicode)
          Else
            
            '循环5次,分别读出ID --"V","A","C","M","N"和各字的长度,内容
            For i = 0 To 4
              '读出ID 和ID 的长度
              Get #lFileNumber, , bMyNote
              Get #lFileNumber, , lTagLen
              
              '如果lTagLen+当前文件指针位置大于文件的长度，那么注释的内容格式出现错误
              If lFSize < Seek(lFileNumber) + lTagLen Then
                  GoTo UnKnow:
              End If
              
              '作者
              Select Case bMyNote
                 Case Asc("A")
                    ReDim bAuthor(lTagLen - 1)
                    Get #lFileNumber, , bAuthor()
                    For j = 0 To UBound(bAuthor())
                       If bAuthor(j) = 0 Then
                         bAuthor(j) = 32
                       End If
                    Next
                     '转为Unicode并返回该值
                     getNote.strAuthor = StrConv(bAuthor(), vbUnicode)
                    
                     
               '公司
               Case Asc("C")
                     ReDim bCompany(lTagLen - 1)
                    Get #lFileNumber, , bCompany()
                    For j = 0 To UBound(bCompany())
                       If bCompany(j) = 0 Then
                         bCompany(j) = 32
                       End If
                    Next
                    '转为Unicode并返回该值
                     getNote.strCompany = StrConv(bCompany(), vbUnicode)

                     
                '附加注释内容
                Case Asc("N")
                    ReDim bNote(lTagLen - 1)
                    Get #lFileNumber, , bNote()
                    For j = 0 To UBound(bNote())
                       If bNote(j) = 0 Then
                         bNote(j) = 32
                       End If
                    Next
                     '转为Unicode并返回该值
                     getNote.strNote = StrConv(bNote(), vbUnicode)
  

                'SuperPlayer版本
                Case Asc("V")
                    ReDim bVer(lTagLen - 1)
                    Get #lFileNumber, , bVer()
                    For j = 0 To UBound(bVer())
                       If bVer(j) = 0 Then
                         bVer(j) = 32
                       End If
                    Next
                  '转为Unicode并返回该值
                     getNote.strVer = StrConv(bVer(), vbUnicode)
               ' 电影名
                Case Asc("M")
                    ReDim bMovieName(lTagLen - 1)
                    Get #lFileNumber, , bMovieName()
                    For j = 0 To UBound(bMovieName())
                       If bMovieName(j) = 0 Then
                         bMovieName(j) = 32
                       End If
                    Next
                  '转为Unicode并返回该值
                     getNote.strMovieName = StrConv(bMovieName(), vbUnicode)
               End Select
            Next
         
          End If
  Close #lFileNumber
Exit Function
err:
   Set ofso = Nothing
  
End Function

'======================================
'写入注释内容
'注意：将重写原来的注释内容
'成功返回True
'失败返回False
'======================================
Public Function writeNote(strFileName As String, strAuthor As String, strCompany As String, strNote As String, strVer As String, strMovieName As String) As Boolean
    Dim ofso As New FileSystemObject             '创建文件对象
    Dim lMSize As Long                           '电影的长度
    Dim lFSize As Long                           '文件的长度
    Dim lFileNumber As Long                      '文件号，在打开文件时用
    Dim strSWFSignature As String * 3            'SWF的签名
    Dim lAuthorLen As Long                       '作者字段的长度
    Dim lCompanyLen As Long                      '公司字段的长度
    Dim lNoteLen As Long                         '注释字段的长度
    Dim lVerLen As Long                          '版本字段的长度
    Dim lMovieNameLen As Long                    '电影名字段的长度
    Dim bMovie() As Byte                         '用来存储电影文件内容的字节数组，在得到到电影长度（lMSize）之后，将Redim其元素个数
    
    On Error GoTo err:
    
       If Not ofso.FileExists(strFileName) Then
            writeNote = False                          '文件找不到
            Set ofso = Nothing
            Exit Function
       End If
       
      If Len(strMovieName) < 1 Then
       strMovieName = "《" & Left(Mid(strFileName, InStrRev(strFileName, "\") + 1), Len(Mid(strFileName, InStrRev(strFileName, "\") + 1)) - 4) & "》"
      End If
      
      '取字段的"字节长度",并赋给相应的“字段长度”
      lAuthorLen = LenB(StrConv(strAuthor, vbFromUnicode))
      lCompanyLen = LenB(StrConv(strCompany, vbFromUnicode))
      lNoteLen = LenB(StrConv(strNote, vbFromUnicode))
      lVerLen = LenB(StrConv(strVer, vbFromUnicode))
      lMovieNameLen = LenB(StrConv(strMovieName, vbFromUnicode))
      
      
      
      lFileNumber = FreeFile
      lFSize = ofso.GetFile(strFileName).Size          '取文件的长度
      Open strFileName For Binary As #lFileNumber
      
            Get #lFileNumber, , strSWFSignature
            If strSWFSignature <> "FWS" Then
               Close #lFileNumber
               Set ofso = Nothing
               writeNote = False                       '不是Flash Movie格式的文件
               Exit Function                           '退出程序
            End If
            
            '取电影的长度，在文件的第5个字节，长为4个字节
            Get #lFileNumber, 5, lMSize
            
            '如果文件长度<电影长度,说明这个电影文件不是一个完整的文件(但这个文件还可以播放),可能是从Internet下载不完全或被破坏
            '则在文件写入文件长度作为电影的长度,在文件的第5个字节,长度为4个字节
            If lFSize < lMSize Then
                lMSize = lFSize + 2
                Put #lFileNumber, 5, lMSize
            End If
            '重定义字节数组,用来存放电影的内容
            '读出电影内容,并存放在bMovie()数组
            ReDim bMovie(lMSize - 1)
            Get #lFileNumber, 1, bMovie
      Close #lFileNumber
      
      '清空文件
      lFileNumber = FreeFile
      Open strFileName For Output As #lFileNumber
      Close #lFileNumber
      
      '重建文件
      lFileNumber = FreeFile
      Open strFileName For Binary As #lFileNumber
            Put #lFileNumber, , bMovie                  '写入电影内容
            Put #lFileNumber, , "SPV"                   '写入附加信息ID "SP" 和SuperPlayer版本信息ID "V"
            Put #lFileNumber, , lVerLen                 '写入SuperPlayer版本信息字段长度
            Put #lFileNumber, , strVer                  '写入SuperPlayer版本信息字段内容
            Put #lFileNumber, , "A"                     '写入作者ID "A"
            Put #lFileNumber, , lAuthorLen              '写入作者字段长度
            Put #lFileNumber, , strAuthor               '写入作者字段内容
            Put #lFileNumber, , "C"                     '写入作者公司字段ID "C"
            Put #lFileNumber, , lCompanyLen             '写入作者公司字段长度
            Put #lFileNumber, , strCompany              '写入作者公司字段内容
            Put #lFileNumber, , "N"                     '写入附加信息字段ID "N"
            Put #lFileNumber, , lNoteLen                '写入附加信息字段长度
            Put #lFileNumber, , strNote                 '写入附加信息字段内容
            Put #lFileNumber, , "M"                     '写入电影名字段ID "M"
            Put #lFileNumber, , lMovieNameLen           '写入电影名字段长度
            Put #lFileNumber, , strMovieName            '写入电影名字段内容
            Put #lFileNumber, , CInt(0)                 '例行定入结束符 "00 00"
      Close #lFileNumber
      
      Set ofso = Nothing
      writeNote = True
    Exit Function
err:     '未知错误
      writeNote = False
      Set ofso = Nothing
End Function

'==============================================
'将SWF文件还原出来
'返回:还原后的文件的路径
'==============================================
Function exe2swf(fExeFileName As String) As String
    Dim fSwfFileName As String                          'swf临时文件名
    Dim lExeFileLen As Long, lSwfFileLen As Long        '文件长度
    Dim bSwf() As Byte                                  'swf文件内容的数组
    Dim lfExeFileNum As Long, lfSwfFileNum As Long      '文件号
    Dim swf As String * 3                               'swf文件的签名
    Dim pos As Long                                     'swf文件的偏移
    Dim j As Long
    j = 0
    
    
    '如果文件的大小<播放器的大小，则可能文件被破坏
    If FileLen(fExeFileName) < PLAYER_SIZE Then
        exe2swf = "0"                                       '返回0
        Exit Function                                       '退出
    End If
   
    lSwfFileLen = FileLen(fExeFileName) - PLAYER_SIZE       'swf文件的大小
    ReDim bSwf(lSwfFileLen)                                 '建立数组大小,接收swf文件的内容
    '取Flash Movie文件的签名档,
    '在FLAYER_SIZE后,三个字节
    lfExeFileNum = FreeFile
    Open fExeFileName For Binary As lfExeFileNum
        Get #lfExeFileNum, PLAYER_SIZE + 1, swf
        If swf <> "FWS" Then                                '是否为Flash动画
            exe2swf = "0"
            Close #lfExeFileNum
            Exit Function
        End If
        
        '如果是,确定字节数组"bSwf()"的大小以存放Flash Movie文件
        lSwfFileLen = FileLen(fExeFileName) - PLAYER_SIZE - 1
        ReDim bSwf(lSwfFileLen)
        Get #lfExeFileNum, PLAYER_SIZE + 1, bSwf
    Close #lfExeFileNum

    '临时目录的临时文件名
    fSwfFileName = fso.GetSpecialFolder(TemporaryFolder) & "\" & fso.GetTempName
 
    ' lfSwfFileNum = FreeFile
    '===============================
    '清空文件！
    '===============================
    'Open fSwfFileName For Output As lfSwfFileNum
    'Close #lfSwfFileNum
   
    lfSwfFileNum = FreeFile
    Open fSwfFileName For Binary As lfSwfFileNum
        Put #lfSwfFileNum, , bSwf()                         '写入文件内容
    Close #lfSwfFileNum
    exe2swf = fSwfFileName                                  '返回还原后的文件路径
End Function