VBScriptとFFmpegを使用したお手軽ドラッグ＆ドロップなエンコード （改訂版？）

　「あの処理」までのVBScript （その１０）FFmpegを使用したお手軽ドラッグ＆ドロップなエンコード の改訂版？です。　エンコードしたいファイルをドラッグ＆ドロップして同じフォルダに出力は一緒なんですけど、追加機能がイロイロと、、、、
　①元ファイル（ドラッグ＆ドロップしたファイル）の詳細情報の表示
　②元ファイルの詳細情報からファイルサイズ優先でエンコ設定を自動選択
　③エンコード品質・縦横サイズの選択（３品質×８サイズ で２４パターン）
　
　④出力先に過去に出力したファイルがあった場合、詳細情報の表示
　⑤元と先ファイルがあった場合、ファイルサイズ・更新日時・再生時間など比較
　
 
　と、別物になってる気がしますが、使うだけなら何も考えずマウスだけでサクサク使えます。　①～⑤の機能は、再帰のに組み込む予定で、検証も兼ねています。
　エンコード設定は今までと同様に品質とサイズ以外は画質の許す限り必要最小設定とし、プロファイルＭａｉｎ１Ｐａｓｓエンコードで音声はそのまま使用です。
　設定できる品質は １画質優先２６、２バランス２９、３高圧縮３２。 　出力設定８サイズは、１，３，５，７は１６：９。　２，４，６は４：３の出力。　０は元ファイルの縦横サイズをそのまま使用。　品質とサイズを二桁の数として指定します。
　ちなみに元が同じファイルでも、出力の縦横サイズが大きくなるほど処理に時間がかかります。
 
　
実行環境：
　VBスクリプトと同じフォルダにffmpeg.exeをコピーして"ffpresets"フォルダを作り、"main.ffpreset"ファイルを設置。 ファイルの中はコチラを参照してください。
　
 
 
実行例：
　動画ファイルをVBスクリプトファイルやショートカットにドラッグ＆ドロップ、もちろん " Cscript MovieDrop1.vbs 動画ファイル "でもＯＫ。　今回は引数による動作変更ありません。
 
①元ファイル（ドラッグ＆ドロップしたファイル）の詳細情報の表示
②元ファイルの詳細情報からエンコードのパラメータを程々のファイルサイズ優先で自動選択
③エンコード品質・縦横サイズの選択（３品質×８サイズ で２４パターン）

こでは変換モード設定を、自動設定３１（品質３２：1280x720）を、１１（品質２６：1280x720）つまり高画質設定に変更して実行してます。

 『はい』でエンコード開始。　

 エンコード終了。　
　④出力先に過去に出力したファイルがあった場合、詳細情報の表示
　⑤元と先ファイルがあった場合、ファイルサイズ・更新日時・再生時間など比較
　により、簡単に比較結果が出ます。出来たファイルは元より大きくなってました。

 再度ドラッグ＆ドロップ。

 今度は変換モードの自動設定を変更せずに、そのまま『ＯＫ』

 変換結果は新ファイルのサイズは元ファイルより小さくなりました。画質は一回目より悪くはなってますが、まぁソレナリと言うことで。

 ちなみにWin8.1だからか、そういう設定にしているかだからか不明ですが、 【分類】以降読み取れないこのような

flvファイルとかも、正常変換そして視聴可能でした。

今後について：
　とっとと再帰版に組み込みかなー。何にしてもボチボチケリ付けないと年度末に突入したらやる気力なくなる。

'以下、末尾までスクリプト

'################################################
'
'実行例：Cscript MovieDrop1.vbs 動画ファイル
'
'処理概要
'　動画ファイルを、指定の品質とサイズでFfmpeg変換する。
'　出力は同じフォルダに 動画ファイル名.mp4となる。
'
'IN
'　動画ファイルをフルパス指定する。ドラッグ＆ドロップが楽。
'
'################################################

Option Explicit

'WScript.Object
Dim WSShel , oWSFso , oWSApp , oWArgu

