コードと歌詞の入り混じったテキストのコードを一括移調するスクリプト

次のような歌詞とコードの書いてあるテキストファイルがあった場合に

溝の口太陽族
Bbm  F/C  Db  Bb/D  Ebm  C/E  F

      Bbm          Ebm
ブルース 飛行機雲と河川敷
Ab                    Db        F
多摩川沿いを股にかけたストーリー

次の様に変換してくれます。（希望のキーに上げ下げが出来る）

溝の口太陽族
C#m  G#/D#  E  C#/F  F#m  D#/G  G#

      C#m          F#m
ブルース 飛行機雲と河川敷
B                    E        G#
多摩川沿いを股にかけたストーリー

使い方

1. 以下を拡張子"vbs"をつけて保存したあと、歌詞ファイルをvbsファイルにドラッグアンドドロップする。
2. 移調する半音の数を聞いてくるので、数字を入力。（マイナスも可）
3. 表示を #,♭ どちらに統一するか聞いてくるのでs又はfを入力。

2009.08.23 修正

'<script language="VBScript">
option explicit
dim sh,fso,reg,infile,outfile,lines,line,transpose_value,notes
set sh=createobject("wscript.shell")
set fso=createobject("scripting.filesystemobject")
set reg=new regexp

set infile=fso.opentextfile(wscript.Arguments(0))
set outfile=fso.createtextfile(wscript.Arguments(0) & "_transpose")

transpose_value=cint(inputbox("半音±いくつ？"))
if inputbox("#の場合...s ♭の場合...f を入力")="f" then
	notes=array("C","Db","D","Eb","E","F","Gb","G","Ab","A","Bb","B")
else
	notes=array("C","C#","D","D#","E","F","F#","G","G#","A","A#","B")
end if
lines=split(infile.readall,vbcrlf)

for each line in lines
	output line
next

sub output(line)
	dim words,word,delim
	reg.Global = true
	reg.Pattern="([ 　^]*)([^ 　\n]+)([ 　$]*)"
	set words=reg.Execute(line)
	if words.count > 0 then
		for each word in words
			exec_word word
		next
	end if
	outfile.writeline
end sub

sub exec_word(word)
	dim no,prespace,postspace,chord
	prespace=word.submatches(0)
	postspace=word.submatches(2)
	word=word.submatches(1)
	reg.Global = false
	reg.Pattern="(^[CDEFGAB][b♭#]?)(m)?(M|maj|aug|dim|sus4)?([0-9])?(-[0-9])?(/|[ 　]?on[ 　]?)?([CDEFGAB][b♭#]?)?$"
	Set chord = reg.Execute(word)
	if chord.count > 0 then 'コードが見つかった
		outfile.write prespace
		for no=0 to chord(0).submatches.count-1
			if no=0 or no=6 then '基音 or オンコードのベース
				outfile.write transpose(chord(0).submatches(no))
			else
				outfile.write chord(0).submatches(no)
			end if
		next
		outfile.write postspace
	else
		outfile.write prespace
		outfile.write word'そのまま出力
		outfile.write postspace
	end if
end sub

function transpose(chord)
	dim noteno,one,two
	if len(chord)=0 then transpose="":exit function
	one=left(chord,1)
	two=mid(chord,2)
	select case one
		case "C" noteno=0
		case "D" noteno=2
		case "E" noteno=4
		case "F" noteno=5
		case "G" noteno=7
		case "A" noteno=9
		case "B" noteno=11
	end select
	if two = "#" then noteno=noteno+1
	if two = "b" then noteno=noteno-1
	if two = "♭" then noteno=noteno-1
	noteno = noteno + transpose_value
	if noteno > 11 then noteno=noteno-12
	if noteno < 0 then noteno=12+noteno

	transpose=notes(noteno)
end function

msgbox "end"
'</script>