2014年1月13日月曜日

VBScriptとFFmpegを使用したお手軽ドラッグ&ドロップなエンコード (改訂版?)

 「あの処理」までのVBScript (その10)FFmpegを使用したお手軽ドラッグ&ドロップなエンコード の改訂版?です。 エンコードしたいファイルをドラッグ&ドロップして同じフォルダに出力は一緒なんですけど、追加機能がイロイロと、、、、
 ①元ファイル(ドラッグ&ドロップしたファイル)の詳細情報の表示
 ②元ファイルの詳細情報からファイルサイズ優先でエンコ設定を自動選択
 ③エンコード品質・縦横サイズの選択(3品質×8サイズ で24パターン)
 
 ④出力先に過去に出力したファイルがあった場合、詳細情報の表示
 ⑤元と先ファイルがあった場合、ファイルサイズ・更新日時・再生時間など比較
 
 
 と、別物になってる気がしますが、使うだけなら何も考えずマウスだけでサクサク使えます。 ①~⑤の機能は、再帰のに組み込む予定で、検証も兼ねています。
 エンコード設定は今までと同様に品質とサイズ以外は画質の許す限り必要最小設定とし、プロファイルMain1Passエンコードで音声はそのまま使用です。
 設定できる品質は 1画質優先26、2バランス29、3高圧縮32。  出力設定8サイズは、1,3,5,7は16:9。 2,4,6は4:3の出力。 0は元ファイルの縦横サイズをそのまま使用。 品質とサイズを二桁の数として指定します。
 ちなみに元が同じファイルでも、出力の縦横サイズが大きくなるほど処理に時間がかかります。
 
 
実行環境
 VBスクリプトと同じフォルダにffmpeg.exeをコピーして"ffpresets"フォルダを作り、"main.ffpreset"ファイルを設置。 ファイルの中はコチラを参照してください。
 
 
 
実行例:
 動画ファイルをVBスクリプトファイルやショートカットにドラッグ&ドロップ、もちろん " Cscript MovieDrop1.vbs 動画ファイル "でもOK。 今回は引数による動作変更ありません。
 
①元ファイル(ドラッグ&ドロップしたファイル)の詳細情報の表示
②元ファイルの詳細情報からエンコードのパラメータを程々のファイルサイズ優先で自動選択
③エンコード品質・縦横サイズの選択(3品質×8サイズ で24パターン)
こでは変換モード設定を、自動設定31(品質32:1280x720)を、11(品質26:1280x720)つまり高画質設定に変更して実行してます。
 『はい』でエンコード開始。 
 エンコード終了。 
 ④出力先に過去に出力したファイルがあった場合、詳細情報の表示
 ⑤元と先ファイルがあった場合、ファイルサイズ・更新日時・再生時間など比較
 
により、簡単に比較結果が出ます。出来たファイルは元より大きくなってました。
 再度ドラッグ&ドロップ。
 今度は変換モードの自動設定を変更せずに、そのまま『OK』
 変換結果は新ファイルのサイズは元ファイルより小さくなりました。画質は一回目より悪くはなってますが、まぁソレナリと言うことで。

 ちなみに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

    'Noを選択したら入力しなおし
    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
    'ビデオと不明以外はNULL
    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
       '4:3
       iMode = 32
      Else
       '16:9
       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


2014年1月11日土曜日

VBScriptによるアイテム情報の取得(汎用版)

 仕事始めから数日たち、ようやく落ち着いて来たので過去の行状を振り返ってみました、、、、削除したい気分になりましたorz 動画の自動圧縮としてブログを書き始めたのに、それはオマケな気が、、、、どうしてこうなった?
 まぁ、イイヤ。急がば回れと言うし。ともかく、何度かは「指定フォルダ内のアイテム詳細情報の取り出し」をテーマに、動画ファイルの情報を取り出したいがために試行錯誤した。 あの時にイロイロ思いついた事を形にして汎用版作って見てもいいかもと思い立ち、リハビリ代わりに組んでみました。
 
 出来るだけお気楽に使用できるよう、ドラッグ&ドロップを基本としています。
 もちろん、ちょとコマンド実行できたら便利かな~な使い方も出来るようにしてみました。
 再帰検索はしていません。指定したアイテムのみの検索としています。


 ※アイテムがショートカットだと詳細情報の表示はできません。 アイテム-フォルダの中にあるショートカットだと詳細情報の表示は出来ます。



