VBScriptでEntity FrameworkっぽくSqlQueryで型付きO/Rマッピング

先日の記事で作った、LINQっぽいArrayListクラスをもっと使い倒す為に、Entity FrameworkっぽくSQLから直接型付きオブジェクトにマッピングしてくれるヘルパー関数 SqlQueryを作成。

型付きっていっても所詮VBScriptですが、IDEの力を借りればそれなりに便利です。

こんな風に使えます。ちょっと.NETっぽくないですか？

'DBオープン
Set DBConnect = Server.CreateObject("ADODB.Connection")
DBConnect.Open DSN, UID

'SELECT文
Dim SQL
SQL = "SELECT Cd, Name, SectionCd FROM Employee ORDER BY Cd;"

'SQLクエリから直接エンティティのリストを生成
Dim empList
Set empList = SqlQuery( DbConnect, "Employee", SQL ) '第二引数はエンティティクラス名

For Each item In empList.Where("item.SectionCd = 30" ).Items
	Response.Write "<li>" & item.Name & "</li>"
Next

DbConnect.Close
Set DBConnect = Nothing

エンティティクラスはこんな感じで自分で定義。テーブル名と同じにする必要はありませんが、メンバ名をテーブルのフィールド名と同名にすればSqlQueryくんが勝手に代入してくれます。

Employee

Class Employee
	Public Cd
	Public Name
	Public SectionCd
End Class

SqlQuery本体はこんな感じです。

SqlQuery

Public Function SqlQuery(DbConn, className, sql)
	Dim RS
	Set RS = Server.CreateObject("ADODB.Recordset")

	RS.Open sql, DbConn, adOpenKeyset, adLockReadOnly    '静的スクロール、読取り専用

	Dim list
	Set list = New ArrayList

	Do Until RS.EOF
		Dim item
		Set item = Eval("New " & className )

		Dim field
		For Each field In RS.Fields
			On Error Resume Next
			If IsNull(RS(field.Name)) Then
				Execute("item." & field.Name & " = RS(field.Name)")	'Nullを設定
			Else
				'とりあえずSQL Serverで必要なぶん
				Select Case field.Type
					Case adChar '余分な末尾空白を除去
						Execute("item." & field.Name & " = RTrim(RS(field.Name))")
					Case adDBTimeStamp
						Execute("item." & field.Name & " = CDate(RS(field.Name))")
					Case Else
						Execute("item." & field.Name & " = RS(field.Name)")
				End Select
			End If
			On Error GoTo 0
		Next

		list.Add item
		RS.MoveNext
	Loop

	RS.Close
	Set RS = Nothing

	Set SqlQuery = list

End Function

楽しいClassic ASPライフの為に。