'実行シェル
Set WSShel = WScript.CreateObject("WScript.Shell")

'フォルダ・ファイル操作
Set oWSFso = WScript.CreateObject("Scripting.FileSystemObject")

'ファイル属性確認
Set oWSApp = WScript.CreateObject("Shell.Application")

'パラメータ確認用
Set oWArgu = WScript.Arguments

'***'変換対象 ファイル判定
Const cBunrui_Video = "ビデオ"
Const cBunrui_Unknown = ""

'***Function sRun_FFmpeg パラメータ
Const cFFMPEG_EXE = "ffmpeg.exe"
Const cFFMPEG_SET = "ffpresets\main.ffpreset"
Const sFFMPEG_2FG = ".mp4"
Dim iPathLen , sExePath , sFFmpegExe , sFFmpegPSet , bFfmpgExe , sFFmpegRun

Dim cDC ' ”
cDC = Chr(34)
Const cNULL = ""

'ヘッダラベル
Dim iPARA_COUNT
Dim rPARA_LABEL(512)
iPARA_COUNT = 512
Dim sParaItem0
Dim iConvMode , sEcho
Dim o1Item , o2Item , v1Item, v2Item , s2Item
Dim sInpRes , sInpPpt , sInpTtl , sInpDef 'InputBox
Dim iMsgRes , sMsgPpt , iMsgBtn , sMsgTtl 'MsgBoxBox
Dim sFfmpegCrf , sFfmpegSiz 'Ffmpeg用

 'パラメータ数チェック
 If oWArgu.count = 1 Then
  sParaItem0 = oWArgu.item(0)
  If oWSFso.FileExists( sParaItem0 ) = True Then
   '***元ファイルの属性確認
   '元ファイルオブジェクト取得
   Set o1Item = oWSFso.GetFile( sParaItem0 )
   '***元情報から自動エンコード設定を取得
   iConvMode = iGetConvertMode ( o1Item )
   If Len(iConvMode)=0 Then
    '変換設定が無かったら中止
    sEcho = o1Item.Name  & "は " & o1Item.Type  & " です。変換できません。"
   Else
    '***元情報の確認
    Do
  
    sEcho = cNULL
    sEcho = sEcho & "【元" & sGetDetailMovie( o1Item ) & vbCrlf & vbCrlf
    '***先情報の取得
    s2Item = sConvertMovieName (o1Item.Path ,  o1Item.Path )

    '***先情報の確認
    If oWSFso.FileExists( s2Item ) = True Then
     Set o2Item = oWSFso.GetFile( s2Item )
     sEcho = sEcho & "【先" & sGetDetailMovie( o2Item ) & vbCrlf
    Else
     sEcho = sEcho & "【変換先パス名】" & s2Item & vbCrlf
    End if
    sInpPpt = sEcho & vbCrlf
    If oWSFso.FileExists( s2Item ) = True Then
     '元と先の比較
     sInpPpt = sInpPpt & sHikakuItem12( o1Item , o2Item ) & vbCrlf & vbCrlf
    End if
    sInpPpt  = sInpPpt  & "【変換モード】ex. " & iConvMode & "品質" & vGetConvertCrf(iConvMode)
    If sGetConvertSiz(iConvMode) = cNULL Then
     sInpPpt  = sInpPpt &  vbCrlf
    Else
     sInpPpt  = sInpPpt & ":" & sGetConvertSiz(iConvMode) &  vbCrlf
    End if
    '品質と解像度の組合せ表記はベタベタ
    sInpPpt = sInpPpt & sDocCrfSiz() & vbCrlf
    sInpPpt = sInpPpt & "『キャンセル』で中止します。"
    sInpTtl = "変換モード設定"
    sInpDef = iConvMode
    sInpRes = InputBox( sInpPpt , sInpTtl , sInpDef )
    '***Ffmpeg実行環境判定  エラー実行時に注意喚起して戻る
    '実行vbsファイルのパス取得
    iPathLen= Len(WScript.Scriptfullname) - Len(WScript.Scriptname)
    sExePath = Left(Wscript.Scriptfullname, iPathLen)
    'ffmpegの実行パスファイル取得
    sFFmpegExe = oWSFso.BuildPath(sExePath , cFFMPEG_EXE)
    sFFmpegPSet = oWSFso.BuildPath(sExePath , cFFMPEG_SET)
    'Ffmpeg実行環境判定
    bFfmpgExe = oWSFso.FileExists(sFFmpegExe) and oWSFso.FileExists(sFFmpegPSet)
    If Len(sInpRes)=0 Then
     iMsgRes = vbCancel
     sEcho = sEcho & vbCrlf & sInpTtl & " 『キャンセル』しました。"
    ElseIf vGetConvertCrf(sInpRes)=cNULL or sGetConvertSiz(sInpRes)=cNULL Then
     sMsgPpt = sEcho & vbCrlf & sInpRes  & " ：変換モード設定値が範囲外です。入力し直してください。"
     iMsgBtn = vbExclamation
     sMsgTtl  = "変換モード設定"
     Call Msgbox(sMsgPpt ,iMsgBtn, sMsgTtl)
   
    Else
     'Yesなので変換モード値更新
     iConvMode = Clng(sInpRes)
     '表示用に品質サイズ取得
     sFfmpegCrf = vGetConvertCrf(iConvMode)
     sFfmpegSiz = sGetConvertSiz(iConvMode)
     'FFmpeg 実行文の生成
     'サイズ変更
     sFFmpegRun = sFFmpegExe & " -i " & cDC & o1Item.Path & cDC & " -vcodec libx264 -vpre main -crf " & sFfmpegCrf & sGetConvertSizS(sFfmpegSiz) & " -vsync 2 -acodec copy -y "  & cDC & s2Item & cDC
     '確認メッセージ 共通部分
     sMsgPpt = vbCrlf & vbCrlf & sFFmpegRun & vbCrlf & vbCrlf & "品質" & sFfmpegCrf & ":" & sFfmpegSiz
     'Ffmpeg環境が整ってなければやり直し
     If bFfmpgExe Then
      sMsgPpt = sEcho & sMsgPpt & " で変換開始しますか？　『いいえ』で再入力『キャンセル』で中止します。"
      iMsgBtn = vbYesNoCancel or vbInformation
      sMsgTtl = "変換最終確認"
     Else
      'Ffmpeg環境未構築
      sMsgPpt = sEcho & sMsgPpt & vbCrlf &  vbCrlf &  "Ffmpeg実行環境が不完全です。環境を作ってから実行してください。"
      iMsgBtn = vbExclamation
      sMsgTtl = "変換最終確認（実行環境不完全）"
     End if
     iMsgRes = Msgbox(sMsgPpt ,iMsgBtn, sMsgTtl)
     If iMsgRes = vbCancel Then
      sEcho = sEcho & vbCrlf & sMsgTtl & " 『キャンセル』しました。"
     End If
    End If
    'Ｎｏを選択したら入力しなおし
    Loop Until (iMsgRes = vbYes or iMsgRes = vbCancel)
   End If
   If iMsgRes = vbYes Then
    'Ffmpeg実行する。
    '同期実行
    Call WSShel.Run(sFFmpegRun , 1, true)
    '出来たか確認
    If  oWSFso.FileExists(s2Item) Then
     Set o2Item = oWSFso.GetFile( s2Item )
     sEcho = sEcho & vbCrlf & "品質" & sFfmpegCrf & ":" & sFfmpegSiz & vbCrlf & vbCrlf
     sEcho = sEcho &  "【新" & sGetDetailMovie( o2Item ) & vbCrlf & vbCrlf
     sEcho = sEcho & sHikakuItem12( o1Item , o2Item )  & vbCrlf & vbCrlf
     sEcho = sEcho &  "Ffmpeg変換完了しました。"
    Else
     sEcho = sEcho & vbCrlf & "品質" & sFfmpegCrf & ":" & sFfmpegSiz & vbCrlf & vbCrlf & "何らかの原因で変換できていません。処理を中止します。"
    End if
   End if
  End If
 Else
  sEcho = "引数が不正です。実行例：Cscript MovieDrop1.vbs 動画ファイルパス名"
 End If
 Wscript.Echo sEcho

