'Registrazione
'INPUT: connessione, elementi della registrazione
'OUTPUT: //
sub registraUtente(objConn,utente_nome,utente_cognome,utente_email,utente_user,utente_password)
strSQL = ""
strSQL = strSQL &"INSERT INTO tUtenti (utente_nome, utente_cognome, utente_email,
utente_user, utente_password) "
strSQL = strSQL &"VALUES ('"& fixQuotes(utente_nome) &"',
'"& fixQuotes(utente_cognome) &"','"& utente_email
&"','"& fixQuotes(utente_user) &"','"& fixQuotes(utente_password)
&"')"
objConn.Execute(strSQL)
end sub
'Controllo l'unicità dello user utente
'INPUT: connessione, user utente
'OUTPUT: "true" se già esiste, "false" se non esiste
sub checkUser(objConn,utente_user,byRef checkUserOutput)
strSQL = "SELECT utente_user FROM tUtenti WHERE utente_user = '"&
fixQuotes(utente_user) &"'"
set objRS = server.createObject("ADODB.Recordset")
objRS.open strSQL, objConn
checkUserOutput = false
if not objRS.EOF then
checkUserOutput = true
end if
objRS.Close
set objRS=nothing
end sub
'Controllo login utente
'INPUT: connessione, user e password utente
'OUTPUT: "true" se già esiste, "false" se non esiste
sub checkLogin(objConn,utente_user,utente_password,byRef checkLoginOutput)
strSQL = "SELECT utente_id FROM tUtenti WHERE utente_user = '"&
fixQuotes(utente_user) &"' AND utente_password = '"& fixQuotes(utente_password)
&"'"
set objRS = server.createObject("ADODB.Recordset")
objRS.open strSQL, objConn
checkLoginOutput = false
if not objRS.EOF then
checkLoginOutput = true
'********************** SESSIONI ATTIVE ***************
Session("utente_id") = objRS("utente_id")
Session("utente_user") = utente_user
'Impostiamo la scadenza a 2 ore
Session.Timeout = 60
'******************************************************
end if
objRS.Close
set objRS=nothing
end sub
'Conto il totale dei messaggi
'INPUT: connessione, mittente
'OUTPUT: numero totale dei messaggi ricevuti
sub totaleMessaggi(objConn,byRef totaleMessaggiOutput)
strSQL = "SELECT COUNT(*) AS totale_messaggi FROM tMessaggi WHERE messaggio_destinatario
= "& session("utente_id")
set objRS = server.createObject("ADODB.Recordset")
objRS.open strSQL, objConn
totaleMessaggiOutput = 0
if not objRS.EOF then
totaleMessaggiOutput = objRS("totale_messaggi")
end if
objRS.Close
set objRS=nothing
end sub
'Controllo la presenza di nuovi messaggi
'INPUT: connessione, mittente
'OUTPUT: numero di messaggi ricevuti non ancora letti
sub contaMessaggi(objConn,byRef contaMessaggiOutput)
strSQL = "SELECT COUNT(*) AS tot_messaggi FROM tMessaggi WHERE messaggio_destinatario
= "& session("utente_id") &" AND messaggio_letto =
0"
set objRS = server.createObject("ADODB.Recordset")
objRS.open strSQL, objConn
contaMessaggiOutput = 0
if not objRS.EOF then
contaMessaggiOutput = objRS("tot_messaggi")
end if
objRS.Close
set objRS=nothing
end sub
'Controllo la presenza del destinatario del messaggio
'INPUT: connessione, destinatario
'OUTPUT: id utente se esiste, 0 se non esiste il destinatario
sub checkDestinatario(objConn,messaggio_destinatario,byRef checkDestinatarioOutput)
strSQL = "SELECT utente_id FROM tUtenti WHERE utente_user = '"&
fixQuotes(messaggio_destinatario) &"' AND utente_user <> '"&
fixQuotes(session("utente_user")) &"'"
set objRS = server.createObject("ADODB.Recordset")
objRS.open strSQL, objConn
checkDestinatarioOutput = 0
if not objRS.EOF then
checkDestinatarioOutput = objRS("utente_id")
end if
objRS.Close
set objRS=nothing
end sub
'Inserisco il nuovo messaggio
'INPUT: connessione, destinatario
'OUTPUT: //
sub inserisciMessaggio(objConn,messaggio_mittente,messaggio_destinatario,messaggio_oggetto,messaggio_corpo)
strSQL = ""
strSQL = strSQL &"INSERT INTO tMessaggi (messaggio_mittente, messaggio_destinatario,
messaggio_oggetto, messaggio_corpo, messaggio_data, messaggio_letto) "
strSQL = strSQL &"VALUES ("& session("utente_id")
&", "& checkDestinatarioOutput &", '"& fixQuotes(messaggio_oggetto)
&"', '"& fixQuotes(messaggio_corpo) &"', #"&
now() &"#, 0)"
objConn.Execute(strSQL)
end sub
'Elenco messaggi ricevuti ed impostazione come "messaggi letti"
'INPUT: connessione
'OUTPUT: array a due dimensioni con le informazioni del recordset
sub listaMessaggi(objConn,byRef listaMessaggiOutput)
strSQL = "SELECT utente_user, messaggio_id, messaggio_oggetto, messaggio_corpo,
messaggio_data FROM tMessaggi, tUtenti WHERE tMessaggi.messaggio_mittente = tUtenti.utente_id
AND tMessaggi.messaggio_destinatario = "& session("utente_id")
&" ORDER BY tMessaggi.messaggio_id DESC"
set objRS = server.createObject("ADODB.Recordset")
objRS.open strSQL, objConn, 1, 3
if not objRS.EOF then
k = 0
ReDim listaMessaggiOutput((objRS.recordcount-1),4)
do until objRS.EOF
listaMessaggiOutput(k,0) = objRS("utente_user")
listaMessaggiOutput(k,1) = objRS("messaggio_id")
listaMessaggiOutput(k,2) = objRS("messaggio_oggetto")
listaMessaggiOutput(k,3) = objRS("messaggio_corpo")
listaMessaggiOutput(k,4) = objRS("messaggio_data")
k = k + 1
objRS.moveNext
loop
end if
objRS.close
set objRS = nothing
'Imposto i messaggi come letti dal momento in cui si accede all'elenco
strSQL = "UPDATE tMessaggi SET messaggio_letto = 1 WHERE messaggio_destinatario
= "& session("utente_id")
objConn.Execute(strSQL)
end sub
'Cancello il messaggio
'INPUT: connessione, id del messaggio
'OUTPUT: //
sub cancellaMessaggio(objConn,messaggio_id)
strSQL = "DELETE * FROM tMessaggi WHERE messaggio_id ="& messaggio_id
objConn.Execute(strSQL)
end sub
sub dbConnect(objConn,connString)
set objConn = server.createObject("ADODB.Connection")
objConn.open connString
end sub
sub dbDisconnect(objConn)
objConn.close
set objConn = nothing
end sub
'Raddoppia agli apici per le query SQL
function fixQuotes(theString)
fixQuotes = replace(theString,"'","''")
end function
'Dimezza gli apici
function undoFixQuotes(theString)
undoFixQuotes = replace(theString,"''","'")
end function
'Controllo email
function check_email(strng) ' Per verificare la correttezza della mail
Set regEx = New RegExp ' Creo una regular Expression
regEx.Pattern = "^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,4}$"
' Determino il pattern di validazione
regEx.IgnoreCase = True ' Nessuna differenza tra maiuscole e minuscole
check_email = regEx.Test(strng) ' torna TRUE se la stringa è valida
end function
%>