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

Text File | 2001-03-02 | 6KB | 249 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "TOWM_ENCODER"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents Encoder As WMEncoder
Attribute Encoder.VB_VarHelpID = -1
Dim EncRunning As Boolean
Function GetCommandArgs(InCommand As String, InputFile As String, OutputFile As String, ProfileName As String) As Boolean
  Dim i As Integer
  Dim Arg As String
  Dim Err As Boolean

  ' Initialize variables

  i = 1
  Err = False

  ' Loop through all arguments

  Do While True

    ' Get next argument

    Arg = GetArgument(InCommand, i)

    ' Process the argument (and any argument following switch)

    If LCase(Arg) = "-in" Then
      i = i + 1
      InputFile = GetArgument(InCommand, i)
    ElseIf LCase(Arg) = "-out" Then
      i = i + 1
      OutputFile = GetArgument(InCommand, i)
    ElseIf LCase(Arg) = "-p" Then
      i = i + 1
      ProfileName = GetArgument(InCommand, i)
    ElseIf Arg = "" Then
      Exit Do
    Else
      Err = True
      Exit Do
    End If

    ' Point to next argument

    i = i + 1
  Loop

  ' Check for argument errors

  If InputFile = "" Then Err = True
  If ProfileName = "" Then Err = True

  ' Set up our return value

  GetCommandArgs = Not Err

End Function
Function GetArgument(InCommand As String, Index As Integer) As String
  Dim ArgStart As Integer
  Dim ArgEnd As Integer
  Dim InArg As Boolean
  Dim InQuotes As Boolean
  Dim i As Integer
  Dim CurrentIndex As Integer
  Dim Argument As String

  ' Initialize variables

  ArgStart = 1
  ArgEnd = 0
  InArg = False
  InQuotes = False
  i = 1
  CurrentIndex = 0

  ' Loop through command string to find start and end of Index-th argument

  While i <= Len(InCommand)

    ' Check for start of argument

    If Mid(InCommand, i, 1) <> " " And Not InArg Then
      If Mid(InCommand, i, 1) = """" Then InQuotes = True
      InArg = True
      CurrentIndex = CurrentIndex + 1
      If CurrentIndex = Index Then
        ArgStart = i
      End If

    ' Check for end of argument

    ElseIf (Mid(InCommand, i, 1) = " " Or Mid(InCommand, i, 1) = """") And InArg And Not InQuotes Then
      InQuotes = False
      InArg = False
      If CurrentIndex = Index Then
        ArgEnd = i - 1
      End If
    End If

    ' Point to next character

    i = i + 1

  Wend

  ' Check if last argument was in quotes and not terminated correctly

  If InArg And CurrentIndex = Index Then
    ArgEnd = Len(InCommand)
  End If

  ' Strip argument out of command string

  Argument = Mid(InCommand, ArgStart, ArgEnd - ArgStart + 1)

  ' Strip off quotes, if necessary

  If Left(Argument, 1) = """" Then Argument = Right(Argument, Len(Argument) - 1)
  If Right(Argument, 1) = """" Then Argument = Left(Argument, Len(Argument) - 1)

  GetArgument = Argument

End Function
Function ConfigEncoder(InputFile As String, OutputFile As String, ProfileName As String) As Boolean
  Dim PeriodPos As Integer
  Dim AudCnt As Integer
  Dim VidCnt As Integer
  Dim Success As Boolean

  Dim SrcGpCol As IWMEncSourceGroupCollection
  Dim SrcGp As IWMEncSourceGroup
  Dim Prf As IWMEncProfile

  On Error GoTo err_handler

  ' Create a new encoder

  Set Encoder = New WMEncoder

  ' Add a source group

  Set SrcGpCol = Encoder.SourceGroupCollection
  Set SrcGp = SrcGpCol.Add("TOWM")

  ' Set the source group to our input file

  SrcGp.AutoSetFileSource (InputFile)

  ' Get the profile from the Profile Collection using its name

  Success = GetProfile(ProfileName, Encoder.ProfileCollection, Prf)
  If Not Success Then GoTo err_handler

  ' Set the profile into the source group

  SrcGp.Profile = Prf

  ' If no output file specified, make it same as input file with correct extension

  If OutputFile = "" Then
    OutputFile = InputFile
    PeriodPos = InStrRev(InputFile, ".")
    If PeriodPos > 0 Then OutputFile = Left(OutputFile, PeriodPos)

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

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

  ' Set output file

  Encoder.File.LocalFileName = OutputFile
  MsgBox "TOWM Starting Encoder To Create  " & OutputFile, vbInformation

  ConfigEncoder = True
  Exit Function

err_handler:
  ConfigEncoder = False

End Function
Function GetProfile(ProfileName As String, PrfCol As IWMEncProfileCollection, Prf As IWMEncProfile) As Boolean
  Dim Err As Boolean
  On Error GoTo err_handler

  ' Initialize variable

  Err = True

  ' Run through the profile collection looking for a name that matches

  For Each Prf In PrfCol
    If UCase(Prf.Name) = UCase(ProfileName) Then
      Err = False
      Exit For
    End If
  Next

  GetProfile = Not Err

  Exit Function

err_handler:
  GetProfile = False

End Function
Sub RunEncoder()

  ' Initialize variable

  EncRunning = True

  ' Start encoder

  Encoder.Start

  ' Spin our wheels while the encoder runs

  While EncRunning = True
    DoEvents
  Wend

End Sub
Private Sub Encoder_OnStateChange(ByVal enumState As WMEncoderLib.WMENC_ENCODER_STATE)

  ' If the encoder has stopped flag RunEncoder to end

  If enumState = WMENC_ENCODER_STOPPED Then
    EncRunning = False
  End If

End Sub