mexe2swf.frm

OpenPlayer代码

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "MultiExe2Swf"
   ClientHeight    =   3090
   ClientLeft      =   2505
   ClientTop       =   1380
   ClientWidth     =   6300
   Icon            =   "MExe2Swf.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3090
   ScaleWidth      =   6300
   Begin VB.CommandButton Command8 
      Caption         =   "全选(&A)"
      Height          =   360
      Left            =   405
      TabIndex        =   18
      Top             =   5940
      Width           =   1065
   End
   Begin VB.CommandButton Command7 
      Caption         =   "转换"
      Height          =   375
      Left            =   3795
      TabIndex        =   4
      Top             =   5925
      Width           =   975
   End
   Begin VB.CommandButton Command6 
      Caption         =   "停止"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4995
      TabIndex        =   15
      Top             =   5925
      Width           =   975
   End
   Begin VB.CommandButton Command5 
      Caption         =   "关于"
      Height          =   375
      Left            =   2475
      TabIndex        =   14
      Top             =   2520
      Width           =   975
   End
   Begin VB.CommandButton Command4 
      Caption         =   "显示文件列表 >>"
      Height          =   375
      Left            =   4710
      TabIndex        =   13
      Top             =   2535
      Width           =   1515
   End
   Begin VB.CommandButton Command3 
      Caption         =   "停止"
      Enabled         =   0   'False
      Height          =   375
      Left            =   1275
      TabIndex        =   3
      Top             =   2535
      Width           =   975
   End
   Begin VB.OptionButton Option1 
      Caption         =   "目标文件夹(&O)"
      Height          =   210
      Index           =   1
      Left            =   180
      TabIndex        =   12
      Top             =   690
      Width           =   1485
   End
   Begin VB.OptionButton Option1 
      Caption         =   "源文件夹(&F)"
      Height          =   210
      Index           =   0
      Left            =   165
      TabIndex        =   11
      Top             =   405
      Value           =   -1  'True
      Width           =   1470
   End
   Begin VB.ListBox List1 
      Height          =   2580
      ItemData        =   "MExe2Swf.frx":0CCE
      Left            =   150
      List            =   "MExe2Swf.frx":0CD0
      Style           =   1  'Checkbox
      TabIndex        =   10
      Top             =   3195
      Width           =   6045
   End
   Begin VB.TextBox Text3 
      Height          =   300
      Left            =   1665
      Locked          =   -1  'True
      TabIndex        =   0
      Top             =   1470
      Width           =   4425
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   195
      TabIndex        =   8
      Top             =   960
      Width           =   1215
   End
   Begin VB.DirListBox Dir1 
      Height          =   930
      Left            =   1665
      TabIndex        =   7
      Top             =   375
      Width           =   4410
   End
   Begin VB.TextBox Text1 
      Height          =   345
      Left            =   1650
      Locked          =   -1  'True
      TabIndex        =   1
      Top             =   1890
      Width           =   4440
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   375
      Left            =   3630
      TabIndex        =   5
      Top             =   2535
      Width           =   915
   End
   Begin VB.CommandButton Command1 
      Caption         =   "搜索(&S)"
      Height          =   375
      Left            =   165
      TabIndex        =   2
      Top             =   2520
      Width           =   975
   End
   Begin VB.Label Label4 
      Caption         =   "选择文件夹："
      Height          =   210
      Left            =   180
      TabIndex        =   17
      Top             =   90
      Width           =   1800
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Height          =   180
      Left            =   240
      TabIndex        =   16
      Top             =   2955
      Width           =   90
   End
   Begin VB.Label Label3 
      Caption         =   "源文件夹:"
      Height          =   240
      Left            =   225
      TabIndex        =   9
      Top             =   1485
      Width           =   1125
   End
   Begin VB.Label Label1 
      Caption         =   "目标文件夹:"
      Height          =   285
      Left            =   225
      TabIndex        =   6
      Top             =   1950
      Width           =   1200
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim oFSO As New FileSystemObject
Dim strExeFileName As String
Dim strSwfFileName As String
Dim ExitFor As Boolean
Dim lSWFFileHeader


