SUPER(c) :元拡張子一括訂正

デジカメやTV録画とか、YouTUBEの閲覧とかで、溜まりにたまった動画が嵩んでまして・・・。

先月の末からずーっと 「SUPER＠」っていうフリーの変換ソフトを使って、AVIへのコンバート作業を続けてる。

互換性も高そうだし、何より軽いので、コーデックは、Xvidとmp3形式にしてますが、・・難点がおひとつ。

画像はNoChangeで良いけど、フレームレートは１0くらいにすると、紙芝居みたいなんで、余程じゃない限りは29.97固定にしてる。　ビットレートは最低1500以上はほしいんですが、現実的に1248にしてますけど、DivX は厳しい事あるけど、XviD は、それほど圧縮率が高い感じはしてないですよねー。

パソコンやポータブルDVDで見る限りは、4000～8000kbpsと見栄え、あまり代わらないですよねー。

サイズ的には、オーディオも馬鹿になりませんけど、元がMonoの場合はMonoのままコンバートした方が倍違うょ。うちは音楽が多いんで基本的には 44.1khz 2ch 128kbps にしてるけど、コンブ後は、画質も音質も落とさずに1/2～1/3のサイズに出来てしまう。


・・で、その拡張子なんですがぁー、　゜○×○×.wmv" 　とかだと、その後ろに ".AVI" とかって付いてしまうんで、後で変更するのにそうとう手間取る。　

めんどくさいんですょー。　

そこでスクリプトで一括処理するコード作ってみました。↓

Dim fs,fpath,ex,exn,Renum,f,fx,fxpath,flist(9999),i,n,strUrl Set objArgs = WScript.Arguments For I = 0 to objArgs.Count - 1 fpath = objArgs(I) Next Set fs = CreateObject("Scripting.FilesystemObject") Set f = fs.GetFolder(fpath) i = 0 for Each fx in f.Files fxpath = fx.Path ex = fs.GetExtensionName(fxpath) If ucase(ex) = ucase(ex) then Set Flist(i) = fs.GetFile(fxpath) i = i + 1 end if next for n = 0 to i-1 Set fx = Flist(n) Ln=Len(fx.name) dOt = Ln - Instr(1, fx.name, ".", 0) mPs = Ln-InstrRev(fx.name, ".", -1, 1) IF dOt=7 And mPs= 3 Then fx.name = Mid(fx.name, 1,Ln-8) & "." & LCase(Right(fx.name, 3)) End if next strUrl = fpath Set objIE = WScript.CreateObject("InternetExplorer.Application") WScript.Sleep(400) objIE.Width = 720 objIE.Height =480 objIE.FullScreen = False objIE.ToolBar = True objIE.AddressBar = False objIE.MenuBar = False objIE.StatusBar = True objIE.Navigate strUrl objIE.Visible = True
対象ファイルがあるフォルダーごと、このスクリプトファイルへドロップするだけで、２重拡張子を訂正してくれます。

ファイル名の後ろから数えて４文字目と8文字目にドットがあるファイルのみを対象にし、元の拡張子を削除してリネームして、拡張子のみ小文字にしてしまう優れものです。　一応、今回はフォルダーのルートだけ。

名前は適当でいいんですけど、コードをテキストにマルコピした後、「 SUPER用_二重拡張子訂正ツール.vbs 」 とでもしてくださいませ。

あと、いちいちフォルダーポップアップしなくて良い人は、next　から後ろのコードを全てコメントアウトか削除して下さい。

知識のある方は、改変自由ですが、配布はこのサイトからのみ行っていますので、ご注意くださいませ。また、ご使用に関しましては、いつも同様、自己責任で、宜しくですね～。

コメント 1

ぷりん＆りくさま、ヒロさまナイス感謝です。
by グッピー (2010-08-22 20:13)