Chip 2002 November/Chip_2002-11_cd1.bin/zkuste/vbasic/Data/Utils/WME71SDK.exe/RCDATA/CABINET/BatcherInput.frm

Text File | 2001-03-02 | 18KB | 621 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{C4941F47-8BC1-49D3-9989-2B7826F26AE6}#1.0#0"; "MSPShell.dll"
Begin VB.Form FrmBatcherIn
   Caption         =   "Windows Media Batcher Sample"
   ClientHeight    =   7995
   ClientLeft      =   2010
   ClientTop       =   510
   ClientWidth     =   8325
   Icon            =   "BatcherInput.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   7995
   ScaleWidth      =   8325
   Begin MSPROPSHELLLibCtl.MSPropShell MSPropMain
      Height          =   3015
      Left            =   0
      OleObjectBlob   =   "BatcherInput.frx":000C
      TabIndex        =   10
      Top             =   4680
      Width           =   6855
   End
   Begin VB.CommandButton CmdExit
      Caption         =   "E&xit"
      Height          =   495
      Left            =   6960
      TabIndex        =   8
      Top             =   6240
      Width           =   1335
   End
   Begin MSComDlg.CommonDialog DlgBat
      Left            =   7080
      Top             =   3960
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "Batcher Files (*.bwm) | *.bwm"
   End
   Begin MSComctlLib.StatusBar StaEncoderStat
      Align           =   2  'Align Bottom
      Height          =   300
      Left            =   0
      TabIndex        =   11
      Top             =   7695
      Width           =   8325
      _ExtentX        =   14684
      _ExtentY        =   529
      Style           =   1
      SimpleText      =   "Encoder Stopped"
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
      EndProperty
   End
   Begin VB.CommandButton CmdStop
      Caption         =   "S&top"
      Height          =   495
      Left            =   6960
      TabIndex        =   7
      Top             =   5520
      Width           =   1335
   End
   Begin VB.CommandButton CmdStart
      Caption         =   "&Start"
      Height          =   495
      Left            =   6960
      TabIndex        =   6
      Top             =   4800
      Width           =   1335
   End
   Begin VB.CommandButton CmdSave
      Caption         =   "Sa&ve"
      Height          =   495
      Left            =   6960
      TabIndex        =   5
      Top             =   3120
      Width           =   1335
   End
   Begin VB.CommandButton CmdLoad
      Caption         =   "&Load"
      Height          =   495
      Left            =   6960
      TabIndex        =   4
      Top             =   2520
      Width           =   1335
   End
   Begin VB.CommandButton CmdClearResults
      Caption         =   "&ClearResults"
      Height          =   495
      Left            =   6960
      TabIndex        =   3
      Top             =   1920
      Width           =   1335
   End
   Begin VB.CommandButton CmdRemoveAll
      Caption         =   "Remove&All"
      Height          =   495
      Left            =   6960
      TabIndex        =   2
      Top             =   1320
      Width           =   1335
   End
   Begin VB.CommandButton CmdRemove
      Caption         =   "&Remove"
      Height          =   495
      Left            =   6960
      TabIndex        =   1
      Top             =   720
      Width           =   1335
   End
   Begin VB.CommandButton CmdAdd
      Caption         =   "A&dd"
      Height          =   495
      Left            =   6960
      TabIndex        =   0
      Top             =   120
      Width           =   1335
   End
   Begin MSComctlLib.ListView LvwBatcher
      Height          =   4455
      Left            =   0
      TabIndex        =   9
      Top             =   120
      Width           =   6855
      _ExtentX        =   12091
      _ExtentY        =   7858
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   4
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         Key             =   "Input"
         Text            =   "Input File"
         Object.Width           =   2469
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   1
         Key             =   "Output"
         Text            =   "Output File"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   2
         Key             =   "Profile"
         Text            =   "Profile"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   3
         Key             =   "Result"
         Text            =   "Result"
         Object.Width           =   2540
      EndProperty
   End
End
Attribute VB_Name = "FrmBatcherIn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents Encoder As WMEncoder
Attribute Encoder.VB_VarHelpID = -1
Dim EncError As Long

Private Sub CmdAdd_Click()
    Dim Profile As String
    Dim InputFile As String
    Dim OutputFile As String
    Dim Success As Integer

    On Error GoTo Err_Handler

    FrmAddFiles.Show 1

    InputFile = FrmAddFiles.GetInputFile
    If InputFile = "" Then
        CmdAdd.SetFocus
        Exit Sub
    End If
    OutputFile = FrmAddFiles.GetOutputFile
    Profile = FrmAddFiles.GetProfile

    InputFile = Trim(InputFile)
    OutputFile = Trim(OutputFile)
    Profile = Trim(Profile)

    Success = Populate_List(InputFile, OutputFile, Profile)
    If Success = 1 Then
        MsgBox "Error Populating the list"
    End If
    CmdRemove.Enabled = True
    CmdRemoveAll.Enabled = True
    CmdClearResults.Enabled = True
    CmdSave.Enabled = True
    CmdStart.Enabled = True

    Exit Sub
