<% Dim strMessageHTML, blnReferrerOK, intPos, strThisServerRootURL
Dim strError, strUsername, strPassword, blnFirstTime, arrUsers
Dim strSiteName, intDictKey, dctSecurity
Const SPLIT_STRING = "<*|*>"
strError = ""
blnFirstTime = (NOT ValidString(Request.Form("FirstTime")))
If ValidString(Request.QueryString("error")) Then strError = Request.QueryString("error")
set dctSecurity = Server.CreateObject("Scripting.Dictionary") %>
<% If NOT (blnFirstTime OR ValidString(strError)) Then
strUsername = Request.Form("Username")
strPassword = Request.Form("Password")
strSiteName = Request.Form("SiteName")
If NOT ValidString(strUsername) Then
strError = "Username"
ElseIf NOT ValidString(strPassword) Then
strError = "Password"
ElseIf NOT ValidString(strSiteName) Then
strError = "SiteName"
Else
strThisServerRootURL = "http://" & Request.ServerVariables("SERVER_NAME")
intPos = InStr(Request.ServerVariables("HTTP_REFERER"), strThisServerRootURL)
blnReferrerOK = False
If PositiveInteger(intPos) Then
If (intPos = 1) Then blnReferrerOK = True
End If
If NOT blnReferrerOK Then
strError = "Referrer"
Else
On Error Resume Next
'/* [dctSecurity] should already be populated */
If (dctSecurity.Count = 0) Then
strError = "LoginAuth"
ElseIf NOT dctSecurity.Exists(strSiteName & SPLIT_STRING & strUsername) Then
strError = "LoginFailed"
ElseIf (Err.Number <> 0) Then
strError = "LoginAuth"
Else
intDictKey = cLng(dctSecurity.Item(strSiteName & SPLIT_STRING & strUsername))
If (StrComp(strUsername, arrUsers(1, intDictKey), 1) <> 0) Then
strError = "LoginUsername"
ElseIf (StrComp(strPassword, arrUsers(2, intDictKey), 0) <> 0) Then
strError = "LoginPassword"
Else
'/* Initiate Login Sequence */
Session("SiteName") = strSiteName
Session("Username") = strUsername
Session("dtLastActivity") = Now()
Response.Redirect("/" & strSiteName & "/Default.asp")
End If
End If
Err.Clear
On Error Goto 0
End If
End If
End If
Call dctSecurity.RemoveAll(): set dctSecurity = nothing
If ValidString(strError) Then
Call Session.Contents.RemoveAll()
Select Case LCase(strError)
Case LCase("Username")
strMessageHTML = "Please enter your account username"
Case LCase("Password")
strMessageHTML = "Please enter your account password"
Case LCase("SiteName")
strMessageHTML = "Please enter the name of the site you are trying to login to"
Case LCase("LoginAuth"), LCase("LoginAuth2"), LCase("LoginAuth3")
strMessageHTML = "An error occurred while attempting to log into the site." & vbcrlf & _
"Please contact your System Administrator for further assistance." & vbcrlf & _
"( Error Code: " & UCase(strError) & " )"
Case LCase("Referrer")
strMessageHTML = "Third-party servers are not allowed to access this web resource"
Case LCase("LoginFailed"), LCase("LoginUsername"), LCase("LoginPassword")
strMessageHTML = "You are not authorized to access the " & strSiteName & " site"
Case LCase("Session")
strMessageHTML = "Your session has expired. Please login to continue"
Case Else
strMessageHTML = "An untrapped error (" & strError & ") occurred"
End Select
End If %>
Summit: Project Delivery Solutions, Inc.
<% Function AddSite(arrNewArray)
Dim intUBound, strDictKey, intLogins
Dim strSite_Temp, strLogin_Temp, strPwd_Temp
If NOT IsNull(arrNewArray) Then
If IsArray(arrNewArray) Then
If (UBound(arrNewArray, 1) = 2) Then
strSite_Temp = arrNewArray(0)
strLogin_Temp = arrNewArray(1)
strPwd_Temp = arrNewArray(2)
strDictKey = (strSite_Temp & SPLIT_STRING & strLogin_Temp)
If NOT dctSecurity.Exists(strDictKey) Then
If NOT IsArray(arrUsers) Then intLogins = 0 Else intLogins = UBound(arrUsers, 2) End If
'Response.Write("arrUsers(*, " & intLogins+1 & ") = [" & strSite_Temp & ", " & strLogin_Temp & ", " & strPwd_Temp & "] " & vbcrlf)
arrUsers = AddToArray(arrUsers, arrNewArray): Call dctSecurity.Add(strDictKey, intLogins+1)
'Response.Write("dctSecurity(" & strDictKey & ") = " & intLogins+1 & " " & vbcrlf)
End If
End If
End If
End If
AddSite = True
End Function %>
