どーもボキです。
RadioGroupBoxやMessgeDlgを応用したTextBox。
 ↓

利用時の注意 ONCLICKをonlickと変換すること。 Option Explicit
msgbox TextBox("タイトル","キャプション","文字A" &vbTAB& ":" &vbCRLF & "文字B" &vbTAB& ":" & vbCRLF& "文字C" &vbTAB& ":") '----------------------------------------------------------------------------------------- ' sTitle : タイトル ' sCaption : メッセージ ' sText : 表示するテキスト Function TextBox(sTitle, sCaption, sText) Const cRegName = "HKCU\Software\Microsoft\Internet Explorer\LinksExplorer\Docked" Dim objWS,objIE,ieDoc Dim i,s,r,ireg,html ' レジストリ修正 > エクスプローラバーを非表示 On Error Resume Next ' Dockedなし Set objWS = CreateObject("WScript.Shell") ireg = objWS.RegRead(cRegName) objWS.RegWrite cRegName, 0, "REG_DWORD" On Error GoTo 0 'エラー無視を解除 ' IEを起動 Set objIE = WScript.CreateObject("InternetExplorer.Application") objIE.Navigate "about:blank" ' タグ記述 html = "<BODY><TABLE ID=Tbl BORDER=0>" &_ "<TR><TD ALIGN=Left VALIGN=Top><SPAN>" & Replace(sCaption,vbCRLF,"<BR>") & "<BR><BR></SPAN>" & _ "<FORM NAME=Form>" & _ "<INPUT TYPE=HIDDEN NAME=Button VALUE=-1><textarea name=text rows=16 cols=64>"&sText&"</textarea>" & _ "<BR></TD></TR><TR><TD ALIGN=Center VALIGN=Bottom>"&_ "<INPUT TYPE=BUTTON VALUE="" OK "" ONCLICK=Form.Button.value="& vbOK &"> " & _ "<INPUT TYPE=BUTTON VALUE=""キャンセル"" ONCLICK=Form.Button.value="& vbCancel &">" & _ "</TD></TR></FORM></TABLE></BODY>" ' ↓↓共通↓↓ Set ieDoc = objIE.Document ieDoc.Body.InnerHtml = html ieDoc.Title = sTitle objIE.ToolBar = False ' 上ツールバーを隠す(AddressBar,MenuBarも非表示となる) objIE.StatusBar = False ' ステータスバーを隠す ieDoc.Body.RuntimeStyle.OverflowX = "hidden" ' 横 スクロールバーを隠す ieDoc.Body.RuntimeStyle.OverflowY = "hidden" ' 縦 〃 objIE.Width = ieDoc.All.Tbl.clientWidth +50 ' 幅 サイズ調整 objIE.Height = ieDoc.All.Tbl.clientHeight +70 ' 高 〃 objIE.Left = Int((ieDoc.parentWindow.screen.availwidth -objIE.Width )/2) ' 左 位置調整 objIE.Top = Int((ieDoc.parentWindow.screen.availheight-objIE.Height)/2) ' 上 〃 For i = 0 To objIE.Width ieDoc.Title = ieDoc.Title +" " ' - Microsoft Internet Explorerを隠す i = i +10 Next ieDoc.Body.bgcolor = "ButtonFace" ' 色 objIE.Visible = True ' ウィンドウ表示 objIE.Resizable = False ' ウィンドウサイズ固定 ※表示前に実行すると縁にゴミ画像が残る ' ユーザ操作取得 On Error Resume Next ' エラー無視 ([×]終了対応) r = -1 Do While r = -1 WScript.Sleep 100 r = CInt(ieDoc.Form.Button.value) If objIE = Null Then Exit Do Loop objIE.Visible = False ' ↑↑共通↑↑ ' 値取得 If r = vbOK Then r = ieDoc.Form.text.value Else r = "" End If objIE.Quit Set objIE = Nothing ' レジストリ修正 > エクスプローラバーを元設定に戻す objWS.RegWrite cRegName, ireg, "REG_DWORD" On Error GoTo 0 'エラー無視を解除 TextBox = r End Function
どーもボキです。
MessageDlgの改良点
改良点
・サイドバー表示が有効な場合、関数内にて一時的にそれを無効とし、終了時に有効に戻すようにした。 ・GetResolution関数の利用を廃止。
 ↓
 利用時の注意 ONCLICKをonlickと変換すること。
