Works - データベース接続あれこれ

ADO で SELECT（CSV形式で標準出力に表示）　▲TOP

ado_select01.vbs

'/************************************************************
' * Usage : CScript ado_select01.vbs //Nologo
' * 
' * ※DOS窓で実行（ダブルクリックでもエラーにはならないが）
' ************************************************************/
Dim uid
Dim pwd
Dim dsn
Dim sCon
Dim Con
Dim rs
Dim sSQL
Dim Result

myQuery

'/************************************************************
' * クエリー実行
' ************************************************************/
Sub myQuery
'// 接続文字列生成
uid = "uid"
pwd = "pwd"
dsn = "dsn"
sCon = "DSN=" & dsn & "; UID=" & uid & "; PWD=" & pwd

'//実行SQL生成（※ODBCドライバのバージョンによっては * だとエラーになる）
sSQL = "select * from kemp"

'// 接続
Set Con = CreateObject("ADODB.Connection")

'// オープン
Con.Open sCon

'// 実行
Set rs=Con.Execute(sSQL)

'// 取得結果をCSV形式で標準出力に表示
'// ※最初は WScript.StdOut.Write を使っていたのだが、某サイトで
'// 　「WScript.Echo を使った方がよい」
'// 　とあったので、1行分を変数に格納し、vbCrLf で改行するタイミングで
'// 　Echo するようにした。
'// 　パフォーマンス的にもこちらの方が良好である。
'// 　また、WScript.StdOut.Write を使用した場合、CScript で実行しないと
'// 　エラーになるので注意。
sDisp = ""
If rs.EOF Then
        MsgBox "該当データがありません"
Else
        rs.MoveFirst
        '// 列名を表示
        fc = rs.Fields.count - 1
        For i = 0 To fc
          sDisp = sDisp & rs.Fields(i).name & ","
        Next
        WScript.Echo sDisp
        sDisp = ""
        '// 取得結果を表示
        Do While Not rs.EOF
          For i = 0 To fc
            sDisp = sDisp & rs.Fields(i).value & ","
          Next
          WScript.Echo sDisp
          sDisp = ""
          rs.Movenext
        Loop
End If
'// クローズ
Con.Close

End Sub

ADO で SELECT（ブラウザから実行）　▲TOP

wshsqlvbs.htm(VBScript版)

<html>
<head>
<title>擬似WEBアプリ</title>
<script language="VBScript">
<!--
Dim uid
Dim pwd
Dim dsn
Dim sCon
Dim Con
Dim rs
Dim sSQL

Dim TheForm

Sub Button1_OnClick
'/************************************************************
' * 接続文字列生成
' ************************************************************/

Set TheForm = Document.QueryForm

'データソースによっては ユーザーID , パスワード を指定しない場合（txt , csv 等）
'もあるので必須にしない
uid = InputBox("ユーザーIDを入力してください","Enter UID","")
pwd = InputBox("パスワードを入力してください","Enter PWD","")

dsn = InputBox("接続先文字列を入力してください","Enter DSN","")
If dsn = "" then
  msgbox "接続先文字列 は必須です"
  Exit Sub
End If

sCon = "DSN=" & dsn & "; UID=" & uid & "; PWD=" & pwd
End Sub

Sub Button2_OnClick

On Error Resume Next
'/************************************************************
' * クエリー実行
' ************************************************************/

Set TheForm = Document.QueryForm

sSQL = TheForm.Query.Value 
TheForm.Result.Value = ""

'// 接続
Set Con = CreateObject("ADODB.Connection")
  If (Err.Number <> 0) Then
     showErrors Err.Number, "on CreateObject" ,""
     Exit Sub
  End If

'// オープン
Con.Open sCon
  If (Err.Number <> 0) Then
     Con.Close
     showErrors Err.Number, "on Open", "Connection:" & sCon
     Exit Sub
  End If

'// 実行
Set rs=Con.Execute(sSQL)
  If (Err.Number <> 0) Then
     Con.Close
     showErrors Err.Number, "on Execute", "SQL:" & sSQL
     Exit Sub
  End If

'// 表示
sDisp = ""
If rs.EOF Then
        MsgBox "該当データがありません"