Err_Handler:
    MsgBox "Error Adding Files", vbCritical, "Error-" & Err.Number
End Sub

Private Sub CmdClearResults_Click()
    Dim cnt As Integer
    On Error GoTo Err_Handler

    cnt = LvwBatcher.ListItems.Count
    If cnt = 0 Then
        MsgBox "Nothing to clear"
    End If


    While cnt > 0
        If LvwBatcher.ListItems(cnt).ListSubItems("Result") = "" Then
        Else
            LvwBatcher.ListItems(cnt).ListSubItems("Result") = ""
        End If
        cnt = cnt - 1
    Wend
    CmdStart.Enabled = True
    Exit Sub
Err_Handler:
    MsgBox "Error clearing the list", vbExclamation

End Sub

Private Sub CmdExit_Click()
    Set Encoder = Nothing
    Unload Me
    End
End Sub

Private Sub CmdLoad_Click()



    Dim FsBat As Object
    Dim InFile As String
    Dim BatcherFile As Object
    Dim ListIn As String
    Dim InputFile As String
    Dim OutputFile As String
    Dim Profile As String
    Dim ColonPosIn As Integer
    Dim ColonPosOut As Integer
    Dim ColonPosPrf As Integer
    Dim LoadCnt As Integer

    On Error GoTo Err_Handler

    DlgBat.DialogTitle = "Input File"
    DlgBat.Flags = cdlOFNFileMustExist
    DlgBat.ShowOpen

    InFile = DlgBat.FileName
    If InFile = "" Then
        Exit Sub
    End If

    DlgBat.FileName = ""

    Set FsBat = CreateObject("Scripting.FileSystemObject")
    Set BatcherFile = FsBat.opentextfile(InFile, 1, 0)

    LvwBatcher.ListItems.Clear
    LoadCnt = 1

    While BatcherFile.AtEndOfStream <> True

        ListIn = BatcherFile.readline
        ColonPosIn = InStr(1, ListIn, ";")
        InputFile = Mid(ListIn, 1, ColonPosIn - 1)

        ColonPosOut = InStr(ColonPosIn + 1, ListIn, ";")
        OutputFile = Mid(ListIn, ColonPosIn + 1, ColonPosOut - ColonPosIn - 1)

        ColonPosPrf = InStr(ColonPosOut + 1, ListIn, ";")
        Profile = Mid(ListIn, ColonPosOut + 1, ColonPosPrf - ColonPosOut - 1)

        LvwBatcher.ListItems.Add LoadCnt, , InputFile
        LvwBatcher.ListItems.Item(LoadCnt).ListSubItems.Add , "OutputFile", OutputFile
        LvwBatcher.ListItems.Item(LoadCnt).ListSubItems.Add , "Profile", Profile
        LvwBatcher.ListItems.Item(LoadCnt).ListSubItems.Add , "Result", ""

        LoadCnt = LoadCnt + 1
    Wend
    BatcherFile.Close

    If LvwBatcher.ListItems.Count > 0 Then
        LvwBatcher.FullRowSelect = True
        Set LvwBatcher.DropHighlight = LvwBatcher.ListItems(1)
        CmdRemove.Enabled = True
        CmdRemoveAll.Enabled = True
        CmdClearResults.Enabled = True
        CmdSave.Enabled = True
        CmdStart.Enabled = True
        'CmdStop.Enabled = True
    End If

    Exit Sub

Err_Handler:
    MsgBox "Error Loading Saved Configuration", vbCritical, "Error-" & Err.Number
End Sub

Private Sub CmdRemove_Click()
    On Error GoTo Err_Handler
    If LvwBatcher.ListItems.Count = 0 Then
        Exit Sub
    End If
    LvwBatcher.ListItems.Remove LvwBatcher.SelectedItem.Index
    Exit Sub

Err_Handler:
    MsgBox "Error Removing Selected Entry From List", vbExclamation

End Sub

Private Sub CmdRemoveAll_Click()
    Dim cnt As Integer
    On Error GoTo Err_Handler

    cnt = LvwBatcher.ListItems.Count
    While cnt > 0
        LvwBatcher.ListItems.Remove cnt
        cnt = cnt - 1
    Wend
    Exit Sub
Err_Handler:
    MsgBox "Error Removing Entries from List", vbExclamation

End Sub