Private Sub Command1_Click()
    Dim i As Long
    Dim myPath As String
  
     If Text3.Text = "" Or Text1.Text = "" Then
            MsgBox "请选择文件夹！", vbOKOnly + vbInformation, "请选择文件夹"
            Text3.SetFocus
            Exit Sub
     End If
     
     Command1.Enabled = False
     Command3.Enabled = True
     List1.Clear
     
     myPath = IIf(Len(Text3.Text) <> 3, Text3.Text & "\", Text3.Text)
     
     '搜索EXE文件
     Call Start(myPath)
    
     Me.Caption = "MultiExe2Swf——小鱼儿工作室"
     Command1.Enabled = True
     Command3.Enabled = False
     Command4.Caption = "<< 隐藏文件列表"
     Me.Height = 6810
     Label2.Caption = "共找到:" & List1.ListCount & "个文件"
End Sub

Private Sub Command2_Click()
    ExitFor = True
    End
End Sub

Private Sub Command3_Click()
    ExitFor = True
    Command1.Enabled = True
    Command3.Enabled = False
End Sub

Private Sub Command4_Click()
    If Command4.Caption = "显示文件列表 >>" Then
        Command4.Caption = "<< 隐藏文件列表"
        Me.Height = 6810
        Label2.Caption = "共找到:" & List1.ListCount & "个文件"
    Else
        Command4.Caption = "显示文件列表 >>"
        Me.Height = 3540
        Label2.Caption = ""
    End If
End Sub

Private Sub Command5_Click()
    MsgBox "        MultiExe2Swf 1.0" & vbCrLf & vbCrLf & _
            "        (C)Copyright 小鱼儿工作室 2002             " & vbCrLf & vbCrLf & _
            "        Email:[e-mail]" & vbCrLf & vbCrLf & _
            "        QQ:59219588", vbOKOnly + vbApplicationModal + vbSystemModal + vbInformation, "关于..."
       
End Sub

Private Sub Command6_Click()
    Command7.Enabled = True
    Command6.Enabled = False
    ExitFor = True
End Sub

Private Sub Command7_Click()
    Dim myPath As String
    Dim i As Long
    Dim count As Long
    
     Command6.Enabled = True
     Command7.Enabled = False
     myPath = IIf(Len(Text1.Text) <> 3, Text1.Text & "\", Text1.Text)
      
      For i = 0 To List1.ListCount - 1
         strExeFileName = List1.List(i)
         List1.ListIndex = i
         If List1.Selected(i) Then
             Me.Caption = (i + 1) & "/" & (List1.ListCount) & "当前文件：" & strExeFileName
             strSwfFileName = myPath & oFSO.GetBaseName(strExeFileName) + ".swf"
             count = count + Exe2Swf(strExeFileName, strSwfFileName)
             If ExitFor Then
                ExitFor = False
                Exit For
             End If
         End If
         DoEvents
      Next
      Me.Caption = "MultiExe2Swf——小鱼儿工作室"
      Command7.Enabled = True
      Command6.Enabled = False
      MsgBox "共:" & count & "个文件转换成功！", vbInformation + vbOKOnly, "小鱼儿工作室"
End Sub

Private Sub Command8_Click()
    Dim i  As Long
    If Command8.Caption = "全选(&A)" Then
        Command8.Caption = "全不选(&A)"
        For i = 0 To List1.ListCount - 1
            List1.Selected(i) = True
        Next
    Else
        Command8.Caption = "全选(&A)"
        For i = 0 To List1.ListCount - 1
            List1.Selected(i) = False
        Next
    End If
End Sub

Private Sub Dir1_Change()
    If Option1(0).Value = True Then
        Text3.Text = Dir1.Path
    Else
        Text1.Text = Dir1.Path
    End If
End Sub

Private Sub Dir1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Option1(0).Value = True Then
        Text3.Text = Dir1.Path
    Else
        Text1.Text = Dir1.Path
    End If
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Private Sub Form_Load()
    Me.Show
    ExitFor = False
End Sub

Private Function Exe2Swf(InFile As String, OutFile As String)
On Error Resume Next
    Dim pt As Long
    Dim pos As Long
    Dim init As Long
    Dim byteTmp() As Byte
    Dim bHasFound As Boolean
    Dim oTs As TextStream
    Dim ver As Byte
    Dim swfLen As Integer
    Dim b(3) As Byte
    
    Dim i As Long
    
    Dim lpos(5) As Long
    Dim j As Integer
    
    lpos(0) = 90100         'SuperPlayer v1.0
    lpos(1) = 94200         'SuperPlayer v1.5
    lpos(2) = 102450        'OpenPlayer v1.0
    lpos(3) = 286700        'FlashPla   v4.0
    lpos(4) = 290800        'FlashPla   v4.0
    lpos(5) = 376800        'FlashPla   v5.0



    
    bHasFound = False
    
    
    
    Open InFile For Binary Access Read Lock Read As #1
    
    
    If LOF(1) > lSWFFileHeader Then '
    
        DoEvents
        
           lSWFFileHeader = lpos(0)
           ReDim byteTmp(0 To LOF(1) - lSWFFileHeader) As Byte
           Seek #1, lSWFFileHeader '直接跳到标志位置
           Get #1, , byteTmp
           init = 0
       bHasFound = False
       For j = 0 To 5
           init = lpos(j) - lpos(0)
           For i = 0 To 200
                  DoEvents
                  If UBound(byteTmp) - 20 < init Then
                       Close #1
                       Exe2Swf = 0
                       Exit Function
                  End If
                  If byteTmp(init) = CByte(Asc("F")) Then
                     If byteTmp(init + 1) = CByte(Asc("W")) Then
                        If byteTmp(init + 2) = CByte(Asc("S")) Then
                            pos = init + lSWFFileHeader
                            bHasFound = True
                            Exit For
                         End If
                     End If
                 End If
              init = init + 1
           Next i
           If bHasFound Then Exit For
        Next j
    Else
        bHasFound = False
    End If
    
    If bHasFound = True Then
        ReDim byteTmp(0 To LOF(1) - pos) As Byte
        Seek #1, pos
        Get #1, , byteTmp
        Open OutFile For Binary Access Write As #2
        Put #2, , byteTmp
        Close #2
        DoEvents
    End If

    Close #1

    If bHasFound = True Then
    Set oTs = oFSO.OpenTextFile(Text1.Text & "\MultiExe2Swf.log", ForAppending, True)
        oTs.WriteLine (pos & "文件大小:" & FormatNumber(FileLen(OutFile), 1) & "Ver:" & byteTmp(3) & "  " & OutFile)
    Set oTs = Nothing
    End If
    ReDim byteTmp(0)
    If bHasFound Then
        Exe2Swf = 1
    Else
        Exe2Swf = 0
    End If
    
    
End Function

Private Sub Form_Unload(Cancel As Integer)
    ExitFor = True
    End
End Sub