Else
        rs.MoveFirst
        fc = rs.Fields.count - 1
        For i = 0 To fc
          sDisp = sDisp & rs.Fields(i).name & ","
        Next
        sDisp = sDisp & vbCrLf
        Do While Not rs.EOF
          For i = 0 To fc
            sDisp = sDisp & rs.Fields(i).value & ","
          Next
          TheForm.Result.Value = TheForm.Result.Value & sDisp & vbCrLf
          sDisp = ""
          rs.Movenext
        Loop
End If

'// クローズ
Con.Close
End Sub

'/************************************************************
' * エラー処理
' ************************************************************/
Sub showErrors(ErrNum, ErrText, ErrText2)
    strText = "Error : " & ErrNum & vbCrLf & Err.Description & vbCrLf & ErrText2
    MsgBox strText, vbInformation, "Error " & ErrText
End Sub
-->
</script>
</head>

<body>
<b>Simple Query for VBScript on IE</b><br>
<br>
<form name="QueryForm">
    <p><input type="button" name="Button1" value="接続">
    <input type="button" name="Button2" value="クエリー実行"></p>
    <p>SELECT文<br><textarea name="Query" rows="6" cols="89"></textarea> </p>
    <p>実行結果<br><textarea name="Result" rows="20" cols="89"></textarea> </p>
</form>

</body>
</html>

oo4o で SELECT（CSV形式で標準出力に表示）　▲TOP

oo4o_select01.vbs

'/************************************************************
' * Usage : CScript oo4o_select01.vbs //Nologo
' * 
' * ※DOS窓で実行（ダブルクリックでもエラーにはならないが）
' ************************************************************/
Dim OraSession
Dim OraDatabase
Dim OraDynaset

Dim uid
Dim pwd
Dim conn
Dim sCon
Dim sSQL
Dim Result

'//セッション確立
Set OraSession = CreateObject("OracleInProcServer.XOraSession")

myQuery

'/************************************************************
' * クエリー実行
' ************************************************************/
Sub myQuery
'// 接続文字列生成
uid = "uid"
pwd = "pwd"
conn = "conn"
sCon = uid & "/" & pwd

'//実行SQL生成
sSQL = "select * from kemp"

'// 接続
Set OraDatabase = OraSession.DbOpenDatabase(conn, sCon,clng(0))
  If OraDatabase.LastServerErr <> 0 Or OraDatabase.LastServerErrText <> "" Then
     showErrors Err.Number, "on CreateObject" ,""
     Exit Sub
  End If

'// 実行
Set OraDynaset = OraDatabase.CreateDynaset(sSQL,clng(0))
  If OraDatabase.LastServerErr <> 0 Or OraDatabase.LastServerErrText <> "" Then
     Con.Close
     showErrors Err.Number, "on Execute", "SQL:" & sSQL
     Exit Sub
  End If

'// 取得結果をCSV形式で標準出力に表示
'// ※最初は WScript.StdOut.Write を使っていたのだが、某サイトで
'// 　「WScript.Echo を使った方がよい」
'// 　とあったので、1行分を変数に格納し、vbCrLf で改行するタイミングで
'// 　Echo するようにした。
'// 　パフォーマンス的にもこちらの方が良好である。
'// 　また、WScript.StdOut.Write を使用した場合、CScript で実行しないと
'// 　エラーになるので注意。
sDisp = ""
fc = OraDynaset.Fields.count - 1
'// 列名を表示
For i = 0 To fc
    sDisp = sDisp & OraDynaset.Fields(i).name & ","
Next
WScript.Echo sDisp
sDisp = ""
'// 取得結果を表示
Do While Not OraDynaset.EOF
    For i = 0 To fc
        sDisp = sDisp & OraDynaset.Fields(i).value & ","
    Next
    WScript.Echo sDisp
    sDisp = ""
    OraDynaset.DBMoveNext
Loop

End Sub

'/************************************************************
' * エラー処理
' ************************************************************/
Sub showErrors(ErrNum, ErrText, ErrText2)
    strText = "Error : " & ErrNum & vbCrLf & Err.Description & vbCrLf & ErrText2
    MsgBox strText, vbInformation, "Error " & ErrText
End Sub

ADO でストアドプロシージャのOUTパラメータ取得　▲TOP

ado_proc01.vbs

