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