form1.frm

OpenPlayer代码

VERSION 5.00
Object = "{D27CDB6B-AE6D-11CF-96B8-444553540000}#1.0#0"; "SWFLASH.OCX"
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   BorderStyle     =   0  'None
   Caption         =   "<|>SimplePlayer 1.0"
   ClientHeight    =   1755
   ClientLeft      =   4470
   ClientTop       =   2820
   ClientWidth     =   3735
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   1755
   ScaleWidth      =   3735
   Begin VB.Timer TitleTimer 
      Interval        =   10
      Left            =   120
      Top             =   1230
   End
   Begin VB.Timer OpenFileTimer 
      Interval        =   50
      Left            =   2970
      Top             =   210
   End
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   2310
      Top             =   210
   End
   Begin ShockwaveFlashObjectsCtl.ShockwaveFlash ShockwaveFlash1 
      Height          =   525
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   555
      _cx             =   4195283
      _cy             =   4195230
      Movie           =   ""
      Src             =   ""
      WMode           =   "Window"
      Play            =   -1  'True
      Loop            =   -1  'True
      Quality         =   "High"
      SAlign          =   ""
      Menu            =   -1  'True
      Base            =   ""
      Scale           =   "ShowAll"
      DeviceFont      =   0   'False
      EmbedMovie      =   0   'False
      BGColor         =   ""
      SWRemote        =   ""
   End
   Begin VB.Shape FlashBorder 
      BorderColor     =   &H00404040&
      Height          =   765
      Index           =   2
      Left            =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   1305
   End
   Begin VB.Shape FlashBorder 
      BorderColor     =   &H00FFFFFF&
      Height          =   675
      Index           =   1
      Left            =   60
      Top             =   30
      Visible         =   0   'False
      Width           =   1035
   End
   Begin VB.Shape FlashBorder 
      BorderColor     =   &H00404040&
      Height          =   555
      Index           =   0
      Left            =   210
      Top             =   120
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Loading 
      BackColor       =   &H00CD586A&
      Caption         =   "Loading...."
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   315
      Left            =   810
      TabIndex        =   1
      Top             =   900
      Width           =   2805
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Mouse As POINTAPI
Dim TitleCharCount As Long
Const PLAYER_SIZE = 98304
Const FROMTITLE = "simpleplayer"

Dim c As Collection

Public Sub RegFileType()
    Dim strIniFileName As String
    Dim Ext As String

    strIniFileName = App.Path & IIf(Len(App.Path) > 4, "/OpenPlayer.ini", "OpenPlayer.ini")
        Call myWriteINI(strIniFileName, "SuperPlayer", "RegFileType", "1")
        Call myWriteINI(strIniFileName, "SuperPlayer", "RegFileType0", "*.swf")
        Call myWriteINI(strIniFileName, "SuperPlayer", "RegFileType1", "*.spl")
        Call myWriteINI(strIniFileName, "SuperPlayer", "RegFileType2", "*.spf")
        For i = 0 To 5
            Ext = Mid(myReadINI(strIniFileName, "SuperPlayer", "RegFileType" & i, ""), 2)
            If Ext <> "" Then
                tmp = Mod_Related_SWFFile(Ext, "ShockwaveFlash.ShockwaveFlash", "ShockwaveFlash.ShockwaveFlash")
            End If
        Next i
End Sub

Sub FixWindows()
   ShockwaveFlash1.Height = Me.Height - 120
   ShockwaveFlash1.Width = Me.Width - 120
End Sub

Sub DrawBorder()
    '画窗口的边框
    FlashBorder(0).Top = 15
    FlashBorder(0).Left = 15
    FlashBorder(0).Height = Me.Height - 30
    FlashBorder(0).Width = Me.Width - 30
    FlashBorder(0).Visible = True
    FlashBorder(1).Top = 30
    FlashBorder(1).Left = 30
    FlashBorder(1).Height = Me.Height - 60
    FlashBorder(1).Width = Me.Width - 60
    FlashBorder(1).Visible = True
    FlashBorder(2).Top = 45
    FlashBorder(2).Left = 45
    FlashBorder(2).Height = Me.Height - 90
    FlashBorder(2).Width = Me.Width - 90
    FlashBorder(2).Visible = True
