2015/06/07

ググる翻訳を・・・

・・・PSO2コメントから使えるようにしてみた。


◆ 具体的には、
PSO2コメント → PSO2yomi → 棒読みちゃん → スクリプト → ググる翻訳 → スクリプト → クリップボード
と、いう流れになっていて、設定が済めばPSO2のコメントで 英訳したい場合は >e 和訳したい場合は >j を それぞれ翻訳したいコメントの末尾に添えると機能する。 ◆ スクリプトは後述するとして、先に 棒読みちゃんの設定を説明しておこう。
スクリプト tGoogle.vbe を
 に 置いたと仮定して、 棒読みちゃんの[辞書登録]の・・・
[タグ]タブ内 [正規表現]タブで、以下2つのタグ登録を行う必要がある。


画像で操作対象を説明するとコンなカンジ ▼


■ 日本語を英訳する。
[優先度]
999
[正規表現]
^([^/]+):([^/]+)>E$
[置換後]
(command wscript "C:\Program Files\Okitsunesama\Scripts\tGoogle.vbe" "$2>e") $1:$2
■ 英語を和訳する1 - 末尾に符号使うのは 和文から英文の時と同じ。
[優先度]
999
[正規表現]
^([^/]+):([^/]+)>J$
[置換後]
(command wscript "C:\Program Files\Okitsunesama\Scripts\tGoogle.vbe" "$2>j") $1:$2
■ 英語を和訳する2 - 半角文字のみで構成される文章を ほぼ全て和訳に掛ける用、優先度設定に注意。
■ 除外対象フィルタ1 ▼
[優先度]
1000
[正規表現]
(H|F)T?TPS?://[A-Z0-9+./.%¥&?#$!'()-= ̄_:;]+
[置換後]
URL省略
■ 除外対象フィルタ2 ▼
[優先度]
1
[正規表現]
^([^/]+):\s?(z*|Z*|Zz*|w*|W*)$
[置換後]
$1、$2
■ 処理本体 ▼
[優先度]
0
[正規表現]
^([^/]+):([ -~。-゚]+)$
[置換後]
(command wscript "C:\Program Files\Okitsunesama\Scripts\tGoogle.vbe" "$2>j") $1:$2
  ★ Tips) [置換後]文字列末尾の " $1:$2" の部分を外すと、翻訳した対象を棒読まなく出来ます。
注) コレは 云わずもがな カモだが、

捧読みちゃんの設定画面、[配信者向け機能]-[配信者向け機能を有効にする] と


[タグ]-[タグ機能を有効にする] と


[Command/CommandW(コマンド実行)] - [タグを有効にする] が 全て True になっていないと機能しない。


ぶっちゃけ、上画像3つと同じ設定になっているのが望ましい。
◆ スクリプトに関しては、とりま配布リンクを・・・
■ プレーンテキスト(Shift-JIS)の.vbsファイル
tGoogle_Sources.ZIP
■ エンコード済みファイルのインストーラ
tGoogleInstaller.exe
◆ 2つあったソースを統合して、ついでにログ機能つけました。
'***** ↓↓↓ScriptTitle↓↓↓ ********************************************************* 
    ' PSO2 Comments to GoogleTranslate 
    ' - Created by LazwardFox -  

    ' Update 20150610 175648 - 通知音処理を一旦無効に。 
    ' Update 20150609 051527 - サウンドファイル再生を配置。(Windows設定依存) 
    ' Update 20150609 042700 - 一旦通知ポップアップを無効に。 
    ' Update 20150609 035551 - ログにタイムスタンプを。 
    ' Release 20150609 030104 - tGoogle_l.vbsと統合。 
    ' βRelease 20150607 051239 
    ' αRelease 20150607 042819 - 運用向けにテスト表示系排除。 
    ' Update 20150607 033047 - フラグを冒頭から末尾に移行。 
    ' DevStart 20150607 011852 


'***** ↓↓↓ Memo ↓↓↓ ************************************************************** 