Private Sub CmdSave_Click()
    Dim ListSave As String
    Dim SaveFile  As String

    Dim FsBat As Object
    Dim BatcherFile As Object

    Dim SaveCnt As Integer
    Dim InputFile As String
    Dim OutputFile As String
    Dim Profile As String
    On Error GoTo Err_Handler


    DlgBat.DialogTitle = "Save File"
    DlgBat.ShowSave
    SaveFile = DlgBat.FileName
    DlgBat.FileName = ""


    Set FsBat = CreateObject("Scripting.FileSystemObject")
    If SaveFile = "" Then
        Exit Sub
    End If

    Set BatcherFile = FsBat.CreateTextFile(SaveFile, True)

    SaveCnt = 1
    While SaveCnt <= LvwBatcher.ListItems.Count
        InputFile = LvwBatcher.ListItems(SaveCnt)
        OutputFile = LvwBatcher.ListItems(SaveCnt).ListSubItems("OutputFile")
        Profile = LvwBatcher.ListItems(SaveCnt).ListSubItems("Profile")
        ListSave = InputFile & ";" & OutputFile & ";" & Profile & ";"
        BatcherFile.writeline (ListSave)
        SaveCnt = SaveCnt + 1
    Wend
    BatcherFile.Close

    Exit Sub
Err_Handler:
    MsgBox "Error Saving List Entries", vbCritical, "Error-" & Err.Number

End Sub

Private Sub CmdStart_Click()
    Dim Success As Long
    Dim CntStart As Long
    Dim Status As String

    Dim InputFile As String
    Dim OutputFile As String
    Dim Profile As String
    Dim PpgMain As New WMEncMonMainPage

    Dim SrcGrpCol As IWMEncSourceGroupCollection
    Dim SrcGrp As IWMEncSourceGroup
    Dim ErrVal
    On Error GoTo Err_Handler

    CmdStart.Enabled = False
    CmdAdd.Enabled = False
    CmdRemove.Enabled = False
    CmdClearResults.Enabled = False
    CmdRemoveAll.Enabled = False
    CmdSave.Enabled = False
    CmdLoad.Enabled = False
    CmdStop.Enabled = True

    If LvwBatcher.ListItems.Count = 0 Then
        MsgBox "No files to encode"
        Exit Sub
    End If

    Set Encoder = New WMEncoder

    MSPropMain.AddObject Encoder
    MSPropMain.AddPage PpgMain

    Set SrcGrpCol = Encoder.SourceGroupCollection
    Set SrcGrp = SrcGrpCol.Add("Batcher")
    CntStart = 1
    While CntStart <= LvwBatcher.ListItems.Count
        InputFile = LvwBatcher.ListItems(CntStart).Text
        OutputFile = LvwBatcher.ListItems(CntStart).ListSubItems("OutputFile").Text
        Profile = LvwBatcher.ListItems(CntStart).ListSubItems("Profile").Text
        Status = LvwBatcher.ListItems(CntStart).ListSubItems("Result").Text

        If Status <> "Done" Then
            Success = ProcessInput(Encoder, InputFile, OutputFile, Profile)

            If Success = 0 Then
                LvwBatcher.ListItems(CntStart).ListSubItems("Result").Text = "Done"
            Else
                ErrVal = Hex(Success)
                LvwBatcher.ListItems(CntStart).ListSubItems("Result").Text = "Error:" & ErrVal
            End If
        End If
        CntStart = CntStart + 1

        If CntStart <= LvwBatcher.ListItems.Count Then
            Set LvwBatcher.SelectedItem = LvwBatcher.ListItems(CntStart)
            Set LvwBatcher.DropHighlight = LvwBatcher.ListItems(CntStart)
        End If
    Wend
    If CntStart > LvwBatcher.ListItems.Count Then
        Set Encoder = Nothing
        CmdStop.Enabled = False
        CmdStart.Enabled = False
    End If

    CmdAdd.Enabled = True
    CmdRemove.Enabled = True
    CmdClearResults.Enabled = True
    CmdRemoveAll.Enabled = True
    CmdSave.Enabled = True
    CmdLoad.Enabled = True
    Exit Sub

Err_Handler:
    MsgBox "Error Processing Input", vbCritical, "Error-" & Err.Number
End Sub

Private Sub CmdStop_Click()
    On Error GoTo Err_Handler

    If Encoder.RunState = WMENC_ENCODER_RUNNING Or WMENC_ENCODER_STARTING Or WMENC_ENCODER_PAUSED Then
        Encoder.Stop
    End If
    Set Encoder = Nothing

    CmdAdd.Enabled = True
    CmdRemove.Enabled = True
    CmdRemoveAll.Enabled = True
    CmdClearResults.Enabled = True
    CmdLoad.Enabled = True
    CmdSave.Enabled = True
    CmdStart.Enabled = True
    Exit Sub
Err_Handler:
    MsgBox "Error stopping Encoder", vbCritical, "Error-" & Err.Number

End Sub

