'***Ffmぺsync ver.1.2 (C)是々録画 http://zezerokuga.blogspot.jp/
'***2014/4/8 Update
Option Explicit
Dim oWSSHEL , oWSFSO , oWSAPP , oWARGU , oIEAPP
Set oWSSHEL = WScript.CreateObject("WScript.Shell")
Set oWSFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set oWSAPP = WScript.CreateObject("Shell.Application")
Set oWARGU = WScript.Arguments
Set oIEAPP = Nothing
Const cIEREFRESH = 20
Const cMP4 = ".mp4"
Const cNULL = ""
Dim cDC
cDC = Chr(34)
Const cF12345 = "12345"
Const cF1234 = "1234"
Dim vFP(6)
Const cP0 = 0
Const cP1 = 1
Const cP2 = 2
Const cP3 = 3
Const cP4 = 4
Const cP5 = 5
Const cDD1 = 0
Const cDD2 = 1
Dim iDETAILt(1),iDETAILb(1),iDETAILh(1),iDETAILf(1),iDETAILw(1)
Dim sDETAILt(1),sDETAILb(1),sDETAILh(1),sDETAILf(1),sDETAILw(1)
Dim vDETAILt(1),vDETAILb(1),vDETAILh(1),vDETAILf(1),vDETAILw(1),vDETAILs(1),vDETAILd(1),bDETAIL(1)
Const cF1 = 1
Const cF2 = 2
Const cF3 = 3
Const cF4 = 4
Const cF5 = 5
Const cF0 = 0
Dim iDC(6) , i1DS(6), i2DS(6)
Dim iPATHCOUNT
Dim iITEMCOUNT , iITEMERROR , iIEREFRESH , i0CONVCOUNT , i0CONVERROR , i2CONVERROR
iITEMCOUNT = 0 : iITEMERROR = 0 : iIEREFRESH = 0 : i0CONVCOUNT = 0 : i0CONVERROR = 0 : i2CONVERROR = 0
Dim rsLOGPRINT(50)
Dim iLOGPRINT
iLOGPRINT = 0
Dim rsEXT(99)
Dim riEXT(99)
Dim iEXTMAX
iEXTMAX = 0
Dim sFFMPeLOGPATH
Dim sMainLog
Dim bIECANCEL
bIECANCEL = False
sFFMPeLOGPATH = cNULL
Call sGETLOG("####開始#### #" & Now() & "#")
Call sGETLOG("VBS実行パス：" & WScript.Scriptfullname)
If oWARGU.count > 0 Then
sMainLog = sMAIN( oWARGU.item(0) )
Else
sMainLog = "引数が不正です。実行例：Cscript " & WScript.Scriptname & " 動画パス"
End If
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , sGETLOG(sMainLog))
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , sGETLOG("####終了#### #" & Now() & "#"))
if Not bIESHOW(True, WScript.Scriptname , sPUTLOG(False)) Then
Call WScript.Echo( sPUTLOG(False) )
End if
Set oWSFSO = Nothing
Set oWARGU = Nothing
Set oWSAPP = Nothing
Set oIEAPP = Nothing
Wscript.Quit
Function sMAIN( psParaItem0 )
Dim o1Dirve , o1Folder , o1File , o2Folder , o2File , s2File , s2Folder
Dim sInpRes , sInpPpt , sInpTtl , sInpDef , bInpRes , vInpHMS , vInpVF
Dim sLogItem1 , sLogItemN , sLogItemIO , sLogExec1 , sLogExec2
Set o1Dirve = Nothing
Set o1Folder = Nothing
Set o1File = Nothing
Set o2Folder = Nothing
Set o2File = Nothing
Call FfmpegParaReset
iPATHCOUNT = 0
Call DogaCountSizeReset()
Call ExtReset()
Call DogaDetailReset(cDD1)
Call DogaDetailReset(cDD2)
Select case True
Case oWSFSO.DriveExists( psParaItem0 )
Set o1Folder = oWSFSO.GetFolder( psParaItem0 )
Set o1Dirve = oWSFSO.GetDrive(psParaItem0)
sLogItem1 =cDC & psParaItem0 & cDC & " は " & o1Dirve.DriveType & " です。"
sLogItemN = sSHOW_ItemDetails( o1Dirve )
Case oWSFSO.FolderExists( psParaItem0 )
Set o1Folder = oWSFSO.GetFolder( psParaItem0 )
sLogItem1 = cDC & o1Folder.Name & cDC & " は " & o1Folder.Type & " です。"
sLogItemN = sSHOW_ItemDetails( o1Folder )
Case oWSFSO.FileExists( psParaItem0 )
Set o1File = oWSFSO.GetFile( psParaItem0 )
sLogItem1 = cDC & o1File.Name & cDC & " は " & o1File.Type & " 。" & oWSFSO.GetExtensionName(psParaItem0)
Call bDogaDetailIndex(cDD1 , Cstr(o1File.ParentFolder))
If bDogaTypeExt( o1File ) or bDogaDetailValue(cDD1 , o1File) Then
Set o1Folder = o1File.ParentFolder
sLogItem1 = sLogItem1 & " で、動画ファイルです。"
Else
sLogItem1 = sLogItem1 & " で、非動画ファイルです。"
End if
sLogItemN = sSHOW_ItemDetails( o1File )
End Select
Call sGETLOG(sLogItem1)
Call sGETLOG(sLogItemN)
if Not bIESHOW(True , WScript.Scriptname , sPUTLOG(False)) Then
Call WScript.Echo(sPUTLOG(False))
End if
If Not o1Folder Is Nothing Then
Set o2Folder = oWSAPP.BrowseForFolder(0, sLogItem1 & vbCrlf & "出力先フォルダを選択してください。『キャンセル』で中止します。", 0)
If Not o2Folder Is Nothing Then
If o2Folder = "デスクトップ" Then
s2Folder = oWSSHEL.SpecialFolders("Desktop")
Else
s2Folder = o2Folder.Items.Item.Path
End if
If Not o1File is Nothing Then
sFFMPeLOGPATH = oWSFSO.BuildPath(s2Folder , o1File.Name) & ".log"
Else
sFFMPeLOGPATH = oWSFSO.BuildPath(s2Folder , o1Folder.Name & ".log")
End if
If bWriteLog(sFFMPeLOGPATH , sPUTLOG(True)) Then
sLogItemIO = "処理(元)パス：" & o1Folder.Path & vbCrlf & "出力(先)パス：" & s2Folder & vbCrlf & "処理ログパス：" & sFFMPeLOGPATH
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , sGETLOG(sLogItemIO))
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , sGETLOG( sITEMCOUNT(o1Folder , s2Folder , o1File) ) )
sLogExec1 = sGETLOG(cNULL)
If Not bIECANCEL Then
If Not o1File Is Nothing Then
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , sGETLOG( "処理(元)" & sDogaDetailEcho( cDD1 , o1File) ) )
sLogExec1 = sGETLOG(cNULL)
s2File = oWSFSO.BuildPath( s2Folder , o1File.Name )
s2File = sConvertMovieName( o1File.Path , s2File)
If oWSFSO.FileExists( s2File ) Then
Call bDogaDetailIndex(cDD2 , s2Folder)
Set o2File = oWSFSO.GetFile( s2File )
Call bDogaDetailValue(cDD2 , o2File)
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , sGETLOG("出力(先)" & sDogaDetailEcho(cDD2 , o2File)))
sLogExec1 = sLogExec1 & vbCrlf & vbCrlf & sGETLOG(cNULL)
End if
End if
If Not bIESHOW(True , WScript.Scriptname , sPUTLOG(False)) Then
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , sGETLOG("ＩＥが起動できないと、以降の停止処理に支障があります。ご注意ください。"))
Call WScript.Echo(sPUTLOG(False))
End if
If Not o1File Is Nothing Then
sInpTtl = "変換モードの入力"
sInpDef = vGetConvertMode( )
sInpPpt = sLogItem1 & vbCrlf& vbCrlf & sLogItemIO & vbCrlf & vbCrlf & sLogExec1
sInpPpt = sInpPpt & vbCrlf
sInpPpt = sInpPpt & vbCrlf & "### " & sInpTtl & " ###"
sInpPpt = sInpPpt & vbCrlf & "__:品質" & sGetConvertCrf(0) & " (例:4 品質" & sGetConvertCrf(4) & "-" & sGetConvertSiz(4)
sInpPpt = sInpPpt & vbCrlf & "1_:品質" & sGetConvertCrf(10) & " (例:11 品質" & sGetConvertCrf(11) & "-" & sGetConvertSiz(11)
sInpPpt = sInpPpt & vbCrlf & "2_:品質" & sGetConvertCrf(20) & " (例:20 品質" & sGetConvertCrf(20) & "-" & sGetConvertSiz(20)
sInpPpt = sInpPpt & vbCrlf & "3_:品質" & sGetConvertCrf(30) & " (例:33 品質" & sGetConvertCrf(33) & "-" & sGetConvertSiz(33)
sInpPpt = sInpPpt & vbCrlf & "4_:品質" & sGetConvertCrf(40) & " (例:42 品質" & sGetConvertCrf(42) & "-" & sGetConvertSiz(42)
sInpPpt = sInpPpt & vbCrlf & " (16:9) , ( 4:3)"
sInpPpt = sInpPpt & vbCrlf & " _1:" & sGetConvertSiz(1) & " , _2:" & sGetConvertSiz(2)
sInpPpt = sInpPpt & vbCrlf & " _3:" & sGetConvertSiz(3) & " , _4:" & sGetConvertSiz(4)
sInpPpt = sInpPpt & vbCrlf & " _5:" & sGetConvertSiz(5) & " , _6:" & sGetConvertSiz(6)
sInpPpt = sInpPpt & vbCrlf & " _7:" & sGetConvertSiz(7) & " , _8:" & sGetConvertSiz(8)
sInpPpt = sInpPpt & vbCrlf & " _9:" & sGetConvertSiz(9) & " , _0:サイズ変更なし"
sInpPpt = sInpPpt & vbCrlf & "※ _は指定数値 十位:品質値 一位:ｻｲｽﾞ値"
sInpPpt = sInpPpt & vbCrlf & "※ 入力値の前二桁のみ有効"
sInpPpt = sInpPpt & vbCrlf
sInpPpt = sInpPpt & vbCrlf & "-s:開始時間、-e:終了時間、-t:適用時間(e-s)"
sInpPpt = sInpPpt & vbCrlf & "※時間指定は 秒 または 0:00:00(時:分:秒)"
sInpPpt = sInpPpt & vbCrlf & "-vf:回転 transpose=1(右90°) 2(左90°)"
sInpPpt = sInpPpt & vbCrlf
sInpPpt = sInpPpt & vbCrlf & "『キャンセル』で中止します。"
Else
sInpTtl = "処理モードの入力"
If (iDC(cF3) + iDC(cF4) + iDC(cF5)) = 0 Then
sInpDef = cF12345
Else
sInpDef = cF1234
End if
sInpPpt = sLogItem1 & vbCrlf& vbCrlf & sLogItemIO & vbCrlf & vbCrlf & sLogExec1
sInpPpt = sInpPpt & vbCrlf
sInpPpt = sInpPpt & vbCrlf & "### " & sInpTtl & " ###"
sInpPpt = sInpPpt & vbCrlf & " 1:未変換（ファイル(元)有(済)無）"
sInpPpt = sInpPpt & vbCrlf & " 2:損壊ファイル（(済)ファイル損壊動画）"
sInpPpt = sInpPpt & vbCrlf & " 3:小大ファイル（(済)ファイルが大きい）"
sInpPpt = sInpPpt & vbCrlf & " 4:新旧ファイル（更新日付(元)新(済)旧）"
sInpPpt = sInpPpt & vbCrlf & " 5:変換済（1,2,3,4 以外の状態）"
sInpPpt = sInpPpt & vbCrlf & " 0:変換対象指定（1,2,3,4,5）実行"
sInpPpt = sInpPpt & vbCrlf & "※ 指定に 0 が無ければ状態一覧出力"
sInpPpt = sInpPpt & vbCrlf & "※ +:品質UP、-:圧縮UP (3Pointスライド)"
sInpPpt = sInpPpt & vbCrlf
sInpPpt = sInpPpt & vbCrlf & "『キャンセル』で中止します。"
End if
sInpRes = InputBox( sInpPpt , sInpTtl , sInpDef )
If sInpRes <> cNull Then
vFP(cP0) = Trim(sInpRes)
If Not o1File Is Nothing Then
If Instr(vFP(cP0),"-s")>0 Then
vInpHMS = InputBox( "-s 開始時間を入力してください。" , "開始時間の入力" , cNULL )
vInpHMS = Trim(vInpHMS)
vFP(cP1) = " -s" & vInpHMS
if IsNumeric(vInpHMS) or IsDate(vInpHMS) Then
if IsDate(vInpHMS) Then
Else
vInpHMS = DateAdd("s", vInpHMS , #0:00:00#)
End if
If Datediff("s" , #0:00:00# , vInpHMS) < 0 Then
vInpHMS = cNULL
Else
vFP(cP3) = Hour(vInpHMS) & ":" & Right("0" & Minute(vInpHMS), 2) & ":" & Right("0" & Second(vInpHMS), 2)
End if
End if
End if
If Instr(vFP(cP0),"-e")>0 or Instr(vFP(cP0),"-t")>0 Then
If Instr(vFP(cP0),"-e") > 0 Then
vInpHMS = InputBox( "-e 終了時間を入力してください。" & vFP(cP1) , "終了時間の入力" , cNULL )
Else
vInpHMS = InputBox( "-t 適用時間を入力してください。" & vFP(cP1) , "適用時間の入力" , cNULL )
End if
vInpHMS = Trim(vInpHMS)
If Instr(vFP(cP0),"-e") > 0 Then
vFP(cP2) = " -e" & vInpHMS
Else
vFP(cP2) = " -t" & vInpHMS
End if
if IsNumeric(vInpHMS) or IsDate(vInpHMS) Then
if IsDate(vInpHMS) Then
Else
vInpHMS = DateAdd("s", vInpHMS , #0:00:00#)
End if
If Datediff("s" , #0:00:00# , vInpHMS) < 0 Then
vInpHMS = cNULL
Else
vInpHMS = Hour(vInpHMS) & ":" & Right("0" & Minute(vInpHMS), 2) & ":" & Right("0" & Second(vInpHMS), 2)
End if
If Instr(vFP(cP0),"-e")>0 Then
If IsDate(vFP(cP3)) Then
vInpHMS = Datediff("s" , vFP(cP3) , vInpHMS)
if Not vInpHMS > 0 Then
vInpHMS = cNULL
Else
vInpHMS = DateAdd("s", vInpHMS , #0:00:00#)
End if
End if
End if
vFP(cP4) = Trim(vInpHMS)
End if
End if
If Instr(vFP(cP0),"-vf")>0 Then
vInpVF = InputBox( "-vf transposeを入力してください。1(右90°) 2(左90°)" , "■■vfオプションの入力■■" , "transpose=1" )
vFP(cP5) = Trim(vInpVF)
End if
vFP(cP0) = Trim(Left(vFP(cP0) , 2))
bInpRes = (sGetConvertCrf(vFP(cP0))<>cNULL) and (sGetConvertSiz(vFP(cP0))<>cNULL)
If bInpRes Then
If Len(vFP(cP1))>0 then
bInpRes = IsDate(vFP(cP3))
End if
End if
If bInpRes Then
If Len(vFP(cP2))>0 then
bInpRes = IsDate(vFP(cP4))
End if
End if
sInpRes = vFP(cP0) & vFP(cP1) & vFP(cP2)
Else
bInpRes = Instr(vFP(cP0) , cF0) > 0 or Instr(vFP(cP0) , cF1) > 0 or Instr(vFP(cP0) , cF2) > 0 or Instr(vFP(cP0) , cF3) > 0 or Instr(vFP(cP0) , cF4) > 0 or Instr(vFP(cP0) , cF5) > 0
End if
If Not bInpRes Then
sInpRes = vFP(cP0) & vFP(cP1) & vFP(cP2)
End if
If bInpRes Then
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , sGETLOG(sInpTtl & ":" & vFP(cP0) & vFP(cP1) & vFP(cP2) & " 処理開始 ※中止は『×閉じる』"))
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , "No. 状態 (元)*パス／nファイル名 長さ(時間) 幅x高 ビットレート ファイルサイズ 更新日時 (済)パスファイル名 幅x高 ビットレート ファイルサイズ 更新日時 FFMpeg")
iPATHCOUNT = 0
Call DogaCountSizeReset()
Call ExtReset()
sLogExec2 = sFFMPeEXEC(o1Folder , s2Folder , o1File , vFP , sFFMPeLOGPATH)
If bIECANCEL Then
sLogExec2 = sFFMPe_Echo(True)
Call bWriteLog(sFFMPeLOGPATH , cNULL)
Call bWriteLog(sFFMPeLOGPATH , sGETLOG(sLogExec2))
sLogExec2 = "処理を中止しました。"
End if
Else
sLogExec2 = "不正な入力値です。変換を中止します：" & sInpRes
End if
Else
sLogExec2 = sInpTtl & "を選択を『キャンセル』しました。"
End if
Else
sLogExec2 = "処理を中止しました。"
End if
Else
sLogExec2 = "書込み出来ません。指定が不適当です：" & s2Folder
End if
Else
sLogExec2 = "出力先フォルダ設定 『キャンセル』しました。"
End If
Else
If Not o1File Is Nothing Then
sLogExec2 = sLogItem1 & "変換できません。"
Else
sLogExec2 = "引数が不正です。" & psParaItem0
End if
End if
Set o1Dirve = Nothing
Set o1Dirve = Nothing
Set o1Folder = Nothing
Set o1File = Nothing
Set o2Folder = Nothing
sMAIN = sLogExec2
End Function
Function sITEMCOUNT(ByVal poSubFolder, Byval ps2Path, po1File)
Dim iErr , iSF , sTemp , b1File , s2File
Dim bFF1 , bFF2 , bFF3 , bFF4 , bFF5
Dim oSSF , o1File , o2File
Dim sItemEcho
sItemEcho = cNULL
If Right(poSubFolder.path ,2) = ":\" or Not ( (poSubFolder.Attributes and 2) = 2) or ( (poSubFolder.Attributes and 4) = 4 ) Then
Set oSSF = poSubFolder.SubFolders
on error resume next
iSF = oSSF.count
iErr = Err.Number
on error goto 0
If iErr <> 0 Then
Err.Clear
Else
For Each o1File In poSubFolder.Files
If bIECANCEL Then
Exit For
End if
Set o2File = Nothing
If Not po1File is Nothing Then
b1File = (po1File.Path = o1File.Path)
Else
b1File = True
End if
If b1File Then
bFF1 = False
bFF2 = False
bFF3 = False
bFF4 = False
bFF5 = False
If Not bDogaTypeExt( o1File ) Then
iITEMERROR = iITEMERROR + 1
Else
iITEMCOUNT = iITEMCOUNT + 1
s2File = oWSFSO.BuildPath( ps2Path , o1File.Name )
s2File = sConvertMovieName( o1File.Path , s2File)
bFF1 = Not oWSFSO.FileExists( s2File )
If Not bFF1 Then
Set o2File = oWSFSO.GetFile( s2File )
bFF3 = (o1File.size < o2File.size)
bFF4 = (o1File.DateLastModified > o2File.DateLastModified)
bFF5 = (Not bFF2) and (Not bFF3) and (Not bFF4)
End if
Set o2File = Nothing
If bFF1 Then
iDC(cF1) = iDC(cF1) + 1
i1DS(cF1) = i1DS(cF1) + o1File.Size
End if
If bFF2 Then
iDC(cF2) = iDC(cF2) + 1
i1DS(cF2) = i1DS(cF2) + o1File.Size
End if
If oWSFSO.FileExists( s2File ) Then
Set o2File = oWSFSO.GetFile( s2File )
If bFF3 Then
iDC(cF3) = iDC(cF3) + 1
i1DS(cF3) = i1DS(cF3) + o1File.Size
i2DS(cF3) = i2DS(cF3) + o2File.Size
End if
If bFF4 Then
iDC(cF4) = iDC(cF4) + 1
i1DS(cF4) = i1DS(cF4) + o1File.Size
i2DS(cF4) = i2DS(cF4) + o2File.Size
End if
If bFF5 Then
iDC(cF5) = iDC(cF5) + 1
i1DS(cF5) = i1DS(cF5) + o1File.Size
i2DS(cF5) = i2DS(cF5) + o2File.Size
End if
End if
Call ExtCount(o1File.path)
sItemEcho = sFFMPe_Echo(False)
If iITEMCOUNT Mod (cIEREFRESH * 10) = 1 Then
If bIESHOW(False , WScript.Scriptname , sItemEcho & vbCrlf & vbCrlf & sPUTLOG(False)) Then
Else
If (iITEMCOUNT Mod (cIEREFRESH * 100) = 1) Then
If vbOK =oWSSHEL.Popup ("File No." & iITEMCOUNT & " 以降の処理を中止しますか？ 中止は５秒以内に【OK】ボタン" , 5 , "処理前カウント" , vbExclamation+vbOKOnly) Then
bIECANCEL = True
Set po1File = o2File
Exit For
Else
Call bIESHOW(True , WScript.Scriptname , sItemEcho & vbCrlf & vbCrlf & sPUTLOG(False))
End if
End if
End if
End if
If Not po1File is Nothing Then
Exit For
End if
End if
End if
Next
If (Not po1File is Nothing) and b1File Then
Else
For Each oSSF In poSubFolder.SubFolders
sTemp = Left( oSSF.Name , 1 )
If sTemp ="." or sTemp ="$" Then
Else
iPATHCOUNT = iPATHCOUNT + 1
sItemEcho = sITEMCOUNT(oSSF , (ps2Path & "\" & oSSF.Name) , po1File )
If bIECANCEL Then
Exit For
End if
End if
Next
End if
End if
End If
Set oSSF = Nothing
Set o1File = Nothing
Set o2File = Nothing
sITEMCOUNT = sItemEcho
End Function
Function sFFMPeEXEC(ByVal poSubFolder , Byval ps2Path, po1File , pvFP() , psLogPath)
Dim iErr , iSF , sTemp , iExtTxt , sExtTxt
Dim oSSF , o1File , o2File
Dim sFF , bFF1 , bFF2 , bFF3 , bFF4 , bFF5 , bERROR0, bERROR2 , bFFMPegEXE
Dim iDogaNo , dFfmpe1 , b1File , s2File , bFilter ,iConvUpDn
Dim sEcho , sEcho1 , sEcho2 ,sConvMode , sffmpeRun , sFfmpeEcho
Dim vFPFolder
Dim vFP(6)
If Right(poSubFolder.path ,2) = ":\" or Not ( (poSubFolder.Attributes and 2) = 2) or ( (poSubFolder.Attributes and 4) = 4 ) Then
Set oSSF = poSubFolder.SubFolders
on error resume next
iSF = oSSF.count
iErr = Err.Number
on error goto 0
If iErr <> 0 Then
Err.Clear
Else
If iPATHCOUNT = 0 and iIEREFRESH = 0 Then
Call bWriteLog(psLogPath , Right("0000" & iPATHCOUNT , 4) & "-*" & vbTab & poSubFolder.Path & vbTab & ps2Path)
End if
iConvUpDn = 0
vFPFolder = pvFP(cP0)
If Instr(vFPFolder,"+") Then
vFPFolder = Replace(vFPFolder , "+" , cNULL)
If Instr(vFPFolder,"-") Then
vFPFolder = Replace(vFPFolder , "-" , cNULL)
Else
iConvUpDn = -10
End if
ElseIf Instr(vFPFolder,"-") Then
vFPFolder = Replace(vFPFolder , "-" , cNULL)
iConvUpDn = 10
End if
sExtTxt = Lcase(Trim(vFPFolder))
iExtTxt = Len(sExtTxt)
If iExtTxt > 8 Then
iExtTxt = 8
End if
sExtTxt = Trim(Right(sExtTxt , iExtTxt))
iExtTxt = Instr(sExtTxt , ".")
If iExtTxt > 1 Then
iExtTxt = Len(sExtTxt) - iExtTxt + 1
sExtTxt = Trim(Right(sExtTxt, iExtTxt))
Else
iExtTxt = 0
sExtTxt = cNULL
End if
Call bDogaDetailIndex( cDD1 , poSubFolder.Path )
If oWSFSO.FolderExists( ps2Path ) Then
Call bDogaDetailIndex( cDD2 , ps2Path )
Else
Call DogaDetailIndexCopy(cDD2 , cDD1)
End if
For Each o1File In poSubFolder.Files
If bIECANCEL Then
Exit For
End if
iIEREFRESH = iIEREFRESH + 1
Call DogaDetailReset(cDD1)
Call DogaDetailReset(cDD2)
Set o2File = Nothing
If Not po1File is Nothing Then
b1File = (po1File.Path = o1File.Path)
sFF = cF12345 & cF0
Else
b1File = True
sFF = pvFP(cP0)
End if
If b1File Then
bFF1 = False
bFF2 = False
bFF3 = False
bFF4 = False
bFF5 = False
sEcho = cNULL
sEcho1 = cNULL
sEcho2 = cNULL
sffmpeRun = cNULL
sFfmpeEcho = cNULL
sConvMode = cNULL
if iExtTxt = 0 Then
bFilter = True
Else
bFilter = (Lcase(Right(o1File.name, iExtTxt)) = sExtTxt)
End if
bERROR0 = Not bDogaTypeExt( o1File )
bFFMPegEXE = False
bERROR2 = False
If Not bERROR0 and bFilter Then
iDogaNo = iDogaNo + 1
sEcho = Right("0000" & iPATHCOUNT , 4) & "-" & iDogaNo
Call bDogaDetailValue( cDD1 , o1File)
sEcho1 = o1File.Name & vbTab & vDETAILt(cDD1) & vbTab & vDETAILw(cDD1) & "x" & vDETAILh(cDD1) & vbTab & vDETAILb(cDD1) & vbTab & sByte2MB(vDETAILs(cDD1)) & vbTab & vDETAILd(cDD1)
s2File = oWSFSO.BuildPath( ps2Path , o1File.Name )
s2File = sConvertMovieName( o1File.Path , s2File)
bFF1 = Not oWSFSO.FileExists( s2File )
If Not bFF1 Then
Set o2File = oWSFSO.GetFile( s2File )
bFF2 = (Not bDogaDetailValue(cDD2 , o2File))
bFF3 = (vDETAILs(cDD1) < vDETAILs(cDD2))
bFF4 = (vDETAILd(cDD1) > vDETAILd(cDD2))
bFF5 = (Not bFF2) and (Not bFF3) and (Not bFF4)
End if
bFF1 = bFF1 and (Instr(sFF , cF1) > 0)
bFF2 = bFF2 and (Instr(sFF , cF2) > 0)
bFF3 = bFF3 and (Instr(sFF , cF3) > 0)
bFF4 = bFF4 and (Instr(sFF , cF4) > 0)
bFF5 = bFF5 and (Instr(sFF , cF5) > 0)
If bFF1 Then sConvMode = "未"
If bFF2 Then sConvMode = "壊"
If bFF3 Then sConvMode = "大"
If bFF4 Then sConvMode = "旧"
If bFF5 Then sConvMode = "○"
Set o2File = Nothing
If Instr(sFF , cF0) > 0 Then
sFfmpeEcho = sFFMPe_Echo(True) & vbCrlf & vbCrlf & sPUTLOG(False)
If po1File is Nothing Then
sFfmpeEcho = sDogaDetailEcho(cDD1 , o1File) & vbCrlf & vbCrlf & sFfmpeEcho
End if
sFfmpeEcho = sEcho1 & vbTab & s2File & vbCrlf & vbCrlf & sFfmpeEcho
If bFF1 or bFF2 or bFF3 or bFF4 or bFF5 Then
If Not po1File is Nothing Then
vFP(cP0) = Clng(pvFP(cP0))
vFP(cP3) = pvFP(cP3)
vFP(cP4) = pvFP(cP4)
vFP(cP5) = pvFP(cP5)
Else
vFP(cP0) = vGetConvertMode( ) + iConvUpDn
End if
sffmpeRun = sRunffmpeExe(o1File , s2File , vFP)
If sffmpeRun <> cNULL Then
If oWSFSO.FolderExists( ps2Path ) Then
sConvMode = sConvMode & sGetConvertCrf(vFP(cP0)) & "-" & sGetConvertSiz(vFP(cP0))
Call bIESHOW(True , WScript.Scriptname , "【変換中】" & sffmpeRun & vbCrlf & sEcho & vbTab & sConvMode & vbTab & sFfmpeEcho )
dFfmpe1 = Now()
Call oWSSHEL.Run(sffmpeRun , 1 , true)
If Not oWSFSO.FileExists( s2File ) Then
bERROR0 = True
Else
bFFMPegEXE = True
Set o2File = oWSFSO.GetFile( s2File )
bERROR2 = (Not bDogaDetailValue(cDD2 , o2File))
If bERROR2 Then
If Not po1File is Nothing Then
bIECANCEL = True
Else
If Not bIECANCEL Then
If vbOK =oWSSHEL.Popup ("File No." & iIEREFRESH & "以降の処理を中止しますか？ 中止は５秒以内に【OK】ボタン" , 5 , "変換中" , vbExclamation+vbOKOnly) Then
Set po1File = o2File
bIECANCEL = True
End if
End if
End if
End if
End if
Else
sConvMode = sConvMode & "【出力先：" & ps2Path & "なし】"
End if
Else
sConvMode = sConvMode & "【Ffmpeg.exeを確認してください】"
End if
End if
End if
End if
If Not bERROR0 and bFilter Then
Call DogaDetailReset(cDD2)
bFF1 = Not oWSFSO.FileExists( s2File )
bFF2 = False
bFF3 = False
bFF4 = False
bFF5 = False
If Not bFF1 Then
Set o2File = oWSFSO.GetFile( s2File )
bFF2 = (Not bDogaDetailValue(cDD2 , o2File))
bFF3 = (vDETAILs(cDD1) < vDETAILs(cDD2))
bFF4 = (vDETAILd(cDD1) > vDETAILd(cDD2))
bFF5 = (Not bFF2) and (Not bFF3) and (Not bFF4)
If bFF3 Then
sConvMode = sConvMode & "大" & Round( vDETAILs(cDD2) / vDETAILs(cDD1) * 100, 2) & "%"
iDC(cF3) = iDC(cF3) + 1
i1DS(cF3) = i1DS(cF3) + vDETAILs(cDD1)
i2DS(cF3) = i2DS(cF3) + vDETAILs(cDD2)
End if
If bFF4 Then
sConvMode = sConvMode & "旧" & Round( vDETAILs(cDD2) / vDETAILs(cDD1) * 100, 2) & "%"
iDC(cF4) = iDC(cF4) + 1
i1DS(cF4) = i1DS(cF4) + vDETAILs(cDD1)
i2DS(cF4) = i2DS(cF4) + vDETAILs(cDD2)
End if
If bFF5 Then
sConvMode = sConvMode & "○" & Round( vDETAILs(cDD2) / vDETAILs(cDD1) * 100, 2) & "%"
iDC(cF5) = iDC(cF5) + 1
i1DS(cF5) = i1DS(cF5) + vDETAILs(cDD1)
i2DS(cF5) = i2DS(cF5) + vDETAILs(cDD2)
End if
End if
If bFF1 Then
sConvMode = sConvMode & "未"
iDC(cF1) = iDC(cF1) + 1
i1DS(cF1) = i1DS(cF1) + vDETAILs(cDD1)
End if
If bFF2 Then
sConvMode = sConvMode & "壊"
iDC(cF2) = iDC(cF2) + 1
i1DS(cF2) = i1DS(cF2) + vDETAILs(cDD1)
End if
sEcho2 = vDETAILw(cDD2) & "x" & vDETAILh(cDD2) & vbTab & vDETAILb(cDD2) & vbTab & sByte2MB(vDETAILs(cDD2)) & vbTab & vDETAILd(cDD2)
If bERROR2 Then
i2CONVERROR = i2CONVERROR + 1
End if
sEcho2 = sEcho2 & vbTab & sffmpeRun
Call ExtCount(o1File.path)
i0CONVCOUNT = i0CONVCOUNT + 1
sEcho = sEcho & vbTab & sConvMode & vbTab & sEcho1 & vbTab & s2File & vbTab & sEcho2
Else
i0CONVERROR = i0CONVERROR + 1
sEcho = Right("*ERR0000" & i0CONVERROR , 8) & vbTab & o1File.Name & "は動画形式でなく変換できません。"
End if
sFfmpeEcho = sFFMPe_Echo(True)
bFF1 = bFF1 and (Instr(sFF , cF1) > 0)
bFF2 = bFF2 and (Instr(sFF , cF2) > 0)
bFF3 = bFF3 and (Instr(sFF , cF3) > 0)
bFF4 = bFF4 and (Instr(sFF , cF4) > 0)
bFF5 = bFF5 and (Instr(sFF , cF5) > 0)
If (bERROR0 or bFFMPegEXE or bFF1 or bFF2 or bFF3 or bFF4 or bFF5) and bFilter Then
Call bWriteLog(psLogPath , sEcho)
End if
If (iIEREFRESH Mod cIEREFRESH = 1) or bFFMPegEXE Then
If bIESHOW(False , WScript.Scriptname , sFfmpeEcho & vbCrlf & vbCrlf & sPUTLOG(False)) Then
Else
If Not po1File is Nothing Then
Else
If Not bIECANCEL Then
If vbOK =oWSSHEL.Popup ("File No." & iIEREFRESH & " 以降の処理を中止しますか？ 中止は５秒以内に【OK】ボタン" , 5 , "処理中" , vbExclamation+vbOKOnly) Then
bIECANCEL = True
Set po1File = o2File
Exit For
Else
Call bIESHOW(True , WScript.Scriptname , sFfmpeEcho & vbCrlf & vbCrlf & sPUTLOG(False))
End if
End if
End if
End if
End if
If Not po1File is Nothing Then
Exit For
End if
End if
Next
If (Not po1File is Nothing) and b1File Then
Else
For Each oSSF In poSubFolder.SubFolders
sTemp = Left( oSSF.Name , 1 )
If sTemp ="." or sTemp ="$" Then
Else
iPATHCOUNT = iPATHCOUNT + 1
Call bWriteLog(psLogPath , Right("0000" & iPATHCOUNT , 4) & "-*" & vbTab & oSSF.Path & vbTab & (ps2Path & "\" & oSSF.Name) )
If Instr(sFF , cF0) > 0 Then
If Not oWSFSO.FolderExists( (ps2Path & "\" & oSSF.Name) ) Then
call oWSFSO.CreateFolder( (ps2Path & "\" & oSSF.Name) )
End if
End if
sFfmpeEcho = sFFMPeEXEC(oSSF , (ps2Path & "\" & oSSF.Name) , po1File , pvFP , psLogPath)
If bIECANCEL Then
Exit For
End if
End if
Next
End if
End if
End If
Set oSSF = Nothing
Set o1File = Nothing
Set o2File = Nothing
sFFMPeEXEC = sFfmpeEcho
End Function
Function sFFMPe_Echo(pb2)
Dim dProgress
Dim dConvert
Dim sEcho , iNo , iSum
Dim iError
dProgress = 0
iSum = iDC(cF3) + iDC(cF4) + iDC(cF5)
If Not pb2 Then
If iSum > 0 and iITEMCOUNT >0 Then
dProgress = iSum / iITEMCOUNT
End if
sEcho = "対象ファイル処理数計：" & iITEMCOUNT
Else
iError = 0
If i0CONVERROR > iITEMERROR Then
iError = i0CONVERROR - iITEMERROR
End if
If iSum > 0 and iITEMCOUNT >0 Then
dProgress = iSum / (iITEMCOUNT - iError)
End if
sEcho = "対象ファイル処理位置：" & i0CONVCOUNT
End if
sEcho = sEcho & vbCrlf & " 1(未)処理ファイル数：" & iDC(cF1) & "(" & sByte2MB(i1DS(cF1)) & ")"
If Not pb2 Then
sEcho = sEcho & vbCrlf & " 2(済)損壊ファイル数：※事前カウント対象外"
Else
sEcho = sEcho & vbCrlf & " 2(済)損壊ファイル数：" & iDC(cF2) & "(" & sByte2MB(i1DS(cF2)) & ")"
End if
dConvert = 0
If i1DS(cF3) > 0 and i2DS(cF3) >0 Then
dConvert = i2DS(cF3) / i1DS(cF3)
End if
sEcho = sEcho & vbCrlf & " 3(済)小大ファイル数：" & iDC(cF3) & "(" & sByte2MB(i1DS(cF3)) & ")⇒" & Round( dConvert * 100, 2) & "%(" & sByte2MB(i2DS(cF3)) & ")"
dConvert = 0
If i1DS(cF4) > 0 and i2DS(cF4) >0 Then
dConvert = i2DS(cF4) / i1DS(cF4)
End if
sEcho = sEcho & vbCrlf & " 4(済)新旧ファイル数：" & iDC(cF4) & "(" & sByte2MB(i1DS(cF4)) & ")⇒" & Round( dConvert * 100, 2) & "%(" & sByte2MB(i2DS(cF4)) & ")"
dConvert = 0
If i1DS(cF5) > 0 and i2DS(cF5) >0 Then
dConvert = i2DS(cF5) / i1DS(cF5)
End if
sEcho = sEcho & vbCrlf & " 5(済)処理ファイル数：" & iDC(cF5) & "(" & sByte2MB(i1DS(cF5)) & ")⇒" & Round( dConvert * 100, 2) & "%(" & sByte2MB(i2DS(cF5)) & ")"
sEcho = sEcho & vbCrlf & "- - - - - - - - - "
sEcho = sEcho & vbCrlf & "処理済(345計)進捗率：" & Round( dProgress * 100, 2) & "%"
If i0CONVCOUNT = 0 Then
sEcho = sEcho & vbCrlf & "対象外ファイル数：" & iITEMERROR
Else
sEcho = sEcho & vbCrlf & "対象外ファイル数：" & i0CONVERROR
End if
If i2CONVERROR > 0 Then
sEcho = sEcho & vbCrlf & "処理実行エラー数：" & i2CONVERROR
End if
sEcho = sEcho & vbCrlf & "検索フォルダ数：" & iPATHCOUNT
sEcho = sEcho & vbCrlf & "- - - - - - - - - "
If iEXTMAX > 0 Then
sEcho = sEcho & vbCrlf & "形式別カウント（計:" & iExtSum() & "）"
For iNo = 1 To iEXTMAX
sEcho = sEcho & vbCrlf & "." & rsEXT(iNo-1) & " ：" & riEXT(iNo-1)
Next
End if
sFFMPe_Echo = sEcho
End Function
Function sRunffmpeExe(po1Doga , ps2Doga1, pvFP())
Dim sExePath , sffmpeExe , sffmpePSet , sffmpeRun , sffmpeCrf , sffmpeSiz , sffmpeSt, sffmpeTt , sffmpeVF
Dim sffmpeSet
sExePath = oWSFSO.GetParentFolderName(WScript.Scriptfullname)
sffmpeExe = oWSFSO.BuildPath(sExePath , "ffmpeg.exe")
sffmpeCrf = sGetConvertCrf(pvFP(cP0))
sffmpeSiz = sGetConvertSiz(pvFP(cP0))
sffmpeSt = cNULL
if IsDate(pvFP(cP3)) Then
sffmpeSt = " -ss " & pvFP(cP3)
End if
sffmpeTt = cNULL
if IsDate(pvFP(cP4)) Then
sffmpeTt = " -t " & pvFP(cP4)
End if
sffmpeSet = " -coder 1 -refs 1 -flags +loop -partitions +parti4x4 -me_method hex -subq 1 -psy 0 -trellis 0 -8x8dct 0 -fast-pskip 1 -bf 3 -b-pyramid 2 -b_strategy 1 -direct-pred 1 -weightp 1 -weightb 1 -g 150 -keyint_min 1 -sc_threshold 40 -mbtree 0 -qcomp 1 "
sffmpeVF = cNULL
if Len(pvFP(cP5))>0 Then
sffmpeVF = " -vf " & pvFP(cP5)
End if
If cMP4 = Lcase(Right(po1Doga.Path , 4)) Then
sffmpeSet = sffmpeSet & " -vsync 2 -acodec copy "
End if
If oWSFSO.FileExists(sffmpeExe) and (sffmpeCrf <> cNULL) and (sffmpeSiz <> cNULL) Then
sffmpeRun = cDC & sffmpeExe & cDC & sffmpeSt & " -i " & cDC & po1Doga.Path & cDC & sffmpeTt & " -vcodec libx264 -crf " & sffmpeCrf & sGetConvertSizS(sffmpeSiz) & sffmpeSet & sffmpeVF & " -y " & cDC & ps2Doga1 & cDC
Else
sffmpeRun = cNULL
End if
sRunffmpeExe = sffmpeRun
End Function
Function sGetConvertSizS(psSiz)
Dim sSizS
sSizS = psSiz
If Len( Trim( sSizS ) ) > 0 Then
sSizS = " -s " & psSiz
End if
sGetConvertSizS = sSizS
End Function
Function sGetConvertCrf(piMode)
Dim vMode , vCrf
vCrf = cNULL
vMode = Trim(piMode)
If IsNumeric(vMode) Then
vMode = CLng(vMode) \ 10
Select Case vMode
Case 0 : vCrf = 25
Case 1 : vCrf = 28
Case 2 : vCrf = 31
Case 3 : vCrf = 34
Case 4 : vCrf = 37
End Select
End if
sGetConvertCrf = vCrf
End Function
Function sGetConvertSiz(piMode)
Dim vMode , vSize
vSize = cNULL
vMode = Trim(piMode)
If IsNumeric(vMode) Then
vMode = CLng(vMode) Mod 10
Select Case vMode
Case 0 : vSize = " "
Case 1 : vSize = "1280x720"
Case 2 : vSize = "960x720"
Case 3 : vSize = "960x540"
Case 4 : vSize = "640x480"
Case 5 : vSize = "854x480"
Case 6 : vSize = "560x420"
Case 7 : vSize = "640x360"
Case 8 : vSize = "480x360"
Case 9 : vSize = "427x240"
End Select
End if
sGetConvertSiz = vSize
End Function
Function vGetCrfSize(ipIdx , bEco)
Dim vCrfSize , iHeight , iWidth , iPixel , iBps
vCrfSize = 10
If IsNumeric(vDETAILw(ipIdx)) and IsNumeric(vDETAILh(ipIdx)) Then
vCrfSize = 0
iHeight = CLng(vDETAILh(ipIdx))
iWidth = CLng(vDETAILw(ipIdx))
iPixel = iHeight * iWidth
iBps = Trim(Replace(Lcase(vDETAILb(ipIdx)) , "kbps", ""))
if Asc(left(iBps,1)) > 59 Then
iBps = Mid(iBps,2)
End if
If (iHeight / iWidth) < 0.6 or iHeight > 1000 and iBps > 5000 Then
If iWidth => 1280 Then
vCrfSize = 1
If bEco Then
vCrfSize = vCrfSize + 2
End if
ElseIf iWidth => 960 Then
vCrfSize = 3
If bEco Then
vCrfSize = vCrfSize + 2
End if
ElseIf iWidth => 854 Then
vCrfSize = 5
If bEco Then
vCrfSize = vCrfSize + 2
End if
ElseIf iWidth => 640 Then
vCrfSize = 7
If bEco Then
vCrfSize = vCrfSize + 2
End if
ElseIf iWidth => 427 Then
If bEco Then
vCrfSize = vCrfSize + 10
End if
End if
Else
If iWidth => 960 Then
vCrfSize = 2
If bEco Then
vCrfSize = vCrfSize + 2
End if
ElseIf iWidth => 640 Then
vCrfSize = 4
If bEco Then
vCrfSize = vCrfSize + 2
End if
ElseIf iWidth => 560 Then
vCrfSize = 6
If bEco Then
vCrfSize = vCrfSize + 2
End if
ElseIf iWidth => 480 Then
If bEco Then
vCrfSize = vCrfSize + 10
End if
End if
End if
If iPixel => 500000 Then
vCrfSize = vCrfSize + 30
ElseIf iPixel => 200000 Then
vCrfSize = vCrfSize + 20
Else
vCrfSize = vCrfSize + 10
End if
End if
vGetCrfSize = vCrfSize
End Function
Function vGetConvertMode( )
Dim vGetConv, iLen
vGetConv = vGetCrfSize(cDD1 , False)
If vDETAILs(cDD1) < vDETAILs(cDD2) Then
If bDETAIL(cDD1) and bDETAIL(cDD2) Then
If (vGetConv mod 10) < ( vGetCrfSize(cDD2 , False) mod 10) Then
vGetConv = vGetCrfSize( cDD2 , True)
Else
vGetConv = vGetCrfSize( cDD1 , True)
End if
ElseIf Not bDETAIL(cDD1) Then
vGetConv = vGetCrfSize( cDD2 , True)
Else
vGetConv = vGetCrfSize( cDD1 , True)
End if
End if
vGetConvertMode = vGetConv
End Function
Function bDogaDetailIndex(pIdx , psFolder)
Dim oNsFolder , sPara , iEcho , iNull
Dim iPara
iPara = 7
iEcho = 0
Set oNsFolder = oWSAPP.Namespace( Cstr(psFolder) )
Do
With oNsFolder
sPara = Cstr(.GetDetailsOf(.Items, iPara))
End With
If Len(sPara) > 0 Then
Select Case sPara
Case "長さ"
iEcho = iEcho + 1
iDETAILt(pIdx) = iPara
sDETAILt(pIdx) = sPara
Case "データ速度"
iEcho = iEcho + 1
iDETAILb(pIdx) = iPara
sDETAILb(pIdx) = sPara
Case "フレーム高"
iEcho = iEcho + 1
iDETAILh(pIdx) = iPara
sDETAILh(pIdx) = sPara
Case "フレーム率"
iEcho = iEcho + 1
iDETAILf(pIdx) = iPara
sDETAILf(pIdx) = sPara
Case "フレーム幅"
iEcho = iEcho + 1
iDETAILw(pIdx) = iPara
sDETAILw(pIdx) = sPara
End Select
iNull = 0
Else
iNull =iNull + 1
End if
iPara = iPara + 1
Loop Until (iNull = 3) or (iEcho = 5)
Set oNsFolder = Nothing
bDogaDetailIndex = (iEcho = 5)
End Function
Sub DogaDetailReset(pIdx)
bDETAIL(pIdx) = False
vDETAILs(pIdx) = 0
vDETAILd(pIdx) = cNULL
vDETAILt(pIdx) = cNULL
vDETAILb(pIdx) = cNULL
vDETAILh(pIdx) = cNULL
vDETAILf(pIdx) = cNULL
vDETAILw(pIdx) = cNULL
End Sub
Function bDogaDetailValue(pIdx , poDoga)
vDETAILs(pIdx) = poDoga.size
vDETAILd(pIdx) = CDate(poDoga.DateLastModified)
With oWSAPP.Namespace( Cstr( poDoga.ParentFolder ) )
vDETAILt(pIdx) = .GetDetailsOf(.Items.Item(poDoga.Name) , iDETAILt(pIdx))
vDETAILb(pIdx) = .GetDetailsOf(.Items.Item(poDoga.Name) , iDETAILb(pIdx))
vDETAILh(pIdx) = .GetDetailsOf(.Items.Item(poDoga.Name) , iDETAILh(pIdx))
vDETAILf(pIdx) = .GetDetailsOf(.Items.Item(poDoga.Name) , iDETAILf(pIdx))
vDETAILw(pIdx) = .GetDetailsOf(.Items.Item(poDoga.Name) , iDETAILw(pIdx))
End With
bDETAIL(pIdx) = IsDate(Trim(vDETAILt(pIdx))) and IsNumeric(vDETAILh(pIdx)) and IsNumeric(vDETAILw(pIdx))
bDogaDetailValue = bDETAIL(pIdx)
End Function
Function sDogaDetailEcho( pIdx , poDoga)
Dim sEcho
sEcho = "ファイル名：" & poDoga.Path
sEcho = sEcho & vbCrlf & " サイズ：" & sByte2MB(poDoga.Size)
sEcho = sEcho & vbCrlf & sDETAILt(pIdx) & "(時間)：" & vDETAILt(pIdx)
sEcho = sEcho & vbCrlf & sDETAILb(pIdx) & "：" & vDETAILb(pIdx)
sEcho = sEcho & vbCrlf & sDETAILh(pIdx) & "：" & vDETAILh(pIdx)
sEcho = sEcho & vbCrlf & sDETAILf(pIdx) & "：" & vDETAILf(pIdx)
sEcho = sEcho & vbCrlf & sDETAILw(pIdx) & "：" & vDETAILw(pIdx)
sDogaDetailEcho = sEcho
End Function
Sub DogaDetailIndexCopy(pi1 , pi0)
iDETAILt(pi1) = iDETAILt(pi0)
iDETAILb(pi1) = iDETAILb(pi0)
iDETAILh(pi1) = iDETAILh(pi0)
iDETAILf(pi1) = iDETAILf(pi0)
iDETAILw(pi1) = iDETAILw(pi0)
End Sub
Function bDogaTypeExt( poItem )
Dim sType , bType , sExt , bExt, bExt1
sType = Lcase(Trim(poItem.Type))
bType = Instr(sType , "ビデオ") > 0 or Instr(sType , "ムービー") > 0
sExt = Lcase(Trim(oWSFSO.GetExtensionName(poItem.path)))
bExt = Instr(sExt , "av") > 0 or Instr(sExt , "as") > 0 or Instr(sExt , "wm") > 0 or Instr(sExt , "mp") > 0 or Instr(sExt , "mo") > 0 or Instr(sExt , "ts") > 0
bExt1 = Instr(sExt , "rm") > 0 or Instr(sExt , "fl") > 0 or Instr(sExt , "sw") > 0 or Instr(sExt , "ps") > 0 or Instr(sExt , "vo") > 0 or Instr(sExt , "og") > 0
bDogaTypeExt = bType or bExt or bExt1
End Function
Function sSHOW_ItemDetails( poItem )
Dim oNsFolder , iErr , sEcho , iPara , sPara , vPara , iNull , sLine
sEcho = cNULL
iPara = 0
iNull = 0
If Lcase(TypeName(poItem))= "drive" Then
sEcho = "ドライブの種類 ：" & poItem.DriveType
If poItem.IsReady = True Then
sEcho = sEcho & vbCrlf & "ファイルシステムの種類：" & poItem.FileSystem
sEcho = sEcho & vbCrlf & "ドライブ全体の容量 ：" & sByte2GB(poItem.TotalSize)
sEcho = sEcho & vbCrlf & "ドライブの空き容量 ：" & sByte2GB(poItem.AvailableSpace)
Else
sEcho = sEcho & vbCrlf & "ドライブは使えません。"
End If
Else
Set oNsFolder = oWSAPP.Namespace(Cstr(poItem.ParentFolder))
Do
With oNsFolder
sPara = .GetDetailsOf(.Items, iPara)
vPara = .GetDetailsOf(.Items.Item(poItem.Name), iPara)
End With
If Len(sPara) > 0 Then
If Len(vPara) > 0 Then
If sEcho = cNULL Then
sLine = cNULL
Else
sLine = sEcho & vbCrlf
End if
sEcho = sLine & Right("0000" & iPara,4) & " " & sPara & vbTab & vPara
End if
iNull = 0
Else
iNull =iNull + 1
End if
iPara = iPara + 1
Loop Until (iNull = 3)
End If
Set oNsFolder = Nothing
sSHOW_ItemDetails = sEcho
End Function
Function sConvertMovieName( ps1Doga , ps2File)
Dim sRet2File
sRet2File = ps2File
If Lcase(ps1Doga) = Lcase(ps2File) Then
sRet2File = ps2File & cMP4
Else
If Lcase( Right( ps1Doga , 4)) <> cMP4 then
sRet2File = ps2File & cMP4
End if
End if
sConvertMovieName = sRet2File
End Function
Function bIESHOW(bRe , psTitle , psBody)
Dim iErr
Dim idx
iErr = 0
on error resume next
If bRe Then
If oIEAPP Is Nothing Then
Set oIEAPP = CreateObject("InternetExplorer.Application")
iErr = Err.Number
If iErr = 0 Then
With oIEAPP
.Visible = False
.Left = 100
.Top = 200
.Width = 500
.Height = 800
End With
End if
End if
End if
If iErr = 0 Then
If Not oIEAPP Is Nothing Then
With oIEAPP
.Navigate "about:blank"
.Document.Write vbCrlf & " "
.Document.Write vbCrlf & " "
.Document.Write vbCrlf & " "
.Document.Write vbCrlf & " "
.Document.Write vbCrlf & " "
.Document.Write vbCrlf & "<html>"
.Document.Write vbCrlf & "<head><title>" & psTitle & "</title></head>"
.Document.Write vbCrlf & "<body><pre>"
.Document.Write vbCrlf & psBody
.Document.Write vbCrlf & "</pre></body>"
.Document.Write vbCrlf & "</html>"
.Document.Write vbCrlf
.Visible = True
.Refresh
End With
End if
iErr = Err.Number
End if
on error goto 0
If iErr <> 0 Then
Err.Clear
Set oIEAPP = Nothing
End if
bIESHOW = (Not oIEAPP Is Nothing)
End Function
Function bWriteLog(psLogPath , psLog)
On Error Resume Next
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim oLog
Set oLog = oWSFSO.OpenTextFile(psLogPath , ForAppending ,True,True)
Call oLog.WriteLine(psLog)
Call oLog.Close()
Set oLog = Nothing
If Err.Number <> 0 Then
Err.Clear
bWriteLog = False
Else
bWriteLog = True
End If
On Error Goto 0
End Function
Function sGETLOG(psLog)
If Len(psLog)=0 Then
psLog = rsLOGPRINT(iLOGPRINT)
Else
rsLOGPRINT(iLOGPRINT) = psLog
iLOGPRINT = iLOGPRINT + 1
End if
sGETLOG = psLog
End Function
Function sPUTLOG(pbUp)
Dim idx
Dim sLog
sLog = cNULL
sLog = rsLOGPRINT(0)
For idx = 1 To iLOGPRINT - 1
If pbUp = True Then
sLog = sLog & vbCrlf & vbCrlf & rsLOGPRINT(idx)
Else
sLog = rsLOGPRINT(idx) & vbCrlf & vbCrlf & sLog
End if
Next
sPUTLOG = sLog
End Function
Sub ExtCount(psFile)
Dim idx , sExt
sExt = Lcase(Trim(oWSFSO.GetExtensionName(psFile)))
For idx = 0 To iEXTMAX
If Len(rsEXT(idx)) > 0 and rsEXT(idx) = sExt Then
riEXT(idx) = riEXT(idx) + 1
Exit for
Else
If idx = iEXTMAX Then
rsEXT(idx) = sExt
riEXT(idx) = 1
iEXTMAX = idx + 1
End if
End if
Next
End Sub
Sub ExtReset()
Dim idx
For idx = 0 To iEXTMAX
rsEXT(idx) = cNULL
riEXT(idx) = 0
Next
iEXTMAX = 0
End Sub
Function iExtSum()
Dim idx
Dim iSum
iSum = 0
For idx = 0 To iEXTMAX
iSum = iSum + riEXT(idx)
Next
iExtSum = iSum
End Function
Function sByte2MB(puByte)
sByte2MB = Round(puByte / 1024^2, 2) & "MB"
End Function
Function sByte2GB(puByte)
sByte2GB = Round(puByte / 1024^3, 2) & "GB"
End Function
Sub DogaCountSizeReset()
Dim idx
For idx = cF1 To cF5
iDC(idx) = 0
i1DS(idx) = 0
i2DS(idx) = 0
Next
End Sub
Sub FfmpegParaReset()
Dim idx
For idx = cP0 To cP5
vFP(idx) = cNULL
Next
End Sub
0 件のコメント:
コメントを投稿