'終了
Set oWSFso = Nothing
Set oWArgu = Nothing
Set oWSApp = Nothing
Wscript.Quit

'################################################
'Item1 Item2の比較
'IN
'　o1Item , o2Item
'OUT
'　ﾌｧｲﾙｻｲｽﾞ　更新日時　再生時間を比較して文書出力
'
Function sHikakuItem12( o1Item , o2Item )
Dim sItem12
 sItem12 = cNULL
 '元と先の比較
 If o1Item.Size > o2Item.Size Then 
  sItem12 = sItem12 & "○【ﾌｧｲﾙｻｲｽﾞ】[先]小"
 Else
  sItem12 = sItem12 & "×【ﾌｧｲﾙｻｲｽﾞ】[先]大"
 End If
 sItem12 = sItem12 & vbCrlf
 If o1Item.DateLastModified < o2Item.DateLastModified Then 
  sItem12 = sItem12 & "○【更新日時】[先]新"
 Else
  sItem12 = sItem12 & "×【更新日時】[先]旧"
 End If
 sItem12 = sItem12 & vbCrlf
 If Cstr(vGetDetailPara1(o1Item,"長さ")) = Cstr(vGetDetailPara1(o2Item,"長さ")) Then
  sItem12 = sItem12 & "○【再生時間】[先]同"
 Else
  sItem12 = sItem12 & "×【再生時間】[先]違"
 End If