Private Sub Encoder_OnError(ByVal hResult As Long)
    EncError = Encoder.ErrorState
End Sub
Private Sub Form_Load()
    Dim I As Integer


    On Error GoTo Err_Handler

    For I = 1 To 4
        LvwBatcher.ColumnHeaders.Item(I).Width = LvwBatcher.Width / 4
    Next I
    Set Encoder = Nothing
    StaEncoderStat.SimpleText = "Encoder Stopped"

    CmdRemove.Enabled = False
    CmdRemoveAll.Enabled = False
    CmdClearResults.Enabled = False
    CmdSave.Enabled = False
    CmdStart.Enabled = False
    CmdStop.Enabled = False

    Exit Sub
Err_Handler:
    MsgBox "Error Executing Application", vbCritical, "Error-" & Err.Number
End Sub
Function Populate_List(InputFile As String, OutputFile As String, Profile As String) As Integer
    Dim SrcGrpCol As IWMEncSourceGroupCollection
    Dim SrcGrp As IWMEncSourceGroup
    Dim Count As Integer


    Dim periodpos As Long

    Dim AudCnt As Integer
    Dim VidCnt As Integer

    On Error GoTo Err_Handler



    If OutputFile = "None" Then
        Set Encoder = New WMEncoder
        Set SrcGrpCol = Encoder.SourceGroupCollection
        Set SrcGrp = SrcGrpCol.Add("SrcList")
        SrcGrp.AutoSetFileSource (InputFile)
        OutputFile = InputFile
        periodpos = InStrRev(InputFile, ".")
        If periodpos > 0 Then OutputFile = Left(OutputFile, periodpos - 1)

        AudCnt = SrcGrp.SourceCount(WMENC_AUDIO)
        VidCnt = SrcGrp.SourceCount(WMENC_VIDEO)

        If AudCnt > 0 And VidCnt = 0 Then
            OutputFile = OutputFile & ".wma"
        Else
            OutputFile = OutputFile & ".wmv"
        End If
    Set Encoder = Nothing
   End If



   Count = LvwBatcher.ListItems.Count + 1
   LvwBatcher.ListItems.Add Count, , InputFile
   LvwBatcher.ListItems(Count).ListSubItems.Add , "OutputFile", OutputFile
   LvwBatcher.ListItems(Count).ListSubItems.Add , "Profile", Profile
   LvwBatcher.ListItems(Count).ListSubItems.Add , "Result", ""

   LvwBatcher.FullRowSelect = True
   Set LvwBatcher.SelectedItem = LvwBatcher.ListItems(1)
   Set LvwBatcher.DropHighlight = LvwBatcher.ListItems(1)
  Exit Function
Err_Handler:
    Populate_List = 1
End Function
Function ProcessInput(Encoder As WMEncoder, InputFile As String, OutputFile As String, Profile As String) As Long

    Dim SrcGrpCol As IWMEncSourceGroupCollection
    Dim SrcGrp As IWMEncSourceGroup
    Dim PrfCol As IWMEncProfileCollection
    Dim Prf As IWMEncProfile

    Dim Success As Integer

    On Error GoTo Err_Handler
    Set SrcGrpCol = Encoder.SourceGroupCollection
    Set SrcGrp = SrcGrpCol.Item(0)

    SrcGrp.AutoSetFileSource (InputFile)
    Set PrfCol = Encoder.ProfileCollection
    Success = GetProfile(Profile, Prf, PrfCol, SrcGrp)
    If Success = 1 Then
        ProcessInput = 1
        Exit Function
    End If
    Encoder.File.LocalFileName = OutputFile
    EncError = 0
    Encoder.Start


    StaEncoderStat.SimpleText = "Encoder Running"
    While Encoder.RunState <> WMENC_ENCODER_STOPPED And EncError = 0
        DoEvents
    Wend

    StaEncoderStat.SimpleText = "Encoder Stopped"
    If EncError <> 0 Then
        ProcessInput = EncError
    End If
    Exit Function
Err_Handler:
      ProcessInput = Err.Number
End Function
Function GetProfile(Profile As String, Prf As IWMEncProfile, PrfCol As IWMEncProfileCollection, SrcGrp As IWMEncSourceGroup) As Integer
    Dim ExistsFlg As Boolean
    On Error GoTo Err_Handler
    ExistsFlg = False

    For Each Prf In PrfCol
        If UCase(Prf.Name) = UCase(Profile) Then
            SrcGrp.Profile = Prf
            ExistsFlg = True
            Exit For
        End If
    Next

    If ExistsFlg = False Then
        GetProfile = 1
    End If
    Exit Function
Err_Handler:
     GetProfile = 1
End Function

Private Sub LvwBatcher_Click()
     Set LvwBatcher.DropHighlight = LvwBatcher.SelectedItem
     LvwBatcher.FullRowSelect = True
End Sub