Aggiungere qualche funzionalità a un comando adodb
/ 0
- Dettagli
- Categoria principale: Code Snippets
- Categoria: ASP Classic
- Pubblicato 30 Marzo 2012
- Visite: 437
Ho deciso di realizzare questa classe asp per poter avere qualche funzionalità in più in particolar modo in fase di debug, nell'uso degli oggetti adodb.commnd. La classe permette di aprire un comando sql di selezione e di tornare indietro il recordset derivante, inoltre attraverso l'uso di alcune proprietà è possibile fare il debug del comando. Dopo la classe si trova un esempio di come si usa. Il codice è commentato per cui non aggiungo altro.
class CommandRecordset
private m_CursorType, m_LockType, m_Opt, m_Log, m_CommandOutput, m_Out, m_URL, m_CursorLocation
'string
Public Property Let URL(value)
m_URL = value
End Property
'int
Public Property Let CursorTypeEnum(value)
m_CursorType = value
End Property
'int
'Public Property Get CursorTypeEnum()
' CursorTypeEnum = m_CursorType
'End Property
'int
Public Property Let LockTypeEnum(value)
m_LockType = value
End Property
'int
'Public Property Get LockTypeEnum()
' LockTypeEnum = m_LockType
'End Property
'int
Public Property Let CursorLocationEnum(value)
m_CursorLocation = value
End Property
Public Property Let Opt(value)
m_Opt = value
End Property
'int
'Public Property Get Opt()
' Opt = m_Opt
'End Property
'boolena
Public Property Let Log(value)
m_Log = value
End Property
'string
Public Property Get Output()
Output = m_Out
End Property
'boolena
Public Property Let CommandOutput(value)
m_CommandOutput = value
End Property
Private Sub Class_Initialize
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adCmdStoredProc = 4
Const adUseClient = 3
m_CursorLocation = null
m_CursorType = null
m_LockType = null
m_Opt = null
m_Out = ""
end sub
function Open(cmd)
dim rs, fs, fname
'controllo se sono state valorizzate le proprietà del recordset
'se non sono state valorizzate imposto dei valori di default
if isnull(m_CursorType) then m_CursorType = adOpenForwardOnly
if isnull(m_LockType) then m_LockType = adLockReadOnly
if isnull(m_Opt) then m_Opt = adCmdStoredProc
'recordset per l'apertura del comando
set rs = CreateObject("ADODB.Recordset")
'se è stato richiesto l'output del comando lo faccio tornare indietro
if m_CommandOutput then
if cmd.CommandType = adCmdStoredProc then
m_Out = writeStoredProcedure(cmd)
else
m_Out = writeSQL(cmd)
end if
else
m_Out = ""
end if
'se è stato richiesto di scrivere un file di log lo scrivo
if m_Log then
set fs = Server.CreateObject("Scripting.FileSystemObject")
set fname = fs.OpenTextFile("e:\log\ado_debug.log", 8, true)
if not m_CommandOutput then
'questo è il caso in cui è stato richiesto solo il file di log
if cmd.CommandType = adCmdStoredProc then
m_Out = writeStoredProcedure(cmd)
else
m_Out = writeSQL(cmd)
end if
fname.WriteLine now & " : " & m_URL & vbNewLine & m_Out
else
'questo è il caso in cui è sono stati richiesti output e file di log
fname.WriteLine now & " : " & m_URL & vbNewLine & m_Out
end if
fname.Close
set fname = nothing
set fs = nothing
end if
if m_Out <> "" then m_Out = m_Out & " "
'imposto il CursorLocation di default se non ne ho specificato uno
if isnull(m_CursorLocation) then m_CursorLocation = adUseClient
rs.cursorlocation = m_CursorLocation
'apertura del recordset
'response.write writeStoredProcedure(cmd) & " "
rs.Open cmd, ,m_CursorType, m_LockType, m_Opt
'restituzione del recordset
set Open = rs
end function
'questa funzione analizza la proprietà commandtext del comando e restituisce una stringa
'che può essere lanciata in sql server
private function writeStoredProcedure(cmd)
dim prmValue, commandTextValue, prmValueList, declaration, prmName, s
'con un po' di replace ripulisco il la proprietà CommandText
commandTextValue = replace(cmd.CommandText, "{ call ", "")
commandTextValue = replace(commandTextValue, "?", "")
commandTextValue = replace(commandTextValue, ",", "")
commandTextValue = replace(replace(commandTextValue, "(", ""), ")", "")
commandTextValue = replace(commandTextValue, "}", "")
commandTextValue = "exec " & Trim(commandTextValue)
'ciclo su i parametri presenti nel comando della procedura
for each prm in cmd.parameters
prmValue = prm.value
'controllo quelli che sono di tipo stringa e gli metto gli apici
select case prm.type
case adChar, adVarChar, adWChar, adLongVarChar, adVarWChar, adLongVarWChar
'se ho dei parametri di output faccio anche dichiarazione per sql server e aggiungo il parametro alla lista
if prm.Direction = adParamOutput then
prmName = replace(prm.name, "@", "")
declaration = declaration & "declare @" & prmName & " nvarchar(4000)" & vbNewLine
prmValue = " @" & prmName & " output,"
else
prmValue = " '" & prmValue & "',"
end if
prmValueList = prmValueList & prmValue
case else
if prm.Direction = adParamOutput then
prmName = replace(prm.name, "@", "")
declaration = declaration & "declare @" & prmName & " bigint" & vbNewLine
prmValue = " @" & prmName & " output,"
else
prmValue = " " & prmValue & ","
end if
prmValueList = prmValueList & prmValue
end select
next
s = declaration & commandTextValue & prmValueList
writeStoredProcedure = left(s, len(s)-1)
'response.write writeStoredProcedure
end function
private function writeSQL(cmd)
dim prmValue, s, prm
'ciclo su i parametri presenti nel comando della procedura
s = cmd.CommandText
for each prm in cmd.parameters
prmValue = prm.value
'response.write prm.name & " = " & prm.value & ""
'controllo quelli che sono di tipo stringa e gli metto gli apici
select case prm.type
case adChar, adVarChar, adWChar, adLongVarChar, adVarWChar, adLongVarWChar
'se ho dei parametri di output faccio anche dichiarazione per sql server e aggiungo il parametro alla lista
prmValue = " '" & prmValue & "'"
case adBoolean
if isnull(prmValue) then
prmValue = " 0"
else
if prmValue > 0 then
prmValue = " 1"
else
prmValue = " 0"
end if
end if
case else
if isnull(prmValue) then
prmValue = " null"
else
prmValue = " " & prmValue
end if
end select
s = replace(s, "?", prmValue, 1, 1, 1)
next
'response.write s
writeSQL = s
end function
end class
'esempio di utilizzo
dim sql
sql = "select * from table where col1 = ? and col2 = ?"
with cmd
.ActiveConnection = cn 'una connessione attiva
'se si chiama una stringa sql
.CommandType = adCmdText
.CommandText = sql
'se si chiama una stored procedure
'.CommandType = adCmdStoredProc
'.CommandText = "usp_nome_procedura"
.Parameters.Append .CreateParameter("@col1", adVarChar, adParamInput, 10, col1)
.Parameters.Append .CreateParameter("@col2", adVarChar, adParamInput, 10, col2)
end with
set rsCommand = new CommandRecordset
with rsCommand
'.URL = "http://www.myDomani.net/Nonepagina.asp?" & Request.Querystring
.CursorTypeEnum = adOpenStatic
.LockTypeEnum = adLockReadOnly
.Opt = adCmdText
.CommandOutput = false
.Log = false
set rs = .open(cmd)
response.write .Output
end with
set rsCommand = nothing