実行環境:
 作成テストはWindows8.1でしています。Windows7sp1での実行は問題ありませんでした。

実行例:

・VBScriptファイルに直接またはショートカットに、詳細表示したいファイルをドラッグ&ドロップした場合。
アイテムの詳細情報が全部出る。 未設定の項目は表示しない。


・VBScriptファイルに直接またはショートカットに、詳細表示したいフォルダをドラッグ&ドロップした場合。
1.【詳細表示アイテム絞込条件の入力】 そのまま「OK」で全対象
2.【表示位置の指定】 表示対象アイテム数が10以上あった場合、10単位で連続出力するので、表示したい位置の番号を入力指定する。(ex. 11以上表示したかったら 1 ) 範囲外または文字を入力した場合は中止となります。
3.【アイテム詳細情報】 入力値の範囲分を順次出力する。
これにて終了。


・コマンドライン
Cscript ShowItemDetails1.vbs パス名 [連続表示数] [出力項目数] 
 コマンドラインでの実行では、アイテム名のみ渡せば実行と同様の動きをしますが、 第2引数 [連続表示数]第3[出力項目数] を渡すことで、出力の整形が出来ます。


・第1引数 アイテム名 のみ
   Cscript ShowItemDetails1.vbs c:
 詳細表示アイテム絞込条件の入力】 【表示位置の指定】 以外はコマンドライン出力



第1引数 アイテム名、第2引数 [連続表示数]

   Cscript ShowItemDetails1.vbs c: 20 
 通常は最大10と固定となっているアイテム連続出力数の設定。ただしあまり数を多くすると実行後に反応が無く不安になるので注意。 詳細表示アイテム絞込条件の入力】で絞り込まれた数が[連続表示数]を超えると別扱いとなる。ドラッグ実行で設定できないのは、うかつに数多くすると詳細表示の際にひたすらOKボタンを押す羽目になるから、、、だったりする。 
 時間がかかっても指定数を一気に出力するので、表出力の際とか便利かもしれない。




第1引数 アイテム名、第2引数 [連続表示数]、第3[出力項目数]
   Cscript ShowItemDetails1.vbs c: 20 5
 [出力項目数]を設定する事で、列[出力項目数]×行[連続表示数]の表出力となる。指定は1~512(不正値は1)。 値が未設定でも出力。
 通常のアイテム詳細表示では、値が有るデータのみ出力としている。 これはアイテムの毎に設定場所が違うからというのがあるが、値の比較をしたい場合とかは不便といえる。

 表出力では項目を基準としているため、値の有無にかかわらず出力する。 タブ区切りなのでリダイレクトでファイル出力してやれば、表計算ソフトなどで利用しやすいかもしれない。

   Cscript ShowItemDetails1.vbs c: 20 5 > c20-5.txt


'処理について
 今回は、コマンドライン以外での使用も考慮したためWscript.Echoの使いどころに注意してみました。 詳細表示出力の他に、検索条件や表示指定などの入力値ももあったため、それらの情報もまとめとして出力するようにしています。
 アイテムの詳細表示ネタはここまでで、以後はメインテーマの動画の自動圧縮に戻ります。まずは差分判定にするか。。。。。


'以下、末尾までスクリプトです。 ではまた~ノシ
'################################################
'
'実行例:Cscript ShowItemDetails1.vbs パス名 [連続表示数] [出力項目数] 
'
'処理概要
' 指定フォルダ内のアイテム情報を抜き出し Echo する。
' ファイルの場合は、ドロップしたアイテムのみ情報を出す。
'
'1.パス名 
' アイテム名をフルパス指定する。ドラッグ&ドロップが楽。
'
'3.[連続表示数] 
' 一度に連続表示するデータを設定。表示数が多くなると出力に時間がかかる。
' 既定値10。
'
'3.[表示項目数] 一覧出力のみ
' 値を設定すると、出力形式が表になる。
' 最少1 最大512 既定334 値が""でも出力。表示数が多くなると出力に時間がかかる。
'
'################################################

