myFFDrop - 带有自动响度校正的小型视频批量转码工具

v0.01 Beta，代号Sienna

Imports System.IO
Imports DropTest.myDir
Imports DropTest.myDragDrop
Imports DropTest.myProc
Imports DropTest.Encoding_Parameter

Imports DropTest.Calc

Public Class Form1
    Dim i As Integer
    Dim n As Integer
    Dim objDragDrop As New myDragDrop
    Dim objProcConv As New myProc
    Dim objProcScan As New myProc
    Dim objProcUdp As New myProc

    Dim gStrCurScanFile As String
    Dim gStrCurConvFile As String
    Dim gStrDestFile As String
    Dim gDblAudioGain As Double

    Dim gTimeConvStart As Date

    Dim gDblStdLoud As Double = -23

    Public Event DragEvent(ByVal msg As String)
    Public Event MyProcEvent(ByVal msg As String)
    Public Event RetNewTask(ByVal taskInfo As String)
    Public Event RetNewSrcFile(ByVal fileName As String)

    Private Sub Init()
        envrCheck()
        initDragDrop()
        objProcUdp.ffKillStyle = False
        objProcScan.ffKillStyle = False
        objProcConv.ffKillStyle = True
        AddHandler objProcUdp.retEvnt, AddressOf invokerUdp
        AddHandler objProcScan.retEvnt, AddressOf invokerScanner
        AddHandler objProcConv.retEvnt, AddressOf invokerConv
        AddHandler Me.RetNewTask, AddressOf evntProcNewTask
        AddHandler Me.RetNewSrcFile, AddressOf evntProcNewSrcFile
        'objProcUdp.run("D:\UdpReader.exe", "-p 1234", "")
    End Sub

    Private Sub closeAll()
        objProcUdp.kill()
        objProcScan.kill()
        objProcConv.kill()
    End Sub

    Private Sub initDragDrop()
        Me.AllowDrop = True
        AddHandler Me.DragEnter, AddressOf objDragDrop.obj_DragEnter
        AddHandler Me.DragDrop, AddressOf objDragDrop.obj_DragDrop
        AddHandler objDragDrop.retNewList, AddressOf evntNewListDragDrop
        AddHandler objDragDrop.retNewFile, AddressOf evntNewFileDragDrop
    End Sub

    Private Sub evntNewFileDragDrop(ByVal msg As String)
        If _chkFileExt(msg, ".avi;.mts;.mp4") = True Then
            RaiseEvent RetNewSrcFile(msg)
        End If
    End Sub

    Private Sub evntNewListDragDrop()
        lbScanTask.Items.Clear()
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Init()
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        objProcConv.kill()
    End Sub

    Private Sub invokerScanner(ByVal msg As String)  ' myProc事件委托，负责在两个类之间传递事件信息
        Dim mi As myProc.dlEvntHnd
        mi = New myProc.dlEvntHnd(AddressOf evntProcScan)
        If IsNothing(msg) = False Then
            Me.BeginInvoke(mi, msg)
        End If
    End Sub

    Private Sub invokerConv(ByVal msg As String)  ' myProc事件委托，负责在两个类之间传递事件信息
        Dim mi As myProc.dlEvntHnd
        mi = New myProc.dlEvntHnd(AddressOf evntProcConv)
        If IsNothing(msg) = False Then
            Me.BeginInvoke(mi, msg)
        End If
    End Sub

    Private Sub invokerUdp(ByVal msg As String)
        Dim mi As myProc.dlEvntHnd
        mi = New myProc.dlEvntHnd(AddressOf evntProcUdp)
        If IsNothing(msg) = False Then
            Me.BeginInvoke(mi, msg)
        End If
    End Sub

    Private Sub evntProcUdp(ByVal msg As String)  ' 由委托触发的事件处理程序
        Dim exitCode As Integer
        If msg.IndexOf("myProc.exitCode") = 0 Then
            exitCode = Val(msg.Substring(16))
            If exitCode <> 0 Then
            Else
            End If
        End If
        If msg.IndexOf("myProc.errOut") = 0 Then
            lbUdpCmd.Items.Add(msg.Substring(14))
            lbScanTask.Items.Add(msg.Substring(14))
        End If
        If msg.IndexOf("myProc.stdOut") = 0 Then
            lbUdpCmd.Items.Add(msg.Substring(35))
            lbScanTask.Items.Add(msg.Substring(35))
        End If
        If msg.IndexOf("myProc.exited") = 0 Then
        End If
        If msg.IndexOf("myProc.disposed") = 0 Then
        End If
    End Sub

    Private Sub evntProcConv(ByVal msg As String)  ' 由委托触发的事件处理程序
        Dim exitCode As Integer

        If msg.IndexOf("myProc.exitCode") = 0 Then
            exitCode = Val(msg.Substring(16))
            If exitCode <> 0 Then
                TextBox7.AppendText("程序非正常退出。错误号：" + Str(exitCode) + vbCrLf)
                TextBox7.AppendText("正在删除目标文件：" + gStrDestFile + vbCrLf)
                System.IO.File.Delete(gStrDestFile)
            Else
                TextBox7.AppendText("程序正常退出。错误号：" + Str(exitCode) + vbCrLf)
            End If
        End If
        If msg.IndexOf("myProc.errOut") = 0 Then
            Dim a1 As String()
            a1 = msg.Substring(14).Split("=")
            For i = 0 To a1.Length - 1
                If a1(i).EndsWith("frame") = True And i + 1 < a1.Length - 1 Then
                    ui_SetFrames(a1(i + 1).Substring(0, 5))
                End If
            Next
            TextBox7.AppendText(msg.Substring(14) + vbCrLf)
        End If
        If msg.IndexOf("myProc.stdOut") = 0 Then
            TextBox7.AppendText(msg.Substring(14) + vbCrLf)
        End If
        If msg.IndexOf("myProc.exited") = 0 Then
            TextBox7.AppendText("程序已经退出。" + vbCrLf)
        End If
        If msg.IndexOf("myProc.disposed") = 0 Then
            TextBox7.AppendText("程序已经销毁。" + vbCrLf)
        End If
    End Sub

    Private Sub ui_SetDuration(ByVal msg As String)
        TextBox4.Text = msg
    End Sub

    Private Sub ui_SetFrames(ByVal msg As String)
        Dim dblPgrs As Double
        Dim TimeConvCur As Date
        Dim TimeSpan1 As TimeSpan
        Dim iSecRemain As Integer

        TimeConvCur = Now()
        TextBox3.Text = msg
        ProgressBar1.Value = Val(TextBox3.Text)
        If ProgressBar1.Maximum <> 0 Then
            dblPgrs = ProgressBar1.Value / ProgressBar1.Maximum
            tbPgrs.Text = Format(dblPgrs * 100, "##0") + "%"
            TimeSpan1 = TimeConvCur - gTimeConvStart
            If dblPgrs <> 0 Then
                iSecRemain = TimeSpan1.TotalSeconds / dblPgrs * (1 - dblPgrs)
                tbSecRemain.Text = "完成当前任务预计还需：" + Math.Floor(iSecRemain / 60).ToString + "分" + (iSecRemain Mod 60).ToString + "秒"
            End If
        Else
            tbPgrs.Text = ""
        End If
    End Sub

    Private Sub evntProcScan(ByVal msg As String)  ' 由委托触发的事件处理程序
        Dim exitCode As Integer
        Dim a1 As String()
        Dim dblFileILoud As Double
        Dim strTaskInfo As String

        If msg.IndexOf("myProc.exitCode") = 0 Then
            exitCode = Val(msg.Substring(16))
            If exitCode <> 0 Then
                TextBox2.AppendText("DropTest::Scanner:程序非正常退出。错误号：" + Str(exitCode) + vbCrLf)
            Else
                TextBox2.AppendText("DropTest::Scanner:程序正常退出。错误号：" + Str(exitCode) + vbCrLf)
                '未对扫描结果做确认，
                If TextBox4.Text <> "" Then
                    strTaskInfo = gStrCurScanFile + "*FRAMES*" + TextBox4.Text + "*GAIN*" + gDblAudioGain.ToString
                    ui_SetDuration("0")
                    RaiseEvent RetNewTask(strTaskInfo)
                End If
            End If
        End If
        If msg.IndexOf("myProc.errOut") = 0 Then
            a1 = msg.Substring(14).Split(",")
            For i = 0 To a1.Length - 1
                If a1(i).IndexOf("Duration:") <> -1 Then
                    ui_SetDuration(TimeToFrames(a1(i).Substring(a1(i).IndexOf("Duration:") + "Duration:".Length)).ToString)
                End If
                If a1(i).IndexOf("I:        ") <> -1 Then
                    dblFileILoud = Val(a1(i).Substring(a1(i).IndexOf("I:        ") + "I:        ".Length)).ToString
                    gDblAudioGain = gDblStdLoud - dblFileILoud
                End If
            Next
            TextBox2.AppendText(msg.Substring(14) + vbCrLf)
        End If
        If msg.IndexOf("myProc.stdOut") = 0 Then
            TextBox2.AppendText(msg.Substring(14) + vbCrLf)
        End If
        If msg.IndexOf("myProc.exited") = 0 Then
            TextBox2.AppendText("DropTest::Scanner:程序已经退出。" + vbCrLf)
            Timer1.Enabled = True
        End If
        If msg.IndexOf("myProc.disposed") = 0 Then
            TextBox2.AppendText("DropTest::Scanner:程序已经销毁。" + vbCrLf)
        End If
    End Sub

    Private Sub evntProcNewTask(ByVal taskInfo As String)
        lbConvTask.Items.Add(taskInfo)
    End Sub

    Private Sub evntProcNewSrcFile(ByVal fileName As String)
        lbScanTask.Items.Add(fileName)
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Dim s As String

        i = lbScanTask.SelectedIndex
        n = lbScanTask.Items.Count
        If n > 0 Then
            If objProcScan.blRunning = False Then
                If i + 1 < n Then
                    i = i + 1
                    lbScanTask.SelectedIndex = i
                    s = lbScanTask.Items(i).ToString
                    TextBox1.Text = "正在扫描文件" + s + "..."
                    Timer1.Enabled = False
                    TextBox4.Text = ""
                    gDblAudioGain = 0
                    gStrCurScanFile = s
                    objProcScan.run(Application.StartupPath + "\ffmpeg.exe", "-i """ + s + """ -af ebur128 -threads 1 -f wav nul -y", "")
                Else
                    lbScantask.Items.Clear()
                End If
            End If
        End If
    End Sub

    Private Sub envrCheck()
        Dim blEnvrGood As Boolean = True
        If File.Exists(Application.StartupPath + "\ffmpeg.exe") = False Then
            MsgBox("找不到运行路径下的ffmpeg.exe，请尝试重新安装软件。", MsgBoxStyle.Information, "运行环境检测")
            blEnvrGood = False
        End If
        If File.Exists(Application.StartupPath + "\downconv.bat") = False Then
            MsgBox("找不到运行路径下的downconv.bat，请尝试重新安装软件。", MsgBoxStyle.Information, "运行环境检测")
            blEnvrGood = False
        End If
        If blEnvrGood = False Then
            closeAll()
            End
        End If
    End Sub

    Private Sub Form1_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
        closeAll()
    End Sub

    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        Dim s As String
        Dim objArray As String()
        Dim strArgLoudCorr As String

        i = lbConvTask.SelectedIndex
        n = lbConvTask.Items.Count

        If n > 0 Then
            If objProcConv.blRunning = False Then
                If i + 1 < n Then
                    i = i + 1
                    lbConvTask.SelectedIndex = i
                    s = lbConvTask.Items(i).ToString
                    objArray = s.Split("*")
                    s = objArray(0)
                    strArgLoudCorr = " -af ""compand=.001:.07:-4/-4|0/-4:0.01:" + objArray(4) + ":0:0.004"" "
                    ProgressBar1.Maximum = Val(objArray(2))
                    ui_SetFrames("0")
                    TextBox6.Text = "正在转换文件" + s + "..."
                    gStrCurConvFile = s
                    gStrDestFile = s + ".test.mpg"
                    gTimeConvStart = Now()
                    objProcConv.run(getEncAppPath(), getEncArgs(s, gStrDestFile) + strArgLoudCorr, "")   '程序与数据没有完全分离
                Else
                    ui_SetFrames("0")
                    lbConvTask.Items.Clear()
                End If
            End If
        End If
    End Sub
End ClassClass myDragDrop
    Public Event retNewFile(ByVal msg As String)
    Public Event retNewList()

    Public Sub obj_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs)
        Dim a As String()
        Dim b As String
        a = e.Data.GetData(DataFormats.FileDrop)
        If a.Length <> 0 Then
            RaiseEvent retNewList()
            For Each b In a
                RaiseEvent retNewFile(b)
            Next
        End If
    End Sub

    Public Sub obj_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs)
        If e.Data.GetDataPresent(DataFormats.FileDrop) <> Nothing Then
            e.Effect = DragDropEffects.All
        Else
            e.Effect = DragDropEffects.None
        End If
    End Sub
End ClassPublic Class myProc
    Public Delegate Sub dlEvntHnd(ByVal msg As String)
    Dim objProc As System.Diagnostics.Process
    Dim objHnd As dlEvntHnd
    Public exitCode As Integer
    Public blIsBreak As Boolean = False
    Public blRunning As Boolean
    Public ffKillStyle As Boolean = False

    Public Event retEvnt(ByVal msg As String)

    Public Sub run(ByVal argUrl As String, ByVal argArg As String, ByVal argPwd As String)
        blRunning = False
        blIsBreak = False
        objProc = New System.Diagnostics.Process()
        objProc.StartInfo.CreateNoWindow = True
        objProc.StartInfo.UseShellExecute = False
        objProc.StartInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Hidden
        objProc.StartInfo.FileName = argUrl
        objProc.StartInfo.Arguments = argArg
        objProc.StartInfo.WorkingDirectory = argPwd
        objProc.EnableRaisingEvents = True
        objProc.StartInfo.RedirectStandardError = True
        objProc.StartInfo.RedirectStandardOutput = True
        objProc.StartInfo.RedirectStandardInput = True
        AddHandler objProc.ErrorDataReceived, AddressOf _hndErrOut
        AddHandler objProc.OutputDataReceived, AddressOf _hndStdOut
        AddHandler objProc.Exited, AddressOf _hndExit
        AddHandler objProc.Disposed, AddressOf _hndDisp
        Try
            objProc.Start()
        Catch ex As System.ComponentModel.Win32Exception
            Throw
        End Try
        objProc.BeginErrorReadLine()
        objProc.BeginOutputReadLine()
        blRunning = True
        exitCode = 0
    End Sub

    Public Sub kill()
        If ffKillStyle = False Then
            If blRunning = True Then
                objProc.Kill()
            End If
        Else
            If blRunning = True Then
                If objProc.HasExited = False Then
                    blIsBreak = True
                    objProc.StandardInput.Write("q")    '为ffdrop定制的参数
                End If
            End If
        End If
    End Sub

    Private Sub _hndErrOut(ByVal sender As Object, ByVal e As System.Diagnostics.DataReceivedEventArgs)
        If IsNothing(e.Data) = False Then
            RaiseEvent retEvnt("myProc.errOut:" + e.Data.ToString())
        End If
    End Sub

    Private Sub _hndStdOut(ByVal sender As Object, ByVal e As System.Diagnostics.DataReceivedEventArgs)
        If IsNothing(e.Data) = False Then
            RaiseEvent retEvnt("myProc.stdOut:" + e.Data.ToString)
        End If
    End Sub

    Private Sub _hndExit(ByVal sender As Object, ByVal e As EventArgs)
        If blIsBreak = True Then
            exitCode = -1
            blIsBreak = False
        Else
            exitCode = objProc.ExitCode
        End If

        RaiseEvent retEvnt("myProc.exitCode:" + exitCode.ToString)
        objProc.Close()
        blRunning = False
        RaiseEvent retEvnt("myProc.exited")
    End Sub

    Private Sub _hndDisp(ByVal sender As Object, ByVal e As EventArgs)
        RaiseEvent retEvnt("myProc.disposed")
    End Sub
End ClassModule Encoding_Parameter

    Public Function getEncAppPath() As String
        Return (Application.StartupPath + "\downconv.bat")
    End Function

    Public Function getEncArgs(ByVal strSrcFile As String, ByVal strDestFile As String) As String
        Dim cmdLine As String
        cmdLine = " .\ffmpeg.exe" + " """ + strSrcFile + """ "
        'cmdLine += " -vcodec mpeg2video -pix_fmt yuv422p -s pal -r pal -flags ilme+ildct "
        'cmdLine += " -b 8000k -top 1"
        'cmdLine += " -bufsize 1792k"
        'cmdLine += " -g 12 -bf 2"
        'cmdLine += " -dct mmx -idct faani"
        'cmdLine += " -ec ""guess_mvs"" "
        'cmdLine += " -cmp ""rd"" -subcmp ""rd"" -mbcmp ""rd"" -dc 10 "
        'cmdLine += " -rc_strategy 2 -b_strategy 2"
        'cmdLine += " -vf """
        'cmdLine += "il=l=d:c=d:a=d,"
        'cmdLine += "tinterlace=6,w3fdif,fps=25,"
        'cmdLine += "w3fdif,fps=50,"
        'cmdLine += "unsharp=3:3:0.5:3:3:0.5,"
        'cmdLine += "hqdn3d=2:1.5:3,"
        'cmdLine += "yadif=3,fps=50,"
        'cmdLine += "kerndeint=thresh=0:map=0:order=0:sharp=1:twoway=0,"
        'cmdLine += "yadif=1,"
        'cmdLine += "tinterlace=0:low_pass_filter,"
        'cmdLine += "yadif=3,"
        'cmdLine += "mcdeint=fast,"
        'cmdLine += "scale=w=720:h=432:flags=lanczos:interl=0," '用于内插的滤波器必须是线性相位的
        'cmdLine += "mcdeint=fast,"
        'cmdLine += "pad=720:576:0:(oh-ih)/2,"
        'cmdLine += "crop=1440:1080,scale=720:576:flags=sinc"
        'cmdLine += "interlace"
        'cmdLine += "tinterlace=4:low_pass_filter"

        'cmdLine += " fps=100,yadif=1,hqdn3d,scale=1440:864:flags=lanczos,scale=720:432:flags=lanczos,pad=720:576:0:(oh-ih)/2,interlace"


        'cmdLine += """"
        'cmdLine += " -acodec mp2 -b:a 384k -ar 48000 -ac 2 -cutoff 14500"
        'cmdLine += " -f vob """ + strDestFile + """ -y"
        cmdLine += strDestFile
        'cmdLine += " -streamid 0:308 -streamid 1:256"
        Return cmdLine
    End Function

End Module
'sLdns = " -af ""compand=attacks=0.001:decays=0.1:points=0/-4|-4/-4:soft-knee=0.01:gain=" + objArr(4) + ":volume=0:delay=0.04"" "Imports System.IO '此段程序的源C#程序来自：http://www.cnblogs.com/eecc/articles/1261126.html

Public Class myDir
    Dim g_strBaseDir As String = ""
    Public a1 As ArrayList
    Public Event retNewFile(ByVal strFullName As String)
    Public Event walkBegin()
    Public Event walkEnd()

    ''' 

    ''' 遍历指定文件夹下的文件(Windows系统)
    ''' 
    ''' 被搜索的最顶层文件夹路径。
    ''' 要寻找的文件扩展名。不区分大小写。多个扩展名可用英文分号“;”隔开。
    ''' 是否连子目录一起搜索，True为是，False为否。默认为是(True)。
    ''' 
   
   
    Public Sub walkDir(ByVal strBaseDir As String, ByVal strExts As String, Optional ByVal blWithSubs As Boolean = True)
        Dim i As Integer
        Dim di As DirectoryInfo
        Dim diA As DirectoryInfo()
        Dim fiA As FileInfo()
        Dim sExt As String

        If g_strBaseDir = "" Then
            g_strBaseDir = strBaseDir
            a1 = New ArrayList
            RaiseEvent walkBegin()
        End If

        di = New DirectoryInfo(strBaseDir)

        Try
            For Each sExt In strExts.Split(";")
                fiA = di.GetFiles(sExt)
                For i = 0 To fiA.Length - 1
                    a1.Add(fiA(i).FullName)
                    RaiseEvent retNewFile(fiA(i).FullName)
                Next
            Next
        Catch ex As System.UnauthorizedAccessException

        End Try

        If blWithSubs = True Then
            Try     '屏蔽无权限或不能访问的目录
                diA = di.GetDirectories
                For i = 0 To diA.Length - 1
                    walkDir(diA(i).FullName, strExts, blWithSubs)
                Next
            Catch ex As System.UnauthorizedAccessException
            End Try
        End If

        If strBaseDir = g_strBaseDir Then
            g_strBaseDir = ""
            RaiseEvent walkEnd()
        End If
    End Sub
End ClassModule Calc
    Public Function TimeToFrames(ByVal strTimeCode As String) As Integer
        Dim s As String
        Dim frames As Double

        frames = 0
        For Each s In strTimeCode.Split(":")
            frames *= 60
            frames += Val(s)
        Next
        frames /= 0.04
        Return frames
    End Function

    Public Function _chkFileExt(ByVal strPath As String, ByVal strExt As String) As Boolean
        Dim s As String
        For Each s In strExt.Split(";")
            If strPath.EndsWith(s, StringComparison.InvariantCultureIgnoreCase) Then
                Return True
            End If
        Next
        Return False
    End Function
End Module


'对于队列来说，重启的时候队列会丢。
'Todo:宽高比转换

'Public Class ffDrop_Meta
'Public Class Video_Resolution
'Public Width As Integer
'Public Height As Integer
'Public DAR As Integer
'Public SAR As Integer
'End Class
'Dim gObjPSTMeta As ffDrop_Meta
'Dim gObjPGMMeta As ffDrop_Meta
'Public Filename As String
'Public Resolution As Video_Resolution
'Public TotalFrames As Integer
'Public CurrentFrame As Integer
'Public Loudness As Double
'End Class"%1" -v "warning" -i %2 -top 1 -pix_fmt yuv422p -bits_per_raw_sample 10 -vf yadif=1,fps=50,mcdeint=fast,hqdn3d,scale=720:432:flags=lanczos:interl=1:out_color_matrix=bt601:out_range=mpeg/tv,pad=720:576:0:(oh-ih)/2,interlace -vcodec rawvideo -acodec copy -f avi - | "%1" -i - -stats -flags ilme+ildct -top 1 -strict strict -b:v 8000k -minrate 6000k -maxrate 12000k -pix_fmt yuv422p -cmp rd -subcmp rd -mbcmp rd -b_strategy 2 -g 12 -bf 2 -dc 9 -keyint_min 3 -vcodec mpeg2video -acodec mp2 %4 %5 -threads 1 -b:a 384k -ar 48000 -ac 2 -f vob %3 -y
@rem -v "warning"
@rem CRC消耗的资源很大。"fps=50",mcdeint=fast