Attribute VB_Name = "cliMain"
'==========================================================================
'
' Copyright (c) On2 Technologies Inc. All Rights Reserved.
'
'--------------------------------------------------------------------------
'
' File: $Workfile: cli_encode.bas$
' $Revision: 6$
'
' Last Update: $DateUTC: 2008-07-02 20:08:36Z$
'
'--------------------------------------------------------------------------
Option Explicit
Dim flix As flixengine_com.flix
Dim encodingStatus As flixengine_com.IEncodingStatus
'Objects used to gain access to the Console StdOut
Dim FSO As New Scripting.FileSystemObject
Dim stdioOut As Scripting.TextStream
'Win32 Console functions
Private Declare Function AttachConsole Lib "kernel32" (ByVal pid As Long) As Boolean
Private Declare Function AllocConsole Lib "kernel32" () As Boolean
Private Declare Function FreeConsole Lib "kernel32" () As Boolean
Private Const ATTACH_PARENT_PROCESS As Long = -1
Dim bNewConsole As Boolean
'Use the Win32 Sleep function for progress updates.
'A Timer object would be used in a forms-based project.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'These file paths are altered in the ParseCommandLine function and used in Main
Dim inputFile As String, outputFile As String
Sub Main()
InitConsole
Set flix = New flixengine_com.flix
'currentFlixProcedure is used here as a convenience to keep track of which
'Flix Engine procedure has generated an error, since VB6 has no standalone
'executable stack trace. Set before each Flix-related call.
Dim currentFlixProcedure As String
On Error GoTo ErrorHandler
'enable logging, 0=none(disable) 1=info 2=error(asserts) 3=debug 4=heavy
'CONOUT$ can be used as the log file name to send output to the console
'flix.setLogLevel (3)
'flix.setLogPath ("\cli_encode_vb6.log")
'Print some library information
currentFlixProcedure = "flix.version"
stdioOut.WriteLine ("Flix Engine COM library. Flix Engine v" & flix.version _
& " COM v" & flix.com_version)
currentFlixProcedure = "flix.copyright"
stdioOut.WriteLine (flix.copyright & vbCrLf)
If (ParseCommandLine = False) Then
stdioOut.WriteLine ("usage: cli_encode_vb6.exe <infile> <outfile>")
stdioOut.WriteLine ("")
ReleaseConsole
Set flix = Nothing
Exit Sub
End If
'Set the source file
stdioOut.WriteLine ("Input file : " & inputFile)
currentFlixProcedure = "flix.setInputFile"
flix.setInputFile (inputFile)
'Retrieve the video options interface, IVideoOptions, and display input
'file properties
Dim on2VidOpts As flixengine_com.IVideoOptions
currentFlixProcedure = "flix.videoOptions"
Set on2VidOpts = flix.videoOptions
currentFlixProcedure = "on2VidOpts.getSourceWidth"
stdioOut.WriteLine (String(14, " ") & "Width: " _
& on2VidOpts.getSourceWidth)
currentFlixProcedure = "on2VidOpts.getSourceHeight"
stdioOut.WriteLine (String(14, " ") & "Height: " _
& on2VidOpts.getSourceHeight)
currentFlixProcedure = "flix.getSourceDuration"
stdioOut.WriteLine (String(14, " ") & "Duration: " _
& flix.getSourceDuration & "ms")
'Release the IVideoOption object, as we don't need it any more.
Set on2VidOpts = Nothing
'Set the destination file
stdioOut.WriteLine ("Output file : " & outputFile)
currentFlixProcedure = "flix.setOutputFile"
flix.setOutputFile (outputFile)
'Options may be set and codecs/filters/muxers may be added prior to encode
'Add the scale filter
'Dim scaleFilter As flixengine_com.IFlixPlgn
'currentFlixProcedure = "flix.addFilter"
'Set scaleFilter = flix.addFilter(flix.FE2_FILTER_SCALE)
'currentFlixProcedure = "scaleFilter.setParam"
'Call scaleFilter.setParam(flix.FE2_SCALE_WIDTH, 240)
'currentFlixProcedure = "scaleFilter.setParam"
'Call scaleFilter.setParam(flix.FE2_SCALE_HEIGHT, 160)
'Set scaleFilter = Nothing
'Add the VP6 codec. Though it is the default, you must add it in order to
'modify its settings.
'Dim vp6Codec As flixengine_com.IFlixPlgn
'currentFlixProcedure = "flix.addCodec"
'Set vp6Codec = flix.addCodec(flix.FE2_CODEC_VP6)
'currentFlixProcedure = "vp6Codec.setParam"
'Call vp6Codec.setParam(flix.FE2_VP6_RC_MODE, VBR_1PASSControl)
'Set vp6Codec = Nothing
'Use the FLV muxer (default)
'Dim muxer As flixengine_com.IFlixPlgn
'currentFlixProcedure = "flix.addMuxer"
'Set muxer = flix.addMuxer(flix.FE2_MUXER_FLV)
'Set muxer = Nothing
'start the encode
currentFlixProcedure = "flix.encode"
flix.encode
currentFlixProcedure = "flix.encodingStatus"
Set encodingStatus = flix.encodingStatus
'Start the progress updates
Dim isRunning As Long, percentString As String * 3
stdioOut.WriteBlankLines (1)
Do
Sleep (500)
currentFlixProcedure = "flix.isEncoderRunning"
isRunning = flix.isEncoderRunning
currentFlixProcedure = "on2EncodingStatus.percentComplete"
RSet percentString = encodingStatus.percentComplete
stdioOut.Write (vbCr & "Encoding..." & percentString & "% ")
Loop Until (isRunning = 0)
stdioOut.WriteLine ("Done!")
EndSummary
Exit Sub
ErrorHandler:
Dim errorValue As Long
errorValue = Err.Number
Call HandleError(errorValue, currentFlixProcedure)
End Sub
'Activates and tests StdOut to the console
Sub InitConsole()
bNewConsole = False
If Not AttachConsole(ATTACH_PARENT_PROCESS) Then
bNewConsole = AllocConsole()
End If
On Error GoTo IOError
Set stdioOut = FSO.GetStandardStream(StdOut)
stdioOut.Write (vbCr) 'Should throw an error if stdioOut is invalid
Exit Sub
IOError:
MsgBox ("Error: cli_encode_vb6.exe was unable to attach to Console Standard Output")
End
End Sub
Sub ReleaseConsole()
'Let the user know the program is exiting; technically not necessary if we
'used the parent console, but we've overwritten the prompt, so having the
'user press <Enter> generates a new prompt
stdioOut.Write (vbLf & "Press any key to continue . . . ")
If bNewConsole Then
Dim temp As String
Dim stdioIn As Scripting.TextStream
Set stdioIn = FSO.GetStandardStream(StdIn)
temp = stdioIn.Read(1)
End If
FreeConsole
End Sub
Private Function ParseCommandLine() As Boolean
'Position in the command string which divides the infile and outfile paths
Dim dividePosition As String, commandLine As String
commandLine = Trim(Command)
If (Len(commandLine) < 3) Then
ParseCommandLine = False
Exit Function
End If
'Check for long file paths with quotes
If (InStr(1, commandLine, """") > 0) Then
If (InStr(1, commandLine, """") = 1) Then 'infile is quoted
dividePosition = InStr(2, commandLine, """") + 1
Else 'infile is not quoted, but outfile is quoted
dividePosition = InStr(1, commandLine, """") - 1
End If
Else 'Neither file path is quoted
dividePosition = InStr(1, commandLine, " ")
End If
If (dividePosition > 0) Then
inputFile = Trim$(Left$(commandLine, dividePosition - 1))
outputFile = Trim$(Right$(commandLine, Len(commandLine) - dividePosition))
End If
If (InStr(1, inputFile, """") > 0) Then
inputFile = Mid$(inputFile, 2, Len(inputFile) - 2)
End If
If (InStr(1, outputFile, """") > 0) Then
outputFile = Mid$(outputFile, 2, Len(outputFile) - 2)
End If
If ((Len(inputFile) > 0) And (Len(outputFile) > 0)) Then
ParseCommandLine = True
Else
ParseCommandLine = False
End If
End Function
Private Sub HandleError(errorNumber As Long, currentFlixProcedure As String)
'Get current state of Flix Engine
Dim flixerr As FE2_errno
flixerr = ErrNone
Dim syserr As Long
Call flix.errno_(flixerr, syserr)
If (flixerr = ErrNone) Then
'If the error is not a Flix Engine error,
'pass the error on to the default VB handler
Err.Clear
Err.Raise (errorNumber)
Else
stdioOut.WriteLine (currentFlixProcedure & " failed!")
stdioOut.WriteLine ("HRESULT (" & errorNumber & ")")
EndSummary
End If
End Sub
'Prints a summary of Flix Engine return values and explicitly cleans references.
Private Sub EndSummary()
'Print encoder status
stdioOut.WriteBlankLines (1)
stdioOut.WriteLine ("Encoder Status")
stdioOut.WriteLine (" flix.getEncoderState: " & flix.getEncoderState)
Dim flixerr As FE2_errno
flixerr = ErrNone
Dim syserr As Long
Call flix.errno_(flixerr, syserr)
stdioOut.WriteLine (" flix.errno_: hr:" & Err.Number & " flixerrno:" _
& flixerr & " syserrno:" & syserr)
ReleaseConsole
'Clean up
If (flix.isEncoderRunning = 1) Then
flix.stopEncoding
End If
Set encodingStatus = Nothing
Set flix = Nothing
End 'Exit program
End Sub
