Urlダウンロード(V)読み上げ <TOP>
Htmlをダウンロードし、フリーソフト(HtoX32c.exe)でTextに変換し、音声合成エンジン体験版(SMARTTALK)を使って読ませています。
※音声合成エンジン体験版(SMARTTALK)は、 下記からダウンロードできます。
http://www.oki.com/jp/Cng/FTP/smart/st3trial.exe
注)ウィルスバスターを使っている場合、インストール時終了させる必要があるようです。
'================================================================ '= Urlダウンロード(V)読み上げ '= (InternetReadFile2.bas) '================================================================ #include "Windows.bi" Type POINTAPI x As Long y As Long End Type Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type ' インターネットのハンドルの作成 Declare Function Api_InternetOpen& Lib "wininet" Alias "InternetOpenA" (ByVal sAgent$, ByVal lAccessType&, ByVal sProxyName$, ByVal sProxyBypass$, ByVal lFlags&) ' Win32インターネット関数のハンドルのクローズ Declare Function Api_InternetCloseHandle% Lib "wininet" Alias "InternetCloseHandle" (ByVal hInet&) ' インターネット上のファイルの読み込み Declare Function Api_InternetReadFile% Lib "wininet" Alias "InternetReadFile" (ByVal hFile&, ByVal sBuffer$, ByVal lNumBytesToRead&, lNumberOfBytesRead&) ' URLのオープン Declare Function Api_InternetOpenUrl& Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession&, ByVal lpszUrl$, ByVal lpszHeaders$, ByVal dwHeadersLength&, ByVal dwFlags&, ByVal dwContext&) ' 指定されたウィンドウの表示状態を設定 Declare Function Api_ShowWindow& Lib "user32" Alias "ShowWindow" (ByVal hWnd&, ByVal nCmdShow&) ' ウィンドウの座標をスクリーン座標系で取得 Declare Function Api_GetWindowRect& Lib "user32" Alias "GetWindowRect" (ByVal hWnd&, lpRect As RECT) ' カーソルの現在のスクリーン座標の取得 Declare Function Api_GetCursorPos& Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) ' 指定の座標位置にあるウィンドウハンドルを取得 Declare Function Api_WindowFromPoint& Lib "user32" Alias "WindowFromPoint" (ByVal xPoint&, ByVal yPoint&) ' ウィンドウのクラス名を取得する関数の宣言 Declare Function Api_GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hWnd&, ByVal lpClassName$, ByVal nMaxCount&) ' 指定された文字列と一致するクラス名とウィンドウ名を持つトップレベルウィンドウ(親を持たないウィンドウ)のハンドルを返す Declare Function Api_FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$) ' ウインドウのタイトル文字列を取得 Declare Function Api_GetWindowText& Lib "user32" Alias "GetWindowTextA" (ByVal hWnd&, ByVal lpString$, ByVal cch&) ' ウィンドウにメッセージを送信。この関数は、指定したウィンドウのウィンドウプロシージャが処理を終了するまで制御を返さない Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any) ' 指定されたウィンドウの位置およびサイズを変更 Declare Function Api_MoveWindow& Lib "user32" Alias "MoveWindow" (ByVal hWnd&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal bRepaint&) ' 指定されたウィンドウ上の点の座標を、クライアント領域の座標からスクリーン座標に変換 Declare Function Api_ClientToScreen& Lib "user32" Alias "ClientToScreen" (ByVal hWnd&, lpPoint As POINTAPI) ' 指定されたクライアント座標を含む子ウインドウのハンドルを返す Declare Function Api_ChildWindowFromPoint& Lib "user32" Alias "ChildWindowFromPoint" (ByVal hWnd&, ByVal xPoint&, ByVal yPoint&) #define USER_AGENT "InternetReadFile Test" 'Header(任意) #define INTERNET_OPEN_TYPE_DIRECT 1 '直接接続 #define INTERNET_OPEN_TYPE_PRECONFIG 0 'IEの設定に従い接続 #define INTERNET_OPEN_TYPE_PROXY 3 'Proxy経由接続 #define INTERNET_FLAG_RELOAD -2147483648 'ローカルのキャッシュを無視し、常にサーバからデータを取得 #define WI_READ_READSIZE 1024 'InternetReadFile で一度に読み込むサイズ #define WI_INITBUFSIZE 32767 ' #define WM_GETTEXT &HD 'コントロールのキャプション・テキストをバッファにコピー #define SW_HIDE 0 '指定のウィンドウを非表示にし他のウィンドウをアクティブ化 #define SW_SHOW 5 'ウィンドウをアクティブ化し現在の位置とサイズで表示 #define WM_Close &H10 'ウィンドウ或いはアプリケーションをクローズされた #define BM_CLICK &HF5 'コマンドボタンをクリックした状態を擬似的に実現 Var Shared Edit(3) As Object Var Shared Text(2) As Object Var Shared Button(6) As Object For i = 0 To 3 Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1))) If i = 1 Then Edit(i).SetFontSize 12 Else Edit(i).SetFontSize 14 Next For i = 0 To 6 Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1))) Button(i).SetFontSize 14 Next For i = 0 To 2 Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1))) Text(i).SetFontSize 14 Next Var Shared URL As String Var Shared FileName As String Var Shared EnginePath As String Var Shared Buff As String Var Shared hFile As Byte Var Shared hWnd As Long Var Shared pt As POINTAPI Declare Sub Html_Dsp edecl () Declare Sub Text_Dsp edecl () Declare Sub Save_File edecl () '================================================================ '= '================================================================ Declare Sub MainForm_Start edecl () Sub MainForm_Start() URL = "https://tokovalue.jp/index_R.htm" '既存のURL FileName = "Default.htm" '既存のフォルダ EnginePath = "C:\Program Files\SMARTTALK\Bin\SMARTALK.EXE" '既知のパス Edit(0).SetWindowText URL Edit(2).SetWindowText FileName Edit(3).SetWindowText EnginePath End Sub '================================================================ '= HTML取得 '================================================================ Declare Sub Button1_on edecl () Sub Button1_on() Var nOpen As Long Var nFile As Long Var Leng As Integer Var ReadSize As Long Var Ret As Long URL = GetDlgItemText("Edit1") FileName = GetDlgItemText("Edit3") Leng = 32767 Buff = Space$(Leng) nOpen = Api_InternetOpen("", INTERNET_OPEN_TYPE_DIRECT, ByVal 0, ByVal 0, 0) nFile = Api_InternetOpenUrl(nOpen, URL, ByVal 0, ByVal 0, INTERNET_FLAG_RELOAD, ByVal 0) Ret = Api_InternetReadFile(nFile, Buff, Leng, ReadSize) Buff = Left$(buff, ReadSize) Ret = Api_InternetCloseHandle(nFile) Ret = Api_InternetCloseHandle(nOpen) Save_File Html_Dsp End Sub '================================================================ '= HTML保存 '================================================================ Sub Save_File() hFile = FreeFile Open FileName For BinIO As hFile If Lof(hFile) <> 0 Then Close hFile Kill FileName Open FileName For BinIO As hFile End If FWrite hFile, Buff Close hFile End Sub '================================================================ '= HTML表示 '================================================================ Sub Html_Dsp() hFile = FreeFile Open FileName For BinInp As hFile Buff = Space$(Lof(hFile)) FRead hFile, Buff Buff = JConv$(Buff, 0, 2) Edit(1).SetWindowText Buff Close hFile End Sub '================================================================ '= HTML → TEXT コンバーター(フリーソフト) '================================================================ Declare Sub Button2_on edecl () Sub Button2_on() Shell "HtoX32c.exe", FileName & " /O0 /F1", 0 Text_DSP End Sub '================================================================ '= テキスト表示・文字列を全選択しクリップボードへ '================================================================ Sub Text_Dsp() On Error Goto *ErrHandler Edit(1).SetWindowText "" FileName = Left$(FileName, Len(FileName) - 3) & "txt" hFile = FreeFile Open FileName For BinInp As hFile If Lof(hFile) <> 0 Then Buff = Space$(Lof(hFile)) FRead hFile, Buff Buff = JConv$(Buff, 0, 2) Edit(1).SetWindowText Buff Close hFile End If Edit(1).SetSelText 0, -1 Edit(1).Copy Wait 10 Edit(1).SetSelText -1, -1 Exit Sub *ErrHandler Resume Next End Sub '================================================================ '= Voiceエンジン起動(既知) '================================================================ Declare Sub Button3_on edecl () Sub Button3_on() Var Rct As RECT Var Ret As Long Shell EnginePath Wait 400 hWnd = Api_FindWindow("ThunderRT5Form", "SMARTTALK") Ret = Api_ShowWindow(hWnd, SW_HIDE) If hWnd <> 0 Then Ret = Api_GetWindowRect(hWnd, Rct) Ret = Api_MoveWindow(hWnd, 0, 0, 348, 253, 1) End If End Sub '================================================================ '= Vエンジン終了 '================================================================ Declare Sub Button4_on edecl () Sub Button4_on() Var Ret As Long Ret = Api_SendMessage(hWnd, WM_CLOSE, 0, 0) End Sub '================================================================ '= StopButtonをクリック '================================================================ Declare Sub Button5_on edecl () Sub Button5_on() Var hStopButton As Long Var Ret As Long pt.x = 20 pt.y = 150 hStopButton = Api_ChildWindowFromPoint(hWnd, pt.x, pt.y) Ret = Api_SendMessage(hStopButton, BM_CLICK, 0, 0) End Sub '================================================================ '= PlayButtonをクリック '================================================================ Declare Sub Button6_on edecl () Sub Button6_on() Var hPlayButton As Long Var Ret As Long pt.x = 100 pt.y = 150 hPlayButton = Api_ChildWindowFromPoint(hWnd, pt.x, pt.y) Ret = Api_SendMessage(hPlayButton, BM_CLICK, 0, 0) End Sub '================================================================ '= PauseButtonをクリック '================================================================ Declare Sub Button7_on edecl () Sub Button7_on() Var hPauseButton As Long Var Ret As Long pt.x = 180 pt.y = 150 hPauseButton = Api_ChildWindowFromPoint(hWnd, pt.x, pt.y) Ret = Api_SendMessage(hPauseButton, BM_CLICK, 0, 0) End Sub '================================================================ '= フォームリサイズ '================================================================ Declare Sub MainForm_Resize edecl () Sub MainForm_Resize() If GetWidth < 550 Or GetHeight < 410 Then SetWindowSize 550, 410 End If Edit(1).SetWindowSize GetWidth - 30, GetHeight - 176 Button(0).MoveWindow GetWidth - 538, GetHeight - 70 Button(1).MoveWindow GetWidth - 464, GetHeight - 70 Button(2).MoveWindow GetWidth - 390, GetHeight - 70 Button(3).MoveWindow GetWidth - 316, GetHeight - 70 Button(4).MoveWindow GetWidth - 242, GetHeight - 70 Button(5).MoveWindow GetWidth - 168, GetHeight - 70 Button(6).MoveWindow GetWidth - 94, GetHeight - 70 End Sub '================================================================ '= フォームリサイズ '================================================================ Declare Sub MainForm_QueryClose edecl () Sub MainForm_QueryClose() Button4_on End End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End