http://www.fmstocks.com/ (Asp Classic MS アプリケーションのサンプル)から提供された関数を常に使用してきました。それは非常にシンプルで、パラメータで動作します
使用例:
set rs = RunSQLReturnRs("Select * from Usuario where UsuarioID = ?", _
array(mp("@UsuarioID", adInteger, 0, UsuarioID)))
If not rs.eof then
UsuarioName = rs("FullName")
end if
DbHelper.ASP の完全なコード (何年にもわたってわずかに変更されています)
<!--#include file="../bus/adovbs.inc"-->
<%
Function GetConnectionString()
GetConnectionString = "file name=c:\udl\miconnstring.udl"
End Function
Function mp(PName , PType , PSize, PValue)
mp = Array(PName, PType, PSize, PValue)
End Function
Function RunSPReturnRS(strSP, params())
On Error Resume next
' Create the ADO objects
Dim rs , cmd
Set rs = server.createobject("ADODB.Recordset")
Set cmd = server.createobject("ADODB.Command")
' Init the ADO objects & the stored proc parameters
cmd.ActiveConnection = GetConnectionString()
cmd.CommandText = strSP
cmd.CommandType = adCmdStoredProc
cmd.CommandTimeout = 900 ' 15 minutos
collectParams cmd, params
' Execute the query for readonly
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
If err.number > 0 then
BuildErrorMessage()
exit function
end if
' Disconnect the recordset
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Set rs.ActiveConnection = Nothing
' Return the resultant recordset
Set RunSPReturnRS = rs
End Function
Function RunSP(strSP , params())
On Error resume next
' Create the ADO objects
Dim cmd
Set cmd = server.createobject("ADODB.Command")
' Init the ADO objects & the stored proc parameters
cmd.ActiveConnection = GetConnectionString()
cmd.CommandText = strSP
cmd.CommandType = adCmdStoredProc
cmd.CommandTimeout = 900 ' 15 minutos
collectParams cmd, params
' Execute the query without returning a recordset
cmd.Execute , , adExecuteNoRecords
If err.number > 0 then
BuildErrorMessage()
exit function
end if
' Disconnect the recordset and clean up
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Exit Function
End Function
Function RunSQL(strSP , params())
On Error resume next
' Create the ADO objects
Dim cmd
Set cmd = server.createobject("ADODB.Command")
' Init the ADO objects & the stored proc parameters
cmd.ActiveConnection = GetConnectionString()
cmd.CommandText = strSP
cmd.CommandType = adCmdText
cmd.CommandTimeout = 900 ' 15 minutos
collectParams cmd, params
' Execute the query without returning a recordset
cmd.Execute , , adExecuteNoRecords
If err.number > 0 then
BuildErrorMessage()
exit function
end if
' Cleanup
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Exit Function
End Function
Function RunSQLReturnRS(sqlstmt, params())
On Error Resume next
' Create the ADO objects
Dim rs , cmd
Set rs = server.createobject("ADODB.Recordset")
Set cmd = server.createobject("ADODB.Command")
' Init the ADO objects & the stored proc parameters
cmd.ActiveConnection = GetConnectionString()
cmd.CommandText = sqlstmt
cmd.CommandType = adCmdText
cmd.CommandTimeout = 900 ' 15 minutos
collectParams cmd, params
' Execute the query for readonly
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
If err.number > 0 then
BuildErrorMessage()
exit function
end if
' Disconnect the recordset
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Set rs.ActiveConnection = Nothing
' Return the resultant recordset
Set RunSQLReturnRS = rs
End Function
Function RunSPReturnInteger(strSP , params())
On Error resume next
' Create the ADO objects
Dim cmd
Set cmd = server.createobject("ADODB.Command")
' Init the ADO objects & the stored proc parameters
cmd.ActiveConnection = GetConnectionString()
cmd.CommandText = strSP
cmd.CommandType = adCmdStoredProc
cmd.CommandTimeout = 900 ' 15 minutos
collectParams cmd, params
' Assume the last parameter is outgoing
cmd.Parameters.Append cmd.CreateParameter("@retval", adInteger, adParamOutput, 4)
' Execute without a resulting recordset and pull out the "return value" parameter
cmd.Execute , , adExecuteNoRecords
If err.number > 0 then
BuildErrorMessage()
exit function
end if
RunSPReturnInteger = cmd.Parameters("@retval").Value
' Disconnect the recordset, and clean up
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Exit Function
End Function
Private Sub collectParams(cmd , argparams())
Dim params , v
Dim i , l , u
params = argparams
For i = LBound(params) To UBound(params)
l = LBound(params(i))
u = UBound(params(i))
' Check for nulls.
If u - l = 3 Then
If VarType(params(i)(3)) = vbString Then
If params(i)(3) = "" then
v = null
else
v = params(i)(3)
end if
Else
v = params(i)(3)
End If
If params(i)(1) = adLongVarChar Then
Dim p 'As New Parameter
Set p = cmd.CreateParameter(params(i)(0), params(i)(1), adParamInput)
p.Attributes = adParamLong + adParamSigned
If Not IsNull(v) Then
'Seteo para text columns is not null
p.AppendChunk v
p.Size = Len(v)
Else
'Seteo para text columns is null
p.Value = v
p.Size = 10000
End If
cmd.Parameters.Append p
Else
cmd.Parameters.Append cmd.CreateParameter(params(i)(0), params(i)(1), adParamInput, params(i)(2), v)
End If
Else
RaiseError m_modName, "collectParams(...): incorrect # of parameters"
End If
Next
End Sub
%>