flash.bas

OpenPlayer代码

                  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

'==========================================
'编译为EXE文件/屏幕保护程序
'原理:将动画文件写在Simple.exe/SSScreen.scr文件后面,这两个程序在运行时,如果检测到自己后面有数据,
'就会把后里面的内容读出来,写入文件放在Temp目录中,运行结束之后,再删除文件.
'参数:
'fSwfFileName    As String           动画文件路径
'fExeFilename    As String           要生成的EXE/SCR文件的路径
'CFN             As FLASHNOTE        FLASHNOTE结构,动画信息,要填充
'strOutType      As String           输出的类型,这里要用模板文件的文件名SimplePlayer.exe/SSScreen.scr
'返回:
'成功           1
'失败           0
'==========================================
Function Swf2Exe(fSwfFileName As String, fExeFilename As String, cfn As FLASHNOTE, strOutType As String) As Integer
    Dim lfnNum As Long
    'Dim oFSO As New FileSystemObject
    Dim bufferSWF() As Byte
    Dim bufferEXE() As Byte
    Dim lSize As Long
    Dim ModleFile As String
    
    On Error GoTo SPErr:
    
    '动画文件是否存在
    'If Not oFSO.FileExists(fSwfFileName) Then
    If Dir(fSwfFileName) = "" Then
        Swf2Exe = 0
        'Set oFSO = Nothing
        Exit Function
    End If
    
    '动画文件是否存在/删除文件
    'If oFSO.FileExists(fExeFilename) Then
    If Dir(fExeFilename) <> "" Then
        Kill fExeFilename
    End If
    
    '如果写入信息错误
    If Not writeNote(fSwfFileName, cfn.strAuthor, cfn.strCompany, cfn.strNote, cfn.strVer, cfn.strMovieName) Then
        Swf2Exe = 0
        'Set oFSO = Nothing
        Exit Function
    End If
      
    '读取动画文件的内容
    lSize = FileLen(fSwfFileName)
    ReDim bufferSWF(lSize - 1)
    lfnNum = FreeFile
    Open fSwfFileName For Binary As #lfnNum
        Get #lfnNum, , bufferSWF()
    Close #lfnNum
      
    '读取模板文件内容
    ModleFile = App.Path & IIf(Len(App.Path) > 3, "\" & strOutType, strOutType)
    lSize = FileLen(ModleFile)
    ReDim bufferEXE(lSize - 1)
    lfnNum = FreeFile
    Open ModleFile For Binary As #lfnNum
        Get #lfnNum, , bufferEXE()
    Close #lfnNum
          
    '合并文件
    lfnNum = FreeFile
    Open fExeFilename For Binary As #lfnNum
        Put #lfnNum, , bufferEXE()
        Put #lfnNum, , bufferSWF()
    Close #lfnNum
      
    '释放资源
    ReDim bufferEXE(0)
    ReDim bufferSWF(0)
    'Set oFSO = Nothing
    '成功,返回 1
    Swf2Exe = 1
    Exit Function
'==============================
'发生错误，写入错误记录
'==============================
SPErr:
    Swf2Exe = 0
    CreateErrorReport ("Swf2Exe()")
End Function