たにぐちBLOG

祝　およげたいやきくんギネス認定

たにぐち — Wed, 20 Feb 2008 14:40:00 GMT

いやぁ懐かしいですね。子供の頃大好きでした。
http://contents.oricon.co.jp/news/music/52000/

私のカラオケの十八番なんですが、３０代後半から４０代前半の方には大ウケします。ほんものの子門真人さんみたいと言ってもらえることも（←ほんとうですってば）！
♪ま～い～にち、ま～い～にち僕らはてっぱんのぉ～♪

# 今日会社を休んでいます。昨日朝通勤途中で足を挫いてしまい、足首の激痛で歩行が困難なためです。
足首が腫れて赤くなっています。１階と２階の上り下りがツライです。
原因は歩道の段差に気付かなかったことですが、われながら情けないです。トホホ。

タイ在住時住んでいたマンションを発見！

たにぐち — Sat, 16 Feb 2008 23:42:00 GMT

何気なく、google earthで遊んでいました。オモシロいですね。中学１年生の頃住んでいたスクムビット通りのソイ４７はどうなっただろうと、見てみました。住んでいたマンションはさすがに無いだろうなぁ、と思っていると、それらしき建物を発見！建物の形状、プールの位置などから間違いないと断定しました。名前は当時「ウィッタヤー・コート」という名前でした。タイの物件情報を検索してもそれらしきものは見つかりませんでした。それもそのはず、そのマンションは「スリンダ・マンション」と名前を変えていたのです。

http://www.kobayashi.co.th/sukhumvit/apartment/sk1397.htm

http://www.platinum-service.jp/new34.htm

建物、プールや庭の様子などはそのまんま（新オーナーの趣味なのか植えてある植物は増えています）。しかし、築１９８９年とは！？私が帰国したのは１９８３年末でその頃すでに新しくは無かったんですが。。
改築したにしてもあまりにもそのまますぎです。

マイペンライ！マイペンライ！

が～ん

たにぐち — Sat, 02 Feb 2008 23:52:00 GMT

昨日、健康診断に行ってきましたが、血圧がなんと上が１３５、下が９０でした。
職場近くはおいしい店がたくさんあるため、連日の食べ歩きのせいか、
なんて思ったりもしていますが、血圧が１年で１０もあがってしまうのは
ちょっとヤバイかもと思っています。

そこで今日から食生活改善計画を打ち立てました！

1.大好きなビール、焼酎は土曜夜週１回に限る。
飲み会のあった週は中止。
2.夜９時以降は、食べない。
3.スナック菓子は食べない。おやつは和菓子のみ。
4.昼の食べ歩きストップはちょっとさびしいので、
朝おにぎり一個、夜は野菜、魚、豆腐、こんにゃく等を中心にする。

さて、いつまで続くやら？

ちなみに餃子騒ぎで回収品目になった「ピリ辛カルビ炒飯」
は好きでよく食べていました。
冷凍餃子も、ホットプレートやフライパンで手軽に調理出来るので、
よく食べていましたが、幸いなことにそれで体調を崩すことはありませんでした。

ファイル「完全削除」

たにぐち — Thu, 10 Jan 2008 23:29:00 GMT

せっかく暗号化しても、いったん復号化してディスクに保存してしまうと、削除してもファイル復活ツールで戻せてしまいます。
ツールを使って実験してみると、なるほど別なファイルにクラスタを使われてさえいなければ、簡単に戻せてしまいます。
#そういえばMS-DOSの時代にUNDELETEなんてツールがありましたね

とある打合せでこの点をズバリ指摘されてしまったのですが、調べてみると色々な方法があるようです。
単に0データで埋めればデータは消せるんじゃないかと思っていましたが、どうやら以前にディスクがどのような状態だったか調べる事も出来るらしく、
安全を期すなら複数回データを上書きする必要があるようです。

1. ランダムなデータを上書き
2. 0データを上書き
3. ファイルの削除

これくらいで十分かな？と思い以下の実験用コードを書いて実験しました。

void FileErase(CString filename)
{
      try
      {
            const int BUF_SIZE = 2048;
            CFile writeFile(filename,
                        CFile::modeWrite |
                        CFile::typeBinary);

            // ファイル長の取得
            int file_len = writeFile.GetLength();

            // NULL埋め用
            unsigned char buf_null[BUF_SIZE];
            memset(buf_null, 0, BUF_SIZE);
            // RANDOM埋め用
            unsigned char buf_rand[BUF_SIZE];

// 乱数初期化
srand((unsigned int)time(NULL));

            int writeSize = 0;
            while (writeSize < file_len)
            {
                  // 乱数作成
                  for (int i = 0; i < BUF_SIZE; i++)
                  {
                        buf_rand[i] = (unsigned char)(rand() * 256 / (1.0 + RAND_MAX));
                  }
                  // 乱数書込
                  writeFile.Write(buf_rand, BUF_SIZE);
                  writeFile.Flush();

                  // さらにNULLで上書きするために巻き戻す
                  writeFile.Seek(-1 * BUF_SIZE, CFile::current);

                  // NULL書込
                  writeFile.Write(buf_null, BUF_SIZE);
                  writeFile.Flush();

writeSize += BUF_SIZE;

            }
            // ファイルを閉じます
            writeFile.Close();
            // ファイルを削除します
            CFile::Remove(filename);
      }
      catch (...)
      {
            throw;
      }
}

