« WMV変換 | トップページ | VC++でJPEGを使う »

2007/01/02

VBScriptでオブジェクト指向的な

VBScriptでもクラスを定義できるので、一応オブジェクト指向的なコードを記述することができます。クラスの書き方は以下の通り。
--ここから--
class YourClassName
private mVariable

 

'コンストラクタ
Private Sub Class_Initialize
End Sub

 

property Let Hoge(ByVal fuga)
mVariable = fuga
end property

 

Property Get Hoge
Hoge = mVariable
End Property

 

function Method1()
...
Method1 = ...
end function

 

sub Method2()

 

end sub

 

'デコンストラクタ
Private Sub Class_Terminate
End Sub
end class
--ここまで--
前回の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"

 

 

 

 

 

class MyWMEncoder
private encoder 'Encoder Object
private srcgrpcoll 'ソースグループコレクション
private srcgrp
private vidsrc 'ビデオソース
private audsrc 'オーディオソース

 

Private Sub Class_Initialize
Set encoder = WScript.CreateObject("WMEncEng.WMEncoder")
Set srcgrpcoll = encoder.SourceGroupCollection
Set srcgrp = srcgrpcoll.Add("SRC_MOVIE")
Set vidsrc = srcgrp.AddSource(2)
Set audsrc = srcgrp.AddSource(1)
End Sub

 

'プロファイルを設定します。
Sub SetProfile(ByVal profileName)
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
Set profile = Nothing
Set profilecoll = Nothing
'ソースグループをアクティブに設定
srcgrpcoll.Active = srcgrp
End Sub

 

Sub Encode(ByVal src_name, ByVal wmv_name)
'出力ファイルをセット
Dim outputfile '出力ファイル
Set outputfile = encoder.file
outputfile.LocalFileName = wmv_name
'ソースファイルをセット
audsrc.SetInput(src_name)
vidsrc.SetInput(src_name)
encoder.Start
Dim status 'エンコーダのステータス 終了時は5
status = encoder.RunState
While status < 3
'エンコード終了を待つために無限ループ
WScript.Sleep 100 '処理を待機
status = encoder.RunState
Wend
End Sub

 

Private Sub Class_Terminate
Set vidsrc = Nothing
Set audsrc = Nothing
Set srcgrp = Nothing
Set srcgrpcoll = Nothing
Set encoder = Nothing
End Sub
end class

 

class ProgressBar
private objExplorer

 

Private Sub Class_Initialize
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
End Sub

 

property Let Caption(ByVal title)
objExplorer.Document.Title = title
end property

 

property Let Message(ByVal msg)
objExplorer.Document.Body.InnerHTML = msg
end property

 

Private Sub Class_Terminate
objExplorer.Quit
Set objExplorer = Nothing
End Sub
end class

 

class MainClass
Private Sub Class_Initialize
End Sub

 

private Function Confirm(ByVal cnt)
Dim ret
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
ret = WshShell.Popup ( cnt & "件の動画をエンコードします。" & Chr(13) & _
"処理には実時間かかります。", 10, WScript.ScriptName, 1 + 32)
Set WshShell = Nothing
if ret > 1 Then
Confirm = false
else
Confirm = true
end if
End Function

 

Sub Run(ByVal OutFolder, ByVal encProfileName)
FolderCheck(OutFolder)
Dim objArgs '引数のオブジェクト
Set objArgs = WScript.Arguments
If objArgs.Count > 0 Then
if Confirm(objArgs.Count) = false then
WScript.Quit
end if
Dim progBar
Set progBar = new ProgressBar
progBar.Caption = "Windows Media Video変換"
progBar.Message = "準備中です..."
Dim encoder
Set encoder = new MyWMEncoder
encoder.SetProfile encProfileName
Dim cnt
cnt = objArgs.Count
Dim wmv_name
On Error Resume Next
Dim I
For I = 0 to cnt - 1
progBar.Message = GetProgressMessage(I, cnt, objArgs(I))
wmv_name = OutFolder & "\" & GetFileNameWithOutExt(objArgs(I)) & ".wmv"
Err = 0
encoder.Encode objArgs(I), wmv_name
If Err <> 0 Then
Set progBar = Nothing
Set encoder = Nothing
WScript.Echo Err.Number & ":" & Err.Description & chr(13) & "処理を中止します。"
WScript.Quit
End If
Next
Set progBar = Nothing
Set encoder = Nothing
WScript.echo "エンコードが終了しました。"
End If
Set objArgs = Nothing
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 Sub FolderCheck(ByVal OutFolder)
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
if fso.FolderExists(OutFolder) = false then
fso.CreateFolder(OutFolder)
end if
Set fso = Nothing
End Sub

 

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

 

Private Sub Class_Terminate
End Sub
end class

 

Dim main
Set main = new MainClass
main.Run OutPath, ProfileName
Set main = Nothing
]]>
</script>
</job>
</package>

« WMV変換 | トップページ | VC++でJPEGを使う »

04 vba & other」カテゴリの記事

コメント

コメントを書く

コメントは記事投稿者が公開するまで表示されません。

(ウェブ上には掲載しません)

トラックバック


この記事へのトラックバック一覧です: VBScriptでオブジェクト指向的な:

« WMV変換 | トップページ | VC++でJPEGを使う »

2022年7月
          1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31            

最近のトラックバック

無料ブログはココログ