Option Explicit

Dim oWSFso , oWArgu , oWSApp

Const cNULL = ""

'引数
Dim sParaItem0
Dim oParaItem0 
Dim sParaItem1
Dim sParaItem2

'ヘッダラベル
Dim iPARA_COUNT
Dim rPARA_LABEL(512)
Const cParaCount = 334 'ヘッダ数既定
Const cParaMin = 1'ヘッダ数下限
Const cParaMax = 512'ヘッダ上限

Dim bLIST '真でリスト表示 Echo

Dim iBLOCK_SIZE
Const cBlockSize = 10 '詳細表示が BlockSize 件以上ある場合、BlockSize毎に出力する
Dim iBlockUpp '表示ブロック番号 上限
Dim iBlockPos '表示ブロック番号
Dim bBlockPos

Dim iShowCount
Dim iAllCount
Dim sInputRes , sInputPromp , sInputTitle , sInputDefault
Dim sInputExt


Dim sEcho 'メッセージ保持

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

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

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

'***第3パラメータ設定
'属性 検索数 デフォルト
iPARA_COUNT = cParaCount

'真でリスト表示 Echo
bLIST = False

bLIST = oWArgu.count >= 3 
If bLIST Then
sParaItem2 = oWArgu.Item(2)

'違反値は先頭列のみ表示
If IsNumeric(sParaItem2)  Then

'範囲外は先頭列のみ表示
iPARA_COUNT = Clng(sParaItem2)
If iPARA_COUNT < cParaMin or cParaMax < iPARA_COUNT Then
iPARA_COUNT = cParaMin 

End if

Else
iPARA_COUNT = cParaMin 

End if
End if


'***第2パラメータ設定
'表示ブロックサイズ デフォルト
iBLOCK_SIZE = cBlockSize

If oWArgu.count >= 2 Then
sParaItem1 = oWArgu.Item(1)

'数値のみ
If IsNumeric(sParaItem1) Then
'符号なしで取得
iBLOCK_SIZE = Abs(Clng(sParaItem1))

End if

End if


'***第1パラメータ設定

'パラメータ数チェック
If oWArgu.count >= 1 Then

sParaItem0 = oWArgu.item(0)

iShowCount = 0

'引数のフォルダ存在チェック
If oWSFso.FileExists( sParaItem0 ) = True Then
'パラメータがフォルダ名 ⇒ 中のアイテム全 表示
Set oParaItem0 = oWSFso.GetFile(sParaItem0)

'対象件数取得 (指定アイテムだけ表示)
iAllCount = iSHOW_ItemDetails( Cstr(oParaItem0.ParentFolder) , Cstr(oParaItem0.Name) , 0 , 0)
iShowCount = iSHOW_ItemDetails( Cstr(oParaItem0.ParentFolder) , Cstr(oParaItem0.Name) , 1 , iAllCount)

sEcho = sParaItem0 & vbCrlf & vbCrlf 
'そのまま詳細表示
If iShowCount > 0 Then
sEcho = sEcho & "1件の詳細表示は終了しました。"

Else
'※ここでのこの状態はあまり考えられない
sEcho = sEcho & "指定アイテムなし。"

End if


Elseif oWSFso.FolderExists( sParaItem0 ) = True Then
'アイテム絞込条件入力
sInputPromp = "パス名 :" & sParaItem0 & vbCrlf & vbCrlf
sInputPromp = sInputPromp & vbCrlf
sInputPromp = sInputPromp & " そのまま「OK」で、指定フォルダ内のアイテムを表示します。" & vbCrlf 
sInputPromp = sInputPromp & " 値を入力するとアイテム名(拡張子含む)で絞込表示します。" & vbCrlf 
sInputPromp = sInputPromp & vbCrlf
sInputPromp = sInputPromp & "「キャンセル」で処理を中止します。"
sInputTitle = "詳細表示アイテム絞込条件の入力"
sInputDefault = " "
sInputRes = InputBox( sInputPromp , sInputTitle , sInputDefault )

'0文字 だとキャンセル
If Len(sInputRes) > 0 Then
sInputExt = Trim(sInputRes)
'対象件数取得
iAllCount = iSHOW_ItemDetails(sParaItem0 , sInputExt , 0, 0)

