flash.bas

OpenPlayer代码

            '取电影的长度，在文件的第5个字节，长为4个字节
            Get #lFileNumber, 5, lMSize
            '如果文件长度<电影长度,说明这个电影文件不是一个完整的文件(但这个文件还可以播放),可能是从Internet下载不完全或被破坏
            '说明这个文件没有注OpenPlayer写入的附加内容
            If lMSize >= lFSize Then
                 Close #lFileNumber
                 Exit Function
            End If
                      
            '读取OpenPlayer符加信息的ID,在电影长度(lMSize)+1的地方
            Get #lFileNumber, lMSize + 1, MyNote
             
            '如果不是OpenPlayer自定义的格式，就把后面的内容读出，作为注释的内容
            '并把作者、公司、版本置为未知
            '再把文件后面的的内容作为strNote信息(也许有可用的)
            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")
                            If lTagLen > 0 Then
                                   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)
                            End If
                                   
                             
                       '公司
                       Case Asc("C")
                            If lTagLen > 0 Then
                                 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)
                             End If
        
                             
                        '附加注释内容
                        Case Asc("N")
                              If lTagLen > 0 Then
                                  If lTagLen = 0 Then
                                     ReDim bNote(0)
                                     bNote(0) = 32
                                  Else
                                      ReDim bNote(lTagLen - 1)
                                      Get #lFileNumber, , bNote()
                                  End If
                                  For j = 0 To UBound(bNote())
                                     If bNote(j) = 0 Then
                                       bNote(j) = 32
                                     End If
                                  Next
                                   '转为Unicode并返回该值
                                   getNote.strNote = StrConv(bNote(), vbUnicode)
                              End If
        
                        'OpenPlayer版本
                        Case Asc("V")
                            If lTagLen > 0 Then
                                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)
                             End If
                       ' 作品名
                        Case Asc("M")
                            '如果大于0则读出来作为Movie Name
                            '如果等于0，因在前面有预设Movie Name ，所以在这里不用再设了。
                            If lTagLen > 0 Then
                                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 If
                    End Select
                Next
            End If
        Close #lFileNumber
    Exit Function
Err:
    Close #lFileNumber
    getNote.strNote = "抱歉,发生错误!"
    CreateErrorReport ("getNote()")
    'Set oFSO = Nothing
End Function

'======================================
'写入注释内容
'注意：将重写原来的注释内容
'成功返回True
'失败返回False
'参数:
'strFileName     As String   '动画文件名
'strAuthor       As String   '动画的作者名
'strCompany      As String   '发布的公司
'strNote         As String   '其它的说明内容
'strVer          As String   '软件的版本
'strMovieName    As String   '作品名
'======================================
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
    If Dir(strFileName) = "" Then
         writeNote = False                          '文件找不到
         'Set oFSO = Nothing
         Exit Function
    End If
   
    If Len(strMovieName) < 1 Then
        strMovieName = "《" & Left(getBaseName(strFileName), InStrRev(getBaseName(strFileName), ".") - 1) & "》"
    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))
  
    If GetAttr(strFileName) = 33 Then
        If MsgBox("文件：" & strFileName & vbCrLf & "是只读文件，是否要保存更改？", vbYesNo + vbInformation, "OpenPlayer") = vbYes Then
            SetAttr strFileName, 32
        Else
            GoTo Err:
        End If
    End If
  
    lFileNumber = FreeFile
    'lFSize = oFSO.GetFile(strFileName).Size              '取文件的长度
    lFSize = FileLen(strFileName)                         '取文件的长度
    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个字节
        '注:文件长度指现有文件的Size,电景长度指该动画完整时具有的Size
        If lFSize < lMSize Then
            lMSize = lFSize + 2
            Put #lFileNumber, 5, lMSize
        End If
        '重定义字节数组,用来存放电影的内容
        '读出电影内容,并存放在bMovie()数组
        ReDim bMovie(lMSize - 1)
        Get #lFileNumber, 1, bMovie
  Close #lFileNumber
  
    '清空文件
    Kill strFileName
    
    '重建文件
    lFileNumber = FreeFile
    Open strFileName For Binary As #lFileNumber
          Put #lFileNumber, , bMovie                  '写入电影内容
          Put #lFileNumber, , "SPV"                   '写入附加信息ID "SP" 和OpenPlayer版本信息ID "V"
          Put #lFileNumber, , lVerLen                 '写入OpenPlayer版本信息字段长度
          Put #lFileNumber, , strVer                  '写入OpenPlayer版本信息字段内容
          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
    CreateErrorReport ("writeNote()")
  'Set oFSO = Nothing
End Function



'==========================================
'取得一个文件路径名中的基本文件名
'参数:
'strFileName,文件路径名
'==========================================
Public Function getBaseName(strFileName As String)
On Error GoTo Err:
    getBaseName = Mid(strFileName, InStrRev(strFileName, "\") + 1)
    Exit Function
Err:
    getBaseName = ""
End Function