テキスト読み上げソフトで、スレを音声で"聞こう"♪

このエントリーをはてなブックマークに追加
967名無しさん@お腹いっぱい。
>>1
Drag & Drop したテキストファイルを、読み上げてくれるスクリプトを、
WSHとMS-AgentとMicrosoft Text-to-Speech Engine で作ったよ。
当然、スレタイだけでなくて、スレの内容まで読んでくれる。
()とかは、「かっこ」「かっことじ」と変換してから読み上げる。

残念ながら、顔文字やAAの部分はまともに読み上げできない。
英語と日本語の切り替えには、失敗した。

ネットしながら、耳で、2chのログを聞くってのが休日の楽しみ。




968967:2005/06/11(土) 20:09:38 ID:l/AmBzZ8
'text_speech.vbs
'
Option Explicit
Dim Agent1
Dim R 'Agent オブジェクトで使用するオブジェクト変数
Dim objFileSystem
Dim objFile
Dim Text1
Dim FileName

Set Agent1 = CreateObject("Agent.Control.1")
Agent1.Connected=True
Agent1.Characters.Load "Robby","C:\Microsoft\msagent\chars\Robby.acs" '←各人の環境によって変更してください
Set R=Agent1.Characters("Robby")

R.LanguageID=&H0411 '日本語読み上げ
' R.LanguageID=&H0409 '英語読み上げの場合

R.Get "State","Showing,Speaking,Hiding"
R.Show

R.Get "Animation","Greet,GreetReturn"
R.Play "Greet"

Dim objReg
Set objReg = New RegExp
objReg.IgnoreCase = True
objReg.Global = True 'Falseにすると、最初に一致した文字列を見つけると、それ以降の検索は行なわなくなる。
969967:2005/06/11(土) 20:10:57 ID:l/AmBzZ8
Do
FileName = InputBox("Please Input Text File Name.", ,Wscript.Arguments(0)) 'Wscript.Arguements(0)

If FileName = "" Then Exit Do

Set objFileSystem = CreateObject("Scripting.FileSystemObject")

' ┌
If objFileSystem.FileExists(FileName)=False Then
' |
Do
FileName = InputBox("指定したファイルが存在しません。もう一度入力し直してください")
Loop Until objFileSystem.FileExists(FileName) Or FileName=""
' |
End If
' └

If FileName = "" Then Exit Do

Set objFile = objFileSystem.OpenTextFile(FileName)

970967:2005/06/11(土) 20:13:08 ID:l/AmBzZ8
' ┌
Do Until objFile.AtEndOfStream = True
Text1 = objFile.ReadLine
Text1 = Replace (Text1, "(", "、かっこ、")
Text1 = Replace (Text1, ")", "、かっことじ、")

objReg.Global = True
objReg.Pattern = "[-=*_−=*☆★ ̄_]{3}" ' 同じ文字の3個以上の繰り返しを除去
Text1 = objReg.Replace(Text1,"")

objReg.Global = False
objReg.Pattern = "[fh]?t?tp://[\41-\177》]*" 'URLアドレス部は、読み上げない仕様にします。
Text1 = objReg.Replace(Text1,"httpコロン 以下略:")

' |
If Text1<>"" Then R.Speak Text1
' |
Loop
' └
R.LanguageID=&H0411 : R.Speak "以上で、読み上げを終了します。"
objFile.Close

Loop
R.Hide
971967:2005/06/11(土) 20:17:06 ID:l/AmBzZ8
こんな機能つけてほしい、という希望があれば、
ソースを乗っけといたので、各自、書き換えてみて下さい。