VBScript・VBAでWAVのサンプリングレートなどを取得【備忘録】
以前エクセルにてWAVのサンプリングレートなどの情報を取得するスクリプトを作ったのですが、ファイルによって想定外の動作があったり、エクセルではなくてVBSファイルのドラッグにて動作させたいなと思い、作り直すことにしました。
以前作った時はとりあえず動けば良いやと思ってたので、参考スクリプトを殆どコピーしてあまり意味は分かっていなかったのですが、今回は色々調べたり検証したりして勉強になりました。でもまだ完全には理解出来ていないですね。多少は理解できたのかなといった感じです。バイナリとかそういうのは難しいですね。
スクリプトのベース
一番参考になって、本記事のベースにもなってるのは、Yahoo!知恵袋のサンプルです。
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1372320783
ただこのサンプル、自分が理解出来てないだけの可能性もありますが、結構間違えている部分があると思います。これは動作には問題ないけど、サンプリングレートの変数名がslateとなってたり。自分もコピーしたもののずっと気付かず、後でそう言えばレートはRだよなと釣られていることに気が付き、全て置換しました(笑) これも含め、多分かなりざっくりと参考になればとささっと書いたのだと思われます。でも自分はこの分野は全然詳しくないので、そもそもが間違ってるものを正解だと思って、何でこの記述になるのだろう…と所々疑問が解けず随分悩みました。
構造体で取得のパターン
http://www.gizcollabo.jp/vbtomo/log/archive/vbqanda_28025_0.html
バイナリから取得するパターンとしては上記もありましたが、これでは取得出来たり出来なかったりしました。はじめ自分の用意したWAVで試して出来なかったので、スクリプトの投稿日が古く環境的なものかと思いましたが、スクリプトに書いてあるWAVのパスそのままで取得できました。パスをきちんと見てなく適当なものが仮で書いてあるかと思ってましたが、Windowsに初めから入ってる音源なんですね。
詳細は後程書きますが、取得できないのは恐らくチャンクの位置が後方にズレている音源が原因かと思われます。バイナリエディタでそのようになってる音源で試すと取得できず、バイナリの文字列がWAVEfmtとWAVEにfmtが続く音源は取得出来ます。本記事のスクリプトのように取得位置を調整出来たりすれば良いのですが、このサンプルではどうやっていいか分からず。因みにデバッグしてみると、取得できないのはHdrFormat(WaveFormat)だけでした。
構造体自体は知っていたけど、自分の知識が浅いことからこのサンプルは興味深く思いました。構造体の各要素は、例えばリストなどからある人の名前、年齢、性別などの各値を構造体の各要素に個別に代入して成すものだと思っていました。しかしこのサンプルは構造体の変数本体をGetの引数に渡していて、結果自身の各要素に正しい値が入っています。どうなっているのか全く分かりません。ただチャンク自体が構造体という表現を目にしたので、構造体の変数を投げれば自動取得出来るのかも。
あと、定数で定義されてる数字をバイナリエディタで探してみましたが、はじめ何か一致しないなと思ったけど順番が逆になっていることに気付きました。これも後に詳しく書きますが、もしかしたらビットシフトとかも関係してるのかも。一纏めにして扱う場合後ろにあるバイト程大きな桁になるため、一つの数字としてまとめて書くと逆になるのかも。
追記
やはりそうですね。例えば88.2kHzの88200は16進数で015888ですが、ビットシフトの要領で88200を割り出す場合、01 58 88に分け、88(136) x 1 + 58(88) x 256 + 01(01) x 65536とやると88200が出ることを理解しました。(カッコは10進数、カッコ内の方を掛けます。) つまり逆になってます。
また、後述のハイレートになると3バイト目を使う理由も上記で理解しました。(例えば44.1kHzは16進数でAC44だけど、5桁目を使っていません。64kHzまでは4桁で、88.2kHzから5桁になり、つまり3バイト目を使用します。)
VBScriptで取得
今回最初に作ったVBScriptのみのバージョンです。
' GetWaveInfo.vbs Option Explicit Dim srate, bits Dim bin Dim fs, arg Dim i, ckPos Dim msg, ch, fname If WScript.Arguments.Count = 0 Then WScript.Quit Set fs = CreateObject("Scripting.FileSystemObject") For Each arg In WScript.Arguments If UCase(fs.GetExtensionName(arg)) = "WAV" Then bin = ReadBinary(arg, 745) If IsWave(bin) Then srate = 0 bits = 0 ch = "" fname = fs.GetFileName(arg) ckPos = GetChunkPos(bin, Array(&H66, &H6D, &H74, &H20)) If ckPos Then srate = GetWaveSamplingRate(bin, ckPos) bits = GetWaveBitRate(bin, ckPos) ch = GetWaveChannel(bin, ckPos) msg = msg & "echo " & CStr(srate / 1000) & " kHz / " & CStr(bits) & " bit " & ch & "【" & fname & "】 & " Else MsgBox fname & " に fmt の文字列がありません。", vbExclamation, WScript.ScriptName End If End If End If Next Set fs = Nothing If msg <> "" Then CreateObject("WScript.Shell").Run "%ComSpec% /c " & msg & "pause", , False Function ReadBinary(ByVal FilePath, ByVal Limit) Dim strm, buf, i Set strm = CreateObject("ADODB.Stream") strm.Mode = 3 strm.Type = 1 strm.Open strm.LoadFromFile FilePath If Limit = 0 Then Limit = strm.Size - 1 ReDim buf(Limit) For i = 0 To Limit buf(i) = AscB(strm.Read(1)) Next strm.Close Set strm = Nothing ReadBinary = buf End Function Function GetChunkPos(bin, hexStrArr) Dim i If UBound(hexStrArr) = 3 Then For i = LBound(bin) To UBound(bin) If bin(i) = hexStrArr(0) Then If i + 3 <= UBound(bin) Then If bin(i + 1) = hexStrArr(1) And bin(i + 2) = hexStrArr(2) And bin(i + 3) = hexStrArr(3) Then GetChunkPos = i Exit Function End If End If End If Next End If GetChunkPos = 0 End Function Function IsWave(bin) If UBound(bin) >= 11 Then If bin(0) = &H52 And bin(1) = &H49 And bin(2) = &H46 And bin(3) = &H46 And bin(8) = &H57 And bin(9) = &H41 And bin(10) = &H56 And bin(11) = &H45 Then IsWave = True Exit Function End If End If IsWave = False End Function Function GetWaveSamplingRate(bin, ByVal ckPos) Dim srPos, srate, sft, i srate = 0 srPos = ckPos + 12 If srPos + 3 <= UBound(bin) Then sft = &H100 For i = srPos To srPos + 3 If srPos = i Then srate = bin(i) Else srate = srate + (bin(i) * sft) sft = sft * &H100 End If Next End If GetWaveSamplingRate = srate End Function Function GetWaveBitRate(bin, ByVal ckPos) Dim brPos brPos = ckPos + 22 If brPos <= UBound(bin) Then GetWaveBitRate = bin(brPos) Exit Function End If GetWaveBitRate = 0 End Function Function GetWaveChannel(bin, ByVal ckPos) Dim cnPos cnPos = ckPos + 10 If cnPos <= UBound(bin) Then If bin(cnPos) = 2 Then GetWaveChannel = "ステレオ" Else GetWaveChannel = "モノラル" End If Exit Function End If GetWaveChannel = "" End Function
ReadBinary関数
バイナリを読み込みます。VBScriptではVBAで使えるOpenステートメントが使えないため、ADODB.Streamオブジェクトを使用しました。但しこれには難があって、結局VBA版を作って本処理はこちらですることになります…。。
ReadBinary関数にLimitと設けたように、読み込み容量を制限することが出来ます。ヘッダの一部が読み込めれば良いので、全ては要らないのです。しかしADODB.Streamオブジェクトでは一旦自身に全て読み込む必要があるようで、このため大変処理が遅いです。数秒のサンプルファイルなどならまだ良いのですが、普通の音楽ファイルを複数となると、現実的な使用には向いていない遅さでした。なので少しでも改善しようと読み込んで配列に格納していく際にLimitで制限した数だけ格納する仕様にしました。これだけでも速くなりました。
Openステートメントは予め配列の容量を確保しておき、その分しか取得しないので、高速です。ファイルを全て読み込んでも、Openステートメントの方が速かったです。
本当はLimitは任意で、指定されていたらその値にし、指定されてなかったら全て読み込む仕様にしたかったのですが、VBScriptではOptionalが使えないので、0に指定されてたら全て読み込む仕様にしました。
GetChunkPos関数
チャンクの位置を取得します。先程チャンクの位置がズレている場合があると書きましたが、その調整で必要になります。チャンクを基準としてその地点から各データの位置は一定なので、チャンクの位置を取得してから各データの位置を加算してデータを取得します。
最初はGetFMTPos関数という形でfmtチャンクの位置を取得するための関数として作りましたが、後日ブログに書く予定のAIFFでも同様にCOMMチャンクの位置を取得する必要があるので、引数で指定して任意のチャンクの位置を返すような仕様にしました。引数には一文字ずつ文字を表す数字を配列に格納し、渡します。上記のスクリプトの場合、「fmt 」を16進数の数字で渡しています。
因みにfmtチャンクの位置ですが、前述のWAVEfmtとなる場合は最小の12です。Cubaseで書き出されたファイルの場合、48であることが多いです。「RF64 互換のファイル形式を使用しない」をチェックすると12になります。その他確認出来た位置の値が大きなデータはSonorisの72、やたらと大きいPro Toolsの722です。スクリプトの中でLimitを745としているのは、致し方なくこのPro Toolsに合わせています。
IF文でチャンクの位置が取得できなかったらメッセージボックスを表示させる仕様にしてますが、WAVデータは必ずfmtチャンクが必要になりますので、通常はLimitで指定した数字以上の位置にfmtチャンクがある場合に表示されます。その場合Limitを適当に大きくしたり全て読みこんだりして、ckPosをデバッグしてみたりバイナリエディタで見てみて位置を確認してLimitを再調整すると良いと思います。
IsWave関数
WAVデータかどうか判定し、WAVならTrueを返します。初めの4文字の「RIFF」とその少し後ろにある「WAVE」の文字で判定しています。
GetWaveSamplingRate関数
サンプリングレートを取得します。
所謂ビットシフトをしていると思うのですが、まだ完全には理解出来てないです(笑) 知恵袋にあるサンプルでは2個目(3バイト目)と3個目(4バイト目)のシフトでそれぞれ&H1000と&H10000となっていたので、何故こうなるのか嵌まりました。また、冒頭で想定外の動作と書きましたが、これが原因でした。
想定外の不具合というのは、88.2kHzや96kHzなどのハイレートの際値がおかしくなってしまうものでした。Ryzenになってから常にハイレートでの制作作業になったのもあってか、たまたまこれに気付きました。
全くよく分かっていなかったのですが、1バイト目から4バイト目をそれぞれデバッグして値を見てみると、44.1kHzなどでは使っていなかった3バイト目をハイレートでは使っていることが分かりました。そのため&H1000を掛けるのが間違いだと分かるきっかけになりました。&H1000ではなく&H10000を掛けると正常な値になります。
ビットシフトの根本的なところはやはり分かっていないのですが、&H100は10進数で256、1バイトは256通りの表現が可能なので、1バイト分シフトしているというのが分かりました。じゃあ3バイト目は2バイト分で256 x 2で512、&H200じゃないのかと思ったりもしたのですが、これは間違いでした。1バイトは8ビットで、8ビットは2を8乗した数字(256)を扱えます。2バイト分は8 x 2で16ビットなので、2を16乗すると65,536になります。だから&H10000になり、また&H1000は間違いだと分かりました。16ビットと65,536という数字は音楽でもよく目にする数字で、今改めて思えば2バイトが512というのはおかしいですね。
サンプリングレートではありませんが、以下のサイトでも同様の記述をしており、またビットシフトを行っていることも分かりました。それぞれRGBA値とWAVデータの長さで、4バイトです。2の◯ビット乗なので、「x * (2 ^ 8)」といった記述でも同じなんですね。
http://blog.livedoor.jp/spqm8sc9/archives/2549766.html
http://rucio.cloudapp.net/ThreadDetail.aspx?ThreadId=18644
とりあえず複数バイトを一つのデータとして扱う場合には必要になるものと覚えました。
ビット演算
本記事のスクリプトとは関係なく、少し脱線するのですが、ビットシフトについて調べてみるとビット演算やビット演算子という用語をよく目にしました。これも完全には理解出来てませんが、今まで疑問だったことが解決しました。
昔VBScriptでウィンドウを透過するスクリプトを書きました。これに以下のような処理がありました。
dwStyle = GetWindowLong(hWnd, GWL_EXSTYLE) dwStyle = dwStyle Or WS_EX_LAYERED Call SetWindowLong(hWnd, GWL_EXSTYLE, dwStyle)
このスクリプトの透過する処理については、ネットによくある記述をそのまま使っていたため、このビット演算についての部分はよく分からず使ってました。上記2行目がビット演算です。
ビット演算ではあるそれぞれの数字の2進数の各桁を照らし合わせ、0にしたり1にしたりします。そのためフラグとして利用されるようです。IF文と同じような感じで、ANDは両方が1なら1、ORは片方が0でももう片方が1なら1となります。
例えば0101と0110で演算子がANDだったら、1桁目が1と0で「0」、2桁目が0と1で「0」、3桁目が1と1で「1」、4桁目が0と0で「0」となり、「0100」が演算結果になります。ORの場合は、1桁目が1と0で「1」、2桁目が0と1で「1」、3桁目が1と1で「1」、4桁目が0と0で「0」となり、「0111」が演算結果になります。
上記のようにORは0を1にする働きがあるため、フラグを立てるために利用されるようです。
つまり上記スクリプトの場合、GetWindowLongであるウィンドウの現在の拡張ウィンドウスタイル情報を取得し、その情報にレイヤードウィンドウのフラグが立っていなかったらフラグを立てて、SetWindowLongでレイヤードウィンドウが適用された拡張ウィンドウスタイルを指定している、ということが分かりました。
GetWaveBitRate関数
ビットレートを取得します。ビットレートは2バイト分あるのですが、実質1バイトしか使っていないようなので、上記スクリプトでは知恵袋のサンプルのチャンネルと同様に1バイトから取得することにしました。
最初の内や今回の作業前はサンプルと同様に2バイト分処理する形で書いていたのですが、これも間違いが含まれていました。最後にサンプリングレートを掛けているのですが、これの意味がどうしても分かりませんでした。これは間違いなのですが、それでも正常動作するのは、2バイト目は使っておらず0が入っており、掛けても値が0になるためです。もし1以上の値が入っている場合、とんでもないビットレート数になりますよね。ビットシフトで256掛けたあとに更に例えば44100とかを掛ける訳ですので。仮に1バイト目を無視して、2バイト目が1だっただけでも11,289,600 Bitとなります(笑)
これは、多分1秒あたりバイト数の平均(Byte Rate)とビットレートがごちゃごちゃになっているのだと思います。以下のページを見ると、サンプリングレートを掛けて取得する値は、唯一Byte Rateになります。
http://d.hatena.ne.jp/uppudding/20071223/1198420222
なので変数名がbytesになっているのも、Byte Rateを思わせます。ですが処理しているバイト数は2バイトです。(Byte Rateは4バイト) そして位置はビットレートの位置なので、チャンネル数やブロックサイズは掛けておらず、ビットレートにサンプリングレートを掛けています。
GetWaveChannel関数
ステレオかモノラルかを文字列で返します。GetWaveBitRate同様、チャンネルも2バイト用意されているものの実質1バイトしか使用されておらず、サンプルもそうなっていたので1バイトで判定し、2が入っていたらステレオ、それ以外はモノラル、と処理しています。
VBAで取得
高速なVBA版です。但しどうしてもドラッグして取得するようにしたかったので、WAVデータをVBSにドラッグして、各ファイルのパスをエクセルに投げる仕様にしました。また、VBScript版ではコマンドプロンプトに結果を表示していましたが、エクセルを使う訳ですのでエクセルの表に書き出すようにしました。
前項のGetChunkPos以降の関数は同じなため、省略です。また、今回はVBScriptからの移植で、面倒なので型定義などは基本的にしませんでした。
' GetWaveInfo.vbs Option Explicit Const xlMaximized = -4137 Dim xlsPath Dim cnt, defWinSize Dim fs, oFile, arg, xls Dim wavPathArr If WScript.Arguments.Count = 0 Then WScript.Quit cnt = 0 xlsPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, ".")) & "xlsm" Set fs = CreateObject("Scripting.FileSystemObject") For Each arg In WScript.Arguments Select Case UCase(fs.GetExtensionName(arg)) Case "WAV" push wavPathArr, arg cnt = cnt + 1 End Select Next Set fs = Nothing If cnt Then With CreateObject("Excel.Application") .Application.Visible = true defWinSize = .Application.WindowState .Application.WindowState = xlMaximized .Workbooks.Open xlsPath .Run "GetWaveInfo", wavPathArr MsgBox "ボタンを押してエクセルを終了します。", , WScript.ScriptName .Application.WindowState = defWinSize .Application.DisplayAlerts = False .Quit .Application.DisplayAlerts = True End With End If Sub push(arr, elm) If IsArray(arr) Then Redim Preserve arr(Ubound(arr)+1) Else arr = Array(0) End If arr(Ubound(arr)) = elm End Sub
' GetWaveInfo.xlsm Sub GetWaveInfo(wavPathArr As Variant) Dim srate, bits, r, ckPos, cnt Dim bin Dim ch Dim arr, a Dim wavPath, wavFname r = 2 For Each wavPath In wavPathArr wavFname = Mid(wavPath, InStrRev(wavPath, "\") + 1) bin = ReadBinary(wavPath, 745) If IsWave(bin) Then srate = 0 bits = 0 ch = "" ckPos = GetChunkPos(bin, Array(&H66, &H6D, &H74, &H20)) If ckPos Then srate = GetWaveSamplingRate(bin, ckPos) bits = GetWaveBitRate(bin, ckPos) ch = GetWaveChannel(bin, ckPos) Else MsgBox wavFname & " に fmt の文字列がありません。", vbExclamation End If arr = Array(wavFname, CStr(srate / 1000) & " kHz", CStr(bits) & " bit", ch) cnt = 1 For Each a In arr Cells(r, cnt).Value = a cnt = cnt + 1 Next r = r + 1 End If Next If r > 2 Then Columns(1).AutoFit End Sub Function ReadBinary(ByVal FilePath, Optional ByVal Limit) Dim buf() As Byte Open FilePath For Binary Access Read As #1 If IsMissing(Limit) Then ReDim buf(0 To LOF(1)) Else ReDim buf(0 To Limit) End If Get #1, , buf Close #1 ReadBinary = buf Erase buf End Function
エクセルファイルとVBSファイルを同じ名前で、同じフォルダに置いて使用します。エクセルの2行目から結果を表示するので、1行目は予め項目を作っておきます。
VBScriptからエクセル操作
VBScriptからエクセルを操作出来るのは知ってて、昔ちょろっとやったことがあったけど、個人的に使い所があんまりなく使ってませんでした。
今回ちょっと驚いたのは、VBScriptからエクセルのマクロを指定して実行出来ることです。更に引数も指定出来るんですね。そんなことは出来ないだろうと思ってたので、当初はVBScriptで各ファイルのパスをテキストファイルに書き出し、エクセルを起動し、エクセルはWorkbook_Openで起動とともに実行してからテキストを削除するような仕様を考えてました。セキュリティ的には良くないんだろうけど、便利ですね。
またエクセル操作の流れとしては、次のようになります。
このスクリプトでは多くの情報が見れるようにウィンドウを最大化をしたいものの、それが保存されるのは嫌だったので、起動してから現在のウィンドウの状態を変数に保存しておいてから最大化します。ファイルを開いてマクロを実行し、メッセージボックスで待機します。メッセージボックスは表示せず普通にAlt + F4などで終了することも考えましたが、保存しますか？のダイアログが表示されるのが嫌だなと思ったので、終了もVBScriptに委ねることにしました。自分でAlt + F4で終了したら、ウィンドウも最大化のままですしね。そして最後にウィンドウを元の状態に戻してからダイアログを表示させずにファイルを保存せず終了します。