End Sub


Function Exe2Swf(fExeFileName As String) As String
'==========================================
'还原出SWF文件，返回文件路径
'==========================================

    Dim fSwfFileName As String
    Dim lExeFileLen As Long, lSwfFileLen As Long       '文件长度
    Dim bSwf() As Byte
    'Dim lExeSize As Long
    'Dim lSwfSize As Long                      '字节的大小
    Dim lfExeFileNum, lfSwfFileNum As Long     '文件号
    Dim swf As String * 3
    Dim pos As Long

    j = 0
    lfExeFileNum = FreeFile
 
   
    '如果文件的大小<播放器的大小，则可能文件被破坏
    If FileLen(fExeFileName) < PLAYER_SIZE Then
        Exe2Swf = "0"
        Exit Function
    End If
   
    lSwfFileLen = FileLen(fExeFileName) - PLAYER_SIZE
    ReDim bSwf(lSwfFileLen)
    '取Flash Movie文件的签名档,
    '在FLAYER_SIZE后,三个字节
    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

Private Sub Form_Resize()
    FixWindows              '调整各控件的位置，
    DrawBorder              '重画边框
End Sub

Public Sub Form_Load()
    Dim i As Integer
    Dim arg As String
    Dim lw As Long
    Dim strIniFileName As String
    Dim Ret As Long
        
    

    strIniFileName = App.Path & IIf(Len(App.Path) > 4, "/OpenPlayer.ini", "OpenPlayer.ini")

    arg = Command

    Filename = App.Path & IIf(Len(App.Path) < 4, App.EXEName & ".exe", "\" & App.EXEName & ".exe")

   If FileLen(Filename) > PLAYER_SIZE + 30 Then                             '程序文件的大小比原来的程序大，这个文件是被编译过的
        Filename = Exe2Swf(Filename)                                        '还原出文件
        If Filename = "0" Then                                              '如果文件出错...
            MsgBox vbCrLf & "        文件已经被破坏！    " & vbCrLf, vbOKOnly, "SuperPlayer 1.0 小鱼儿工作室"
            End
        Else                                                                '还原成功
            arg = Filename                                                  '将参数变量高为文件的路径
            bEXE = True                                                     '设置标记变量bEXE为真
            OpenFileTimer.Enabled = False
            Form2.ReturnPlay.Enabled = True                                 '设置[播放原来的文件(&R)]菜单
            Form2.ReturnPlay.Caption = "播放原来的文件(&R)"
        End If
   End If
   
    '如果是拖放的，文件名没有加双引号“ " ”，如果是用打开的，文件加了双引号“ " ”
    '34为 “ " ”的ASCII码
    If InStr(arg, Chr(34)) <> 0 Then
       arg = Mid(arg, 2, Len(arg) - 2)
    End If
    
   
   If (Not bEXE) And Len(arg) > 3 Then                                      '如果不是EXE文件
        lw = (FindWindow("ThunderRT6FormDC", "OpenPlayer"))                '
        If Not (lw = 0) Or App.PrevInstance Then
            Call myWriteINI(strIniFileName, "OpenFile", "FileName", arg)
            End
        End If
   End If
   
   
   
    If Not bEXE Then
        If myReadINI(strIniFileName, "SuperPlayer", "RegFileType", "0") = 0 Then
            If MsgBox("是否将OpenPlayer注册为*.swf;*.spl文件的默认打开程序?", vbYesNo + vbQuestion, "OpenPlayer") = vbYes Then
                Call RegFileType
            End If
        End If
    End If
  
   If Len(arg) < 3 Then
        For i = 0 To 2
           arg = ShowOpenDialog(Me, "Flash Movie", "*.swf;*.spl;*.spf", "--==SimplePlayer==--       打开...")
          If arg <> "" Then
             OpenFlash (arg)
             If ShockwaveFlash1.Movie <> "" Then
                Exit For
             End If
          End If
        Next i
        If ShockwaveFlash1.Movie = "" Then
          End
        End If
    End If
    
    '回调，实现右键
    Ret = EnumChildWindows(Me.hWnd, AddressOf EnumChildProc, ByVal 0&)
    
    OpenFlash (arg)

End Sub
Sub OpenFlash(fn As String)
   Dim FH As FLASHHEADER
   FH = getFlashHeader(fn)
   
   If FH.intIsFlashMovie = -1 Then
       MsgBox "找不到文件", vbOKOnly + vbCritical, "小鱼儿工作室"
       Exit Sub
   End If
   
   If FH.intIsFlashMovie = 0 Then
       MsgBox "文件不是Flash Movie 格式！", vbOKOnly + vbCritical, "小鱼儿工作室"
       Exit Sub
   End If
   
   If FH.intIsFlashMovie = 2 Then
       MsgBox "未知错误！", vbOKOnly + vbCritical, "小鱼儿工作室"
       Exit Sub
   End If
   typeFLASHNOTE = getNote(fn)
  
   With ShockwaveFlash1
       .Visible = True
       .BackgroundColor = RGB(FH.bColorB, FH.bColorG, FH.bColorR)
       .Movie = fn
       .play
   End With
   
   With Me
      .Visible = True
      .Height = FH.lMHeight * 15 + 120
      .Width = FH.lMWidth * 15 + 120
      .Top = (Screen.Height - .Height) / 2
      .Left = (Screen.Width - .Width) / 2
      .WindowState = 0
   End With
   

   
   Form2.speed.Caption = "速度:" & FH.intMRate & "帧/秒"
   MHeight = FH.lMHeight
   MWidth = FH.lMWidth
   MTotalFrames = FH.intMTotalFrames
Form2.total.Caption = "共：" & MTotalFrames & "帧"
Timer1.Enabled = True

isFullScreen = False

Call DrawBorder

End Sub








Private Sub ResizeTimer_Timer()

End Sub

Private Sub OpenFileTimer_Timer()
    Dim inifile As String
    Dim File2Open As String
    
    inifile = App.Path & IIf(Len(App.Path) > 4, "/OpenPlayer.ini", "OpenPlayer.ini")
    File2Open = UCase(myReadINI(inifile, "OpenFile", "FileName", ""))
    
    
    If Len(File2Open) > 3 And (FindWindow("ThunderRT6FormDC", "SuperPlayer")) = 0 Then
        myWriteINI inifile, "OpenFile", "FileName", ""
        OpenFlash File2Open
        SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 3   '设置
        SetWindowPos Me.hWnd, -2, 0, 0, 0, 0, 3   '取消
    End If
End Sub

Private Sub Timer1_Timer()
'在右键菜单上显示进度
On Error Resume Next
    Dim n As String
    Dim p As Double
    
    If ShockwaveFlash1.Visible = True Then
        p = ShockwaveFlash1.FrameNum / MTotalFrames
        n = Round(p * 100, 1) & "%"
        If Len(n) < 5 Then n = n & " "
        If Len(n) < 5 Then n = n & " "
        If Len(n) < 5 Then n = n & " "
        Form2.jd.Caption = "进度：" & n
        Form2.played.Caption = "完成:" & n & "  " & "播放到第:" & (ShockwaveFlash1.FrameNum + 1) & "帧"
     
    End If
End Sub


Private Sub TitleTimer_Timer()
    '动态标题
    If TitleCharCount > Len(FROMTITLE) Then
          TitleCharCount = 0
    End If
    
    TitleCharCount = TitleCharCount + 1
    Me.Caption = "ＳＰ：" & Left(FROMTITLE, TitleCharCount - 1) & UCase(Mid(FROMTITLE, TitleCharCount, 1)) & Mid(FROMTITLE, TitleCharCount + 1)
  
End Sub