iBlockUpp = ( ( iAllCount - 1 ) \ iBLOCK_SIZE )
'↓↓↓結果出力で使用
sEcho  = "パス名 :" & sParaItem0 & vbCrlf & vbCrlf
sEcho = sEcho & " 絞込条件: " & sInputExt & vbCrlf
sEcho = sEcho & " 該当件数が " &  iAllCount & " あります。" & vbCrlf 
sEcho = sEcho & " 連続表示数 " & iBLOCK_SIZE & " で出力します。"  & vbCrlf 

iBlockPos = 0 '表示 初期位置
bBlockPos = True

'該当件数が 連続表示数を超えている ⇒ 表示位置の選択
If iAllCount > iBLOCK_SIZE Then
'範囲出力用
sEcho = sEcho & " 表示範囲( 0 - " & iBlockUpp  &  " )"
'↑↑↑結果出力で使用
sInputPromp = sEcho & "を指定してください。" 
sInputPromp = sInputPromp & vbCrlf
sInputPromp = sInputPromp & vbCrlf
sInputPromp = sInputPromp & "「キャンセル」で処理を中止します。"
sInputTitle = "表示位置の指定"
sInputDefault = 0 '先頭位置指定
sInputRes = InputBox(sInputPromp , sInputTitle , sInputDefault )
sInputRes = Trim(sInputRes)

bBlockPos = Len(sInputRes) > 0'入力文字確認
'0文字 だとキャンセル
If bBlockPos Then
'数値チェック
bBlockPos = IsNumeric(sInputRes)
If bBlockPos Then
'範囲チェック
iBlockPos = Clng(sInputRes)
bBlockPos = ( 0 <= iBlockPos and iBlockPos <= iBlockUpp )
End if
'数値・範囲 から外れている文字を指定外とする
If Not bBlockPos  Then
sEcho = sEcho & vbCrlf
sEcho = sEcho & vbCrlf
sEcho = sEcho & " 表示指定:" & sInputRes & vbCrlf & vbCrlf & "入力値が指定外です。 詳細表示を中止します。" 
End if

Else
sEcho = sEcho & vbCrlf
sEcho = sEcho & vbCrlf
sEcho = sEcho &  "【表示位置】" & vbCrlf & "詳細表示を「キャンセル」しました。" 

End If

End if

If bBlockPos Then
'表示位置指定が範囲内
iShowCount = iSHOW_ItemDetails(sParaItem0 , sInputExt , ( iBlockPos + 1 ) , iAllCount)

sEcho = sEcho & vbCrlf
sEcho = sEcho & vbCrlf
sEcho = sEcho & " 表示位置:" & (iBlockPos * iBLOCK_SIZE + 1) & "から" & iShowCount & "件" & vbCrlf

'ブロックサイズ設定があれば表示
If Len(sParaItem1)>0 Then
sEcho = sEcho & vbCrlf
sEcho = sEcho & " 連続表示数:" & iBLOCK_SIZE & " (連続表示数:" & sParaItem1  & ")" 
End if

If bLIST then
sEcho = sEcho & vbCrlf
sEcho = sEcho & " 表示列数:" & iPARA_COUNT 
'列数設定があれば表示
If Len(sParaItem2)>0 Then
sEcho = sEcho & " (表示項目数:" & sParaItem2  & ")" 
End if

End if

sEcho = sEcho & vbCrlf
If iShowCount > 0 Then
sEcho = sEcho & "詳細表示は終了しました。"

Else
sEcho = sEcho & "該当アイテムなし。終了します。" 

End if

End if

Else
'処理結果判定 中止
sEcho = sParaItem0  & vbCrlf & "【絞込設定】" & vbCrlf & "詳細表示を「キャンセル」しました。" 

End If

Else
sEcho =  sParaItem0  & vbCrlf &  "指定アイテムはありません。 詳細表示を中止します。" 

End if

Else
sEcho = "引数が不正です。実行例:Cscript ShowItemDetails1.vbs パス名"

End If

Wscript.Echo sEcho


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