実験してみると、復元されたファイルは0埋めされていたので、どうやら成功だったようです。

一時ファイルを作成するプログラムもありますが、そこまで追いかけていくことは難しそうです。

あけましておめでとうございます

たにぐち — Thu, 10 Jan 2008 02:01:00 GMT

あけましておめでとうございます。

かなり久しぶりの投稿です。去年の６月に７年間半暮らした板橋のアパートを引き払い

故郷の千葉県北西部に戻ってきました。

昔過ごした「元実家」に一人で住むことになりましたが。。さすがに古い！です。

Internationalに何気なくチェックしてしまったがために押し寄せてきた大量の

MSDNのCDROMをしまう場所が出来たのはうれしいですが。。

古いけれど、住み慣れた家というのはやっぱりいいもんですね。

たにぐち、MSDN premium subscriptionに入会する

たにぐち — Mon, 06 Feb 2006 00:05:00 GMT

前からの夢だったんですけど。。でもやっぱ３０万円は痛かった。。

仕事は現在PHP、その前は通信系(Linux, C++)でなぜか仕事に結びつきません。

んー、そのうちいつか、ね。

現在、押し寄せてくるCDの山に備えて部屋を整理中です。

今年もまた寝正月

たにぐち — Fri, 06 Jan 2006 02:25:00 GMT

あけましておめでとうございます。

年末は勉強しようと思い、実家に行く前に本をかばんに入れました。
さらにはたまたま寄った本屋で欲しかった本を見つけ購入しました。

ところが。。

年末は酒を飲んで眠くなり、年越しそばを食って眠くなる。
正月も酒を飲んで眠くなり、雑煮を食って眠くなる。

結局食う寝るの生活で終わってしまいました。

元日に実家の近所を歩いていると、なんだか時間がゆっくり流れているような独特の雰囲気を感じました。
この静けさで毎年、正月が来たんだな、去年はもう終わってしまったんだなとつくづく実感します。

今になって何もしないで終わってしまった去年を悔やんでも仕方がないのですが、この様子だと今年も！？
(><)

Visual Basic 6.0で擬似抽象クラス

たにぐち — Sat, 13 Aug 2005 04:45:00 GMT

よく知られている通り、Visual Basic 6.0ではクラスの継承ができません。よって、抽象クラスもないしprotectedというアクセス指定子もありません。VB6プログラマにとって唯一インターフェース継承のみが残されていますが、これも機能は貧弱です。それではVB6プログラマはデザインパターンを意識したプログラミングはあきらめなければならないのでしょうか？
今回は、VB6のインターフェース継承の機能が貧弱であることを逆に利用してVB6で擬似的に抽象クラスを実装してしまおうというお話です。

インターフェースには本来実装が許されません。しかし、VB6では幸いにも?それができてしまいます。
以下のようなクラスを作成してみました。

' 擬似抽象クラス
' PseudoAbstractClass.cls(クラスモジュール)

Private m_SubClass As PseudoAbstractClass

' 内部変数(本当はprotectedにしたい)
Private m_Message As String
Private m_Count As Integer

' 子クラスを保持します
Public Property Set SubClass(value As PseudoAbstractClass)
   Set m_SubClass = value
End Property

Public Sub Release()
   ' 後始末用
   ' ここでは実装しない
End Sub

Public Property Get Message() As String
Message = m_Message
End Property

Public Property Let Message(value As String)
m_Message = value
End Property

Public Property Get Count() As Integer
Count = m_Count
End Property

Public Property Let Count(value As Integer)
m_Count = value
End Property

' 擬似abstract関数。子クラスで実装
Public Function SuperClassAbstractFunction() As String
SuperClassAbstractFunction = _
m_SubClass.SuperClassAbstractFunction
End Function

Public Sub SuperClassAbstractSub()
m_SubClass.SuperClassAbstractSub
End Sub

Public Sub SuperClassSub()
   Dim I As Integer
   For I = 1 To m_Count
      Debug.Print SuperClassAbstractFunction
   Next I
   Call SuperClassAbstractSub
End Sub

Visual Basic 6.0ではprotectedアクセス指定子がないので、仕方なくプロパティで代用します。メンバ変数はMessageと、Countです。
もう一つ、m_SubClassという変数があります。プロパティSubClassで取得した子クラスはここに格納されます。擬似抽象メソッドSuperClassAbstractFunction、SuperClassAbstractSubでは、m_SubClassの相当関数を実行します。擬似抽象メソッドは、これを継承したクラスが決定後初めて決まります。今は入れ物だけです。

メソッドSuperClassSubですが、ここでは抽象メソッドを使用して何を実行するかが書かれています。ここでは、SuperClassAbstractFunctionの戻り値をm_Count回デバッグウィンドウに表示した後、SuperClassAbstractSubを実行するといった単純なものです。擬似抽象クラスSuperClassAbstractFunctionと、SuperClassAbstractSubが何を行うかまだ決定していないことにご注意ください。

