Je ne sais pas au juste...je crois que sais un de fichier de conexion a la base de donnes..voici le fichier de conexion du portal ...que ne resemble pas de tout au fichier de conexion du systeme de e-mail...
Merci
<%
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'' GLOBAL DECLARATIONS AND DATABASE CONNECTIONS
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'' initiate global vars and constants
dim action
dim b_error, a_errors, error_list, a_msg, msg_list
dim cn, cmd, rs, rsselect, sql, do_search, a_records
'' instantiate error handling and messaging
if not isObject(error_list) then
set error_list = CreateObject("Scripting.Dictionary")
set msg_list = CreateObject("Scripting.Dictionary")
end if
'' initiate db objects and connections
'' app database
set cn = Server.CreateObject("ADODB.Connection")
set user_cn = Server.CreateObject("ADODB.Connection")
on error resume next
cn.Open application("cn_str")
user_cn.Open application("cn_str")
if err.number <> 0 then response.redirect "error.asp"
on error goto 0
'' command object
set cmd = Server.CreateObject("ADODB.Command")
cmd.ActiveConnection = cn
'' recordset object
set rs = Server.CreateObject("ADODB.Recordset")
'' set locale identifier - default is US English
'' (
[ Lien ])
session.lcid = 1033
'' set proper contcanation operator
if inStr(lcase(cn.Provider),"jet") = 0 then
'' SQL
cn.Execute ("SET CONCAT_NULL_YIELDS_NULL OFF")
cc = "+"
else
'' Access concatentation
cc = "&"
end if
'' remember this page name
this_page = request.servervariables("script_name")
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'' ERROR AND MESSAGE DISPLAY SUBS
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
sub display_errs
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' display content of the error dictionary object
':::::::::::::::::::::::::::::::::::::::::::::::::::::
if error_list.count > 0 then
''' display errors
a_errors = error_list.items
for i = 0 to error_list.count - 1
response.write "<div class=ErrFont>" & a_errors(i) & "</div>"
next
end if
end sub
sub display_msg
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' displays msgs after successful database action
':::::::::::::::::::::::::::::::::::::::::::::::::::::
':: check if a msg was passed to the page
if request("msg") <> "" then
msg = replace(request("msg"),"://","")
msg = replace(msg,"script","")
msg = replace(msg,"%","")
msg = replace(msg,"form","")
msg_list.add "msg",msg
end if
':: display messages
a_msg = msg_list.items
for i = 0 to msg_list.count - 1
response.write "<div class=MsgFont>" & a_msg(i) & "</div>"
next
end sub
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'' USER MANAGMENT FUNCTIONS
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function check_security(iLevel)
if application("enable_group_security") then
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' authenticates user's group access level
':::::::::::::::::::::::::::::::::::::::::::::::::::::
if session("user_id") = "" OR isNull(session("accesslevel")) then
response.redirect("login.asp?ret_page=" & to_url(request.serverVariables("SCRIPT_NAME")&"?"&request.serverVariables("QUERY_STRING")))
elseif session("group_accesslevel") <> "" then
if cLng(session("group_accesslevel")) < cLng(iLevel) then response.redirect("login.asp?action=noaccess&querystring=" & to_url(request.serverVariables("QUERY_STRING")) & "&ret_page=" & to_url(request.serverVariables("SCRIPT_NAME")))
elseif session("accesslevel") <> "" then
if cLng(session("accesslevel")) < cLng(iLevel) then response.redirect("login.asp?action=noaccess&ret_page=" & to_url(request.serverVariables("SCRIPT_NAME")&"?"&request.serverVariables("QUERY_STRING")))
else
user_id = session("user_id")
accesslevel = session("accesslevel")
end if
else
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' authenticates user and verifies access level
':::::::::::::::::::::::::::::::::::::::::::::::::::::
if session("user_id") = "" OR isNull(session("accesslevel")) then
response.redirect("login.asp?ret_page=" & to_url(request.serverVariables("SCRIPT_NAME")&"?"&request.serverVariables("QUERY_STRING")))
elseif session("accesslevel") <> "" then
if cLng(session("accesslevel")) < cLng(iLevel) then response.redirect("login.asp?action=noaccess&ret_page=" & to_url(request.serverVariables("SCRIPT_NAME")&"?"&request.serverVariables("QUERY_STRING")))
else
user_id = session("user_id")
accesslevel = session("accesslevel")
end if
end if
end function
sub do_login
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' autheticates user in db and creates session
':::::::::::::::::::::::::::::::::::::::::::::::::::::
sql = "SELECT user_name, password FROM Users WHERE user_name = " & to_sql(user_name,"text") & " AND password = " & to_sql(password,"text") & ""
set rs = user_cn.Execute(sql)
if rs.EOF then
'login failed
error_list.add "login", "Login or password is incorrect."
b_error = true
else
'login and password passed
sql = "SELECT user_id, Users.accesslevel, Users.group_id, Groups.accesslevel FROM Users LEFT JOIN Groups ON Users.group_id = Groups.group_id WHERE user_name = " & to_sql(user_name,"text") & " AND password = " & to_sql(password,"text") & ""
set rs = user_cn.Execute(sql)
if rs.EOF then
'should never happen
error_list.add "login", "User does not exist."
b_error = true
else
'login user
session("user_id") = rs(0)
session("accesslevel") = rs(1)
session("group_id") = rs(2)
session("group_accesslevel") = rs(3)
'add user_name to app dict (global.asa)
if isObject(online_users) then online_users.item(session.sessionid) = session("user_id") & "," & user_name
'store last visit date in session, set current date in db
on error resume next
set rs = user_cn.Execute("SELECT dtlast FROM Users WHERE user_id = " & to_sql(session("user_id"),"number"))
session("dtlast") = rs(0)
if err.number = 0 then user_cn.Execute = "UPDATE Users SET last_ip='" & Request.ServerVariables("REMOTE_ADDR") & "', dtlast = " & to_sql(now,"date") & " WHERE user_id = " & to_sql(session("user_id"),"number")
on error goto 0
'where to next?
querystring = request("querystring")
ret_page = request("ret_page")
if (ret_page <> request.serverVariables("SCRIPT_NAME")) AND (ret_page <> "") then
'return to page that preceded login
response.redirect(ret_page)
else
'go home
response.redirect("default.asp")
end if
end if
end if
rs.Close
end sub
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'' FORMATTING FUNCTIONS
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function to_url(strValue)
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' make passed paramters url friendly
':::::::::::::::::::::::::::::::::::::::::::::::::::::
if IsNull(strValue) then strValue = ""
to_url = Server.URLEncode(strValue)
end function
function to_html(strValue)
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' convert and clean string
':::::::::::::::::::::::::::::::::::::::::::::::::::::
if IsNull(strValue) then strValue = ""
strValue = Replace(strValue,"<%","<"&chr(37))
strValue = Replace(strValue,"%>",chr(37)&">")
to_html = Server.HTMLEncode(strValue)
end function
function to_sql(Value,DataType)
'::::::::::::::::::::::::::::::::::::::::::::::::::::
' prepare string for sql insert/update
'::::::::::::::::::::::::::::::::::::::::::::::::::::
dim dteDateTime
dteDateTime = Value
if Value = "" or isNull(Value) then
to_sql = "NULL"
elseif (DataType = "date" OR DataType = "absdate") then
if IsDate(dteDateTime) = True then
if DataType="date" AND Hour(dteDateTime)>0 AND application("server_time_diff")<>0 AND not isNull(application("server_time_diff")) then dteDateTime = DateAdd("H",application("server_time_diff"),dteDateTime)
dim dteDay, dteMonth, dteYear, dteHour, dteMinute, dteSecond
dteDay = Day(dteDateTime)
dteMonth = Month(dteDateTime)
dteYear = Year(dteDateTime)
dteHour = Hour(dteDateTime)
dteMinute = Minute(dteDateTime)
dteSecond = Second(dteDateTime)
dteDateTime = dteYear & _
"-" & Right(Cstr(dteMonth + 100),2) & _
"-" & Right(Cstr(dteDay + 100),2) & _
" " & Right(Cstr(dteHour + 100),2) & _
":" & Right(Cstr(dteMinute + 100),2) & _
":" & Right(Cstr(dteSecond + 100),2)
if instr(lcase(cn.Provider),"jet")>0 then
':access
to_sql = "#" & Replace(dteDateTime, "'", "''") & "#"
else
':sql server
to_sql = "'" & Replace(dteDateTime, "'", "''") & "'"
end if
else
to_sql = "NULL"
end if
elseif DataType <> "number" then
Value = Replace(Value,"<"&chr(37),"<%")
Value = Replace(Value,chr(37)&">","%>")
to_sql = "'" & Replace(Value, "'", "''") & "'"
elseif inStr(Value,".") then
to_sql = Value
else
to_sql = cLng(Value)
end if
end function
':::::::::::::::::::::::::::::::::::::::::::
function parse(str_value)
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
' finds special {|---|} tags within content and returns string to execute
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
if not isNull(str_value) then
':: remove line feeds
str_value = replace(str_value,vbCRLF," ")
if (instr(str_value,"{|")>0 AND instr(str_value,"|}")>0) OR (instr(str_value,"{%")>0 AND instr(str_value,"%}")>0) then
': check for includes or script to replace
do until instr(str_value,"{|")=0 AND instr(str_value,"{%")=0
': determine if next is {| or {%
pos_inc = instr(str_value,"{|")
pos_code = instr(str_value,"{%")
if ((pos_inc<pos_code) AND pos_inc>0) OR (pos_inc>0 and pos_code=0) then
findnext="|"
elseif pos_code>0 then
findnext="%"
else
exit do
end if
if instr(str_value,"{"&findnext)>0 then
': include page
pos = instr(str_value,"{"&findnext)
e_pos = instr(str_value,findnext&"}")
beg_code = left(str_value,pos-1)
run_this = mid(str_value,pos+2,(e_pos-2)-pos)
end_code = right(str_value,len(str_value)-(e_pos+1))
out_str = end_code
': double up on any quotes in the literal portions
beg_code = replace(beg_code,"""","""""")
end_code = replace(end_code,"""","""""")
if len(beg_code)>0 then parse = parse & "response.write """ & beg_code & """:"
if findnext="|" then
': handle page include using server execute
if instr(lcase(run_this),"i_")>0 then
'local inc file - use server execute
parse = parse & "server.execute """ & run_this & """:"
elseif instr(lcase(run_this),".")>0 then
'other file - use xml
parse = parse & "response.write include("""&run_this&""",null):"
end if
elseif findnext="%" then
': handle code execution
if instr(left(run_this,2),"=")>0 then run_this=replace(run_this,"=","response.write ",1,1)
if len(run_this)>0 then parse = parse & trim(replace(run_this," "," ")) & ":"
end if
end if
str_value=out_str
loop
': now send the last literal portion
if len(end_code)>0 then parse = parse & "response.write """ & end_code & """:"
else
str_value = replace(str_value,"""","""""")
parse = "response.write """ & str_value & """"
end if
else
parse = "response.write """ & str_value & """"
end if
end function
function include(str_value,b_includepage)
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' includes file contents using remote XML transfer
':::::::::::::::::::::::::::::::::::::::::::::::::::::
if b_includepage = TRUE then
'' should not be true
else
'set oXML = Server.CreateObject("Microsoft.XMLHTTP")
set oXML = Server.CreateObject("MSXML2.ServerXMLHTTP")
oXML.open "GET", application("site_root")&str_value, false
oXML.send
include = oXML.responseText
set oXML = NOTHING
end if
end function
function strip_html(str_html)
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' removes html tags from str_html
':::::::::::::::::::::::::::::::::::::::::::::::::::::
dim objRegExp, str_output
set objRegExp = new Regexp
if not isNull(str_html) then
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<(.|\n)+?>"
str_output = objRegExp.Replace(str_html, "")
objRegExp.Pattern = "\&(.|\n)+?;"
str_output = objRegExp.Replace(str_output, "")
str_output = Replace(str_output, "<", "<")
str_output = Replace(str_output, ">", ">")
strip_html = str_output
end if
set objRegExp = Nothing
end function
function get_options(sql,selected_value)
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' displays option tags for a select list
':::::::::::::::::::::::::::::::::::::::::::::::::::::
'response.write sql
if isNull(selected_value) then selected_value = ""
set rsSelect = cn.Execute(sql)
do until rsSelect.EOF
if not isNull(rsSelect(0)) then
get_options = get_options + "<option"
if cStr(rsSelect(0)) = cStr(selected_value) then
get_options = get_options + " SELECTED"
end if
get_options = get_options + " value='" & rsSelect(0) & "'>"
if rsSelect.Fields.Count-1 = 0 then
get_options = get_options + "" & rsSelect(0) & " "
else
for i = 1 to rsSelect.Fields.Count-1
if rsSelect(i) <> "" then
get_options = get_options + "" & rsSelect(i)
if i < rsSelect.Fields.Count-1 then get_options = get_options + ": "
end if
next
end if
get_options = get_options + "</option>" & vbCRLF & chr(9) & chr(9)
end if
rsSelect.MoveNext
loop
rsSelect.Close
end function
function is_reserved(strValue)
':::::::::::::::::::::::::::::::::::::::::::::::::::::
' compare a string with a list of vb and sql reserved words
':::::::::::::::::::::::::::::::::::::::::::::::::::::
reserved_words = "|and||as||boolean||byref||byte||byval||call||case||class||const||currency||date||desc||debug||dim||do||double||each||else||elseif||empty||end||endif||enum||eqv||event||exit||false||for||function||get||goto||if||imp||implements||in||integer||is||let||like||long||loop||lset||me||mod||new||next||not||nothing||null||on||option||optional||or||paramarray||preserve||private||public||raiseevent||redim||rem||resume||rows||rset||select||set||shared||single||size||static||stop||sub||then||to||true||type||typeof||until||variant||wend||while||with||xor|"
if inStr(reserved_words,"|" & lcase(strValue) & "|") > 0 then
is_reserved = true
else
is_reserved = false
end if
end function
':: correct secure urls :::::::::::::::::::::::::::::::::::::::
': this section assures that user does not persist in
': ssl (https://) mode. only pages in the application
': secure_pages variable (global.asa) will stay in https.
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
if request.servervariables("https") = "on" then
': list of pages where https is permitted
secure_list = application("secure_pages")
this_page = request.servervariables("script_name")
a_tmp = split(secure_list, ",")
for ctr = 0 to uBound(a_tmp)
if instr(this_page,trim(a_tmp(ctr))) > 0 then
'' this page should be secure
b_redirect = false
exit for
else
b_redirect = true
end if
next
if b_redirect then response.redirect "http://" & request.servervariables("server_name") & request.servervariables("script_name")
end if
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
%>