Show streaminfo.bas syntax highlighted
Attribute VB_Name = "streaminfo"
'***************************************************
'*
'* AllToAVI
'*
'* Genesis Kiith 2006-2007
'*
'* genesis.kiith@gmail.com
'*
'***************************************************
Public ShownOnce1 As Boolean
Public ShownOnce2 As Boolean
Public Function h264(filename) As Boolean
Dim fnum As Long
Dim line As String
Dim i As Integer
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set a = fso.CreateTextFile(Temp + "\h264info.bat", True)
a.WriteLine (left(App.path, 2))
a.WriteLine ("cd " + Chr(34) + App.path + "\" + Chr(34))
a.WriteLine ("mencoder.exe " + Chr(34) + filename + Chr(34) + ">" + Chr(34) + Temp + "\h264info.mif" + Chr(34))
a.Close
ShellAndWait Temp + "\h264info.bat", vbMinimizedNoFocus
'V_MPEG4/ISO/AVC
fnum = FreeFile
'Open "info.mif" For Input As fnum
Open Temp + "\h264info.mif" For Input As fnum
While Not (EOF(fnum))
Line Input #fnum, line
i = InStr(1, line, "V_MPEG4/ISO/AVC")
If i > 0 Then
h264 = True
'Sleep (500)
Close #fnum
Close
Kill Temp + "\h264info.bat"
Kill Temp + "\h264info.mif"
Exit Function
End If
Wend
Sleep (2000)
Kill Temp + "\h264info.bat"
Kill Temp + "\h264info.mif"
h264 = False
End Function
'ExtractMediaInfo(frm_options.file_info.Path + "\" + frm_options.file_info.filename, frm_options.cmb_audio, frm_options.cmb_sub, frm_options.txt_width, frm_options.txt_height, frm_options.lb_vcodec, frm_options.lb_vbitrate, frm_options.lb_fourcc, frm_options.lb_acodec, frm_options.lb_abitrate, frm_options.lb_aspect, frm_options.lb_screen, frm_options.lb_FPS, frm_options.lb_font)
Public Function ExtractMediaInfo(filename As String, cmb_audio As ComboBox, cmb_sub As ComboBox, Optional txt_width As TextBox, Optional txt_height As TextBox, Optional lb_vcodec As Label, Optional lb_vbitrate As Label, Optional lb_fourcc As Label, Optional lb_acodec As Label, Optional lb_abitrate As Label, Optional lb_aspect As Label, Optional lb_size As Label, Optional lb_FPS As Label, Optional lb_font As Label) As Integer
Dim fnum As Integer
Dim line As String
Dim width As String
Dim height As String
Dim aspect As Double
Dim pos As Integer
Dim a_pos As Integer
Dim s_pos As Integer
Dim v_pos As Integer
Dim a_id As Integer
Dim s_id As Integer
Dim temp_line As String
Dim v_codec As String
Dim fourcc As Integer
Dim font As Integer
cmb_audio.Clear
cmb_sub.Clear
cmb_audio.Text = "Default audio"
cmb_sub.Text = "Default subtitle [NONE]"
cmb_sub.AddItem " -2 External Sub"
cmb_audio.AddItem " -2 External Audio"
cmb_sub.AddItem " -1 No Sub"
cmb_audio.AddItem " -1 No Audio"
On Error Resume Next
'Kill "C:\Documents and Settings\Sakuya\Desktop\mkvtoolnix-unicode-1.6.5\info.mif"
On Error GoTo Err
a_id = -1
s_id = -1
Set fso = CreateObject("Scripting.FileSystemObject")
Set a = fso.CreateTextFile(Temp + "\extractmediainfo.bat", True)
a.WriteLine (left(App.path, 2))
a.WriteLine ("cd " + Chr(34) + App.path + "\bin\" + Chr(34))
'Set a = fso.CreateTextFile("C:\Documents and Settings\Sakuya\Desktop\mkvtoolnix-unicode-1.6.5\extractmediainfo.bat", True)
'a.writeline ("cd " + Chr(34) + "C:\Documents and Settings\Sakuya\Desktop\mkvtoolnix-unicode-1.6.5" + "\" + Chr(34))
'a.writeline ("F:\Programs\AlltoaviSrc\src\GUI\mencoder.exe" + Chr(34) + filename + Chr(34) + ">" + "info.mif")
a.WriteLine ("mencoder.exe -v " + Chr(34) + filename + Chr(34) + " -o dummy >" + Chr(34) + Temp + "\info.mif" + Chr(34))
'a.writeline ("F:\Programs\AlltoaviSrc\src\GUI\mencoder.exe" + Chr(34) + filename + Chr(34) + ">" + Chr(34) + Temp + "\info.mif" + Chr(34))
a.Close
ShellAndWait Temp + "\" + "extractmediainfo.bat", vbMinimizedNoFocus
'parse
fnum = FreeFile
'Open "info.mif" For Input As fnum
Open Temp + "\info.mif" For Input As fnum
Line Input #fnum, line
While Not (EOF(fnum))
Debug.Print line + vbCrLf
font = InStr(1, line, "font")
a_pos = InStr(1, line, "-aid")
s_pos = InStr(1, line, "-sid")
v_pos = InStr(1, line, "VIDEO:")
fourcc = InStr(1, line, "fourcc")
If font > 0 Then
If (InStr(1, line, "loaded successfully!") > 0) Then
lb_font.ForeColor = &H80000012
lb_font.Caption = "Font Path: Correct"
End If
End If
If a_pos > 0 Then
pos = InStr(1, line, "(")
temp_line = Mid(line, pos + 1)
pos = InStr(1, temp_line, ")")
lb_acodec.Caption = lb_acodec.Caption + " " + Mid(temp_line, 1, pos - 1)
a_id = a_id + 1
line = Mid(line, a_pos)
pos = InStr(1, line, "-alang")
If pos > 0 Then
line = Mid(line, (pos + 7))
cmb_audio.AddItem str(a_id) + " " + line
Else
If (frm_options.Check1.Value = vbUnchecked) And (ShownOnce1 = False) Then
MsgBox "AllToAVI has detected unnamed Audio stream." + DBLNL + _
"You should play the original and see which track is the one" + NL + _
"you want. The 1st listed in the drop down is audio 1, 2nd is" + NL + _
"audio stream 2 and so on." + DBLNL + _
"!!IF you find that the audio in converted file is incorrect, please" + NL + _
"watch the original and make sure you chose the right stream.", vbInformation + vbOKOnly
ShownOnce1 = True
End If
cmb_audio.AddItem str(a_id) + " Unnamed Audio " + str(a_id)
End If
End If
If s_pos > 0 Then
s_id = s_id + 1
line = Mid(line, s_pos)
pos = InStr(1, line, "-slang")
If pos > 0 Then
line = Mid(line, (pos + 7))
cmb_sub.AddItem str(s_id) + " " + line
Else
If (frm_options.Check1.Value = vbUnchecked) And (ShownOnce2 = False) Then
MsgBox "AllToAVI has detected unnamed Subtitle stream." + DBLNL + _
"You should play the original and see which track is the one" + NL + _
"you want. The 1st listed in the drop down is Subtitle 1, 2nd is" + NL + _
"sub stream 2 and so on." + DBLNL + _
"!!IF you find that subtitle did not show up once converted, please" + NL + _
"watch the original and make sure you chose the right stream. Some" + NL + _
"Files contain empty subtitles, although they are still named english", vbInformation + vbOKOnly
ShownOnce2 = True
End If
cmb_sub.AddItem str(s_id) + " Unnamed Sub " + str(s_id)
End If
End If
If v_pos > 0 Then
'VIDEO: [XVID] 640x480 24bpp 23.976 fps 912.4 kbps (111.4 kbyte/s)
pos = InStr(1, line, "x")
If pos > 0 Then
pos = InStr(1, line, "[")
temp_line = Mid(line, pos + 1)
pos = InStr(1, temp_line, "]")
v_codec = Mid(temp_line, 1, pos - 1)
pos = InStr(1, line, "x")
width = Mid(line, 9, pos - 9)
height = Mid(line, pos + 1)
pos = InStr(1, width, " ")
width = Mid(width, pos + 2)
pos = InStr(1, height, " ")
height = Mid(height, 1, pos - 1)
End If
aspect = (Int(width) / Int(height))
txt_height.Text = height
txt_width.Text = width
aspects = aspect
lb_vcodec.Caption = lb_vcodec.Caption + " " + v_codec
lb_aspect.Caption = lb_aspect.Caption + " " + str(Round(aspect, 2))
lb_size.Caption = lb_size.Caption + " " + width + "x" + height
pos = InStr(1, line, "kbps")
If pos > 0 Then
temp_line = Mid(line, 1, pos + 4)
pos = InStrRev(temp_line, "fps")
If pos > 0 Then
temp_line = Mid(line, pos + 5)
End If
lb_vbitrate.Caption = lb_vbitrate.Caption + " " + temp_line
Else
lb_vbitrate.Caption = lb_vbitrate.Caption + " " + "VBR/Unknown"
End If
lb_abitrate.Caption = lb_abitrate.Caption + " " + "VBR/Unknown"
'lb_acodec.Caption = lb_acodec.Caption + " " + "Unknown"
End If
If fourcc > 0 Then
pos = InStr(1, line, "fourcc:")
'pos = InStr(fourcc, line, "fourcc:")
line = Mid(line, pos + 7)
pos = InStr(1, line, " ")
lb_fourcc.Caption = lb_fourcc.Caption + " " + Mid(line, 1, pos - 1)
pos = InStr(1, line, "fps:")
temp_line = Mid(line, pos + 4)
pos = InStr(1, temp_line, " ")
lb_FPS.Caption = lb_FPS.Caption + " " + Mid(temp_line, 1, pos - 1)
End If
Line Input #fnum, line
Wend
Close #fnum
Close
Close
Sleep 200
Kill Temp + "\info.mif"
Kill Temp + "\extractmediainfo.bat"
ExtractMediaInfo = 0
If (InStr(1, frm_options.lb_vcodec.Caption, "avc") > 0) Or (InStr(1, frm_options.lb_vcodec.Caption, "AVC") > 0) Then
frm_action.Hide
ret = MsgBox("H.264 Video detected!" + vbCrLf + "Do you want AllToAVI to switch to more restricted special mode? [RECOMMANDED]", vbInformation + vbYesNo, "H.264 Detection")
If ret = vbYes Then
H264_Mode = True
frm_h264.Show
frm_options.Hide
End If
End If
Exit Function
Err:
ExtractMediaInfo = -1
End Function
Public Function ParseInfo(inputline As String, txt_dir As TextBox, txt_ext As TextBox, aid As TextBox, sid As TextBox, bitrate As TextBox, codec As TextBox, width As TextBox, height As TextBox, out As TextBox, Optional cmb_audio As ComboBox, Optional cmb_sub As ComboBox, Optional cmb_codec As ComboBox, Optional cmb_bitrate As ComboBox)
Dim pos As Integer
Dim pos_start As Integer
Dim str As String
pos = 1
pos_start = InStr(1, inputline, ",")
str = Mid(inputline, pos, pos_start - 1)
txt_dir.Text = str
inputline = Mid(inputline, pos_start + 1)
Debug.Print pos
Debug.Print str
Debug.Print inputline
pos = 1
pos_start = InStr(1, inputline, ",")
str = Mid(inputline, pos, pos_start - 1)
txt_ext.Text = str
inputline = Mid(inputline, pos_start + 1)
Debug.Print pos
Debug.Print str
Debug.Print inputline
pos = 1
pos_start = InStr(1, inputline, ",")
str = Mid(inputline, pos, pos_start - 1)
aid.Text = str
inputline = Mid(inputline, pos_start + 1)
Debug.Print pos
Debug.Print str
Debug.Print inputline
pos = 1
pos_start = InStr(1, inputline, ",")
str = Mid(inputline, pos, pos_start - 1)
sid.Text = str
inputline = Mid(inputline, pos_start + 1)
Debug.Print pos
Debug.Print str
Debug.Print inputline
pos = 1
pos_start = InStr(1, inputline, ",")
str = Mid(inputline, pos, pos_start - 1)
bitrate.Text = str
inputline = Mid(inputline, pos_start + 1)
Debug.Print pos
Debug.Print str
Debug.Print inputline
pos = 1
pos_start = InStr(1, inputline, ",")
str = Mid(inputline, pos, pos_start - 1)
codec.Text = str
inputline = Mid(inputline, pos_start + 1)
Debug.Print pos
Debug.Print str
Debug.Print inputline
pos = 1
pos_start = InStr(1, inputline, ",")
str = Mid(inputline, pos, pos_start - 1)
width.Text = str
inputline = Mid(inputline, pos_start + 1)
Debug.Print pos
Debug.Print str
Debug.Print inputline
pos = 1
pos_start = InStr(1, inputline, ",")
str = Mid(inputline, pos, pos_start - 1)
height.Text = str
inputline = Mid(inputline, pos_start + 1)
Debug.Print pos
Debug.Print str
Debug.Print inputline
out.Text = inputline
cmb_audio.Text = ""
cmb_sub.Text = ""
cmb_codec.Text = ""
cmb_bitrate.Text = ""
End Function
See more files for this project here