'################################################
'Function iSHOW_ItemDetails(psFolder , ps1Item , piBlock , iItemAll)
'処理概要
'同一フォルダ内のアイテムを絞込条件(ファイル名拡張子含むから後方一致)に従い、カウントまたはEchoする。
'
'IN
' psFolder
'  情報取得する存在するフォルダ名
' 
' ps1Item
'  {ファイル名完全一致・条件なし・条件あり}
' 
' piBlock 
'  ( piBlock = 0 )該当件数取得
'  ( piBlock > 0 )表示ブロック指定
' 
' iItemAll
'  予め取得しておいた全件カウント。詳細情報表示の際に使用
'
'OUT
' 1.ps1Itemに従い 条件該当件数を取得
' 2.ps1Itemに従い piBlock 位置の詳細情報を表示
'
'補足
' 内部計算はカウント基準(0<Count)
'
Function iSHOW_ItemDetails(psFolder , ps1Item , piBlock , iItemAll)
Dim iItemCount '処理アイテムカウント(表示が0ならこちら出力)
Dim iShowCount '表示アイテムカウント

Dim oNsFolder
Dim oItem

Dim bItem'アイテム取得フラグ
Dim bShow'アイテム表示フラグ

Dim iPara
Dim s1Echo

'指定フォルダのNamespace取得
Set oNsFolder = oWSApp.Namespace(psFolder)

if 0 < piBlock Then

s1Echo=cNULL

'詳細ラベルの取得
For iPara = 0 to (iPARA_COUNT - 1 )
rPARA_LABEL(iPara) = oNsFolder.GetDetailsOf(oNsFolder.Items, iPara)

If bLIST then
'一覧出力
s1Echo = s1Echo & vbTab & rPARA_LABEL(iPara)
End if
Next

If bLIST then
'一覧出力
Wscript.Echo s1Echo
End if

End if

'処理カウント初期化
iItemCount = 0
'表示カウント初期化
iShowCount = 0


For Each oItem in oNsFolder.Items

'値がoItemと一致なら表示。 ps1Itemが空白か、

'ファイル名完全一致
bItem = ( oItem.Name = ps1Item ) 

'ファイル絞込条件なし
If Not bItem Then
bItem = ( ps1Item = cNULL )
End if

'ファイル名 拡張子 後方一致条件アリ
If Not bItem Then
bItem =  Right( oItem.Name , Len( ps1Item ) ) = ps1Item 
End if

'絞込条件許可のみ
If bItem Then
iItemCount = iItemCount + 1

If piBlock  > 0 Then
bShow = ( ((piBlock-1)*iBLOCK_SIZE+1) <= iItemCount ) and ( iItemCount <= (piBlock * iBLOCK_SIZE) )

Else '=0
'Countだけなので出力はしない
bShow = False

End If

'指定件数から出力
If bShow Then

iShowCount = iShowCount + 1

'パスの出力
s1Echo =  iItemCount  & "/" & iItemAll  
If bLIST then
'一覧出力
Else
'パスの出力
s1Echo = s1Echo & vbTab & oItem.Path
End if

'詳細情報の取得 iPARA_COUNT まで検索して保管情報を抜き出す
For iPara = 0 to (iPARA_COUNT-1)

If bLIST then
'一覧出力
s1Echo = s1Echo & vbTab & oNsFolder.GetDetailsOf(oItem, iPara)
Else
'情報格納分のみラベルと詳細情報の表示
If oNsFolder.GetDetailsOf(oItem, iPara) <> cNULL Then

s1Echo = s1Echo & vbCrlf &  iPara & ")" & rPARA_LABEL(iPara) & ": " & vbTab & oNsFolder.GetDetailsOf(oItem, iPara)
End If
End if

Next
If piBlock>0 Then
If bLIST then
'一覧出力
Else
'詳細表示は次のアイテム間データに改行
s1Echo = s1Echo & vbCrlf
End if

'出力
Wscript.Echo s1Echo
End if
End if
End if
Next

'結果出力

'処理アイテムカウント出力
iSHOW_ItemDetails = iItemCount

'詳細表示が行われていたら、表示アイテムカウント出力
If iShowCount > 0 Then iSHOW_ItemDetails = iShowCount
End Function