早速、この擬似抽象クラスを継承した子クラスを作成します。

' 子クラス
' SubClass1.cls(クラスモジュール)

Implements PseudoAbstractClass

Private m_BaseClass As PseudoAbstractClass

Private Sub Class_Initialize()
    ' 擬似抽象クラスのインスタンスを作り、そのSubClassプロパティに自分を代入する。
   Set m_BaseClass = New PseudoAbstractClass
   Set m_BaseClass.SubClass = Me
End Sub

Private Sub PseudoAbstractClass_Release()
   ' 後始末。使用後、必ず実行する。
   Set m_BaseClass.SubClass = Nothing
   Set m_BaseClass = Nothing
End Sub

Private Property Set PseudoAbstractClass_SubClass(value As PseudoAbstractClass)
   ' 実装しない
End Property

Private Property Let PseudoAbstractClass_Message(value As String)
   m_BaseClass.Message = value
End Property
Private Property Get PseudoAbstractClass_Message() As String
   PseudoAbstractClass_Message = m_BaseClass.Message
End Property
Private Property Let PseudoAbstractClass_Count(value As Integer)
   m_BaseClass.Count = value
End Property
Private Property Get PseudoAbstractClass_Count() As Integer
   PseudoAbstractClass_Count = m_BaseClass.Count
End Property

Private Sub PseudoAbstractClass_SuperClassSub()
m_BaseClass.SuperClassSub
End Sub

' ここより上は全て共通
' この下よりこのクラスの固有の実装(override)

Private Function PseudoAbstractClass_SuperClassAbstractFunction() As String
PseudoAbstractClass_SuperClassAbstractFunction = "*****" & m_BaseClass.Message & "*****"
End Function

Private Sub PseudoAbstractClass_SuperClassAbstractSub()
   Debug.Print "******************************" & vbCrLf
   Debug.Print "*********" & m_BaseClass.Message & "*********" & vbCrLf
   Debug.Print "******************************" & vbCrLf
End Sub

冒頭にImplements PseudoAbstractClassとあります。これで、このクラスのオブジェクトをPseudoAbstractClassのSubClassプロパティに入れることができるようになります。このクラスのInitializeメソッド(コンストラクタ)で、擬似抽象クラスのインスタンスを作り、SubClassプロパティに自分(Me)を代入してしまいます。Message, Countプロパティはそのまま親クラスのものを引き継ぎます。PseudoAbstractClass_SuperClassSubは親クラスのものをそのまま引き継ぐため、m_BaseClassの相当関数を実行します。ここより上は全て共通です。PseudoAbstractClass_SuperClassAbstractFunction、PseudoAbstractClass_SuperClassAbstractSubで、このクラスに固有の実装(override)をします。メッセージに「*」の飾りをつけるだけという簡単なものです。

「ここより上は全て共通」コメントより上の部分をコピーして、SubClass2.clsというクラスを作り貼り付けます。その下に以下のような関数を作成します。

Private Function PseudoAbstractClass_SuperClassAbstractFunction() As String
PseudoAbstractClass_SuperClassAbstractFunction = "-----" & m_BaseClass.Message & "-----"
End Function

Private Sub PseudoAbstractClass_SuperClassAbstractSub()
   Debug.Print "------------------------------" & vbCrLf
   Debug.Print "---------" & m_BaseClass.Message & "---------" & vbCrLf
   Debug.Print "------------------------------" & vbCrLf
End Sub