sHikakuItem12 = sItem12
End Function

'################################################
'モード変換>>>品質
'
'IN316
'　piMode モード
'
'Return
'　品質　該当なしは""
'
Function vGetConvertCrf(piMode)
Dim vCrf
 vCrf = cNULL
 If IsNumeric(piMode) Then
  Select Case (piMode \ 10)
  Case 1 : vCrf = 26
  Case 2 : vCrf = 29
  Case 3 : vCrf = 32
  End Select
 End if
vGetConvertCrf = vCrf
End Function

'################################################
'モード変換>>>ｻｲｽﾞ
'
'IN
'　piMode モード
'
'Return
'　サイズ　該当なしは""
'
Function sGetConvertSiz(piMode)
Dim vSize
 vSize = cNULL
 If IsNumeric(piMode) Then
  Select Case (piMode Mod 10)
  Case 0 : vSize = " " 'サイズ変更なし
  Case 1 : vSize = "1280x720"
  Case 2 : vSize = "960x720"
  Case 3 : vSize = "854x480"
  Case 4 : vSize = "640x480"
  Case 5 : vSize = "640x360"
  Case 6 : vSize = "380x270"
  Case 7 : vSize = "426x240"
  End Select
 End if
sGetConvertSiz = vSize
End Function

'################################################
'品質とモードの組合せ説明出力。修正ずらいのでこっちに表記
'
'IN
'　なし
'
'Return
'　品質とモードの組合せ説明
'
Function sDocCrfSiz()
Dim sDoc
 sDoc = cNULL
 sDoc = sDoc & "10品質26, 11同:1280x720, 12同:960x720,,," & vbCrlf
 sDoc = sDoc & "20品質29, 21同:1280x720, 22同:960x720,,," & vbCrlf
 sDoc = sDoc & "30品質32, 31同:1280x720, 32同:960x720,,," & vbCrlf
 sDoc = sDoc & "　_0:ｻｲｽﾞ変更ﾅｼ　　　　　　_7:426x240" & vbCrlf
 sDoc = sDoc & "　　_1:1280x720, _3:854x480, _5:640x360" & vbCrlf
 sDoc = sDoc & "　　　_2:960x720, _4: 640x480, _6:380x270" & vbCrlf