'***** ↓↓↓ConstructDecralations↓↓↓ ********************************************************* 
    Option Explicit

    Const vbWq = """" ' 文字列データに ダブルクォーテーションを利用する為の変数。 
    Const defType = 64 ' Popupメッセージの既定表示指定  

    Const pTitle = "Translated"
    Const strUrl = "https://translate.google.co.jp/?q="
    Const strTagID = "result_box"

    Const strLogFile = "Translated.log" 'ファイル名だけ指定で Mydocumentフォルダ直下に 

    Dim vbWCrLf
    vbWCrLf = vbCrLf & vbCrLf


'***** ↓↓↓ ObjectDecralations ↓↓↓ ************************************************* 

    Dim My, MySh, Parameters, xmlHTTP, Fs, objSMTP, objMx ', objADO 
    Public objIE

    Set My = WScript
    With My
        Set Parameters = .Arguments 'パラメーター取得 
        If Parameters.Count <= 0 Then 'パラメータなし起動の無効化 誤操作による起動を防止 
            Parameters = Array(InputBox ( _
                "TrenslateStrings" & vbWCrLf & "英訳したい文字列>e" & vbCrLf & "  or" &_
                vbCrLf & "String you want to Japanese translation>j", pTitle))
            If Parameters(0) = "" Then
                .Quit
            End If
        End If
        Set MySh = .CreateObject("WScript.Shell")
        Set xmlHTTP = .CreateObject("Msxml2.ServerxmlHTTP.6.0") ' 20141205 130226 
        Set Fs = .CreateObject("Scripting.FileSystemObject") 'ファイル制御 
        Set objMx = .CreateObject("MSXML2.xmlHTTP") ' URL Check  
        Set objIE = .CreateObject("InternetExplorer.Application")
    End With



'***** ↓↓↓AuthDecralations↓↓↓ ********************************************************* 


'***** ↓↓↓ValiableConstDecralations↓↓↓ *********************************************************  
    Public sRoot, UserProf, fnDocuments
    UserProf = MySh.ExpandEnvironmentStrings("%UserProfile%")
    fnDocuments = Fs.BuildPath(UserProf, "Documents")


'***** ↓↓↓PublicDecralations↓↓↓ ********************************************************* 
    'Public pTitle 


'***** ↓↓↓Decralations↓↓↓ ********************************************************* 
    Dim flgTr, strFlg, strSource, encSource, encURL, strResult



' ------------------------------------------------------- 
' ------------------------------------------------------- 

'***** ↓↓↓MainRoutine↓↓↓ ********************************************************* 
    On Error Resume Next

    flgTr = Array("","")
    strFlg = Right(Trim(Parameters(0)), 2)

    If LCase(strFlg) =">j" Then
        flgTr = Array("#en/ja/", strFlg)
    ElseIf LCase(strFlg) = ">e" Then
        flgTr = Array("#ja/en/", strFlg)
    End If

    If flgTr(0) = "" Then
        flgTr(0) = 16
        strResult = "Nothing - FlagKeys"
    Else
        strSource = Replace(Parameters(0), flgTr(1), "")
        If LCase(flgTr(1)) = ">e" Then
            encSource = sEncoder(strSource, "shift_jis", "utf-8")
        Else
            encSource = Replace(LCase(strSource), " ", "%20")
        End If
        encURL = strUrl & encSource & flgTr(0) & encSource
        If nSightLoader(encURL, strTagID, strResult) Then
            flgTr(0) = 64
        Else
            flgTr(0) = 16
            strResult = "Can't Connect - GoogleTranslate"
        End If
    End If
    
    'Regexの代わり  
    strResult = Replace(strResult,"<span class=" & vbWq & "hps" & vbWq & ">","")
    strResult = Replace(strResult,"<span class=" & vbWq & "atn" & vbWq & ">","")
    strResult = Replace(strResult,"<span class=" & vbWq & "hps atn" & vbWq & ">","")
    strResult = Replace(strResult,"<span>","")
    strResult = Replace(strResult,"</span>","")

    ClipSet strResult ' クリップボードへ格納。 
    'MySh.Popup strResult, 2, pTitle, flgTr(0) ' 通知音用ポップアップ、2secで消える。 
    'MySh.Run vbWq & "c:\windows\media\windows ding.wav" & vbWq, 0, False 
    sLog strLogFile, strResult ' ログファイルへ追記。 
    MyQuit


' ------------------------------------------------------- 
' ------------------------------------------------------- 

'***** ↓↓↓ CreatingFunctions ↓↓↓ ********************************************************* 


'***** ↓↓↓ LimitedFunctions ↓↓↓ ********************************************************* 


'***** ↓↓↓ GlobalFunctions ↓↓↓ ********************************************************* 

    '------------------------------------ 
    ' sLog - ログ(ローカルテキストファイル)への書き込み。 
    ' - Created by LazwardFox -  
    
        ' My, Fs 

        ' Update 20150609 035053 - タイムスタンプ憑きに。 
        ' Release 20150609 033103 - Logファイルの位置を自動判定に。 
        ' Update 20150609 032021 - おきつね仕様から 簡易ロガーに書き換え。 
        ' βRelease 20150609 013300 
        ' DevStart 20150609 010718  


    Function sLog(fnLog, trStrings)
        Dim tgtLog, objTxt
        If InStr(fnLog, "\") <=0 Then
            tgtLog = Fs.BuildPath(fnDocuments, fnLog)
        End If
        Set objTxt = Fs.OpenTextFile(tgtLog, 8, True)
        My.Sleep 200
        objTxt.Write CStr(Now()) & vbTab & trStrings & vbCrLf
        objTxt.Close
        Set objTxt = Nothing
    End Function


    '------------------------------------ 
    ' ClipSet - クリップボードへ文字列を代入。(コマンドプロンプト版) 
    ' - Created by LazwardFox -  
    
        ' MySh 

        ' Update  
        ' Release  
        ' Update  
        ' βRelease 20150608 112249 
        ' DevStart 20150608 110745 

    Function ClipSet(strTarget)

        Dim exClips
        exClips = "cmd /c " & vbWq & "echo " & strTarget & "| clip" & vbWq
        MySh.Run exClips, 0, False
        My.Sleep 300

    End Function


    '------------------------------------ 
    ' MyQuit - 終了処理  
    ' - Created by LazwardFox -  
    
        ' MySh 

        ' Update  
        ' Release  
        ' Update  
        ' βRelease 20120914 085236 
        ' DevStart 20120914  

    Function MyQuit()
        Set objIE = Nothing
        Set objMx = Nothing
        Set xmlHTTP = Nothing
        Set Fs = Nothing
        Set MySh = Nothing
        My.Quit
    End Function


    ' X3FManeger (fCopy) 
    '------------------------------------ 
    ' uWaitS 
    ' 指定時間の間、ネットワークの接続を待つ。 
    ' - Created by LazwardFox - 
    
        ' My, Fs, URLExist  

        ' Update  
        ' Release 20120731 20120731 - fWaitS からの改変。 
        ' Update 20091105 0228  
        ' βRelease 20091104 2357  
        ' Update 20091104 2342 nWaitMinute誤代入に対応。 
        ' DevStart 20091101 0155  

        ' シンプル版、 エラーチェックは最小限  
        ' uWaitS - TargetFolderに文字列以外代入/タイムアウト で、Falseを返す。 
        '        (  
        '         TargetURL - 接続待機対象、対象サイトのURLを文字列で指定    (必須)  
        '        ,{strWaitMinute} - 指定しないと延々接続を待つ(ウソ)    (省略時 - 30min)  
        '                           整数で待機時間(分)を指定  
        '        )  

    Function uWaitS(strTargetURL, nWaitMinute) ', Result) 
        Dim iResult
        uWaitS = (VarType(strTargetURL) = 8) ' 文字列以外拒否  
        If uWaitS Then 
            Dim wTime, qTime
            If VarType(nWaitMinute) <> 2 Then ' 整数以外訂正  
                nWaitMinute = 30
            End If
            wTime = 5000 ' 5sec  
            qTime = Now() + TimeSerial(0, nWaitMinute, 0) ' 未検出自動終了時間  
            iResult = True
            Do Until URLExist(strTargetURL) 'Fs.FolderExists(TargetFolder) 
                My.Sleep wTime
                If Now() > qTime Then ' タイムアウト  
                    iResult = False
                    Exit Do
                End If
            Loop
            uWaitS = iResult
        End If
    End Function


    'from fCopy  
    '------------------------------------ 
    ' URLExist - 指定URLの存在を確認する。 
    ' - Created by LazwardFox - 

        ' objMx  

        ' Update 20090---- ---- 
        ' Release 200900717 1445 

    Function URLExist(TargetURL)
        On Error Resume Next
        Dim exMx
        Set exMx = objMx
        With exMx
            .open "GET", TargetURL, False
            .send
            My.Sleep 600
            If .Status = 12007 Then
                URLExist = False
            Else
                URLExist = True
            End If
        End With
        Set exMx = Nothing
    End Function


    '------------------------------------ 
    ' nSightLoader - 指定URLのサイトを変数に格納する。 
    ' - Created by LazwardFox -  

        ' Update  
        ' Release 20141024 125639  
        ' DevStart 20141024 110326  

        ' strID未指定で InnerText取得動作。 

    Function nSightLoader(strURL, strID, Result)

        If uWaitS(strURL, 15) Then

            'Dim objIE 

            ' サイト取得  
            'Set objIE = CreateObject("InternetExplorer.Application") 
            With objIE
                .Width = 800
                .Height = 600
                .Left = 0
                .Top = 0
                .Visible = False
                .Navigate strURL
                Do Until .Busy = False
                    My.Sleep 250
                Loop
                .Refresh
                Do Until .Busy = False
                    My.Sleep 250
                Loop
                WIth .Document
                    If strID = "" Then
                        Result = .Body.InnerText
                    Else
                        Result = .getElementById(strID).InnerHTML
                    End If
                End With
                .Quit
            End With
            'Set objIE = Nothing 

            nSightLoader = True

        Else

            nSightLoader = False

        End If
            
    End Function


    '------------------------------------ 
    ' sEncoder - SimpleEncoder 
    ' - Created by LazwardFox -  

        ' Update 20150607 015256 - 
        ' Release 20141024 125708  
        ' DevStart 20141024 112813  

    Function sEncoder(Source, strFrom, strTo)
        Dim objFrom, objTo, iResult

        If strFrom = "" Then
            strFrom = "shift_jis"
        End If
        If strTo = "" Then
            strTo = "utf-8"
        End If

        Set objFrom = My.CreateObject("ADODB.Stream")
        Set objTo = My.CreateObject("ADODB.Stream")

        With objTo
            .Open
            .Charset = strTo
        End With

        With objFrom
            .Open
            .Charset = strFrom
            .WriteText Source
            .Position = 0
            .CopyTo objTo
            .Close
        End With
        Set objFrom = nothing

        With objTo
            .Position = 0
            iResult = .ReadText
            .Close
        End With
        Set objTo = nothing

        sEncoder = iResult
        iResult = ""

    End Function
◆ 因みに、おきつね仕様はコレと違っていて、
・棒読みを実行している2ndマシンにログを
・PSOをプレイしている1stマシンには1行のテキストファイルを
それぞれ書き込む様に構成してあったりします。 1stマシン側では、そのファイルを Folders で監視させ、更新検出で その内容をクリップボードに取り込むスクリプトを実行させるコトで、リモート対応してます(^_^)

0 件のコメント:

コメントを投稿