"
end if
end Sub
'=========================================================
Sub fopendb ( sCs , sSql )
'=========================================================
' alias per apertura recordset in sola lettura solo avanzamento
opendb sCs , sSql , "f"
end Sub
'=========================================================
Sub sopendb ( sCs , sSql )
'=========================================================
' alias per apertura recordset in modalità statica e lock ottimistico
opendb sCs , sSql , "s"
end Sub
'=========================================================
Sub topendb ( sCs , sSql )
'=========================================================
' alias per apertura recordset in modalità tabella solo avanzamento e lock ottimistico
opendb sCs , sSql , "t"
end Sub
'=========================================================
Sub opendb( sCs , sSql , sType )
'=========================================================
' procedura di apertura database generale
'
' debug
'
debug ( sCs & " " & sSql & " " & sType )
Select case sType
case "f"
' fast opendb
nCursortype = 0
nLocktype = 1
nCmdtype = 1
case "s"
' dynamic opendb
nCursortype = 3
nLocktype = 3
nCmdtype = 1
case "t"
' dynamic opendb
nCursortype = 0
nLocktype = 3
nCmdtype = 2
end Select
if not isvoid(sCs) then
set ocn = CreateObject("ADODB.Connection")
ocn.Open sCs
end if
if not isvoid(sSql) then
set ors = CreateObject("ADODB.recordset")
ors.Open sSql , ocn , nCursortype , nLocktype , nCmdtype
end if
End Sub
'=========================================================
Sub DoCnt( sCs )
'=========================================================
' 10.03.2006 | maurizio
' apre una connessione per operazioni sql
set ocn = CreateObject("ADODB.Connection")
ocn.Open sCs
End Sub
'=========================================================
Sub opentdb( sCs , sSql )
'=========================================================
'
set tcn = CreateObject("ADODB.Connection")
set trs = CreateObject("ADODB.recordset")
tcn.Open sCs
trs.Open sSql , tcn , 0 , 1
end Sub
'=========================================================
Sub closetdb()
'=========================================================
' procedura per la chiusura del recordset temporaneo
trs.Close
tcn.Close
Set trs = Nothing
Set tcn = Nothing
end Sub
'=========================================================
Sub closedb()
'=========================================================
' procedura per la chiusura del recordset
ors.Close
ocn.Close
Set ors = Nothing
Set ocn = Nothing
end Sub
'=========================================================
Function GetValue ( sCs , sSql )
'=========================================================
' procedura per la restituzione di un solo valore
' 24.02. 06 | maurizio
' se il primo parametro è impostato a null sfrutto la connessione già aperta
debug ( sCs & " " & sSql )
if isvoid(sCs) then
debug ( "senza nuova connessione" )
Set objrec_Gv = Server.CreateObject("ADODB.Recordset")
objrec_Gv.Open sSql, ocn , 0, 1, 1
else
Set objconn_Gv = Server.CreateObject("ADODB.Connection")
Set objrec_Gv = Server.CreateObject("ADODB.Recordset")
objconn_Gv.Open sCs
objrec_Gv.Open sSql, objconn_Gv, 0, 1, 1
end if
if objrec_Gv.eof or objrec_Gv.bof then
GetValue = ""
else
GetValue = objrec_Gv.GetString
end if
if isvoid(scs) then
objrec_Gv.Close
Set objrec_Gv = Nothing
else
objrec_Gv.Close
objconn_Gv.Close
Set objrec_Gv = Nothing
Set objconn_Gv = Nothing
end if
End Function
'===============================================
Sub DoSql ( sCs , sSql )
'===============================================
' 24.02. 06 | maurizio
' se il primo parametro è impostato a null sfrutto la connessione già aperta
debug ( sCs & " " & sSql )
if isvoid(scs) then
debug ( "senza nuova connessione" )
Application.lock
ocn.execute sSql
Application.Unlock
else
set objconn_Do = CreateObject("ADODB.Connection")
objconn_Do.Open sCs
Application.lock
objconn_Do.execute sSql
Application.Unlock
objconn_DO.close
set objconn_Do = nothing
end if
end Sub
'===============================================
Sub DoSqls ( sCs , sSqls )
'===============================================
'
' 07.09.2005 | maurizio
' esegue multiple istruzioni sql separate da vbcrlf
' 29.03.2006 | maurizio
' controllo se il parametro connessione è presente per usare la connessione già aperta
debug ( sCs & " " & sSql )
if isvoid(scs) then
debug ( "senza nuova connessione" )
aSql = split(sSqls,vbcrlf)
Application.lock
For i = 0 To UBound(aSql)
if not isvoid( aSql(i) ) then
'echo "#" & aSql(i)
ocn.execute aSql(i)
end if
Next
Application.Unlock
Application.Unlock
else
set objconn_Do = CreateObject("ADODB.Connection")
objconn_Do.Open sCs
aSql = split(sSqls,vbcrlf)
Application.lock
For i = 0 To UBound(aSql)
if not isvoid( aSql(i) ) then
'echo "#" & aSql(i)
objconn_Do.execute aSql(i)
end if
Next
Application.Unlock
objconn_DO.close
set objconn_Do = nothing
end if
end Sub
'===============================================
Sub ComboGen ( sCs , sFilter , sSelection )
'===============================================
'
sSql = "select * from tabgen where filter_tabgen = """ & sFilter & """ order by tvalue1_tabgen"
Combo sCs , sSql , "cod_tabgen" , "tvalue1_tabgen" , sSelection
end sub
'===============================================
Sub Combo ( sCs , sSql , sField , sLabel , sSelection )
'===============================================
' genera il contenuto delle combobox ( tag option )
'
' sCs : Stringa di connessione
' sSql : Istruzione SQl
' sField : tag "value" della combo
' sLabel : valore visualizzato
' sSelection : mach con sField per settare il valore selezionato
'
if isnumeric(sSelection) then
sSelection = cdbl(sSelection)
else
sSelection = lcase(sSelection)
end if
Set objConnCombo = CreateObject ("ADODB.Connection")
Set objCombo = CreateObject("ADODB.Recordset")
objConnCombo.Open sCs
objcombo.Open sSql , objConnCombo , 0 , 1
If objCombo.BOF or objCombo.EOF Then
str_combo = "" & vbcrlf
Else
'objcombo.MoveLast
'objcombo.MoveFirst
Do While not objCombo.EOF
campo = objCombo(sField)
if isnumeric(objCombo(sField)) then
campo = cdbl(objCombo(sField))
else
campo = lcase(objCombo(sField))
end if
if campo = sSelection then
str_selected = "selected"
else
str_selected = ""
end if
' 28.06.2005 | maurizio
' tolto l'encoding dalla label pe problemi di visualizzazione
' sLabel_html = server.htmlencode(objcombo(sLabel))
sLabel_html = objcombo(sLabel)
if not isvoid(objcombo(sField)) then
sField_html = server.htmlencode(objcombo(sField))
end if
str_combo = str_combo & "" & vbcrlf
objcombo.MoveNext
Loop
End If
objCombo.close
objConnCombo.close
set objCombo = Nothing
set objConnCombo = Nothing
response.write vbcrlf & str_combo
end sub
'===============================================
function CheckRadio ( sname , svalue , bcheck )
'===============================================
'
' restituisce "checked" se il confronto è positivo
' sname: valore del radiobutton
' svalue: valore per il controllo
' bcheck: booleano che restituisce "checked" se svalue è vuoto
'
' 30.5.2005 -> implementato il controllo bcheck con isvoid
'
sname = trim(sname)
svalue = trim(svalue)
if isnumeric(sname) then
sname = cdbl(sname)
else
sname = lcase(sname)
end if
if isnumeric(svalue) then
svalue = cdbl(svalue)
else
svalue = lcase(svalue)
end if
CheckRadio = ""
if not isvoid(svalue) then
if sname = svalue then CheckRadio = " checked "
else
if bcheck = true then CheckRadio = " checked "
end if
end function
'===============================================
function makeboolean ( sname , svalue , stype)
'===============================================
select case stype
case "attivo"
sTrue = "Attivo"
sFalse = "Non Attivo"
sTrueValue_en = "True"
sFalseValue_en = "False"
sTrueValue_it = "Vero"
sFalseValue_it = "Falso"
case "truefalse"
sTrue = "True"
sFalse = "False"
sTrueValue_en = "True"
sFalseValue_en = "False"
sTrueValue_it = "Vero"
sFalseValue_it = "Falso"
case "sìno"
sTrue = "Sì"
sFalse = "No"
sTrueValue_en = "True"
sFalseValue_en = "False"
sTrueValue_it = "Vero"
sFalseValue_it = "Falso"
case else
sTrue = "yes"
sFalse = "no"
sTrueValue_en = "True"
sFalseValue_en = "False"
sTrueValue_it = "Vero"
sFalseValue_it = "Falso"
end select
select case lcase(cstr(svalue))
case lcase(sFalseValue_en) , lcase(sFalseValue_it)
sTrueCheck = ""
sFalseCheck = "checked"
case lcase(sTrueValue_en) , lcase(sTrueValue_it)
sTrueCheck = "checked"
sFalseCheck = ""
case else
sTrueCheck = ""
sFalseCheck = ""
end select
makeboolean = " " & sTrue & " " & _
" " & sFalse & " "
end function
'===============================================
Sub CreateDic ( )
'===============================================
' creo un dizionario dal recordset corrente
' l'utilizzo del dizionario mi permette di chiudere l'oggetto recordset
' ad eventualmente utilizzarlo per altro
'
set odic = CreateObject("scripting.dictionary")
If ors.BOF or ors.EOF Then
for each objf in ors.fields
'response.write "
" & lcase(f.name)
odic.add lcase(objf.name) , ""
next
else
for each objf in ors.fields
'response.write "
" & lcase(f.name)
if isnull(objf.value) or isempty(objf.value) then
odic.add lcase(objf.name) , ""
else
odic.add lcase(objf.name) , cstr(objf.value)
end if
next
end if
end sub
'===============================================
Sub PrintDic ( )
'===============================================
' funzione di debug ; stampa il dizionario
'
response.write "Dizionario"
for each key in oDic
response.write "
" & key & " : " & oDic(key)
next
end sub
'===============================================
Sub CreateCookies ( sCookiesName , sCookiesKey , sCookiesValue )
'===============================================
' 19.04.2005 | maurizio
' creazione veloce di un cookies
'
if isnull(sCookiesValue) or isempty(sCookiesValue) then sCookiesValue = ""
response.cookies( sCookiesName ).Expires= DateAdd("h",24,Now())
response.cookies( sCookiesName ).secure = FALSE
response.cookies( sCookiesName )( sCookiesKey ) = sCookiesValue
end sub
'===============================================
Sub SaveCookies ( sCookiesName , bCript )
'===============================================
' salvo il recordset in un cookies specificandone il nome
'
' sCookiesName : nome del cookies
' bCript : parametro booleano ( True / False ) che specifica
' se i dati all'interno del cookies devono essere criptati
' la chiave per la criptazione è il nome del cookies
'
response.cookies( sCookiesName ).Expires= DateAdd("h",24,Now())
response.cookies( sCookiesName ).secure = FALSE
If ors.BOF or ors.EOF Then
for each f in ors.fields
response.cookies( sCookiesName )( f.name ) = ""
next
else
for each f in ors.fields
if isnull(f.value) or isempty(f.value) then
response.cookies( sCookiesName )( f.name ) = ""
else
if bCript = True then
response.cookies( sCookiesName )( f.name ) = toPlain ( EncryptData( tobyte( lcase( f.value ) ) , tobyte(sCookiesName) ) )
else
response.cookies( sCookiesName )( f.name ) = f.value
end if
end if
next
end if
end sub
'===============================================
Sub LoadCookies ( sCookiesName , bCript )
'===============================================
' caricamento del cookies in un dizionario
'
' sCookiesName : nome del cookies
' bCript : parametro booleano ( True / False ) che specifica
' se i dati all'interno del cookies devono essere criptati
' la chiave per la criptazione è il nome del cookies
sDebug = " LoadCookies :" & sCookiesName
if Request.CooKies(sCookiesName).HasKeys then
set odic = CreateObject("scripting.dictionary")
For each key in Request.CooKies(sCookiesName)
if request.CooKies(sCookiesName)(key) = "" then
odic.add lcase(key) , ""
sDebug = sDebug & "
" & key & ":"
else
if bCript = True then
odic.add lcase(key) , totext ( DecryptData ( toArray( request.CooKies(sCookiesName)(key) ) , tobyte(sCookiesName) ) )
else
odic.add lcase(key) , Request.CooKies(sCookiesName)(key)
end if
sDebug = sDebug & "
" & key & ":" & Request.CooKies(sCookiesName)(key)
end if
next
end if
debug ( sDebug )
end sub
'===============================================
function opencookies ( sCookiesName )
'===============================================
' caricamento del cookies in un dizionario
'
' sCookiesName : nome del cookies
' bCript : parametro booleano ( True / False ) che specifica
' se i dati all'interno del cookies devono essere criptati
' la chiave per la criptazione è il nome del cookies
bCript = false
sDebug = " LoadCookies :" & sCookiesName
opencookies = ""
set odicCookies = CreateObject("scripting.dictionary")
if Request.CooKies(sCookiesName).HasKeys then
For each key in Request.CooKies(sCookiesName)
if request.CooKies(sCookiesName)(key) = "" then
odicCookies.add lcase(key) , ""
sDebug = sDebug & "
" & key & ":"
else
if bCript = True then
odicCookies.add lcase(key) , totext ( DecryptData ( toArray( request.CooKies(sCookiesName)(key) ) , tobyte(sCookiesName) ) )
else
odicCookies.add lcase(key) , Request.CooKies(sCookiesName)(key)
end if
sDebug = sDebug & "
" & key & ":" & Request.CooKies(sCookiesName)(key)
end if
next
end if
'set opencookies = CreateObject("scripting.dictionary")
set opencookies = odicCookies
set odicCookies = nothing
debug ( sDebug )
end function
'===============================================
Sub PrintCookies ( sCookiesName , bCript )
'===============================================
' caricamento del cookies in un dizionario
'
' sCookiesName : nome del cookies
' bCript : parametro booleano ( True / False ) che specifica
' se i dati all'interno del cookies devono essere criptati
' la chiave per la criptazione è il nome del cookies
response.write "Cookies"
if Request.CooKies(sCookiesName).HasKeys then
For each key in Request.CooKies(sCookiesName)
if request.CooKies(sCookiesName)(key) = "" then
response.write "
" & key & " : "
else
if bCript = True then
response.write "
" & key & " : " & Request.CooKies(sCookiesName)(key)
end if
end if
next
end if
end sub
'===============================================
Sub DeleteCookies ( sCookiesName )
'===============================================
' azzero il cookies
'
' sCookiesName : nome del cookies
if Request.CooKies(sCookiesName).HasKeys then
For each key in Request.CooKies(sCookiesName)
response.cookies( sCookiesName )( key ) = ""
next
end if
end sub
'===============================================
Sub sub_newrecord (strDB, tblname, campo, valore)
'===============================================
' inserimento nuovo record
' gestione retrocompatbilità
'Apre la connessione
set tcn = CreateObject("ADODB.Connection")
tcn.Open(strDB)
'Crea l'istruzione
sql = "insert into " & tblname & " (" & campo & ") values (" & valore & ")"
Application.lock
'Esegue l'SQL
set trs = tcn.Execute(sql)
Application.unlock
tcn.Close
Set tcn = Nothing
End sub
'===============================================
Sub echo ( EchoValue )
'===============================================
response.write trim(EchoValue) & " "
end sub
'===============================================
Sub breakpoint ( bpValue )
'===============================================
response.write " >>>" & trim(bpValue) & "<<< "
response.end
end sub
'===============================================
Function SetValue ( v )
'===============================================
'
' prepara il valore per l'inserimento
' di un campo testo dentro una query sql
'
' 30.05.2005 -> implementato controllo isvoid
' 20.01.2006 -> cambiato il nome della varibile - sReturn > SetValueReturn
if isvoid(v) then
SetValueReturn = " NULL "
else
SetValueReturn = " """ & replace(trim(v),"""","""""") & """ "
end if
SetValue = SetValueReturn
end Function
'===============================================
Function CheckValue ( v )
'===============================================
'
' 29.6.2005 | maurizio
' verifica che il valore non sia nullo
' altrimenti restituisce ""
'
'
if isvoid(v) then
sReturn = ""
else
sReturn = trim(v)
end if
CheckValue = sReturn
end Function
'===============================================
Function HtmlDecode ( v )
'===============================================
'
' 29.6.2005 | maurizio
' trasofrma per il campo specificato
'
'
if isvoid(v) then
sReturn = ""
else
sReturn = trim(v)
sReturn = replace(sReturn,vbcr,"")
sReturn = replace(sReturn,vblf,"")
sReturn = replace(sReturn,"<","<")
sReturn = replace(sReturn,">",">")
sReturn = replace(sReturn,""","""")
sReturn = replace(sReturn,"&npsp;"," ")
sReturn = replace(sReturn,"&","&")
end if
HtmlDecode = sReturn
end Function
'===============================================
Sub dbLog ( stype , stext )
'===============================================
' 26.05.2005 | maurizio
' gestione log su db
' necessita di datetime.asp
'
' 22.09.2005 | maurizio
' aggiunto il log la pagina
'
sSqlInsert = "insert into log " & _
"(date_log, text_log, type_log , urlpage_log ) " & _
"values " & _
"(" & setvalue( mydate(date()) ) & _
"," & setvalue( stext ) & _
"," & setvalue ( stype ) &_
"," & setvalue ( Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("SCRIPT_NAME") ) &_
" )"
'echo sSqlInsert
dosql mercurius_mysql , sSqlInsert
end sub
'===============================================
Function IsZero( IsZeroValue )
'===============================================
'
' 29.09.2005 | maurizio
' verifica se il valore è numero ed è zero
'
sReturn = false
if not isvoid(IsZeroValue) then
if isnumeric(IsZeroValue) then
select case VarType(IsZeroValue)
case 2
nTmp = cint(IsZeroValue)
case 3
nTmp = clng(IsZeroValue)
case else
nTmp = cdbl(IsZeroValue)
end select
if nTmp = 0 then sReturn = true
end if
end if
iszero = sReturn
end function
'===============================================
Function IsVoid( IsVoidValue )
'===============================================
'
' verifica se il valore è vuoto
'
' 20.01.2006 -> cambiato il nome della varibile - sReturn > IsVoidReturn
IsVoidReturn = false
sTmp = trim(IsVoidValue) & " "
sTmp = replace(sTmp,vbcr,"")
sTmp = replace(sTmp,vblf,"")
sTmp = replace(sTmp,vbtab,"")
sTmp = trim(sTmp)
if isnull(sTmp) then IsVoidReturn = true
if isempty(sTmp) then IsVoidReturn = true
if sTmp = "" then IsVoidReturn = true
if len(sTmp) = 0 then IsVoidReturn = true
IsVoid = IsVoidReturn
end function
'===============================================
Function GetQs( sExclude )
'===============================================
' 30.5.2005 | maurizio
' enumera i parametri passati in querystring
' se sExclude è presente lo esclude
' 09.02.2006 | maurizio
' modificato la stringa restituita, da "&" -> "&"
set oRequest = request.querystring
sReturn = ""
sExclude = lcase(sExclude)
if isvoid(sExclude) then sExclude = ","
aExclude = split( CleanValue(sExclude),"," )
for each RequestItem in oRequest
bExclude = false
for each iExclude in aExclude
if iExclude = lcase(RequestItem) then bExclude = true
next
if not bExclude then
RequestValue = request.querystring(RequestItem)
if not isvoid( RequestValue ) then
sReturn = sReturn & "&" & RequestItem & "=" & RequestValue
end if
end if
next
sReturn = mid(sReturn,2)
set oRequest = Nothing
GetQs = sReturn
end function
'===============================================
Function GetPost( sExclude )
'===============================================
' 20.6.2005 | maurizio
' enumera i parametri passati da un form in post
' se sExclude è presente lo esclude
set oRequest = request.form
sReturn = ""
sExclude = lcase(sExclude)
for each r in oRequest
if sExclude <> lcase(r) then
v = trim(request.form(r))
'v = server.htmlencode(request.form(r))
if not isvoid(v) then
sReturn = sReturn & "&" & r & "=" & v
end if
end if
next
sReturn = mid(sReturn,2)
set oRequest = Nothing
GetPost = sReturn
end function
'===============================================
function HashTable(code,value)
'===============================================
' 19.1.2006 | maurizio
' restituisce un dizionario ciclando su un recordset specificando chiave e valore
' es.
' sql_hash = "SELECT cod_tabgen, snota2_tabgen FROM tabgen where filtro_tabgen = ""sito"" and snota2_tabgen <> """" order by cod_tabgen asc"
' fopendb mediaplanning_mdb , sql_hash
' set dictest = hashtable("cod_tabgen","snota2_tabgen")
' closedb
' echo ">>" & dictest("3")
' echo ">>" & dictest("2")
' 24.2.2006 | maurizio
' aggiunto un movefirst alla fine del ciclo per rispritinare la posizione iniziale
set hashdic = CreateObject("scripting.dictionary")
If not ors.BOF and not ors.EOF Then
Do While not ors.EOF
sDicValue = ors(value)
if isvoid(sDicValue) then sDicValue = ""
hashdic.add cstr(ors(code)) , cstr(sDicValue)
ors.movenext()
loop
ors.movefirst()
end if
set hashtable = hashdic
end function
'===============================================
function rq( sRequestName )
'===============================================
' 06.02.2006 | maurizio
rq = CleanValue( Request.querystring(sRequestName) )
if isvoid(rq) then rq = CleanValue( Request.form(sRequestName) )
end function
'===============================================
sub print( sPrintLine )
'===============================================
' 06.02.2006 | maurizio
response.write trim(sPrintLine) & vbcrlf
end sub
'=========================================================
Function CleanValue( sCleanValue )
'=========================================================
' 13.03.2005 | maurizio
CleanValue = sCleanValue
if not isvoid(sCleanValue) then
CleanValue = Replace(CleanValue,vbCr,"")
CleanValue = Replace(CleanValue,vbLf,"")
CleanValue = Replace(CleanValue,vbTab,"")
CleanValue = trim ( CleanValue )
end if
End function
'=========================================================
Function getjson ( oDicValue )
'=========================================================
getjson = "{" '&
for each iDicKey in oDicValue
iDicValue = Replace(cleanvalue(oDicValue(iDicKey)),"""","\""")
getjson = getjson & " """ & iDicKey & """ : """ & iDicValue & """ ,"
next
getjson = replace(getjson & ", }" ,",,","")
End function
'=========================================================
Function RandomNumber(intHighestNumber)
'=========================================================
Randomize
RandomNumber = Int(Rnd * intHighestNumber)
End Function
'===============================================
sub MailLog( sMessage )
'===============================================
' 04.07.2006 | maurizio
if not isvoid(sMessage) then
Dim CDOMail
Set CDOMail = Server.CreateObject("CDO.Message")
CDOMail.To = "maurizio@mavida.com"
CDOMail.from = "mercurius@mercurius.it"
CDOMail.subject = "MailLog v1.0 - " & date()
CDOMail.TextBody = sMessage
CDOMail.Send
Set CDOMail = nothing
end if
end sub
%>