sDocCrfSiz = sDoc
End Function

'################################################
'モード変換>>>ｻｲｽﾞ
'
'IN
'　sSiz サイズバラメータ
'
'Return
'　設定値があったら-sを前に付ける
'
Function sGetConvertSizS(sSiz)
Dim sSizS
 sSizS = sSiz
 If Len( Trim( sSizS ) ) > 0 Then
  sSizS = " -s " & sSiz
 End if
sGetConvertSizS = sSizS
End Function

'################################################
'アイテム詳細出力（指定項目を一つだけ参照）
'出力形式は項目毎に対応
'
'IN
'　poFile 詳細出力オブジェクト
'　psPara 詳細出力する項目名
'
'Return
'　指定項目の詳細出力　文字・数値混在
'
Function vGetDetailPara1( poFile , psPara)
Dim iPara
Dim vPara
 'ファイル詳細の取得
 Dim sName
 Dim oNsFolder
 sName = Cstr( poFile.Name )
 Set oNsFolder = oWSApp.Namespace( Cstr( poFile.ParentFolder ) )
 vPara = cNULL
 For iPara = 0 to (iPARA_COUNT - 1 )
  If psPara = Cstr(oNsFolder.GetDetailsOf(oNsFolder.Items, iPara)) Then
   vPara = oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara)
   Exit for
  End If
 Next
vGetDetailPara1 = vPara
End Function

'################################################
'アイテム詳細出力（動画 向け）
'
'IN
'　poFile 詳細出力したいファイルオブジェクト
'
'Return
'　ピックアップして詳細出力
'
Function sGetDetailMovie( poFile )
Dim sDetail
Dim iPara
 'ファイル詳細の取得
 Dim sName
 Dim sPara
 Dim sFolder
 Dim oNsFolder
 Dim idxN : idxN = 0 ' 名前
 Dim idxS : idxS = 0 ' サイズ
 Dim idxU : idxU = 0 ' '更新日時
 Dim idxC : idxC = 0 ' '作成日時
 Dim idxB : idxB = 0 ' 分類
 Dim idxL : idxL = 0 ' 長さ
 Dim idxH : idxH = 0 ' フレーム高
 Dim idxR : idxR = 0 ' フレーム率
 Dim idxW : idxW = 0 ' フレーム幅
 sName = Cstr( poFile.Name )
 sFolder =  Cstr( poFile.ParentFolder )
 Set oNsFolder = oWSApp.Namespace( sFolder )
 sDetail = cNULL
 For iPara = 0 to (iPARA_COUNT - 1 )
  sPara = Cstr(oNsFolder.GetDetailsOf(oNsFolder.Items, iPara))
  Select Case sPara
  case "名前" : idxN = iPara: sDetail = sDetail & "アイテム名】" & oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara) & vbCrlf
  case "サイズ" :idxS = iPara: sDetail = sDetail & "【ﾌｧｲﾙｻｲｽﾞ】" & oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara) & vbCrlf
  case "更新日時" :idxU = iPara: sDetail = sDetail & "【更新日時】" & oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara) & vbCrlf
  case "分類" :idxB = iPara: sDetail = sDetail & "【分類】" & oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara) 
  case "長さ" : idxL = iPara: sDetail = sDetail & "【再生時間】" & oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara) & vbCrlf
  case "データ速度" : idxH = iPara: sDetail = sDetail & "【bps】" & oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara)
  case "フレーム高" : idxH = iPara: sDetail = sDetail & "【高さ】" & oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara) & vbCrlf
  case "フレーム率" : idxR = iPara: sDetail = sDetail & "【fps】" & oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara)
  case "フレーム幅" : idxW = iPara: sDetail = sDetail & "【横幅】" & oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sName), iPara)
  end select
  '分類以降判定
  If idxB > 0  and idxL > 0  and idxH > 0  and idxR > 0  and idxW > 0 then
   Exit for
  End if
 Next