Option Explicit
MsgBox MessageDlg("タイトル","キャプション" &vbCRLF& "01234567890123456789012345678901234567890123456789","Button0,Button1,Button2") '----------------------------------------------------------------------------------------- ' sTitle : タイトル ' sCaption : メッセージ ' Items : アイテムリスト ' Index : デフォルト選択するアイテムインデックス Function MessageDlg(sTitle, sCaption, Items) Const cRegName = "HKCU\Software\Microsoft\Internet Explorer\LinksExplorer\Docked" Dim objWS,objIE,ieDoc Dim i,s,r,ireg,html
' レジストリ修正 > エクスプローラバーを非表示 On Error Resume Next ' Dockedなし Set objWS = CreateObject("WScript.Shell") ireg = objWS.RegRead(cRegName) objWS.RegWrite cRegName, 0, "REG_DWORD" On Error GoTo 0 'エラー無視を解除 If Not IsArray(Items) Then Items = Split(Items,",") ' IEを起動 Set objIE = WScript.CreateObject("InternetExplorer.Application") objIE.Navigate "about:blank" ' タグ記述 html = "<BODY><TABLE ID=Tbl BORDER=0 STYLE=font-size:10pt>" &_ "<TR><TD ALIGN=Left VALIGN=Top><SPAN>" & Replace(sCaption,vbCRLF,"<BR>") & "<BR><BR><SPAN>" & _ "<FORM NAME=Form>" & _ "<INPUT TYPE=HIDDEN NAME=Button VALUE=-1>" &_ "</TD></TR><TR><TD ALIGN=Center VALIGN=Center>" ' ボタン html = html & "<INPUT TYPE=BUTTON VALUE=" & Items(0) & " ONCLICK=Form.Button.value=0>" For i = 1 To UBound(Items) html = html & " <INPUT TYPE=BUTTON VALUE=" & Items(i) & " ONCLICK=Form.Button.value=" & i & ">" Next html = html & "</TD></TR></FORM></TABLE></BODY>" ' ↓↓共通↓↓ Set ieDoc = objIE.Document ieDoc.Body.InnerHtml = html ieDoc.Title = sTitle objIE.ToolBar = False ' 上ツールバーを隠す(AddressBar,MenuBarも非表示となる) objIE.StatusBar = False ' ステータスバーを隠す ieDoc.Body.RuntimeStyle.OverflowX = "hidden" ' 横 スクロールバーを隠す ieDoc.Body.RuntimeStyle.OverflowY = "hidden" ' 縦 〃 objIE.Width = ieDoc.All.Tbl.clientWidth +50 ' 幅 サイズ調整 objIE.Height = ieDoc.All.Tbl.clientHeight +70 ' 高 〃 objIE.Left = Int((ieDoc.parentWindow.screen.availwidth -objIE.Width )/2) ' 左 位置調整 objIE.Top = Int((ieDoc.parentWindow.screen.availheight-objIE.Height)/2) ' 上 〃 For i = 0 To objIE.Width ieDoc.Title = ieDoc.Title +" " ' - Microsoft Internet Explorerを隠す i = i +10 Next ieDoc.Body.bgcolor = "ButtonFace" ' 色 objIE.Visible = True ' ウィンドウ表示 objIE.Resizable = False ' ウィンドウサイズ固定 ※表示前に実行すると縁にゴミ画像が残る ' ユーザ操作取得 On Error Resume Next ' エラー無視 ([×]終了対応) r = -1 Do While r = -1 WScript.Sleep 100 r = CInt(ieDoc.Form.Button.value) If objIE = Null Then Exit Do Loop objIE.Visible = False ' ↑↑共通↑↑ objIE.Quit Set objIE = Nothing ' レジストリ修正 > エクスプローラバーを元設定に戻す objWS.RegWrite cRegName, ireg, "REG_DWORD" On Error GoTo 0 'エラー無視を解除 MessageDlg = r End Function
[VBScript] メッセージダイアログを実現する
どーもボキです。
RadioGroupBoxの改良版です。
改良点
・サイドバー表示が有効な場合、関数内にて一時的にそれを無効とし、終了時に有効に戻すようにした。 ・GetResolution関数の利用を廃止。
 ↓
 利用時の注意 ONCLICKをonlickと変換すること。 Option Explicit
