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