sGetDetailMovie = sDetail
End Function

'################################################
'変換モード自動決定関数
'
'IN
'　poItem 変換アイテムオブジェクト
'
'Return
'　変換モード
'
Function iGetConvertMode( poItem )
Dim iMode
 'ファイル詳細の取得
 Dim sFile
 Dim iPara
 Dim sPara
 Dim sFolder
 Dim oNsFolder
 Dim idxB : idxB = 0 ' 分類
 Dim idxH : idxH = 0 ' フレーム高
 Dim idxR : idxR = 0 ' フレーム率
 Dim idxW : idxW = 0 ' フレーム幅
 Dim sBunrui ' 分類
 Dim iHeight ' フレーム高
 Dim sRate ' フレーム率
 Dim iWidth ' フレーム幅

 sFile = Cstr( poItem.Name )
 sFolder =  Cstr( poItem.ParentFolder )
 Set oNsFolder = oWSApp.Namespace( sFolder )
 '既定値
 'sName = oNsFolder.GetDetailsOf(poItem, idxN)
 For iPara = 0 to (iPARA_COUNT - 1 )
  sPara = Cstr(oNsFolder.GetDetailsOf(oNsFolder.Items, iPara))
  Select Case sPara
  case "分類" :idxB = iPara: sBunrui = oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sFile), iPara)
  case "フレーム高" : idxH = iPara: iHeight = oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sFile), iPara)
  case "フレーム率" : idxR = iPara: sRate = oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sFile), iPara)
  case "フレーム幅" : idxW = iPara: iWidth = oNsFolder.GetDetailsOf(oNsFolder.Items.Item(sFile), iPara)
  end select
  '分類以降判定
  If idxB > 0  and idxH > 0  and idxR > 0  and idxW > 0 then
   'ビデオと不明のみ通す（フォルダやショートカットは除外）
   If Not (sBunrui = cBunrui_Video or sBunrui = cBunrui_Unknown) Then
    'ビデオと不明以外はＮＵＬＬ
    iMode = cNULL
   Else
    '分類以外の詳細を取得
    iMode = 10
    '縦横設定有り
    If (IsNumeric(iWidth)) and (IsNumeric(iHeight)) Then
     iHeight = CLng(iHeight)
     iWidth = CLng(iWidth)
     If iHeight < 720 Then
      iMode = 10
     ElseIf iHeight = 720 Then '変換基準値
      iMode = 20
     ElseIf iHeight > 720 Then
      If (iHeight / iWidth) > 0.6 Then
       '４：３
       iMode = 32
      Else
       '１６：９
       iMode = 31
      End if
     End if
     '実写系補正
     If (iHeight <= 720) and ( Instr(sRate,"29") Or Instr(sRate,"30") Or Instr(sRate,"59") Or Instr(sRate,"60") ) Then
      iMode = iMode + 10
     End if
    End if
   End if
   Exit for
  End if
 Next
iGetConvertMode = iMode
End Function

'################################################
'変換ファイル名決定関数
'
'違うパスの.mp4以外、ファイル名末尾に.mp4追加する
'
'IN
' ps1Doga 動画元ファイル名
' ps2File "初期"変換後ファイル名
'
'Return
' "正式"変換後ファイル名
'
Function sConvertMovieName ( ps1Doga , ps2File)
Dim sRet2File ' "正式"変換後ファイル名
 'Return初期値
 sRet2File = ps2File
 '元と先が一致したら、末尾に追加
 If Lcase(ps1Doga) = Lcase(ps2File) Then
  sRet2File = ps2File  & sFFMPEG_2FG
 Else
  '拡張子.mp4ではなかったら末尾に付加
  If Lcase( Right( ps1Doga , Len(sFFMPEG_2FG))) <> sFFMPEG_2FG then
   sRet2File = ps2File  & sFFMPEG_2FG
  End if
 End if
sConvertMovieName = sRet2File
End Function