vidtranscode.asmx.vb

Video transcoding source code for media files

Imports System.Web
Imports System.Web.Services
Imports System.Web.Services.Protocols

Imports Microsoft.VisualBasic
Imports System.Diagnostics
Imports System.IO
Imports System.Text.RegularExpressions


<WebService(Namespace:="http://tempuri.org/")> _
<WebServiceBinding(ConformsTo:=WsiProfiles.BasicProfile1_1)> _
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Public Class vidTranscode
    Inherits System.Web.Services.WebService

    'full path to where ffmpeg lives on your system, including the ffmpeg.exe part
    Public Shared strFfmpegPath As String = ""

    'full path to where the video files to process are located on the server, including trailing "\"
    Public Shared strVidsPath As String = ""

    'the default target resolution of videos for the site
    Public Shared wxhDefaultResolution As New vidTranscode.WxH(320, 240)


    Structure WxH
        Private _w As Integer
        Private _h As Integer
        Sub New(ByVal w As Integer, ByVal h As Integer)
            Me._w = w
            Me._h = h
        End Sub
        Public Property W() As Integer
            Get
                Return _w
            End Get
            Set(ByVal Value As Integer)
                _w = Value
            End Set
        End Property
        Public Property H() As Integer
            Get
                Return _h
            End Get
            Set(ByVal Value As Integer)
                _h = Value
            End Set
        End Property
    End Structure

    Structure Paddings
        Private _padTop As Integer
        Private _padRight As Integer
        Private _padBottom As Integer
        Private _padLeft As Integer

        Sub New(ByVal padTop As Integer, ByVal padRight As Integer, ByVal padBottom As Integer, ByVal padLeft As Integer)
            Me._padTop = padTop
            Me._padRight = padRight
            Me._padBottom = padBottom
            Me._padLeft = padLeft
        End Sub
        Public Property PadTop() As Integer
            Get
                Return _padTop
            End Get
            Set(ByVal Value As Integer)
                _padTop = Value
            End Set
        End Property
        Public Property PadRight() As Integer
            Get
                Return _padRight
            End Get
            Set(ByVal Value As Integer)
                _padRight = Value
            End Set
        End Property
        Public Property PadBottom() As Integer
            Get
                Return _padBottom
            End Get
            Set(ByVal Value As Integer)
                _padBottom = Value
            End Set
        End Property
        Public Property PadLeft() As Integer
            Get
                Return _padLeft
            End Get
            Set(ByVal Value As Integer)
                _padLeft = Value
            End Set
        End Property
    End Structure



    <WebMethod()> _
    Public Function doFLVTranscode(ByVal strInputFile As String) As Boolean
        'perform an actual transcode from source format to FLV
        'most variables in here are hardcoded for my own needs, could be changed to allow for more passed variables

        If System.Environment.MachineName.ToUpper = "LETH" Then
            strFfmpegPath = "E:\PROJECTS\bytown\www-vmc\ffmpeg\ffmpeg.exe" 'local, for testing
        Else
            strFfmpegPath = "W:\WEBS\bytown-eventually-rename\www\ffmpeg\ffmpeg.exe" 'remote, for live
        End If

        If System.Environment.MachineName.ToUpper = "LETH" Then
            strVidsPath = "E:\PROJECTS\bytown\www-vmc\media\videos\" 'local, for testing
        Else
            strVidsPath = "W:\WEBS\bytown-eventually-rename\www\media\videos\" 'remote, for live
        End If


        Dim theTargetFileName As String = Mid(strInputFile, 1, (InStrRev(strInputFile, ".") - 1))
        Dim sourceVidInfo As String = vidTranscode.getAllSpecs(strInputFile)
        Dim sourceWxHValue As vidTranscode.WxH = vidTranscode.getWxH(sourceVidInfo)
        Dim sourceReckonedResolution As vidTranscode.WxH = vidTranscode.reckonTargetResolution(sourceWxHValue, wxhDefaultResolution)
        Dim sourceReckonedPaddings As vidTranscode.Paddings = vidTranscode.reckonPaddings(sourceReckonedResolution, wxhDefaultResolution)

        '/////////// the following is a sample ffmpeg call with details
        ' ffmpeg.exe -i [input file] -ar [audio frequency, default 44100] -ab [audio bitrate, default 64k]
        ' -f [conversion format, eg flv] -b [video bitrate, default 200] -r [frames/sec, default 25] -s [widthxheight]
        ' -padEtc [padding around the image] -y [overwrite without warning]

        Dim strGeneratedCall As String = " -i " & strVidsPath & strInputFile & " -ar 22050 -ab 32 -f flv -b 100 -r 20 -s " & _
        sourceReckonedResolution.W & "x" & sourceReckonedResolution.H & _
        " -padtop " & sourceReckonedPaddings.PadTop & " -padright " & sourceReckonedPaddings.PadRight & " -padbottom " & sourceReckonedPaddings.PadBottom & " -padleft " & sourceReckonedPaddings.PadLeft & " -padcolor FF0000 " & _
        " -y " & strVidsPath & theTargetFileName & ".flv"

        '================

        Dim p As Process = New Process()
        Dim s As String

        p.StartInfo.FileName = strFfmpegPath
        p.StartInfo.Arguments = strGeneratedCall

        p.StartInfo.UseShellExecute = False
        p.StartInfo.CreateNoWindow = True
        p.StartInfo.RedirectStandardError = True
        p.Start()

        Dim sError As StreamReader = p.StandardError 'ffmpeg passes back file info as "error" stream, not output stream

        s = sError.ReadToEnd

        If Not p.HasExited Then
            p.Kill()
        End If

        sError.Close()
        p.Close()

        Return True

    End Function




    Shared Function getAllSpecs(ByVal strTheFilename As String) As String

        Dim p As Process = New Process()
        Dim s As String

        p.StartInfo.FileName = strFfmpegPath
        p.StartInfo.Arguments = "-i " & strVidsPath & strTheFilename

        p.StartInfo.UseShellExecute = False
        p.StartInfo.CreateNoWindow = True
        p.StartInfo.RedirectStandardError = True
        p.Start()

        Dim sError As StreamReader = p.StandardError 'ffmpeg passes back file info as "error" stream, not output stream

        s = sError.ReadToEnd

        If Not p.HasExited Then
            p.Kill()
        End If

        sError.Close()
        p.Close()

        Return s

    End Function

    Shared Function getWxH(ByVal strPassedAllSpecs As String) As vidTranscode.WxH
        'get the width and height info from ffmpeg output text and return it as a WxH object

        Dim thereturn As vidTranscode.WxH

        Dim pattern1 = ".*(Stream.\#).*(Video\:).*" 'parentheses added for legibility. first get the right lines
        Dim pattern2 As String = "[0-9]*x[0-9]\w+" 'then get the WxH
        'do it in 2 passes to reduce the risk of someone uploading a file named, say:
        '  "myvideo-320x240.avi" and throwing a false-positive
        Dim matches1 As MatchCollection
        Dim matches2 As MatchCollection
        Dim options As RegexOptions = RegexOptions.IgnoreCase Or RegexOptions.Compiled

        Dim optionRegex As New Regex(pattern1, options)
        ' Get matches of pattern in text
        matches1 = optionRegex.Matches(strPassedAllSpecs)

        If matches1.Count > 0 Then
            'we got a hit for a line with video info in it, parse for WxH
            Dim optionRegex2 As New Regex(pattern2, options)
            matches2 = optionRegex2.Matches(matches1(0).Value)
            If matches2.Count > 0 Then
                Dim splitWxH As Array
                splitWxH = Split(matches2(0).Value, "x")
                thereturn.W = splitWxH(0)
                thereturn.H = splitWxH(1)
            Else
                'there was video stream info, but no resolution info
                thereturn.W = 0
                thereturn.H = 0
            End If
        Else
            'ffmpeg choked on the file provided and disn't return any video stream info
            thereturn.W = 0
            thereturn.H = 0
        End If

        Return thereturn

    End Function

    Shared Function reckonTargetResolution(ByVal currentResolution As WxH, ByVal fitToResolution As WxH) As WxH
        'pass through the current size of the movie, and the desired "fit to" resolution. come up with a new resolution,
        'maintaining aspect ratio and fitting to target

        Dim targetResolution As WxH

        'first figure if width or height is determining factor for resizing
        Dim ratioWidth As Decimal = fitToResolution.W / currentResolution.W
        Dim ratioHeight As Decimal = fitToResolution.H / currentResolution.H
        Dim targetRatio As Decimal = Math.Min(ratioWidth, ratioHeight)

        targetResolution.W = currentResolution.W * targetRatio
        targetResolution.H = currentResolution.H * targetRatio

        'h&w of video must be even number for ffmpeg
        If targetResolution.W Mod 2 <> 0 Then targetResolution.W += 1
        If targetResolution.H Mod 2 <> 0 Then targetResolution.H += 1

        Return targetResolution

    End Function

    Shared Function reckonPaddings(ByVal currentResolution As WxH, ByVal fitToResolution As WxH) As vidTranscode.Paddings
        'figure out how many pixels of black bars are needed around the video to fit nicely at 320X240

        Dim theReturn As vidTranscode.Paddings
        Dim heightDiff As Integer = fitToResolution.H - currentResolution.H
        Dim widthDiff As Integer = fitToResolution.W - currentResolution.W

        If (heightDiff / 2) Mod 2 > 0 Then 'when you split the difference in half, doesn't go equally
            theReturn.PadTop = (heightDiff + 1) / 2
            theReturn.PadBottom = (heightDiff - 1) / 2
        Else 'it does go equally, just split
            theReturn.PadTop = heightDiff / 2
            theReturn.PadBottom = heightDiff / 2
        End If

        'do the same for the sides of the film

        If (widthDiff / 2) Mod 2 > 0 Then 'when you split the difference in half, doesn't go equally
            theReturn.PadLeft = (widthDiff + 1) / 2
            theReturn.PadRight = (widthDiff - 1) / 2
            theReturn.PadLeft = theReturn.PadRight = 800
        Else 'it does go equally, just split
            theReturn.PadLeft = widthDiff / 2
            theReturn.PadRight = widthDiff / 2
        End If

        'ffmpeg has limitation where padding amounts must be even numbers. make it so
        If theReturn.PadTop Mod 2 > 0 Then theReturn.PadTop += 1
        If theReturn.PadBottom Mod 2 > 0 Then theReturn.PadBottom += 1
        If theReturn.PadLeft Mod 2 > 0 Then theReturn.PadLeft += 1
        If theReturn.PadRight Mod 2 > 0 Then theReturn.PadRight += 1

        Return theReturn

    End Function

End Class