「*」が「-」に変わっただけです(^^;。以下は使用例です。

' Form1.frm(フォームモジュール)

Private Sub Command1_Click()
   Dim AbstractBaseClass1 As PseudoAbstractClass
   Set AbstractBaseClass1 = New SubClass1
   AbstractBaseClass1.Message = "継承クラス１"
   AbstractBaseClass1.Count = 2
   AbstractBaseClass1.SuperClassSub
   ' 後始末は必ず実行する
   AbstractBaseClass1.Release
   Dim AbstractBaseClass2 As PseudoAbstractClass
   Set AbstractBaseClass2 = New SubClass2
   AbstractBaseClass2.Message = "継承クラス２"
   AbstractBaseClass2.Count = 3
   AbstractBaseClass2.SuperClassSub
   AbstractBaseClass2.Release
End Sub

出力は以下の通りです。

*****継承クラス１*****
*****継承クラス１*****
******************************

*********継承クラス１*********

******************************

-----継承クラス２-----
-----継承クラス２-----
-----継承クラス２-----
------------------------------

---------継承クラス２---------

------------------------------

一見、子クラスのメンテが大変のように見えますが、擬似抽象メソッドの実装を除きほとんど共通ですので、一個作成、変更すれば後はコピペでいけます。
基本的な考え方は、親クラスで入れ物を用意しておき、子クラスで入れ物に実装することです。新しい実装がほしくなれば、SubClass1をじゃんじゃんコピーして擬似抽象メソッドの中だけ書き換えればよいわけです。

VBのInterfaceは、一回継承したものを親クラスとしてさらに継承することはできません。その代わり、一度に複数のInterfaceを継承することができます。

この考え方でVB6で色々なデザインパターンを試してみると面白そうです。できないもの、複雑すぎて実用性のないものも出てくるとは思いますが、「継承」について基本に戻って考えさせてくれる良い機会になるかもしれません。

ASPのActiveX dllを使った連動プルダウンの実装

たにぐち — Thu, 21 Jul 2005 02:37:00 GMT

http://blogs.sqlpassj.org/masatotaniguchi/archive/2005/07/09/12119.aspx

の続きになります。
前回は、aspファイルからデータアクセスを分離してみましたが、そのデータアクセスオブジェクト(DAO)はaspから呼ばれるとは限りません。別のActiveX dllから呼ばれ、例えばWEBの画面を動的に構成するということも考えられます。その例として取り上げたのが連動（連結）プルダウン（コンボボックス）です。部署を選択すると、その部署に属する社員だけが選択されるといったVisual Basic 6.0やVBAのプログラミングではおなじみのインターフェースです。WEBアプリケーションでは連動プルダウンがいくつもある場合、部署を選択するたびにリクエストを行うと、ユーザーにもサーバーにも負担をかけてしまいます。
そこで、例えばこのようなActiveX dllを作ってみました。

ソースファイル：linkedlist.asp
<HTML>
<HEAD>
<TITLE>連動プルダウン</TITLE>
<%
Set EmpLinkedListBox = Server.CreateObject("ScottView.clsEmpLinkedListBox")
EmpLinkedListBox.InitFunctionName = "onInit"
EmpLinkedListBox.ParentOnChangeFunctionName = "parentOnChange"
EmpLinkedListBox.ParentListName = "parentList"
EmpLinkedListBox.ChildListName = "childList"
%>
<%=empLinkedListBox.GetJavaScript%>
</HEAD>
<BODY onLoad="onInit(document.linkedList.parentList, document.linkedList.childList)">
<FORM name="linkedList">
   部署 <SELECT name="parentList" onChange="parentOnChange(document.linkedList.parentList, document.linkedList.childList)">
   </SELECT><BR>
   社員 <SELECT name="childList">
   </SELECT>
</FORM>
</BODY>
</HTML>

上のようなaspが変換後、下のようになれば成功です。

<HTML>
<HEAD>
<TITLE>連動プルダウン</TITLE>
<SCRIPT LANGUAGE="JavaScript1.1">
<!--
function onInit(parentList, childList) {
      childList.options[0] = new Option("CLARK", "7782")
      childList.options[1] = new Option("KING", "7839")
      childList.options[2] = new Option("MILLER", "7934")
      parentList.options[0] = new Option("ACCOUNTING", "10")
      parentList.options[1] = new Option("RESEARCH", "20")
      parentList.options[2] = new Option("SALES", "30")
      parentList.options[3] = new Option("OPERATIONS", "40")

}
function parentOnChange(parentList, childList) {
   var parentListValue = parentList.value;
   childList.length = 0;
   if (parentListValue == "10") {
      childList.options[0] = new Option("CLARK", "7782")
      childList.options[1] = new Option("KING", "7839")
      childList.options[2] = new Option("MILLER", "7934")
   } else if (parentListValue == "20") {
      childList.options[0] = new Option("SMITH", "7369")
      childList.options[1] = new Option("JONES", "7566")
      childList.options[2] = new Option("SCOTT", "7788")
      childList.options[3] = new Option("ADAMS", "7876")
      childList.options[4] = new Option("FORD", "7902")
   } else if (parentListValue == "30") {
      childList.options[0] = new Option("ALLEN", "7499")
      childList.options[1] = new Option("WARD", "7521")
      childList.options[2] = new Option("MARTIN", "7654")
      childList.options[3] = new Option("BLAKE", "7698")
      childList.options[4] = new Option("TURNER", "7844")
      childList.options[5] = new Option("JAMES", "7900")
   } else if (parentListValue == "40") {
   }
}
// -->
</SCRIPT>

</HEAD>
<BODY onLoad="onInit(document.linkedList.parentList, document.linkedList.childList)">
<FORM name="linkedList">
   部署 <SELECT name="parentList" onChange="parentOnChange(document.linkedList.parentList, document.linkedList.childList)">
   </SELECT><BR>
   社員 <SELECT name="childList">
   </SELECT>
</FORM>
</BODY>
</HTML>

この例では、連動プルダウンは一つですが、SELECTタグの名前と、それにあわせて関数を呼ぶ時の引数を変えれば部署-社員の連動プルダウンはいくつも作ることができます（ただし初期化関数は個数分繰り返して呼ぶ必要があります）。変換後のHTMLソースをじっと眺めると、onInit関数は親子の初期化、parentOnChange関数はif分の条件式と、その{}の中に特徴があります。そこで、初期化関数(onInit)のオプション生成をコレクションにしたものと、親プルダウン変更時関数(parentOnChange)のIFブロック（部署ごとにグループ化された社員のオプション生成）をコレクションにしたものを渡せば、上記JavaScriptを生成するクラスを作成してみました。ScottViewという名前のActiveX dllプロジェクトをつくり、プロジェクトメニューの参照設定で、ScottDAOを追加します。そして以下のソースファイルを追加します。JavaScript用標準モジュール以外全てクラスモジュールですがclsEmpLinkedListBox以外はInstancingプロパティをPrivateにします。エラー処理、データのチェックは省略してあります。

' ソースファイル clsLinkedListBoxBuilder：クラスモジュール
Private m_ParentListName As String
Private m_ChildListName As String
Private m_InitFunctionName As String
Private m_ParentOnChangeFunctionName As String
Private m_InitFunctionOptions As Collection
Private m_ParentOnChangeIfBlocks As Collection

' 初期化関数名
Public Property Let InitFunctionName(strInitFunctionName As String)
m_InitFunctionName = strInitFunctionName
End Property

' 親リスト変更イベント関数名
Public Property Let ParentOnChangeFunctionName( _
strParentOnChangeFunctionName As String)
m_ParentOnChangeFunctionName = strParentOnChangeFunctionName
End Property

' 親リスト名
Public Property Let ParentListName(strParentListName As String)
m_ParentListName = strParentListName
End Property

Public Property Get ParentListName() As String
ParentListName = m_ParentListName
End Property

' 子リスト名
Public Property Let ChildListName(strChildListName As String)
m_ChildListName = strChildListName
End Property

Public Property Get ChildListName() As String
ChildListName = m_ChildListName
End Property

' 初期化関数本体
Public Property Set InitFunctionOptions(Options As Collection)
Set m_InitFunctionOptions = Options
End Property

' ParentOnChange関数用If Block
Public Property Set ParentOnChangeIfBlocks(IfBlocks As Collection)
Set m_ParentOnChangeIfBlocks = IfBlocks
End Property

' 初期化関数作成
Private Function CreateInitFunctionBody() As String
    Dim strRet As String
    Dim strOption As Variant

    strRet = ""

    For Each strOption In m_InitFunctionOptions
        strRet = strRet & JS_INDENT & strOption & vbCrLf
    Next

    CreateInitFunctionBody = strRet

End Function

' ParentOnChange関数作成
Private Function CreateParentOnChangeFunctionBody() As String

    Dim strRet As String
    Dim IfBlock As clsParentOnChangeIfBlock

    Const FIRST_IF_TEMPLATE = JS_INDENT & "if (parentListValue == ""?"") {"
    Const ELSE_IF_TEMPLATE = JS_INDENT & "} else if (parentListValue == ""?"") {"
    Const CLOSE_IF = JS_INDENT & "}"

    ' 選択されている親リストのキーをparentListValue変数に代入するjavaScriptコード
    strRet = JS_INDENT & "var parentListValue = " & m_ParentListName & ".value;" & vbCrLf
    ' 子リストの内容をクリア(length = 0)
    strRet = strRet & JS_INDENT & m_ChildListName & ".length = 0;" & vbCrLf

    ' IFブロックの作成
    Dim blnFirstBlock As Boolean
    blnFirstBlock = True
    For Each IfBlock In m_ParentOnChangeIfBlocks
        If blnFirstBlock Then
            strRet = strRet & Replace(FIRST_IF_TEMPLATE, "?", IfBlock.Key) & vbCrLf
            strRet = strRet & IfBlock.Body
        Else
            strRet = strRet & Replace(ELSE_IF_TEMPLATE, "?", IfBlock.Key) & vbCrLf
            strRet = strRet & IfBlock.Body
        End If
        blnFirstBlock = False
    Next
    ' IFブロックを閉じる
    strRet = strRet & CLOSE_IF

    CreateParentOnChangeFunctionBody = strRet

End Function

' JavaScript作成
Public Function GetJavaScript() As String

    Dim strRet As String

    ' 初期化関数引数
    Dim strInitVar As String
    ' ParentOnChange関数引数
    Dim strParentOnChangeVar As String
    strInitVar = m_ParentListName & ", " & m_ChildListName
    strParentOnChangeVar = m_ParentListName & ", " & m_ChildListName

    ' JSタグ
    strRet = JS_START_TAG
    ' 初期化関数
    strRet = strRet & CretateJSFunction(m_InitFunctionName, _
            strInitVar, CreateInitFunctionBody()) & vbCrLf
    ' ParentOnChange関数
    strRet = strRet & CretateJSFunction(m_ParentOnChangeFunctionName, _
            strParentOnChangeVar, CreateParentOnChangeFunctionBody()) & vbCrLf

    strRet = strRet & JS_END_TAG

    GetJavaScript = strRet

End Function

ただし、親プルダウン変更時関数(parentOnChange)のIFブロックを保存するために以下のクラスを用いました。

' ソースファイル clsParentOnChangeIfBlock：クラスモジュール
Private m_Key As String

Private m_Body As String

Public Property Let Key(strKey As String)
m_Key = strKey
End Property

Public Property Get Key() As String
Key = m_Key
End Property

Public Property Let Body(strBody As String)
m_Body = strBody
End Property

Public Property Get Body() As String
Body = m_Body
End Property

またJavaScript用の共通関数として、以下の標準モジュールを使用しています。Active X dllではグローバル変数の使用はご法度なので注意が必要です。

' ソースファイル JavaScript：標準モジュール
' JavaScriptタグ
Public Const JS_START_TAG = " " & vbCrLf

' インデント
Public Const JS_INDENT = " "

' JavaScript関数を作成
Public Function CretateJSFunction(strFunctionName As String, _
        strVar As String, strFunctionBody As String) As String

    CretateJSFunction = "function " & _
        strFunctionName & "(" & strVar & ") {" & _
        vbCrLf & strFunctionBody & vbCrLf & "}"

End Function

' オプションを作成
Public Function CreateJSOption( _
        strSelectName As String, intOptionIndex As Integer, _
        strText As String, strValue As String)
    CreateJSOption = strSelectName & ".options" & "[" & intOptionIndex & "]"
    CreateJSOption = CreateJSOption & _
        " = new Option(""" & strText & """, """ & strValue & """)"
End Function

clsLinkedListBoxBuilderを包み込むような感じで、clsEmpLinkedListBoxクラスを作成します。
ScottDAOで作成したclsEmpDaoのほかに、部署用のclsDeptDaoが追加されています。
clsDeptDaoの作り方はclsEmpDaoと全く同じです。

' ソースファイル clsEmpLinkedListBox：クラスモジュール

Private LinkedListBoxBuilder As clsLinkedListBoxBuilder

' 初期化関数名
Public Property Let InitFunctionName(strInitFunctionName As String)
LinkedListBoxBuilder.InitFunctionName = strInitFunctionName
End Property

' 親リスト変更イベント関数名
Public Property Let ParentOnChangeFunctionName( _
        strParentOnChangeFunctionName As String)
    LinkedListBoxBuilder.ParentOnChangeFunctionName = _
            strParentOnChangeFunctionName
End Property

' 親リスト名
Public Property Let ParentListName(strParentListName As String)
LinkedListBoxBuilder.ParentListName = strParentListName
End Property

' 子リスト名
Public Property Let ChildListName(strChildListName As String)
LinkedListBoxBuilder.ChildListName = strChildListName
End Property

' clsLinkedListBoxBuilderクラス初期化
Private Sub Class_Initialize()
Set LinkedListBoxBuilder = New clsLinkedListBoxBuilder
End Sub

Public Function GetJavaScript() As String

    Dim ScottDaoFactory As clsScottDAOFactory
    Dim EmpDao As clsEmpDao
    Dim DeptDao As clsDeptDao
    Dim Dept As Collection
    Dim DeptVo As clsDeptVo

    ' LinkedListBoxBuilderに渡す
    ' InitFunctionOptionsプロパティと
    ' ParentOnChangeIfBlocksプロパティ
    Dim InitFunctionOptions As Collection
    Dim ParentOnChangeIfBlocks As Collection
    Set InitFunctionOptions = New Collection
    Set ParentOnChangeIfBlocks = New Collection

    ' 部署リストボックスの配列のINDEX用
    Dim intDeptCount As Integer

    ' 初期化関数オプション一時保存用
    Dim InitFunctionOption As String

    ' DAOFactoryインスタンス作成
    Set ScottDaoFactory = New clsScottDAOFactory

    ' 部署、社員DAO取得
    Set DeptDao = ScottDaoFactory.DeptDao
    Set EmpDao = ScottDaoFactory.EmpDao

    ' 部署を全て選択
    Set Dept = DeptDao.SelectDept

    ' 全選択された部署ごとのループ
    intDeptCount = 0
    For Each DeptVo In Dept

        Dim Emp As Collection
        Dim EmpVo As clsEmpVo

        ' 部署（親）リスト変更イベント関数IFブロック作成
        Dim ParentOnChangeIfBlock As clsParentOnChangeIfBlock
        Set ParentOnChangeIfBlock = New clsParentOnChangeIfBlock
        ParentOnChangeIfBlock.Key = DeptVo.DeptNo
        ParentOnChangeIfBlock.Body = ""

        intDeptCount = intDeptCount + 1

        Set Emp = EmpDao.SelectEmp(DeptVo.DeptNo)

        ' 社員番号リストボックスの配列のINDEX用
        Dim intEmpCount As Integer
        intEmpCount = 0
        ' 部署に属する社員のループ
        For Each EmpVo In Emp

            intEmpCount = intEmpCount + 1
            If intDeptCount = 1 Then
                ' 初期化関数は、社員（子）リストボックスに
                ' 最初のINDEXの部署の社員をリストする
                InitFunctionOption = JS_INDENT & _
                    CreateJSOption(LinkedListBoxBuilder.ChildListName, _
                    intEmpCount - 1, EmpVo.Ename, EmpVo.EmpNo)
                Call InitFunctionOptions.Add(InitFunctionOption)
            End If
            ' ParentOnChangeのIfブロック内のオプション(INDENT二つ)
            ParentOnChangeIfBlock.Body = ParentOnChangeIfBlock.Body & _
                JS_INDENT & JS_INDENT & _
                CreateJSOption(LinkedListBoxBuilder.ChildListName, _
                    intEmpCount - 1, EmpVo.Ename, EmpVo.EmpNo) & vbCrLf
        Next
        ' 初期化関数の本体を作成
        InitFunctionOption = JS_INDENT & _
            CreateJSOption(LinkedListBoxBuilder.ParentListName, intDeptCount - 1, _
            DeptVo.DName, DeptVo.DeptNo)
        Call InitFunctionOptions.Add(InitFunctionOption)
        ' その部署の社員分のオプションをBodyにつめ終えたので、
        ' ParentOnChangeIfBlocksコレクションに追加
        Call ParentOnChangeIfBlocks.Add(ParentOnChangeIfBlock)
    Next

    ScottDaoFactory.CloseConnection

    Set LinkedListBoxBuilder.InitFunctionOptions = InitFunctionOptions
    Set LinkedListBoxBuilder.ParentOnChangeIfBlocks = ParentOnChangeIfBlocks

    GetJavaScript = LinkedListBoxBuilder.GetJavaScript

End Function

もし、他の連動プルダウンがほしくなった時は、同じようにclsLinkedListBoxBuilderを使い新たにクラスを作成します。

ASP(非ASP.NET)で、なるべくコードの変更を少なくして複数のデータベースに確実に対応できるようにする

たにぐち — Sat, 09 Jul 2005 02:43:00 GMT

http://blogs.sqlpassj.org/masatotaniguchi/archive/2005/06/10/9475.aspx
のASP版(非ASP.NET)です。ActiveX dllを使用し、ASPファイルからデータアクセス部分を分離、少ない変更で複数のデータベースに対応できるようにします。

Visual Basic 6.0で、ActiveX dllを作成し、ScottDAOという名前をつけます。これは、以前にご紹介したVB6版をActiveX dll化したものです。
※以下のソースコードはエラー処理などが省略してあり、完全ではありません。

テーブル(OracleのScott.Empテーブルと、それをSQL Server 2000にインポートしたテーブル)のレコードを保存するために、VO(Value Object)を用意します。これはVB6版と全く同じでそのまま移植できます。
Instancingプロパティは5-MultiUseとします。

' ソースコード(clsEmpVo)：クラスモジュール

' Private 変数
' 従業員番号
Private m_lngEmpNo As Long
' 従業員名
Private m_strEname As String

' 以下略

' プロパティ

Public Property Get EMPNO() As Long
EMPNO = m_lngEmpNo
End Property

Public Property Let EMPNO(lngEmpNo As Long)
m_lngEmpNo = lngEmpNo
End Property

Public Property Get Ename() As String
Ename = m_strEname
End Property

Public Property Let Ename(strEname As String)
m_strEname = strEname
End Property

' 以下略（フィールド分同じものを作ります）

インターフェースクラスは外部に公開したいため、Instancingプロパティを5-MultiUseとします。
これをこのまま公開しても、中は空っぽです。後でちょっと細工をします。

' ソースコード(clsEmpDao) ：クラスモジュール

Public Function SelectEmp(lngDeptNo As Long) As Collection

End Function

Public Function InsertEmp(EmpVo As clsEmpVo) As Boolean

End Function

Public Function UpdateEmp(EmpVo As clsEmpVo) As Boolean

End Function

Public Property Set Connection(con As Object)

End Property

clsEmpSQLServerDaoはVB6版とほとんど同じです（選択条件が部署番号になっている部分だけが違います）。このクラスは外部に公開しないため、Instancingプロパティを1-Privateとします。
Oracleについても全く同じなので、ここでは省略します。VB6版をご参照ください。
なお、nvl関数は標準モジュールにある独自の関数で動作はORACLEのNVLと全く同じです。

' ソースコード(clsEmpSQLServerDao)：クラスモジュール

Implements clsEmpDao

Private Connection As Object

Public Property Set clsEmpDao_Connection(con As Object)
Set Connection = con
End Property

Public Function clsEmpDao_SelectEmp(lngDeptNo As Long) As Collection

    Dim cmd As New ADODB.Command
    Dim result As New Collection
    Dim rs As ADODB.Recordset

    ' Commandの設定
    With cmd
        .ActiveConnection = Connection
        .CommandText = "SELECT * FROM EMP WHERE DEPTNO = ?"
        .CreateParameter , adInteger, adParamInput
        .Parameters(0).Value = lngDeptNo
    End With

    ' SQLを実行して結果セットを取得します
    Set rs = cmd.Execute

    ' Recordsetから、VOへ値を詰めます
    Do Until rs.EOF
        Dim EmpVo As clsEmpVo
        Set EmpVo = New clsEmpVo
        EmpVo.EmpNo = nvl(rs.Fields("EMPNO"), 0)
        EmpVo.Ename = nvl(rs.Fields("ENAME"), "")
        EmpVo.Job = nvl(rs.Fields("JOB"), "")
        EmpVo.Mgr = nvl(rs.Fields("MGR"), 0)
        EmpVo.HireDate = nvl(rs.Fields("HireDate"), 0)
        EmpVo.Sal = nvl(rs.Fields("SAL"), 0)
        EmpVo.Comm = nvl(rs.Fields("COMM"), 0)
        EmpVo.DeptNo = nvl(rs.Fields("DEPTNO"), 0)
        Call result.Add(EmpVo)
        rs.MoveNext
    Loop

    ' 後始末
    rs.Close
    Set rs = Nothing
    ' 戻り値(VOのコレクション)の設定
    Set clsEmpDao_SelectEmp = result
End Function

Public Function clsEmpDao_InsertEmp(EmpVo As clsEmpVo) As Boolean
' 省略
End Function

Public Function clsEmpDao_UpdateEmp(EmpVo As clsEmpVo) As Boolean
' 省略
End Function

さて、公開したいのはEmpDaoですがASPに渡したいのは中身の詰まったクラスです。
そこで以下のようなクラスを作成し外部に公開します（Instancingプロパティを5-MultiUse）。
データベースを変更する必要が出た時はここを変更します。

' ソースコード(clsScottDaoFactory)：クラスモジュール

' このクラスが生成するDAOは、clsScottDaoFactory
' のインスタンスが存命中の場合のみ使用できます。
' clsScottDaoFactoryインスタンスの消滅とともにDB
' 接続も自動的にCloseされるためです。

Private Connection As clsConnection

Public Function EmpDAO() As clsEmpDao
   Dim emp As clsEmpDao
   ' DB変更時、コードの変更が必要な場所
   Set emp = New clsEmpSQLServerDao
   ' Set emp = New clsEmpOracleDao
   Set Emp.Connection = Connection.GetConnection
   Set EmpDAO = emp
End Function

Private Sub Class_Initialize()
   Dim ConnectionFactory As New clsConnectionFactory
   Set Connection = ConnectionFactory.GetClsConnection
End Sub

' このメソッドは使用後、なるべく早く実行するようにします。
Public Sub CloseConnection()
    Connection.CloseConnection
    Set Connection = Nothing
End Sub

' 安全策
Private Sub Class_Terminate()
    If Not Connection Is Nothing Then
        Connection.CloseConnection
    End If
End Sub

ＤＢの接続のためのクラス、clsConnectionを定義します。これはインターフェースとして扱います（Instancingプロパティを5-MultiUse）。

' ソースコード(clsConnection)：クラスモジュール

Public Function GetConnection() As Object

End Function

Public Sub CloseConnection()

End Sub

SQLServerのためのclsConnectionの実装クラスを定義します（Instancingプロパティを1-Private）。Oracle用のclsOracleConnectionは省略します。

' ソースコード(clsSQLServerConnection)：クラスモジュール

Implements clsConnection

Private adoSQLServerCon As ADODB.Connection

Public Function clsConnection_GetConnection() As Object
    Set clsConnection_GetConnection = adoSQLServerCon
End Function

Public Sub clsConnection_CloseConnection()
    adoSQLServerCon.Close
    Set adoSQLServerCon = Nothing
End Sub

Private Sub Class_Initialize()
   Set adoSQLServerCon = New ADODB.Connection
    adoSQLServerCon.ConnectionString = _
        "PROVIDER=SQLOLEDB;SERVER=ServerName;DATABASE=Scott;UID=sa;PWD=*******"
    adoSQLServerCon.Open
End Sub

clsConnectionクラスを作成するためのクラスを定義します（Instancingプロパティを5-MultiUse）。

' ソースコード(clsConnectionFactory)：クラスモジュール

Public Function GetClsConnection() As clsConnection
   ' DB変更時、コードの変更が必要な場所
   Set GetClsConnection = New clsSQLServerConnection
   ' Set GetClsConnection = New clsOracleConnection
End Function

以上のActiveX dllを作成しレジストリに登録します。これをテストするためのＡＳＰファイルを用意しました。
For Eachが不安な方は、レコード数をresult.countで取得できるのでFor...Next文で書き換えてもいいと思います。

' ソースコード(ScottEmp.asp)：aspファイル

<HTML>
<BODY>
<%
Set scottDAOFactory = Server.CreateObject("ScottDAO.clsScottDAOFactory")
Set empDAO = scottDAOFactory.EmpDAO
Set result = empDAO.SelectEmp(20)
scottDAOFactory.CloseConnection
%>
<TABLE border="1">
<TR>
   <TH>従業員番号</TH>
   <TH>名前</TH>
   <TH>職種</TH>
   <TH>上司</TH>
   <TH>入社日</TH>
   <TH>給料</TH>
   <TH>歩合</TH>
   <TH>部署番号</TH>
</TR>
<%
For Each empVo In result
%>
<TR>
   <TD><%=empVo.EmpNo%></TD>
   <TD><%=empVo.Ename%></TD>
   <TD><%=empVo.Job%></TD>
   <TD><%=EmpVo.Mgr%></TD>
   <TD><%=EmpVo.Hiredate%></TD>
   <TD><%=empVo.Sal%></TD>
   <TD><%=EmpVo.Comm%></TD>
   <TD><%=empVo.deptNo%></TD>
</TR>
<%
Next
%>
</TABLE>
</BODY>
</HTML>

基本方針は、

aspファイルには画面表示ロジック以外はなるべく書かないようにする

ということです。ビジネスロジックもActiveX dllでカプセル化し、aspファイルからはそれを呼ぶだけにするようにします。