WMV変換

mpegやaviなどをまとめてWindowsMediaVideに変換します。
以下のソースをメモ帳に貼り付けて「wmvenc.wsf」で保存。
wmvに変換したい動画ファイルをエクスプローラからドラッグ＆ドロップして下さい。

--<ソース>--
<?XML version="1.0" encoding="Shift_JIS" standalone="yes" ?>
<package>
<job>
<script language="VBScript">
<![CDATA[
Option Explicit
'------------------------------------------
' 環境設定です。 お好みによって変更して下さい。
' 出力先に既に同じ名前のファイル名が存在するときは上書きされます。
' 一切の内容を保証しません。自己責任でご利用下さい。
'------------------------------------------
'プロファイル名
Const ProfileName = "Windows Media Video 8 for Local Area Network (384 Kbps)"
'保存先
Const OutPath = "C:\wmv"

Private Sub wmv_enc(ByRef DestPath, ByRef objArgs)
Dim objExplorer
Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Width = 500
objExplorer.Height = 120
objExplorer.Left = 100
objExplorer.Top = 100
Do While (objExplorer.Busy)
Wscript.Sleep 200
Loop
objExplorer.Visible = 1
objExplorer.Document.Title = "wmv変換"
objExplorer.Document.Body.InnerHTML = "準備中です..."

'WMEncoderの生成
Dim encoder 'Encoder Object
Set encoder = WScript.CreateObject("WMEncEng.WMEncoder")

'ソースグループの設定
Dim srcgrpcoll
Dim srcgrp
Dim vidsrc
Dim audsrc

Set srcgrpcoll = encoder.SourceGroupCollection
Set srcgrp = srcgrpcoll.Add("SRC_MOVIE")
Set vidsrc = srcgrp.AddSource(2)
Set audsrc = srcgrp.AddSource(1)

'プロファイルの設定
Dim profilecoll
Dim profile

Set profilecoll = encoder.ProfileCollection
For Each profile In profilecoll
If profile.Name = ProfileName Then
srcgrp.Profile = profile
Exit For
End If
Next
srcgrpcoll.Active = srcgrp
Dim outputfile
Set outputfile = encoder.file

Dim I
Dim status_val 'エンコーダのステータス 終了時は5
Dim src_name 'ソースファイル名のフルパス
Dim wmv_name 'WMVへのフルパス

Dim cnt
cnt = objArgs.Count
For I = 0 to cnt - 1
objExplorer.Document.Body.InnerHTML = GetProgressMessage(I, cnt, objArgs(I))
src_name = objArgs(I)
wmv_name = DestPath & "\" & GetFileNameWithOutExt(objArgs(I)) & ".wmv"
outputfile.LocalFileName = wmv_name
audsrc.SetInput(src_name)
vidsrc.SetInput(src_name)
On Error Resume Next
Err = 0
encoder.Start
If Err <> 0 Then
WScript.Echo Err.Number & ":" & Err.Description & chr(13) & "処理を中止します。"
objExplorer.Quit
WScript.Quit
End If
status_val = encoder.RunState
While status_val < 3
'エンコード終了を待つために無限ループ
WScript.Sleep 100 '処理を待機
status_val = encoder.RunState
Wend
Next

'エンコーダ関連の開放
Set vidsrc = Nothing
Set audsrc = Nothing
Set outputfile = Nothing
Set profile = Nothing
Set profilecoll = Nothing
Set srcgrp = Nothing
Set srcgrpcoll = Nothing
Set encoder = Nothing
objExplorer.Quit
Set objExplorer = Nothing
WScript.echo "エンコードが終了しました。"
End Sub

private Function GetFileName(ByVal orgName)
Dim idx
idx = InStrRev(orgName, "\")
GetFileName = Mid(orgName, idx + 1)
End Function

private Function GetFileNameWithOutExt(ByVal orgName)
Dim temp
temp = GetFileName(orgName)
Dim idx
idx = InStrRev(temp, ".")
GetFileNameWithOutExt = Left(temp, idx - 1)
End Function

private Function GetProgressMessage(ByVal idx, ByVal cnt, ByVal srcName)
Dim step
step = idx + 1
Const MAX_STEP = 10
Dim pos
pos = Int(step / cnt * 10.0)
GetProgressMessage = "<b>" & step & " / " & cnt & "</b>：「<span style=""color:#696969;"">" & srcName & "</span>」を変換中です...<br>" _
& "<span style=""color:#6495ed;"">" & String(pos, "■") & String(MAX_STEP - pos, "□") & "</span> " & FormatPercent(step / cnt)
End Function

Dim objArgs
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
if fso.FolderExists(OutPath) = false then
fso.CreateFolder(OutPath)
end if
Set fso = Nothing

Set objArgs = WScript.Arguments
If objArgs.Count > 0 Then
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
Dim ret
ret = WshShell.Popup ( objArgs.Count & "件の動画をエンコードします。", 10, WScript.ScriptName, 1 + 32)
if ret > 1 then
WScript.Quit
end if
Set WshShell = Nothing
Call wmv_enc(OutPath, objArgs)
End If
Set objArgs = Nothing

]]>
</script>
</job>
</package>