最近は観たり聴いたりしませんが、以前、フランスの映画で『禁じられた遊び』という反戦映画がありました。また、その映画音楽はナルシソ・イエペスのクラシック・ギターによる名曲でした。今回は、その映画評論や音楽評論をするつもりではありません。
私にとっての『禁じられた遊び』とは、「パーソナルコンピュータでプログラムを組むこと」でした。つまり、私は（古い言葉になってしまいましたが）いわゆるパソコン・マニアでした。このことが、２０代もしくは３０代の私にとっては、お見合いや結婚に関する大きな障害になっていました。「パソコンなんか趣味にしている男性なんて夫として不適格」というのが当時の女性の共通意識でした。
誰も私と同じ趣味を持っていないくせに、「コンピュータのプログラム開発には、ものすごく時間と手間がかかって、職業にすると女性と交際する時間もない」ということが、日本の全国民に知られていました。日本を飛び出す勇気のない私は、ドコにも逃げ場がありませんでした。
しかしながら、私は当時から人目を忍んで、すなわちコソコソとコンピュータのためにプログラムを組んでいました。それはまさに『禁じられた遊び』だったわけです。おそらく皆さんは、私がその過去の不運と不幸のために、コンピュータや人工知能が人間に復讐することを期待しているのではないかと疑うことでしょう。もし、そうだとしたら大変なことです。人間自身が、人間に危害を及ぼすコンピュータ・システムや人工知能を作ってしまうわけです。人間の怨念が、人間自身を滅ぼす機械（マシン）を作ってしまうわけです。もはや、マッド・サイエンティスト（気違い科学者）の領域と言えましょう。
実際の私には、そうした怨みも、テロを起こす勇気もありませんでした。それどころか、それだけのことを実現するための技術も才能もありませんでした。あくまでも、人目をはばかって、こっそりとコンピュータ・プログラムを組んでいました。他人に迷惑をかけないどころか、他人には何の役にも立たないと知りながらも、この趣味を（年甲斐もなく）今でも続けているわけです。
こうしたことは、今の社会通念からは信じられないことかもしれません。ＩＴ関連の会社は、今でも人材不足だと噂に聞きます。ただし、人手不足というよりも人材不足なのだそうです。実務経験が継続していないと、復帰は無理だと聞いています。それに、今の女性は、コンピュータの機械よりも、コンピュータがもたらすお金に興味があるみたいですが、それは間違いだよ、と私は主張します。そういうあさましさは、見え透いている、と私は主張します。
というわけで、私の『禁じられた遊び』の一環を、以下に紹介したいと思います。コンピュータのプログラムは「正常に動いてなんぼ」の世界ですが、私の『禁じられた遊び』の価値基準では、「上手く動かない」とか「動かし方がわからない」というのもアリです。本当は使い勝手が良いのですが、あえてそれは明記しないでおきましょう。便利さだけを追求していては、その奥深い（ディープな）世界は理解できないかもしれません。
私としては新作のつもりですが、発想としては大したことありません。コンピュータ上のファイル（情報の集まり）の中を見たり、それをプログラムとして実行してコンピュータを自動的に動かしたりすることは、ウィンドウズのＯＳ上で簡単にできます。そこに手作りのプログラムをおっ被せて、人間が日本語で命令するだけのものです。何だ下らない、と思うかもしれません。私の自己満足に過ぎない、と思うかもしれません。もちろん、それが当たり前の意見だと思います。
私の発見は、日本語解析という難しい手続きをコンピュータにさせなくても、日本語の命令を与えて動かせるということにあります。パーソナル・コンピュータ自身は、仕組みとしては自動販売機と同じようなものですから、人間そっくりに動作する必要はありません。「テキストファイルＡを見せる」とか「スクリプトファイルＢを動かす」とか、私がコンピュータに日本語で指示したら、それらの文から、文の右端の「を見せる」や「を動かす」を私からのお決まりの命令語と受け取って、必要な手続きを自動的に行えばいいわけです。つまり、人間（日本人）は、中の情報を見たいテキストファイルや、簡易言語が書かれているスクリプトファイルの名前の後ろに、その命令語を日本語でくっつけるだけでいいのです。
その動作の途中でエラーが出て、プログラムが止まりさえしなければ、プログラムの完成です。ただし、それでこのプログラムの開発は終わりではありません。むしろ新たな始まりと言えます。そのプログラムにとっての『バージョンアップ』もしくは『グレードアップ』と呼ばれる改良が始まると言えます。
このように、プログラムの開発は、本当は終わりがありません。どんなに時間と手間をかけたとしても、終わらないわけです。それではビジネスにならないため、納期もしくは作業の打ち切りがあるのです。趣味としてのプログラム開発には、一応の完成あるいは（再開未定の）一時中止がありました。私には、作成中だったのを中止して、半年か数年間、手つかずということが数多くあります。趣味としては、それくらい気楽にやらないと続かないと思います。それが、趣味のやり甲斐につながるコツと言えましょう。
日本語プログラミング言語というと、今日までにいくつかのものがネット上で知られています。クジラ飛行机さんの『ひまわり』や『なでしこ』、又は、別の人の作でＭｉｎｄやＴＴＳｎｅｒｏなどは、かなり以前から私も知っていて関心がありました。しかし、それらの真似をしても、私としてはメリットを感じられないと思いました。それらの日本語プログラミング言語は、コンピュータのプログラムを日本語で記述できるので、それなりのメリットがあるのは事実です。しかし、私の勝手な意見としては、日本語で長編プログラムを書くことが面倒に思えて仕方がなかったのです。
現在のところ、ＪａｖａやＲｕｂｙやＣ言語などの言語でも、私はプログラムを書くつもりがありません。それも同じ理由で面倒くさいからです。何かの必要に迫られたらば、それらを使うかもしれません。今のところは、ＶＢＳｃｒｉｐｔだけにしておきます。コンピュータの知識や技術は、過去に蓄積されたそれらがあって初めて進歩するものだ、と私は会社の先輩から教えられてきました。過去の知識や技術の蓄積があって初めて、新しいものが生まれてくるのです。私が初めてマイクロコンピュータを買った時に、その機械に付いてきたのはＢａｓｉｃ言語でした。それから後に、趣味でその機械のマシン語（機械語）やアセンブリ言語を使うまでになりました。が、結局一番使いやすかったのは、Ｂａｓｉｃ言語でした。
ところが、昔のプログラミング有識者や会社の先輩が言っていたように、Ｂａｓｉｃ言語は良いコンピュータ言語ではないそうです。Ｂａｓｉｃ言語を覚えて使っていると、プログラムが汚くなって、不具合ばかり発生してコンピュータが正常に動かなくなってしまう、と私は言われました。そして、Ｂａｓｉｃ言語を使っていると、ついにはプログラムが組めなくなる、と私は言われました。彼らは、それゆえにＢａｓｉｃ言語を嫌っていました。
しかし、私はこの年齢（５４）でいまだにＢａｓｉｃ言語を年甲斐もなく使っていますし、作ったプログラムがコンピュータ上でどうしても動かない、ということはありません。無理をしていないせいかもしれませんが、ある意味では『禁じられた遊び』なのかもしれませんが、私とコンピュータとの仲はうまくいっているようです。
それでは、以下にＢａｓｉｃ言語の一種であるＶＢＳｃｒｉｐｔで私が作ったプログラムのいくつかのバージョンを示しておきます。プログラムの内容は、大したことはないので、興味がなかったら読み飛ばしてください。なお、例のごとく、免責事項を示しておきます。このプログラムのコピーと改変は自由ですが、このプログラムを動作させて生じたいかなる損失にも私の側は責任を持たないことをあらかじめ断っておきます。また、このプログラムはウィンドウズ８．１上で動作することが確認されていますが、プログラムのコピーと改変と動作に関しては自己責任でお願いします。
（１）日本語コンソール.hta バージョン0.50
<HTML>
<HEAD>
<TITLE>日本語コンソール</TITLE>
<META content="text/html; charset=shift_jis" http-equiv=Content-Type>
<META content="MSHTML 5.00.2919.6307" name=GENERATOR>
</HEAD>
<STYLE TYPE="text/css">
BODY {background-color:black; font-family:"MS UI Gothic", "ＭＳ 明朝";}
SPAN {font-size:12pt; color:white; background-color:black;}
INPUT {font-size:12pt; color:white; border:none; background-color:black; ime-mode:active;}
</STYLE>
<SCRIPT LANGUAGE = "VBScript">
Option Explicit
Dim WshShell, FS
Set WshShell = CreateObject("WScript.Shell")
Set FS = CreateObject("Scripting.FileSystemObject")
Call ResizeTo(660, 300)
Dim PCode, ICode
PCode = "入力待ち＞"
ICode = string(len(PCode), " ")
Sub Window_onLoad()
WSHShell.SendKeys "{TAB}"
End Sub
Sub CatchRetCode()
Dim dstr
Select Case window.event.keyCode
Case 13
dstr = UserBuffer.value
UserBuffer.value = ""
Call AddScreen(dstr & "<BR>")
Call AddMessage(answer(dstr))
WSHShell.SendKeys "+{TAB}"
Case Else
End Select
End Sub
Private Sub AddMessage(dat)
If dat <> "" Then
Call AddScreen(ICode & dat & "<BR>" & PCode)
Else
Call AddScreen(PCode)
End If
End Sub
Private Sub AddScreen(dat)
ScreenBuffer.InnerHTML = ScreenBuffer.InnerHTML & dat
End Sub
Private Function answer(Lstr)
Dim Rstr, Cmd, Param, OpenFName
Cmd = FindCommand(Lstr)
Select Case Cmd
Case "を見せる"
Param = GetParameter(Lstr, Cmd)
OpenFName = SearchFileExt(Param)
If OpenFName <> "" Then
Rstr = "［" & Param & "］" & "の中を見せました。"
WshShell.Run "notepad " & OpenFName ,, True
Else
Rstr = "［" & Param & "］" & "が見つかりません。"
End If
Case Else
Rstr = "｛理解不能！｝"
End Select
answer = Rstr
End Function
Private Function FindCommand(Lstr)
Dim Rstr, key
key = "を見せる"
If Right(Lstr, Len(key)) = key Then
Rstr = key
Else
Rstr = Lstr
End If
FindCommand = Rstr
End Function
Private Function GetParameter(Lstr, Cmd)
GetParameter = Left(Lstr, Len(Lstr)-Len(Cmd))
End Function
Private Function SearchFileExt(Param)
Dim Rstr, idx, cnt, Ext, Fnm
Rstr = ""
Ext = array("hta","vbs","txt")
cnt = Ubound(Ext)
For idx = 0 to cnt
Fnm = Param & "." & Ext(idx)
If FS.FileExists(Fnm) Then
Rstr = Fnm
Exit For
End If
Next
SearchFileExt = Rstr
End Function
</SCRIPT>
<BODY SCROLL = "Yes" LEFTMARGIN = "0", TOPMARGIN = "0" onKeyPress="CatchRetCode()">
<SPAN id="ScreenBuffer">入力待ち＞ </SPAN>
<INPUT type="text" name="UserBuffer" size=64 />
</BODY>
</HTML> ちょっとだけ説明しますと、このプログラムをウィンドウズ上で起動すると、背景がまっ黒のウィンドウが画面に現れます。そのウィンドウ枠の内側左上に、『入力待ち＞』という白文字が出て、そのすぐ右端に棒状のカーソルが点滅します。そこへローマ字入力で日本語を一行入れて、最後に改行キーを押します。
あらかじめ、このプログラムを置いてある同じフォルダ内に、日本語名のテキストファイルを『メモ帳』などのアクセサリを使って作っておきます。例えば、『テスト.txt』という名前で作っておいたならば、『テストを見せる』と日本語入力して改行キーを押します。すると、『メモ帳』が自動的に『テスト.txt』というテキストファイルを開きます。
その『メモ帳』をウィンドウ枠の内側右上にあるクローズボタンを押して閉じて終了すれば、このプログラムに戻って、「［テスト］の中を見せました。」などとメッセージを出して、次の日本語一行の入力待ちとなります。このプログラムもまた、ウィンドウ枠の内側右上のクローズボタンを押すと終了します。
ここまで述べたプログラムの操作は、今回紹介したどのバージョンにも共通しています。ただし、この（１）のバージョンだけ、受け付ける日本語は「を見せる」を後ろにつけたもの一つだけで、それ以外は、『理解不能！』とメッセージされることに注意が必要です。
（２）日本語コンソール.hta バージョン1.00
<HTML>
<HEAD>
<TITLE>日本語コンソール</TITLE>
<META content="text/html; charset=shift_jis" http-equiv=Content-Type>
<META content="MSHTML 5.00.2919.6307" name=GENERATOR>
</HEAD>
<STYLE TYPE="text/css">
BODY {background-color:black; font-family:"MS UI Gothic", "ＭＳ 明朝";}
SPAN {font-size:12pt; color:white; background-color:black;}
INPUT {font-size:12pt; color:white; border:none; background-color:black; ime-mode:active;}
</STYLE>
<SCRIPT LANGUAGE = "VBScript">
Option Explicit
Dim WshShell, FS
Set WshShell = CreateObject("WScript.Shell")
Set FS = CreateObject("Scripting.FileSystemObject")
Call ResizeTo(660, 300)
Dim PCode, ICode
PCode = "待ち＞"
ICode = string(len(PCode), " ")
Sub Window_onLoad()
WSHShell.SendKeys "{TAB}"
End Sub
Sub CatchRetCode()
Dim dstr
Select Case window.event.keyCode
Case 13
dstr = UserBuffer.value
UserBuffer.value = ""
Call AddScreen(dstr & "<BR>")
Call AddMessage(answer(dstr))
WSHShell.SendKeys "+{TAB}"
Case Else
End Select
End Sub
Private Sub AddMessage(dat)
If dat <> "" Then
Call AddScreen(ICode & dat & "<BR>" & PCode)
Else
Call AddScreen(PCode)
End If
End Sub
Private Sub AddScreen(dat)
ScreenBuffer.InnerHTML = ScreenBuffer.InnerHTML & dat
End Sub
Private Function answer(Lstr)
Dim Keys, Cmd, Rstr
Keys = Array("を見せる","を動かす","一覧")
Cmd = FindCommand(Lstr, Keys, UBound(keys))
Select Case Cmd
Case "を見せる"
Rstr = ParamShow(GetParameter(Lstr, Cmd))
Case "を動かす"
Rstr = ParamExec(GetParameter(Lstr, Cmd))
Case "一覧"
Rstr = GetParamList()
Case Else
Rstr = "｛理解不能！｝"
End Select
answer = Rstr
End Function
Private Function FindCommand(Lstr, KW, Cnt)
Dim Idx, Key, Cmd
Cmd = ""
For Idx = 0 to Cnt
Key = KW(Idx)
If Right(Lstr, Len(Key)) = Key Then
Cmd = Key
Exit For
End If
Next
FindCommand = Cmd
End Function
Private Function GetParameter(Lstr, Cmd)
GetParameter = Left(Lstr, Len(Lstr)-Len(Cmd))
End Function
Private Function ParamShow(Param)
Dim Rstr, ExtOrder, FileName
ExtOrder = "hta / vbs / txt"
FileName = SearchFileExt(Param, ExtOrder)
If FileName <> "" Then
Rstr = "［" & Param & "］" & "の中を見せました。"
WshShell.Run "notepad " & FileName ,, True
Else
Rstr = "［" & Param & "］" & "が見つかりません。"
End If
ParamShow = Rstr
End Function
Private Function ParamExec(Param)
Dim Rstr, ExtOrder, FileName
ExtOrder = "exe / com / hta / vbs"
FileName = SearchFileExt(Param, ExtOrder)
If FileName <> "" Then
Rstr = "［" & Param & "］" & "を動かしました。"
WshShell.Run FileName ,, True
Else
Rstr = "［" & Param & "］" & "は動かせません。"
End If
ParamExec = Rstr
End Function
Private Function SearchFileExt(Param, ExtOrder)
Dim Rstr, idx, cnt, Ext, Fnm
Rstr = ""
Ext = Split(ExtOrder, "/")
cnt = Ubound(Ext)
For idx = 0 to cnt
Fnm = Param & "." & Trim(Ext(idx))
If FS.FileExists(Fnm) Then
Rstr = Fnm
Exit For
End If
Next
SearchFileExt = Rstr
End Function
Private Function GetParamList()
Dim Rstr, oFe, oFdr
Rstr = ""
Set oFdr = FS.GetFolder("./")
For Each oFe In oFdr.Files
Rstr = Rstr & FS.GetBaseName(oFe.Name) & "<BR>" & ICode
Next
GetParamList = Rstr
End Function
</SCRIPT>
<BODY SCROLL = "Yes" LEFTMARGIN = "0", TOPMARGIN = "0" onKeyPress="CatchRetCode()">
<SPAN id="ScreenBuffer">待ち＞ </SPAN>
<INPUT type="text" name="UserBuffer" size=64 />
</BODY>
</HTML> このバージョンは、前のバージョンと比べて、理解できる日本語の命令を３つに増やしました。プログラムのこの機能追加に伴って、いわゆるモジュール構造化プログラミングを試みてみました。ＶＢＳｃｒｉｐｔはＭｉｃｒｏＳｏｆｔ Ｂａｓｉｃの流れをくんでいるために、伝統的に行番号が無く、字下げによりプログラムの制御の及ぶ範囲（すなわち、ブロック）を表現しています。
ただし、このバージョンでは、理解できる日本語の命令を一つ追加する場合に、２か所に同じ命令語を書かなければならないという煩（わずら）わしさがあります。次のバージョン以降は、その点を改良しています。追加した日本語の命令を、プログラム自身を読み込んで調べて、その検索テーブルを作るようにしています。それによって、その命令語を追加する箇所を１か所にしています。
また、これ以降のバージョンは、コンピュータ上でできることがほぼ同じです。ほとんどの人には退屈かもしれませんが、Ｂａｓｉｃのプログラムの書き方の違いが改良点となります。
（３）日本語コンソール.hta バージョン1.10
<HTML>
<HEAD>
<TITLE>日本語コンソール</TITLE>
<META content="text/html; charset=shift_jis" http-equiv=Content-Type>
<META content="MSHTML 5.00.2919.6307" name=GENERATOR>
</HEAD>
<STYLE TYPE="text/css">
BODY {background-color:black; font-family:"MS UI Gothic", "ＭＳ 明朝";}
SPAN {font-size:12pt; color:white; background-color:black;}
INPUT {font-size:12pt; color:white; border:none; background-color:black; ime-mode:active;}
</STYLE>
<SCRIPT LANGUAGE = "VBScript">
Option Explicit
const ForReading = 1
Dim WshShell, FS
Set WshShell = CreateObject("WScript.Shell")
Set FS = CreateObject("Scripting.FileSystemObject")
Call ResizeTo(660, 300)
Dim o, PCode, ICode, KeyCmds
o = chr(34)
PCode = "待ち＞"
ICode = string(len(PCode), " ")
ReDim KeyCmds(0)
Call GetCommands()
Private Sub GetCommands()
Dim rf, Lstr, flg, Cmds
flg = False
Set rf = FS.OpenTextFile(Document.Title & ".hta", ForReading)
Do Until rf.AtEndOfStream
Lstr = Trim(rf.ReadLine)
If Lstr <> "" Then
If Lstr = "Select Case Cmd" Then
flg = True
Else
If Lstr = "End Select" And flg = True Then
flg = False
Else
If flg = True Then
Call AddCommand(Lstr)
End If
End If
End If
End If
Loop
rf.Close
End Sub
Private Sub AddCommand(Lstr)
Dim Key, Cnt, Idx, Jcmd, Ptr
Key = "Case " & o
Cnt = Len(Key)
If Left(Lstr, Cnt) = Key Then
Idx = InStr(Cnt+1, Lstr, o)
If Idx > 0 Then
Jcmd = Mid(Lstr, Cnt+1, Idx-Cnt-1)
If KeyCmds(0) <> "" Then
Ptr = UBound(KeyCmds) + 1
ReDim Preserve KeyCmds(Ptr)
KeyCmds(Ptr) = Jcmd
Else
KeyCmds(0) = Jcmd
End If
End If
Else
End If
End Sub
Sub Window_onLoad()
WSHShell.SendKeys "{TAB}"
End Sub
Sub CatchRetCode()
Dim dstr
Select Case window.event.keyCode
Case 13
dstr = UserBuffer.value
UserBuffer.value = ""
Call AddScreen(dstr & "<BR>")
Call AddMessage(answer(dstr))
WSHShell.SendKeys "+{TAB}"
Case Else
End Select
End Sub
Private Sub AddMessage(dat)
If dat <> "" Then
Call AddScreen(ICode & dat & "<BR>" & PCode)
Else
Call AddScreen(PCode)
End If
End Sub
Private Sub AddScreen(dat)
ScreenBuffer.InnerHTML = ScreenBuffer.InnerHTML & dat
End Sub
Private Function answer(Lstr)
Dim Cmd, Rstr
Cmd = FindCommand(Lstr, KeyCmds, UBound(KeyCmds))
Select Case Cmd
Case "を見せる"
Rstr = ParamShow(GetParameter(Lstr, Cmd))
Case "を動かす"
Rstr = ParamExec(GetParameter(Lstr, Cmd))
Case "一覧"
Rstr = GetParamList()
Case Else
Rstr = "｛理解不能！｝"
End Select
answer = Rstr
End Function
Private Function FindCommand(Lstr, KW, Cnt)
Dim Idx, Key, Cmd
Cmd = ""
For Idx = 0 to Cnt
Key = KW(Idx)
If Right(Lstr, Len(Key)) = Key Then
Cmd = Key
Exit For
End If
Next
FindCommand = Cmd
End Function
Private Function GetParameter(Lstr, Cmd)
GetParameter = Left(Lstr, Len(Lstr)-Len(Cmd))
End Function
Private Function ParamShow(Param)
Dim Rstr, ExtOrder, FileName
ExtOrder = "hta / vbs / txt"
FileName = SearchFileExt(Param, ExtOrder)
If FileName <> "" Then
Rstr = "［" & Param & "］" & "の中を見せました。"
WshShell.Run "notepad " & FileName ,, True
Else
Rstr = "［" & Param & "］" & "が見つかりません。"
End If
ParamShow = Rstr
End Function
Private Function ParamExec(Param)
Dim Rstr, ExtOrder, FileName
ExtOrder = "exe / com / hta / vbs"
FileName = SearchFileExt(Param, ExtOrder)
If FileName <> "" Then
Rstr = "［" & Param & "］" & "を動かしました。"
WshShell.Run FileName ,, True
Else
Rstr = "［" & Param & "］" & "は動かせません。"
End If
ParamExec = Rstr
End Function
Private Function SearchFileExt(Param, ExtOrder)
Dim Rstr, idx, cnt, Ext, Fnm
Rstr = ""
Ext = Split(ExtOrder, "/")
cnt = Ubound(Ext)
For idx = 0 to cnt
Fnm = Param & "." & Trim(Ext(idx))
If FS.FileEXists(Fnm) Then
Rstr = Fnm
Exit For
End If
Next
SearchFileExt = Rstr
End Function
Private Function GetParamList()
Dim Rstr, oFe, oFdr
Rstr = ""
Set oFdr = FS.GetFolder("./")
For Each oFe In oFdr.Files
Rstr = Rstr & FS.GetBaseName(oFe.Name) & "<BR>" & ICode
Next
GetParamList = Rstr
End Function
</SCRIPT>
<BODY SCROLL = "Yes" LEFTMARGIN = "0", TOPMARGIN = "0" onKeyPress="CatchRetCode()">
<SPAN id="ScreenBuffer">待ち＞ </SPAN>
<INPUT type="text" name="UserBuffer" size=64 />
</BODY>
</HTML>前のバージョン（２）を改良した際に、離れたモジュール間（つまり、直接上下関係の無い関数の間）でやり取りされるデータが出てきてしまい、それらを外部変数（グローバル変数とも言う。）にしなければなりませんでした。それらの変数の定義は、全てのモジュール（もしくは関数）の定義の上にされるのが一番わかりやすいのですが、それらが使われているモジュール（もしくは関数）と離れているため、将来何らかのプログラム改良をした時に、プログラムの内容がよく理解できずに間違った修正をして、プログラムが動かなくなる危険性があります。
（４）日本語コンソール.hta バージョン1.20
<HTML>
<HEAD>
<TITLE>日本語コンソール</TITLE>
<META content="text/html; charset=shift_jis" http-equiv=Content-Type>
<META content="MSHTML 5.00.2919.6307" name=GENERATOR>
</HEAD>
<STYLE TYPE="text/css">
BODY {background-color:black; font-family:"MS UI Gothic", "ＭＳ 明朝";}
SPAN {font-size:12pt; color:white; background-color:black;}
INPUT {font-size:12pt; color:white; border:none; background-color:black; ime-mode:active;}
</STYLE>
<SCRIPT LANGUAGE = "VBScript">
Option Explicit
const ForReading = 1
Dim WshShell, FS
Set WshShell = CreateObject("WScript.Shell")
Set FS = CreateObject("Scripting.FileSystemObject")
Call ResizeTo(660, 300)
Dim PCode, ICode, KW
PCode = "待ち＞"
ICode = string(len(PCode), " ")
Set KW = New KeyCommandClass
Class KeyCommandClass
Public Cmds, Count
Private o
Private Sub Class_Initialize
o = chr(34)
ReDim Cmds(0)
Call GetCommands()
Count = UBound(Cmds)
End Sub
Private Sub GetCommands()
Dim rf, selfnm, Lstr, flg
flg = False
selfnm = Document.Title & ".hta"
Set rf = FS.OpenTextFile(selfnm, ForReading)
Do Until rf.AtEndOfStream
Lstr = Trim(rf.ReadLine)
If Lstr <> "" Then
If Lstr = "Select Case Cmd" Then
flg = True
Else
If Lstr = "End Select" And flg = True Then
flg = False
Else
If flg = True Then
Call AddCommand(Lstr)
End If
End If
End If
End If
Loop
rf.Close
End Sub
Private Sub AddCommand(Lstr)
Dim Key, Cnt, Idx, Jcmd, Ptr
Key = "Case " & o
Cnt = Len(Key)
If Left(Lstr, Cnt) = Key Then
Idx = InStr(Cnt+1, Lstr, o)
If Idx > 0 Then
Jcmd = Mid(Lstr, Cnt+1, Idx-Cnt-1)
If Cmds(0) <> "" Then
Ptr = UBound(Cmds) + 1
ReDim Preserve Cmds(Ptr)
Cmds(Ptr) = Jcmd
Else
Cmds(0) = Jcmd
End If
End If
Else
End If
End Sub
Private Sub Class_Terminate
End Sub
End Class
Sub Window_onLoad()
WSHShell.SendKeys "{TAB}"
End Sub
Sub CatchRetCode()
Dim dstr
Select Case window.event.keyCode
Case 13
dstr = UserBuffer.value
UserBuffer.value = ""
Call AddScreen(dstr & "<BR>")
Call AddMessage(answer(dstr))
WSHShell.SendKeys "+{TAB}"
Case Else
End Select
End Sub
Private Sub AddMessage(dat)
If dat <> "" Then
Call AddScreen(ICode & dat & "<BR>" & PCode)
Else
Call AddScreen(PCode)
End If
End Sub
Private Sub AddScreen(dat)
ScreenBuffer.InnerHTML = ScreenBuffer.InnerHTML & dat
End Sub
Private Function answer(Lstr)
Dim Cmd, Rstr
Cmd = FindCommand(Lstr, KW)
Select Case Cmd
Case "を見せる"
Rstr = ParamShow(GetParameter(Lstr, Cmd))
Case "を動かす"
Rstr = ParamExec(GetParameter(Lstr, Cmd))
Case "一覧"
Rstr = GetParamList()
Case Else
Rstr = "｛理解不能！｝"
End Select
answer = Rstr
End Function
Private Function FindCommand(Lstr, KW)
Dim Idx, Key, Cmd
Cmd = ""
For Idx = 0 to KW.Count
Key = KW.Cmds(Idx)
If Right(Lstr, Len(Key)) = Key Then
Cmd = Key
Exit For
End If
Next
FindCommand = Cmd
End Function
Private Function GetParameter(Lstr, Cmd)
GetParameter = Left(Lstr, Len(Lstr)-Len(Cmd))
End Function
Private Function ParamShow(Param)
Dim Rstr, ExtOrder, FileName
ExtOrder = "hta / vbs / txt"
FileName = SearchFileExt(Param, ExtOrder)
If FileName <> "" Then
Rstr = "［" & Param & "］" & "の中を見せました。"
WshShell.Run "notepad " & FileName ,, True
Else
Rstr = "［" & Param & "］" & "が見つかりません。"
End If
ParamShow = Rstr
End Function
Private Function ParamExec(Param)
Dim Rstr, ExtOrder, FileName
ExtOrder = "exe / com / hta / vbs"
FileName = SearchFileExt(Param, ExtOrder)
If FileName <> "" Then
Rstr = "［" & Param & "］" & "を動かしました。"
WshShell.Run FileName ,, True
Else
Rstr = "［" & Param & "］" & "は動かせません。"
End If
ParamExec = Rstr
End Function
Private Function SearchFileExt(Param, ExtOrder)
Dim Rstr, idx, cnt, Ext, Fnm
Rstr = ""
Ext = Split(ExtOrder, "/")
cnt = Ubound(Ext)
For idx = 0 to cnt
Fnm = Param & "." & Trim(Ext(idx))
If FS.FileExists(Fnm) Then
Rstr = Fnm
Exit For
End If
Next
SearchFileExt = Rstr
End Function
Private Function GetParamList()
Dim Rstr, oFe, oFdr
Rstr = ""
Set oFdr = FS.GetFolder("./")
For Each oFe In oFdr.Files
Rstr = Rstr & FS.GetBaseName(oFe.Name) & "<BR>" & ICode
Next
GetParamList = Rstr
End Function
</SCRIPT>
<BODY SCROLL = "Yes" LEFTMARGIN = "0", TOPMARGIN = "0" onKeyPress="CatchRetCode()">
<SPAN id="ScreenBuffer">待ち＞ </SPAN>
<INPUT type="text" name="UserBuffer" size=64 />
</BODY>
</HTML> 離れたモジュール間にまたがるデータのために、その一方のデータとプログラムをクラス定義の中に入れて一つのオブジェクトにしてみました。いわゆるオブジェクト指向プログラミングの簡単なものを試みてみました。Ｂａｓｉｃ言語なんかで、こんなことができるのかと、いぶかる人もいらっしゃるかもしれません。しかし、コンピュータのプログラミング言語というものは、それを使う人（ユーザ）が居なくならない限り、絶えず進歩していくものなのです。その進歩に、使う人（ユーザ）が、いつまでもついていけるかというのが問題かもしれませんが…。
もっとも、オブジェクトで定義したパブリック変数の定義（Public Cmds, Count）は、本当はよろしくありません。なぜならば、このプログラムをよくわかっていない人がプログラム改良時に、この変数を間違っていじくって、このプログラムを誤動作させてしまう危険性がまだ残されているからです。これらのデータは、このオブジェクトの外からデータ参照されるだけできるように、プログラムで直しておく必要があります。それを修正したものが、次の最新バージョンです。
（５）日本語コンソール.hta 最新バージョン
<HTML>
<HEAD>
<TITLE>日本語コンソール</TITLE>
<META content="text/html; charset=shift_jis" http-equiv=Content-Type>
<META content="MSHTML 5.00.2919.6307" name=GENERATOR>
</HEAD>
<STYLE TYPE="text/css">
BODY {background-color:black; font-family:"MS UI Gothic", "ＭＳ 明朝";}
SPAN {font-size:12pt; color:white; background-color:black;}
INPUT {font-size:12pt; color:white; border:none; background-color:black; ime-mode:active;}
</STYLE>
<SCRIPT LANGUAGE = "VBScript">
Option Explicit
const ForReading = 1
Dim WshShell, FS
Set WshShell = CreateObject("WScript.Shell")
Set FS = CreateObject("Scripting.FileSystemObject")
Call ResizeTo(660, 300)
Dim PCode, ICode, KW
PCode = "待ち＞"
ICode = string(len(PCode), " ")
Set KW = New KeyCommandClass
Class KeyCommandClass
Private KeyCmds, KeyCount, o
Private Sub Class_Initialize
o = chr(34)
ReDim KeyCmds(0)
Call GetCommands()
KeyCount = UBound(KeyCmds)
End Sub
Public Function Cmds(idx)
Cmds = KeyCmds(idx)
End Function
Property Get Count()
Count = KeyCount
End Property
Private Sub GetCommands()
Dim rf, selfnm, Lstr, flg
flg = False
selfnm = Document.Title & ".hta"
Set rf = FS.OpenTextFile(selfnm, ForReading)
Do Until rf.AtEndOfStream
Lstr = Trim(rf.ReadLine)
If Lstr <> "" Then
If Lstr = "Select Case Cmd" Then
flg = True
Else
If Lstr = "End Select" And flg = True Then
flg = False
Else
If flg = True Then
Call AddCommand(Lstr)
End If
End If
End If
End If
Loop
rf.Close
End Sub
Private Sub AddCommand(Lstr)
Dim Key, Cnt, Idx, Jcmd, Ptr
Key = "Case " & o
Cnt = Len(Key)
If Left(Lstr, Cnt) = Key Then
Idx = InStr(Cnt+1, Lstr, o)
If Idx > 0 Then
Jcmd = Mid(Lstr, Cnt+1, Idx-Cnt-1)
If KeyCmds(0) <> "" Then
Ptr = UBound(KeyCmds) + 1
ReDim Preserve KeyCmds(Ptr)
KeyCmds(Ptr) = Jcmd
Else
KeyCmds(0) = Jcmd
End If
End If
Else
End If
End Sub
Private Sub Class_Terminate
End Sub
End Class
Sub Window_onLoad()
WSHShell.SendKeys "{TAB}"
End Sub
Sub CatchRetCode()
Dim dstr
Select Case window.event.keyCode
Case 13
dstr = UserBuffer.value
UserBuffer.value = ""
Call AddScreen(dstr & "<BR>")
Call AddMessage(answer(dstr))
WSHShell.SendKeys "+{TAB}"
Case Else
End Select
End Sub
Private Sub AddMessage(dat)
If dat <> "" Then
Call AddScreen(ICode & dat & "<BR>" & PCode)
Else
Call AddScreen(PCode)
End If
End Sub
Private Sub AddScreen(dat)
ScreenBuffer.InnerHTML = ScreenBuffer.InnerHTML & dat
End Sub
Private Function answer(Lstr)
Dim Cmd, Rstr
Cmd = FindCommand(Lstr, KW)
Select Case Cmd
Case "を見せる"
Rstr = ParamShow(GetParameter(Lstr, Cmd))
Case "を動かす"
Rstr = ParamExec(GetParameter(Lstr, Cmd))
Case "一覧"
Rstr = GetParamList()
Case Else
Rstr = "｛理解不能！｝"
End Select
answer = Rstr
End Function
Private Function FindCommand(Lstr, KW)
Dim Idx, Key, Cmd
Cmd = ""
For Idx = 0 to KW.Count
Key = KW.Cmds(Idx)
If Right(Lstr, Len(Key)) = Key Then
Cmd = Key
Exit For
End If
Next
FindCommand = Cmd
End Function
Private Function GetParameter(Lstr, Cmd)
GetParameter = Left(Lstr, Len(Lstr)-Len(Cmd))
End Function
Private Function ParamShow(Param)
Dim Rstr, ExtOrder, FileName
ExtOrder = "hta / vbs / txt"
FileName = SearchFileExt(Param, ExtOrder)
If FileName <> "" Then
Rstr = "［" & Param & "］" & "の中を見せました。"
WshShell.Run "notepad " & FileName ,, True
Else
Rstr = "［" & Param & "］" & "が見つかりません。"
End If
ParamShow = Rstr
End Function
Private Function ParamExec(Param)
Dim Rstr, ExtOrder, FileName
ExtOrder = "exe / com / hta / vbs"
FileName = SearchFileExt(Param, ExtOrder)
If FileName <> "" Then
Rstr = "［" & Param & "］" & "を動かしました。"
WshShell.Run FileName ,, True
Else
Rstr = "［" & Param & "］" & "は動かせません。"
End If
ParamExec = Rstr
End Function
Private Function SearchFileExt(Param, ExtOrder)
Dim Rstr, idx, cnt, Ext, Fnm
Rstr = ""
Ext = Split(ExtOrder, "/")
cnt = Ubound(Ext)
For idx = 0 to cnt
Fnm = Param & "." & Trim(Ext(idx))
If FS.FileExists(Fnm) Then
Rstr = Fnm
Exit For
End If
Next
SearchFileExt = Rstr
End Function
Private Function GetParamList()
Dim Rstr, oFe, oFdr
Rstr = ""
Set oFdr = FS.GetFolder("./")
For Each oFe In oFdr.Files
Rstr = Rstr & FS.GetBaseName(oFe.Name) & "<BR>" & ICode
Next
GetParamList = Rstr
End Function
</SCRIPT>
<BODY SCROLL = "Yes" LEFTMARGIN = "0", TOPMARGIN = "0" onKeyPress="CatchRetCode()">
<SPAN id="ScreenBuffer">待ち＞ </SPAN>
<INPUT type="text" name="UserBuffer" size=64 />
</BODY>
</HTML> 私が仕事でプログラムを組んでいた頃のことをふと思い出しました。あの頃は、プログラムをバージョンアップすればするほど、不具合な点（バグ）が増えて本当に困りました。コンピュータの動作の不具合が発覚するたびに、プログラムを直していました。ついには、あらかじめ設計していたものとは似ても似つかないものになってしまい、その説明の内部ドキュメントを一から書き直さなければならなかったこともありました。プログラムの改良と修正のために、プログラム開発にあてられていた時間と手間のほとんどが費やされていました。それが余りに大量であったために、私のプログラミングには、大きなクセがついてしまいました。
私の作ったプログラムを見るとわかると思いますが、コメントが極端に少ないのです。まったく無い場合もあります。折角コメントをつけても、処理やデータの内容が変わって、変更しなければならないことがしばしばありました。そうでなくても、時間が無くて苦労をしていました。プログラム中のコメントというものは、人間に読まれても、コンピュータという機械からは読み飛ばされます。そのようなコンピュータに入らないデータを作り込むこと自体に、私は疑問を抱いていました。
なぜならば、Ｂａｓｉｃ言語はもともと高級言語であり、コンピュータが直接理解できる機械語（極端に言えば、それは人間にとってはただの数字の列にしか見えない。）と比べたら、はるかに人間にとって理解しやすいわけです。かつ、プログラミング言語の言葉一つ一つは、コンピュータを動かすための一つ一つの部品として、入れ替え差し替えがいついかなる時でも自由でなくてはなりません。
そのような２つの理由から、私は趣味でＢａｓｉｃ言語のプログラムを組む場合は、なるだけコメントをつけずにやってしまうようになりました。プログラミングの専門家の人から見たら邪道と言われるかもしれませんが、それで支障が無いのですから仕方がありません。それでコンピュータが動かないと言うのならば、私は考え直すと思います。これは、もう一つ別の意味での『禁じられた遊び』なのかもしれません。