Const RadioGroupBox_MaxCount = 10 MsgBox RadioGroupBox("タイトル","キャプション" &vbCRLF&"01234567890123456789012345678901234567890123456789","アイテム0,アイテム1,アイテム2",1) '----------------------------------------------------------------------------------------- ' sTitle : タイトル ' sCaption : メッセージ ' Items : アイテムリスト ' Index : デフォルト選択するアイテムインデックス Function RadioGroupBox(sTitle, sCaption, Items, Index) Const cRegName = "HKCU\Software\Microsoft\Internet Explorer\LinksExplorer\Docked" Dim objWS,objIE,ieDoc Dim i,s,r,ireg,html,bCmbBx ' レジストリ修正 > エクスプローラバーを非表示 On Error Resume Next ' Dockedなし Set objWS = CreateObject("WScript.Shell") ireg = objWS.RegRead(cRegName) objWS.RegWrite cRegName, 0, "REG_DWORD" On Error GoTo 0 'エラー無視を解除 If Not IsArray(Items) Then Items = Split(Items,",") ' IEを起動 Set objIE = WScript.CreateObject("InternetExplorer.Application") objIE.Navigate "about:blank" ' タグ記述 html = "<BODY><TABLE ID=Tbl BORDER=0 STYLE=font-size:10pt>" &_ "<TR><TD ALIGN=Left VALIGN=Top><SPAN>" & Replace(sCaption,vbCRLF,"<BR>") & "<BR><BR></SPAN>" & _ "<FORM NAME=Form>" & _ "<INPUT TYPE=HIDDEN NAME=Button VALUE=-1>" bCmbBx = UBound(Items) >= RadioGroupBox_MaxCount-1 If bCmbBx Then ' コンボボックス html = html +"<SELECT NAME=ComboBox size=" & RadioGroupBox_MaxCount &" style=width:100%>" For i = 0 To UBound(Items) If i = Index Then s = " selected" Else s = "" html = html +"<OPTION value=" & i & s & ">" & Items(i) &"</OPTION>" Next s = s+"</SELECT>" Else ' ラジオボタン html = html +"<INPUT NAME=Radio TYPE=HIDDEN VALUE="& Index & ">" For i = 0 to UBound(Items) If i = Index Then s = " checked" Else s = "" html = html +" <INPUT TYPE=RADIO Name=RG ONCLICK=Radio.value=" & i & s & ">" & Items(i) &"</INPUT><BR>" Next End If html = html +"<BR></TD></TR><TR><TD ALIGN=Center VALIGN=Bottom>"&_ "<INPUT TYPE=BUTTON VALUE="" OK "" ONCLICK=Form.Button.value="& vbOK &"> " & _ "<INPUT TYPE=BUTTON VALUE=""キャンセル"" ONCLICK=Form.Button.value="& vbCancel &">" & _ "</TD></TR></FORM></TABLE></BODY>" ' ↓↓共通↓↓ Set ieDoc = objIE.Document ieDoc.Body.InnerHtml = html ieDoc.Title = sTitle objIE.ToolBar = False ' 上ツールバーを隠す(AddressBar,MenuBarも非表示となる) objIE.StatusBar = False ' ステータスバーを隠す ieDoc.Body.RuntimeStyle.OverflowX = "hidden" ' 横 スクロールバーを隠す ieDoc.Body.RuntimeStyle.OverflowY = "hidden" ' 縦 〃 objIE.Width = ieDoc.All.Tbl.clientWidth +50 ' 幅 サイズ調整 objIE.Height = ieDoc.All.Tbl.clientHeight +70 ' 高 〃 objIE.Left = Int((ieDoc.parentWindow.screen.availwidth -objIE.Width )/2) ' 左 位置調整 objIE.Top = Int((ieDoc.parentWindow.screen.availheight-objIE.Height)/2) ' 上 〃 For i = 0 To objIE.Width ieDoc.Title = ieDoc.Title +" " ' - Microsoft Internet Explorerを隠す i = i +10 Next ieDoc.Body.bgcolor = "ButtonFace" ' 色 objIE.Visible = True ' ウィンドウ表示 objIE.Resizable = False ' ウィンドウサイズ固定 ※表示前に実行すると縁にゴミ画像が残る ' ユーザ操作取得 On Error Resume Next ' エラー無視 ([×]終了対応) r = -1 Do While r = -1 WScript.Sleep 100 r = CInt(ieDoc.Form.Button.value) If objIE = Null Then Exit Do Loop objIE.Visible = False ' ↑↑共通↑↑ ' 値取得 If r = vbOK Then If bCmbBx Then r = ieDoc.Form.ComboBox.selectedIndex Else r = CInt(ieDoc.Form.Radio.value) ' 取得データは文字のため End If Else r = -1 End If objIE.Quit Set objIE = Nothing ' レジストリ修正 > エクスプローラバーを元設定に戻す objWS.RegWrite cRegName, ireg, "REG_DWORD" On Error GoTo 0 'エラー無視を解除 RadioGroupBox = r End Function
[VBScript] ラジオボタンダイアログを実現する その3
どーもボキです。 ニュースで英会話のバックアップでは、記事ごとに再生ボタンの表示高さ(Y座標)が異なり、 クリック位置の記録&調整に苦労した。 mp3を上書き更新とすることで、サイズ≠0で録音の成功を判断させた。 このときファイル名が「yymmdd_記事タイトル」となるため「記事タイトル」を固定できない。 FileExistsや、GetFileは、ファイル名をそのものを指定しければならず、記事タイトルを把握しないかぎり利用できない。 そのため、ワイルドカードを指定できるCopyFileやMoveFileを応用したファイル名取得関数「SearchFile」を作成した。 重複しない名前のフォルダへMoveし、そのMove先のファイル名を取得するようにしている。なお、戻り値は最後に見つかったファイル名としている。 ' 指定したファイル名が存在するか調べる(ワイルドカードOK) ' 戻り値:見つかったファイル名 Function SearchFile(DirectoryPath, FileName) Dim objFS,f,r,dpth r = "" Set objFS = CreateObject("Scripting.FileSystemObject") On Error Resume Next dpth = DirectoryPath & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) objFS.CreateFolder(dpth) ' 重複しないフォルダを作成 objFS.MoveFile DirectoryPath & FileName, dpth &"\" For Each f In objFS.GetFolder(dpth).Files r = f.Name Next objFS.MoveFile dpth &"\"& FileName, DirectoryPath objFS.DeleteFolder dpth On Error GoTo 0 SearchFile = r End Function
どーもボキです。 [VBScript] ニュースで英会話をバックアップするを改良して、新番組である「 世界へ発信!英語術」に対応させた。 必要な準備は、前回の記事を参考に。 UWSCの設定 > 指定ウィンドウ名を「 - 世界へ発信!英語術 - 」へ変更すること。 実行イメージSetScriptHost("CScript")
Set objWS = CreateObject("WScript.Shell") Set objFS = CreateObject("Scripting.FileSystemObject")
' 18.04.01~実行日までをループさせる y0 = 2018 y1 = Year(Now)
If y1 = y0 Then m0 = 4 m1 = Month(Now) Else m0 = 1 m1 = 12 End If
d0 = 1 If m0 = m1 Then d1 = Day(Now) Else d1 = 31 End If
Arr_url = Array("s", "k", "w") Arr_key = Array("_センテンス", "_キーワード", "_ボキャブラリー")
DPath = objWS.SpecialFolders("MyDocuments") &"\" For yyyy = y0 To y1 For mm = m0 To m1 If Len(mm) = 1 Then mm = "0" & mm For dd = d0 To d1: Do If Len(dd) = 1 Then dd = "0" & dd r = -1 On Error Resume Next r = Weekday(yyyy &"/" & mm & "/" & dd) On Error GoTo 0 If (r < vbMonday) Or (r > vbFriday) Then Exit Do ' 保存フォルダ作成 DPath_Save = DPath & Right(yyyy,2) & mm &"\" If Not objFS.FolderExists(DPath_Save) Then objFS.CreateFolder(DPath_Save) ' 保存済みmp3のサイズチェック yymmdd = Right(yyyy,2) & mm & dd fname = SearchFile(DPath_Save, yymmdd & "*.mp3") If fname <> "" Then Set fmp3 = objFS.GetFile(DPath_Save & fname) If fmp3.Size <> 0 Then Exit Do ' 保存済み End If ' 本文テキスト&音声を録音 fname = ProcURL("http://www.nhk.or.jp/snsenglish/news/n"& yymmdd &".html", DPath_Save, "") If fname = "" Then Exit Do ' 放送なし or アンコール放送 ' 残りのテキストを保存 For i = 0 To UBound(Arr_url) fname = SearchFile(DPath_Save, yymmdd & "*" & Arr_key(i) & "*") If fname = "" Then ProcURL "http://www.nhk.or.jp/snsenglish/elearning/" & Arr_url(i) & yymmdd &".html", DPath_Save, fname & Arr_key(i) End If Next Loop Until 1: Next Next Next '=============================================================================== ' URLを開く ' 戻り値:(番組が存在した場合)YYMMDD_タイトル Function ProcURL(URL, FolderPath, PostFix) Dim objWS: Set objWS = CreateObject("WScript.Shell") Dim i,s,key,fname,yymmdd,objIE,ieDoc i = InStr(URL, ".html") yymmdd = Mid(URL, i-6,6) ' yymmddを取得 Do Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate URL Do While objIE.Busy: WScript.Sleep 1000: Loop ' ページ読み込み完了待ち Set ieDoc = objIE.Document s = ieDoc.Title i = InStr(s," - 世界へ発信!英語術 - NHK") -1 If (i < 0) Or (InStr(s,"アンコール放送") > 0) then Exit Do ' ⇒ 終了 fname = yymmdd &"_"& Left(s,i) If PostFix = "" Then dprintf fname ' VoiceRecorderの設定変更 rpth = "HKCU\Software\Moo0\Moo0 VoiceRecorder\SaveData\MainWindow\CreationPath\" key = rpth & "FolderPath" i = objWS.RegWrite(key, FolderPath, "REG_SZ") ' 保存フォルダパス key = rpth & "FileName" i = objWS.RegWrite(key, fname, "REG_SZ") ' 保存ファイル名 ' VoiceRecorder起動 objWS.Run """"& objWS.SpecialFolders("MyDocuments") &"\AudioRecorder 1.46\VoiceRecorder.exe""" WScript.Sleep 1000 objWS.SendKeys "^ " ' Rec Start Do objIE.Visible = True ' 再生(UWSC) WScript.Sleep 10000 objIE.Visible = False r = CreateObject("WScript.Shell").PopUp("finish?",80,"now recording...",vbYesNo) Loop Until (r = vbYes) Or (r = -1) TerminateProcess("VoiceRecorder.exe") End If ' URLをmhtファイルで保存 On Error Resume Next Set objCDO = CreateObject("CDO.Message") objCDO.CreateMHTMLBody(URL) objCDO.BodyPart.GetStream.SaveToFile FolderPath & fname & PostFix & ".mht", 2 Set objCDO = Nothing
Loop Until 1 objIE.Quit Set objIE = Nothing ProcURL = fname End Function '------------------------------------------------------------------------------- ' 指定したファイル名が存在するか調べる(ワイルドカードOK) ' 戻り値:見つかったファイル名 Function SearchFile(DirectoryPath, FileName) Dim objFS,f,r,dpth r = "" Set objFS = CreateObject("Scripting.FileSystemObject") On Error Resume Next dpth = DirectoryPath & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) objFS.CreateFolder(dpth) ' 重複しないフォルダを作成 objFS.MoveFile DirectoryPath & FileName, dpth &"\" For Each f In objFS.GetFolder(dpth).Files r = f.Name Next objFS.MoveFile dpth &"\"& FileName, DirectoryPath objFS.DeleteFolder dpth On Error GoTo 0 SearchFile = r End Function ' ------------------------------------------------------------------------------- ' 指定した名前のプロセスを強制終了する Sub TerminateProcess(ProcessName) Dim objProcList,objProcess
Set objProcList = GetObject("winmgmts:").InstancesOf("win32_process") For Each objProcess In objProcList If LCase(objProcess.Name) = LCase(ProcessName) Then objProcess.Terminate End If Next End Sub ' ------------------------------------------------------------------------------- ' 実行ホストを切り替える Sub SetScriptHost(HostName) Dim i,s If InStr(LCase(WSCript.FullName), LCase(HostName)) <> 0 Then Exit Sub s = HostName & " """ & WScript.ScriptFullName & """" If WScript.Arguments.Count > 0 Then For i = 0 To WScript.Arguments.Count -1 s = s &" """ & WScript.Arguments.Item(i) & """" ' 引数 Next End If CreateObject("WScript.Shell").Run s WScript.Quit End Sub ' ------------------------------------------------------------------------------- ' デバッグ ※ここだけ抜粋してもOK Dim objDbg ' クラス Class TDebug Dim FCScript ' 初期化処理 Private Sub Class_Initialize() FCScript = InStr(LCase(WSCript.FullName), "cscript") > 0 End Sub ' 終了処理 Private Sub Class_Terminate() If Not FCScript Then Exit Sub WScript.StdOut.WriteLine NOW & " [END]" WScript.StdIn.ReadLine End Sub ' CScriptホストかどうか Public Property Get CScript CScript = FCScript End Property ' デバッグメッセージ処理 Public Sub dprintf(v) Dim i,s,ityp If Not FCScript Then Exit Sub s = v ityp = VarType(v) If ityp = vbBoolean Then s = CStr(v) ElseIf VarType(v) >= vbArray Then s = "" For i = 0 to UBound(v) s = s & "dprintf(" &i& ")=" & v(i) & vbCRLF Next End If WScript.Echo s End Sub End Class ' 関数 Sub dprintf(v) If VarType(objDbg) = vbEmpty Then Set objDbg = New TDebug objDbg.dprintf(NOW & " " & WScript.ScriptFullName) End If objDbg.dprintf(v) End Sub ' -------------------------------------------------------------------------------
どーもボキです。 英語学習を始め、 ニュースで英会話の存在を知った。 サイト自体は2009年から存在したようだ。 日々最近のニュースが更新され、1分前後の短い文章がナチュラルスピードで読み上げられ、 センテンスごとの解説も用意されている。TOEICで500点以上を狙う人には最適なサイトと思う。 この ニュースで英会話が、この3月で終了した。 4月末にはサイトも閉鎖される。 こんなに充実したサイトなのにもったいない。 だからバックアップしよう。 スクリプトの実行イメージ
ニュースで英会話の音声はHLS配信(ストリーミング)なので、音声ファイルはダウンロードできない。 ならアナログで対応するしかない。そう、再生される音声を録音する、だ。 キーボード操作ならVBScriptで再現できるが、音声の再生にはマウス操作が必要。なので、以下のフリーソフトを用意する。 ・ Moo0 音声録音機(音声が流れている時間のみを録音するツール) ・ UWSC(マウス操作を記録&再現するツール) Moo0 音声録音機 に必要な設定
※マイドキュメントに保存すること。VBScriptではマイドキュメントにある前提とした。 ・ 無音カット、上書き可にチェック これは、録音を音声再生~終了に同期させるため。上書き不要なファイルを作らせないため。 増幅は、PCによる。音割れするならば100%未満に、録音ボリュームが小さすぎるならば100%より大に。  ・ 設定 > 無音カット - 「無音」認識のボリューム閾値 > 1% これは、センテンス間で録音を止めさせないため。  ・ 設定 > 無音カット - 停止するまでの無音の長さ > 3.0sec
これは、終了部をしっかり残すため。上の設定だけでは終了時の音声が切れてしまうので、これも必要。  ・ 設定 > キーボード・ショートカット > [Ctrl+スペース]:録音開始/終了 これは、VBScriptから Moo0 音声録音機の録音をスタンバイさせるため。 UWSC に必要な設定
※UWSCは起動させておく。 ・ニュースで英会話のサイトにて、音声再生させるマウス位置とクリック操作を記録する。 Alt+F3で記録開始、Alt+F2で記録停止、記録した操作に名前を付けて保存する。 ※操作記録ファイル(.UWS)で必要となるコマンドはBTN()のみ。いったん記録したファイルをテキストエディタで編集するとよい。 以下はマウス左クリック、1040はマウスのX座標、 610~700はY座標、100は実行時の待ち時間[ms]。 以下は、x=1040、y=610~700を10刻みでクリックしていく。実行PCによるので適宜修正を。 BTN(LEFT,CLICK,1040,610,100) BTN(LEFT,CLICK,1040,620,100) BTN(LEFT,CLICK,1040,630,100) BTN(LEFT,CLICK,1040,640,100) BTN(LEFT,CLICK,1040,650,100) BTN(LEFT,CLICK,1040,660,100) BTN(LEFT,CLICK,1040,670,100) BTN(LEFT,CLICK,1040,680,100) BTN(LEFT,CLICK,1040,690,100) BTN(LEFT,CLICK,1040,700,100)
・ 設定 > スケジュールを設定する にて、上のイベントファイルを選択、指定ウィンドウが現れた時 をチェックし、「- ニュースで英会話 -」を指定。 これで、ニュースで英会話のWebが立ち上がると自動でマウスクリックされるようになる。  以上で準備完了。以下のスクリプトを.vbsファイルととて保存し実行する。 正常に動作すれば、マイドキュメントに[yymm」フォルダを作り、そのなかに日々のニュースを「yymmdd_タイトル」で保存していく。 SetScriptHost("CScript")
Set objWS = CreateObject("WScript.Shell") Set objFS = CreateObject("Scripting.FileSystemObject")
DPath = objWS.SpecialFolders("MyDocuments") &"\" For yyyy = 2009 To 2018 m0 = 1 m1 = 12 For mm = m0 To m1 If Len(mm) = 1 Then mm = "0" & mm For dd = 1 To 31: Do If Len(dd) = 1 Then dd = "0" & dd r = -1 On Error Resume Next r = Weekday(yyyy &"/" & mm & "/" & dd) On Error GoTo 0 If (r < vbMonday) Or (r > vbFriday) Then Exit Do ' 保存フォルダ作成 DPath_Save = DPath & Right(yyyy,2) & mm &"\" If Not objFS.FolderExists(DPath_Save) Then objFS.CreateFolder(DPath_Save) yyyymmdd = yyyy & mm & dd ' 保存済みmp3のサイズチェック If yyyymmdd >= "20150401" Then fname = SearchFile(DPath_Save, Right(yyyymmdd,6) & "*.mp3") If fname <> "" Then Set fmp3 = objFS.GetFile(DPath_Save & fname) If fmp3.Size <> 0 Then Exit Do ' 保存済み End If End If fname = ProcURL("https://cgi2.nhk.or.jp/e-news/news/index.cgi?ymd=" & yyyymmdd, DPath_Save, "") If fname = "" Then Exit Do ' 放送なし or アンコール放送 ProcURL "https://cgi2.nhk.or.jp/e-news/elearning/explain.cgi?ymd=" & yyyymmdd & "&type=news", DPath_Save, fname & "_センテンス" ProcURL "https://cgi2.nhk.or.jp/e-news/elearning/explain.cgi?ymd=" & yyyymmdd & "&type=keyword", DPath_Save, fname & "_キーワード" ProcURL "https://cgi2.nhk.or.jp/e-news/news/words.cgi?ymd=" & yyyymmdd, DPath_Save, fname & "_ボキャブラリー" Loop Until 1: Next Next Next '=============================================================================== ' URLを開く ' 戻り値:(番組が存在した場合)YYMMDD_タイトル Function ProcURL(URL, FolderPath, FileName) Dim objWS: Set objWS = CreateObject("WScript.Shell") Dim i,s,key,fname,yymmdd,objIE,ieDoc i = InStr(URL, "ymd") yymmdd = Mid(URL, i+6,6) ' yymmddを取得 Do Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate URL Do While objIE.Busy: WScript.Sleep 1000: Loop ' ページ読み込み完了待ち Set ieDoc = objIE.Document s = ieDoc.Title i = InStr(s," - ニュースで英会話 - NHK") -1 If (i < 0) Or (InStr(s,"アンコール放送") > 0) then Exit Do ' ⇒ 終了 If FileName = "" Then FileName = yymmdd &"_"& Left(s,i) dprintf FileName If yymmdd >= "150401" Then ' VoiceRecorderの設定変更 rpth = "HKCU\Software\Moo0\Moo0 VoiceRecorder\SaveData\MainWindow\CreationPath\" key = rpth & "FolderPath" i = objWS.RegWrite(key, FolderPath, "REG_SZ") ' 保存フォルダパス key = rpth & "FileName" i = objWS.RegWrite(key, FileName, "REG_SZ") ' 保存ファイル名 ' VoiceRecorder起動 objWS.Run """"& objWS.SpecialFolders("MyDocuments") &"\AudioRecorder 1.46\VoiceRecorder.exe""" WScript.Sleep 1000 objWS.SendKeys "^ " ' Rec Start Do objIE.Visible = True ' 再生(UWSC) WScript.Sleep 10000 objIE.Visible = False r = CreateObject("WScript.Shell").PopUp("finish?",80,"now recording...",vbYesNo) Loop Until (r = vbYes) Or (r = -1) TerminateProcess("VoiceRecorder.exe") End If End If ' URLをmhtファイルで保存 On Error Resume Next Set objCDO = CreateObject("CDO.Message") objCDO.CreateMHTMLBody(URL) objCDO.BodyPart.GetStream.SaveToFile FolderPath & FileName & ".mht", 2 Set objCDO = Nothing Loop Until 1 objIE.Quit Set objIE = Nothing ProcURL = FileName End Function '------------------------------------------------------------------------------- ' 指定したファイル名が存在するか調べる(ワイルドカードOK) ' 戻り値:見つかったファイル名 Function SearchFile(DirectoryPath, FileName) Dim objFS,f,r,dpth r = "" Set objFS = CreateObject("Scripting.FileSystemObject") On Error Resume Next dpth = DirectoryPath & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) objFS.CreateFolder(dpth) ' 重複しないフォルダを作成 objFS.MoveFile DirectoryPath & FileName, dpth &"\" For Each f In objFS.GetFolder(dpth).Files r = f.Name Next objFS.MoveFile dpth &"\"& FileName, DirectoryPath objFS.DeleteFolder dpth On Error GoTo 0 SearchFile = r End Function ' ------------------------------------------------------------------------------- ' 指定した名前のプロセスを強制終了する Sub TerminateProcess(ProcessName) Dim objProcList,objProcess
Set objProcList = GetObject("winmgmts:").InstancesOf("win32_process") For Each objProcess In objProcList If LCase(objProcess.Name) = LCase(ProcessName) Then objProcess.Terminate End If Next End Sub ' ------------------------------------------------------------------------------- ' 実行ホストを切り替える Sub SetScriptHost(HostName) Dim i,s If InStr(LCase(WSCript.FullName), LCase(HostName)) <> 0 Then Exit Sub s = HostName & " """ & WScript.ScriptFullName & """" If WScript.Arguments.Count > 0 Then For i = 0 To WScript.Arguments.Count -1 s = s &" """ & WScript.Arguments.Item(i) & """" ' 引数 Next End If CreateObject("WScript.Shell").Run s WScript.Quit End Sub ' ------------------------------------------------------------------------------- ' デバッグ ※ここだけ抜粋してもOK Dim objDbg ' クラス Class TDebug Dim FCScript ' 初期化処理 Private Sub Class_Initialize() FCScript = InStr(LCase(WSCript.FullName), "cscript") > 0 End Sub ' 終了処理 Private Sub Class_Terminate() If Not FCScript Then Exit Sub WScript.StdOut.WriteLine NOW & " [END]" WScript.StdIn.ReadLine End Sub ' CScriptホストかどうか Public Property Get CScript CScript = FCScript End Property ' デバッグメッセージ処理 Public Sub dprintf(v) Dim i,s,ityp If Not FCScript Then Exit Sub s = v ityp = VarType(v) If ityp = vbBoolean Then s = CStr(v) ElseIf VarType(v) >= vbArray Then s = "" For i = 0 to UBound(v) s = s & "dprintf(" &i& ")=" & v(i) & vbCRLF Next End If WScript.Echo s End Sub End Class ' 関数 Sub dprintf(v) If VarType(objDbg) = vbEmpty Then Set objDbg = New TDebug objDbg.dprintf(NOW & " " & WScript.ScriptFullName) End If objDbg.dprintf(v) End Sub ' -------------------------------------------------------------------------------'
どーもボキです。 フォルダ内にあるCSVファイルをひとつのExcelファイルにまとめるスクリプト。 CSVファイルごとにシートを分けるようにしている。 エキサイトブログには.openが記述できなかったので全角で記述した。 全角のOPENを半角へ変えること。 使い方は簡単、CSVファイルを保存したフォルダをVBSファイルにドロップするだけ。 フォルダ名.xlsx(拡張しは、実行PCのExcelバージョンによる)が作成される。 なお、CSVファイル名をそのままシート名にするため、 CSVファイル名が半角 31 文字 or 全角は 15 文字を超えていた場合、エラーとなる。 Set objWS = CreateObject("WScript.Shell") Set objFS = CreateObject("Scripting.FileSystemObject")
' 引数なし If WScript.Arguments.Count = 0 Then WScript.Quit
SetScriptHost("CScript") ' ドロップだとWScriptとなるためCScriptで再起動
For i = 0 To WScript.Arguments.Count -1: Do s = WScript.Arguments.Item(i) If objFS.FolderExists(s) Then ProcFolder(s) End If Loop Until 1: Next
r = CreateObject("WScript.Shell").PopUp("処理が終了しました。",3,cTitle,64) '================================================================================' Function ProcFolder(DPath) Dim i,r,s,b_init,objFolder,objExcel,xlBook,xlSheet
dprintf(DPath) Set objExcel = CreateObject("Excel.Application") objExcel.Application.DisplayAlerts = False ' 警告OFF 'objExcel.Application.Visible = True ' Excel非表示 objExcel.Workbooks.Add ' ブックの新規作成
' フォルダ内のファイル分ループ b_init = True Set objFolder = objFS.GetFolder(DPath) For Each File In objFolder.Files: Do If InStr(LCase(File.Path), LCase(".csv")) = 0 Then Exit Do ' .csv以外は処理しない dprintf(vbTab & File.Name) Set xlBook = objExcel.Workbooks.Open(File.Path) ' ファイルを開く Set xlSheet = xlBook.Worksheets(1) ' シートを格納 s = objFS.GetFileName(File.Path) ' ファイル名 xlSheet.Name = Left(s, InStrRev(s,".")-1) ' ファイルタイトルをシート名 r = xlSheet.Move(,objExcel.Workbooks(1).Sheets( objExcel.Workbooks(1).Sheets.Count )) ' 最後に追加 If b_init Then ' 新規作成で生成されるSheet1~3を削除(Excelバージョンによる) While objExcel.Workbooks(1).Sheets.Count > 1 objExcel.WorkBooks(1).Sheets(1).Delete WEnd b_init = False End If
'objExcel.Workbooks(1).WorkSheets(1).Select ' 先頭シートを最前面へ Loop Until 1: Next ' 解析結果を保存 objExcel.Workbooks(1).SaveAs(objFolder.Path) objExcel.Quit Set objExcel = Nothing ' オブジェクト開放 ※これをしないとExcelプロセスが残る End Function ' ------------------------------------------------------------------------------- ' デバッグ ※ここだけ抜粋してもOK Dim objDbg ' クラス Class TDebug Dim FCScript ' 初期化処理 Private Sub Class_Initialize() FCScript = InStr(LCase(WSCript.FullName), "cscript") > 0 End Sub ' 終了処理 Private Sub Class_Terminate() If Not FCScript Then Exit Sub WScript.StdOut.WriteLine WScript.ScriptFullName & " [END]" WScript.StdIn.ReadLine End Sub ' デバッグメッセージ処理 Public Sub dprintf(v) Dim i,s,ityp If Not FCScript Then Exit Sub s = v ityp = VarType(v) If ityp = vbBoolean Then s = CStr(v) ElseIf VarType(v) >= vbArray Then s = "" For i = 0 to UBound(v) s = s & "dprintf(" &i& ")=" & v(i) & vbCRLF Next End If WScript.Echo s End Sub End Class ' 関数 Sub dprintf(v) If VarType(objDbg) = vbEmpty Then Set objDbg = New TDebug objDbg.dprintf(v) End Sub ' ------------------------------------------------------------------------------- ' 実行ホストを切り替える Sub SetScriptHost(HostName) If InStr(LCase(WSCript.FullName), LCase(HostName)) <> 0 Then Exit Sub s = HostName & " """ & WScript.ScriptFullName & """" If WScript.Arguments.Count > 0 Then For i = 0 To WScript.Arguments.Count -1 s = s &" """ & WScript.Arguments.Item(i) & """" Next End If CreateObject("WScript.Shell").Run s WScript.Quit End Sub
どーもボキです。 AdjustStringは ・半角カナ → 全角カナ ・全角記号 → 半角記号 ・全角英数 → 半角数字 と変換する関数。 半角カナは、濁点(゛)や半濁点(゜)が別の文字となる、つまり、次の文字まで読まないと文字を確定できない。 そのため、今回はひとつの関数内で変換元の文字管理と変換処理を行った。 全角と半角とで文字の並びが統一されていなかったため、Case文処理が必須だったものの、可能な限り定型処理化した。  SetScriptHost("cscript")
s = "どーもボキです" dprintf " 前:" & s dprintf " 後:" & AdjustString(s) dprintf ""
s = "http://yozda.exblog.jp" dprintf " 前:" & s dprintf " 後:" & AdjustString(s) dprintf ""
s = "2004/05~" dprintf " 前:" & s dprintf " 後:" & AdjustString(s) dprintf ""
' =============================================================================== ' 全角→半角 Function AdjustString(iStr) Dim i,a1,a0,r,s,s0,s1
i = 1 r = "" Do While i <= Len(iStr) a1 = 1 a0 = 0 s0 = "" s = Mid(iStr, i, 1) r = s If ( Asc(s) >= Asc("。") ) And ( Asc(s) <= Asc("゚") ) Then ' 半角カナ → 全角 Select Case s Case "。" r = "。" Case "ヲ" r = "ヲ" Case "ッ" r = "ッ" Case "ー" r = "ー" Case Else If Asc(s) >= Asc("゙") Then s0="゙": s1="゛": a1=1 ElseIf Asc(s) >= Asc("ワ") Then s0="ワ": s1="ワ": a1=4 ElseIf Asc(s) >= Asc("ラ") Then s0="ラ": s1="ラ": a1=1 ElseIf Asc(s) >= Asc("ヤ") Then s0="ヤ": s1="ヤ": a1=2 ElseIf Asc(s) >= Asc("ム") Then s0="ム": s1="ム": a1=1 ElseIf Asc(s) >= Asc("マ") Then s0="マ": s1="マ": a1=1 ElseIf Asc(s) >= Asc("ハ") Then s0="ハ": s1="ハ": a1=3 If Mid(iStr, i+1, 1) = "゙" Then a0=1 If Mid(iStr, i+1, 1) = "゚" Then a0=2 ElseIf Asc(s) >= Asc("ナ") Then s0="ナ": s1="ナ": a1=1 ElseIf Asc(s) >= Asc("ツ") Then s0="ツ": s1="ツ": a1=2 If Mid(iStr, i+1, 1) = "゙" Then a0=1 ElseIf Asc(s) >= Asc("タ") Then s0="タ": s1="タ": a1=2 If Mid(iStr, i+1, 1) = "゙" Then a0=1 ElseIf Asc(s) >= Asc("カ") Then s0="カ": s1="カ": a1=2 If Mid(iStr, i+1, 1) = "゙" Then a0=1 ElseIf Asc(s) >= Asc("ア") Then s0="ア": s1="ア": a1=2 ElseIf Asc(s) >= Asc("ャ") Then s0="ャ": s1="ャ": a1=2 ElseIf Asc(s) >= Asc("ァ") Then s0="ァ": s1="ァ": a1=2 ElseIf Asc(s) >= Asc("、") Then s0="、": s1="、": a1=4 ElseIf Asc(s) >= Asc("「") Then s0="「": s1="「": a1=1 End If End Select ElseIf ( Asc(s) >= Asc(" ") ) And ( Asc(s) <= Asc("z") ) Then ' 全角記号&英数 → 半角 Select Case s Case " " r=" " Case "," r="," Case "." r="." Case ":" r=":" Case ";" r=";" Case "?" r="?" Case "!" r="!" Case "^" r="^" Case "_" r="_" 'Case "ー" r="-" ' 全角文字で利用するため半角変換しない Case "―" r="-" Case "‐" r="-" Case "/" r="/" Case "\" r="\" 'Case "~" r="~" ' 全角文字で利用するため半角変換しない Case "|" r="|" Case "’" r="'" Case "”" r="""" Case "(" r="(" Case ")" r=")" Case "[" r="[" Case "]" r="]" Case "{" r="{" Case "}" r="}" 'Case "「" r="「" ' 全角文字で利用するため半角変換しない 'Case "」" r="」" ' 全角文字で利用するため半角変換しない Case "+" r="+" Case "-" r="-" Case "=" r="=" Case "<" r="<" Case ">" r=">" Case "′" r="'" Case "″" r="""" Case "¥" r="\" Case "$" r="$" Case "%" r="%" Case "#" r="#" Case "&" r="&" Case "*" r="*" Case "@" r="@" Case Else If Asc(s) >= Asc("a") Then s0="a": s1="a" ElseIf Asc(s) >= Asc("A") Then s0="A": s1="A" ElseIf Asc(s) >= Asc("0") Then s0="0": s1="0" End If End Select End If If s0 <> "" Then r=Chr( (Asc(s) -Asc(s0))*a1 +Asc(s1) +a0) ' 変換処理 AdjustString = AdjustString & r i = i +1 +Abs(CInt(a0 > 0)) Loop End Function ' =============================================================================== ' 実行ホストを切り替える Sub SetScriptHost(HostName) Dim i,s If InStr(LCase(WSCript.FullName), LCase(HostName)) <> 0 Then Exit Sub s = HostName & " """ & WScript.ScriptFullName & """" If WScript.Arguments.Count > 0 Then For i = 0 To WScript.Arguments.Count -1 s = s &" """ & WScript.Arguments.Item(i) & """" ' 引数 Next End If CreateObject("WScript.Shell").Run s WScript.Quit End Sub ' ------------------------------------------------------------------------------- ' デバッグ Dim objDbg ' クラス Class TDebug Dim FCScript ' 初期化処理 Private Sub Class_Initialize() FCScript = InStr(LCase(WSCript.FullName), "cscript") > 0 End Sub ' 終了処理 Private Sub Class_Terminate() If Not FCScript Then Exit Sub WScript.StdOut.WriteLine NOW & " [END]" WScript.StdIn.ReadLine End Sub ' CScriptホストかどうか Public Property Get CScript CScript = FCScript End Property ' デバッグメッセージ処理 Public Sub dprintf(v) Dim i,s,ityp If Not FCScript Then Exit Sub s = v ityp = VarType(v) If ityp = vbBoolean Then s = CStr(v) ElseIf VarType(v) >= vbArray Then s = "" For i = 0 to UBound(v) s = s & "dprintf(" &i& ")=" & v(i) & vbCRLF Next End If WScript.Echo s End Sub End Class ' 関数 Sub dprintf(v) If VarType(objDbg) = vbEmpty Then Set objDbg = New TDebug objDbg.dprintf(NOW & " " & WScript.ScriptFullName) End If objDbg.dprintf(v) End Sub ' -------------------------------------------------------------------------------
[VBScript] 全角文字を半角文字へ変換する
どーもボキです。 定型業務のツール支援するにも、文字バイトが統一されていないとそれすらままならない。 というか、たいていの人は文字バイトなど意識しない。 本当にわからないのだろう、言っても直らない。ツール側で吸収したほうが早い。 以下のZenToHan関数で文字サイズを半角に統一するとよい。 ZenToHan関数での変換事例SetScriptHost("cscript")
s = "yozda ( … > Z_ ̄∂ " dprintf " 前:" & s dprintf " 後:" & ZenToHan(s)
' =============================================================================== ' 全角→半角 Function ZenToHan(iStr) Dim i,r r = "" For i = 1 To Len(iStr) r = r & ZenToHan_func(Mid(iStr, i, 1)) Next ZenToHan = r end function ' 関数 Function ZenToHan_func(iStr) Dim r r = iStr ZenToHan_func = r If Asc(r) < Asc(" ") Then Exit Function If Asc(r) > Asc("z") Then Exit Function Select Case r Case " " r = " " Case "," r = "," Case "." r = "." Case ":" r = ":" Case ";" r = ";" Case "?" r = "?" Case "!" r = "!" Case "^" r = "^" Case "_" r = "_" Case "ー" r = "-" Case "―" r = "-" Case "‐" r = "-" Case "/" r = "/" Case "~" r = "~" Case "|" r = "|" Case "’" r = "'" Case "”" r = """" Case "(" r = "(" Case ")" r = ")" Case "[" r = "[" Case "]" r = "]" Case "{" r = "{" Case "}" r = "}" Case "+" r = "+" Case "-" r = "-" Case "=" r = "=" Case "<" r = "<" Case ">" r = ">" Case "′" r = "'" Case "″" r = """" Case "¥" r = "\" Case "$" r = "$" Case "%" r = "%" Case "#" r = "#" Case "&" r = "&" Case "*" r = "*" Case "@" r = "@" Case Else If Asc(r) >= Asc("a") Then r = Chr(Asc(r) -Asc("a") +Asc("a")) ElseIf Asc(r) >= Asc("A") Then r = Chr(Asc(r) -Asc("A") +Asc("A")) ElseIf Asc(r) >= Asc("0") Then r = Chr(Asc(r) -Asc("0") +Asc("0")) End If End Select ZenToHan_func = r End Function ' =============================================================================== ' 実行ホストを切り替える Sub SetScriptHost(HostName) Dim i,s If InStr(LCase(WSCript.FullName), LCase(HostName)) <> 0 Then Exit Sub s = HostName & " """ & WScript.ScriptFullName & """" If WScript.Arguments.Count > 0 Then For i = 0 To WScript.Arguments.Count -1 s = s &" """ & WScript.Arguments.Item(i) & """" ' 引数 Next End If CreateObject("WScript.Shell").Run s WScript.Quit End Sub ' ------------------------------------------------------------------------------- ' デバッグ ※ここだけ抜粋してもOK Dim objDbg ' クラス Class TDebug Dim FCScript ' 初期化処理 Private Sub Class_Initialize() FCScript = InStr(LCase(WSCript.FullName), "cscript") > 0 End Sub ' 終了処理 Private Sub Class_Terminate() If Not FCScript Then Exit Sub WScript.StdOut.WriteLine NOW & " [END]" WScript.StdIn.ReadLine End Sub ' CScriptホストかどうか Public Property Get CScript CScript = FCScript End Property ' デバッグメッセージ処理 Public Sub dprintf(v) Dim i,s,ityp If Not FCScript Then Exit Sub s = v ityp = VarType(v) If ityp = vbBoolean Then s = CStr(v) ElseIf VarType(v) >= vbArray Then s = "" For i = 0 to UBound(v) s = s & "dprintf(" &i& ")=" & v(i) & vbCRLF Next End If WScript.Echo s End Sub End Class ' 関数 Sub dprintf(v) If VarType(objDbg) = vbEmpty Then Set objDbg = New TDebug objDbg.dprintf(NOW & " " & WScript.ScriptFullName) End If objDbg.dprintf(v) End Sub
どーもボキです。 ★★★★★ ノーマル&クラシックでクリア。クリアまでのプレイ時間40h。 特別版に付属していたDLC「星の神殿」もフル活用。 1章は、DLCで部隊を鍛え上げまったく歯ごたえなし。 とはいえ、ファミコン時代にやり遂げたドゼー撃破は達成できず。 さすがに村人ループをやる気力はなく、ある程度強くなったところでストーリを進めた。 前々作の「覚醒」、前作の「if」に比べ、グラフィックは格段に進化した。 「if」から採用されたマップからの先頭シーンへのシームレスな突入はさらに進化。 キャラクタの頭身も上がり、戦闘シーンのリアル度が増した。 グラフィックは進化しているものの、ファミコンを忠実に再現したためか、 ファミコン時代の手抜きマップがそのまま再現されている。 少年時代のアルム&セリカの関係など、ファミコン時代にはなかった(と思う)、 そこらのストーリー肉付けがあるものの、本筋はほぼ原作どおり(だったと思う)。 ているものの、仲間との支援会話はあっさり。 ファミコン時代には支援会話すらなかった(と思う)ので、そこは進化といえるか。 せっかくリメイクするなら、マップを作り直す。 キャラ間の支援会話をもっと充実させる、などあっても良かったのでは? 最終ステージやクリア後は、アルムとセリカが一緒に行動することになるが、 この二人に支援会話がないのはもったいない。ラスボス前も「気をつけていきましょう」の一言のみ。 そんな主人公二人のあっさりな会話に対し、最終ステージのキャラごとの演出やBGMには萌えた。 特にこのリメイクはBGMに気合が入りまくっている。 以下は、最終ステージの「神よ、その黄昏よ」。 ファミコン版⇒3DS版と流れるので、そのリメイクの素晴らしさを聴いてほしい。 [3DS] ファイアーエムブレム エコーズ
|
S |
M |
T |
W |
T |
F |
S |
|
|
|
|
|
1
|
2
|
3
|
4
|
5
|
6
|
7
|
8
|
9
|
10
|
11
|
12
|
13
|
14
|
15
|
16
|
17
|
18
|
19
|
20
|
21
|
22
|
23
|
24
|
25
|
26
|
27
|
28
|
検索
カテゴリ
タグ
以前の記事
フォロー中のブログ
ブログジャンル
|