Const adCmdStoredProc = &H0004
Const adParamInput = &H0001
Const adParamOutput = &H0002
Const adVarChar = 200

Dim uid
Dim pwd
Dim dsn
Dim sCon
Dim Con
Dim Cmd
Dim Result

doProc

'/************************************************************
' * ストアドプロシージャ実行
' ************************************************************/
Sub doProc
'// 接続文字列生成
uid = "uid"
pwd = "pwd"
dsn = "dsn"
sCon = "DSN=" & dsn & "; UID=" & uid & "; PWD=" & pwd

'// 接続
Set Con = CreateObject("ADODB.Connection")
  If (Err.Number <> 0) Then
     showErrors Err.Number, "on CreateObject" ,""
     Exit Sub
  End If

'// オープン
Con.Open sCon
  If (Err.Number <> 0) Then
     Con.Close
     showErrors Err.Number, "on Open", "Connection:" & sCon
     Exit Sub
  End If

'// コマンドオブジェクト
Set Cmd = CreateObject("ADODB.Command")
Cmd.ActiveConnection = Con
Cmd.CommandType = adCmdStoredProc
Cmd.CommandText = "SP_HOGE_OUTP"
  If (Err.Number <> 0) Then
     showErrors Err.Number, "on CommandCreateObject" ,""
     Exit Sub
  End If

'// パラメータ生成
Cmd.Parameters.Append Cmd.CreateParameter("OVAR", adVarChar, adParamOutput, 20)
  If (Err.Number <> 0) Then
     showErrors Err.Number, "on CreateParameter" ,""
     Exit Sub
  End If

'//ストアドプロシージャ実行
Cmd.Execute Result

'// クローズ
Con.Close

'// 取得結果を表示
MsgBox Cmd.Parameters("OVAR").Value

End Sub

'/************************************************************
' * エラー処理
' ************************************************************/
Sub showErrors(ErrNum, ErrText, ErrText2)
    strText = "Error : " & ErrNum & vbCrLf & Err.Description & vbCrLf & ErrText2
    MsgBox strText, vbInformation, "Error " & ErrText
End Sub

oo4o でストアドプロシージャのOUTパラメータ取得　▲TOP

oo4o_proc01.vbs

Const ORAPARM_INPUT = 1   '入力変数
Const ORAPARM_OUTPUT = 2  ' 出力変数
Const ORAPARM_BOTH = 3    '入力変数および出力変数の両方
Const ORATYPE_VARCHAR2 = 1   'VARCHAR2
Const ORATYPE_NUMBER = 2     'NUMBER
Const ORATYPE_DATE = 12      'DATE

Dim OraSession
Dim OraDatabase
Dim OraDynaset

'//セッション確立
Set OraSession = CreateObject("OracleInProcServer.XOraSession")

doProc

'/************************************************************
' * ストアドプロシージャ実行実行
' ************************************************************/
Sub doProc
'// 接続文字列生成
uid = "uid"
pwd = "pwd"
conn = "conn"
sCon = uid & "/" & pwd

'// 接続
Set OraDatabase = OraSession.DbOpenDatabase(conn, sCon,clng(0))
  If OraDatabase.LastServerErr <> 0 Or OraDatabase.LastServerErrText <> "" Then
     showErrors Err.Number, "on OpenDatabase" ,""
     Exit Sub
  End If

OraDatabase.Parameters.Add "OVAR", 0, ORAPARM_OUTPUT
OraDatabase.Parameters("OVAR").ServerType = ORATYPE_VARCHAR2

OraDatabase.DbExecuteSQL ("begin SP_HOGE_OUTP (:OVAR); end;")
  If OraDatabase.LastServerErr <> 0 Or OraDatabase.LastServerErrText <> "" Then
     showErrors Err.Number, "on ExecuteSQL" ,""
     Exit Sub
  End If

MsgBox OraDatabase.Parameters("OVAR").Value
 
End Sub

'/************************************************************
' * エラー処理
' ************************************************************/
Sub showErrors(ErrNum, ErrText, ErrText2)
    strText = "Error : " & ErrNum & vbCrLf & Err.Description & vbCrLf & ErrText2
    MsgBox strText, vbInformation, "Error " & ErrText
End Sub