C and S Design.
Search Friendly Programming and Design

Go to -> C and S Design -> Articles -> Code -> ASP -> Site Logon


Get this Code: Click to download the ASP file.
Do not copy and paste the displayed code. The display function adds line breaks so what you see is definitely not what you would get.

Code for this Example. (Site Logon) 

<%
' the code in his file has the contents of the 3 include _ 
	files
'functions.asp, logon_code.asp and logon_form.asp
' ensure it is split up before use
' each sections is delimited with asterisks _ 
	*******************
%>

<%'
' this is the basic structure of the page
%>

<!--#include file="function.asp"-->
<!--#include file="logon_code.asp"-->

<html>
<head>
<title>Untitled Document</title>
<meta http-equiv="Content-Type" _ 
	content="text/html; charset=iso-8859-1">
</head>

<body>
<!--#include file="logon_form.asp"-->

</body>
</html>

<%
' ***************************************
' code for functions.asp
<%
dim UserNames
set UserNames = _ 
	server.CreateObject("Scripting.Dictionary")
UserNames.add "fred","Fred _ 
	Flintstone,password"
' add usernames to the list in the same format
' UserNames.add "logon","Full _ 
	Name,password"

function ScriptName()
if request.servervariables("QUERY_STRING") _ 
	<> "" then
	ScriptName = _ 
	request.servervariables("SCRIPT_NAME") & _ 
	"?" & _ 
	request.servervariables("QUERY_STRING")
else
	ScriptName = _ 
	request.servervariables("SCRIPT_NAME")
end if
end function

function NameProper(strIn)
' function for setting proper case for names
' for a single line of text
if instr(strIn,vbCrLf) > 0 then
'	if string contains CR call MultiLine function
	NameProper = MultiLineProper(strIn)
	exit function
end if
dim words
dim i
words = Split(strIn," ")
for i = 0 to ubound(words)
	words(i) = Capitalise(words(i))
	if lcase(left(words(i),2)) = "mc" then
	words(i) = Capitalise(left(words(i),2)) & _ 
	Capitalise(mid(words(i),3))
	end if
	if lcase(left(words(i),3)) = "mac" then
	words(i) = Capitalise(left(words(i),3)) & _ 
	Capitalise(mid(words(i),4))
	end if
	if lcase(mid(words(i),2,1)) = "'" then
	words(i) = Capitalise(left(words(i),2)) & _ 
	Capitalise(mid(words(i),3))
	end if
		
next
if ubound(words) > 0 then
	for i = 0 to ubound(words)
			if i = 0 then
				NameProper = NameProper & words(i)
			else
				NameProper = NameProper & " " & words(i)
			end if			
	next
else
	NameProper = Capitalise(strIn)
end if
end function

function Proper(strIn)
' function for setting proper case
' for a single line of text
if instr(strIn,vbCrLf) > 0 then
'	if string contains CR call MultiLine function
	Proper = MultiLineProper(strIn)
	exit function
end if
dim words
dim i
words = Split(strIn," ")
for i = 0 to ubound(words)
	words(i) = Capitalise(words(i))
next
if ubound(words) > 0 then
	for i = 0 to ubound(words)
			if i = 0 then
				Proper = Proper & words(i)
			else
				Proper = Proper & " " & words(i)
			end if			
	next
else
	Proper = Capitalise(strIn)
end if
end function

' capitalise first letter of string sent
function Capitalise(strText)
Capitalise = ucase(left(strText,1)) & lcase(mid(strText,2))
end function


function MultiLineProper(strIn)
' function for setting proper case
' for multi line textbox inputs
dim words
dim i
dim temp
words = Split(strIn,vbCrLf)
for i = 0 to ubound(words)
	words(i) = Proper(words(i))
next
if ubound(words) > 0 then
	for i = 0 to ubound(words)
			if i = 0 then
				temp = temp & words(i)
			else
				temp = temp & vbCrLf & words(i)
			end if			
	next
else
	temp = Proper(strIn)
end if
MultiLineProper = temp
end function


function CheckUser(strUserName, strPassword)
dim UserInfo
strUserName = lcase(strUserName)

if  UserNames.exists(strUserName)  then
	UserInfo = split(UserNames(strUserName),",")
		if UserInfo(1) <> strPassword then
		CheckUser = "Incorrect Password"
		exit function
	else
		CheckUser = True
	end if  '   password check
else
	CheckUser = "Username not found"
	exit function
end if   '   exists

end function   '   CheckUser

function GetFullUserName(strUserName)
dim UserInfo
strUserName = lcase(strUserName)

if  UserNames.exists(strUserName)  then
	UserInfo = split(UserNames(strUserName),",")
	GetFullUserName = UserInfo(0)
end if
end function	' GetUserLevel

' functions for logon cookies
function GetCookie()
	AutoLogin = _ 
	 _ 
	request.cookies("cookie_name")("savestate")
	strUserName = _ 
	 _ 
	request.cookies("cookie_name")("username")
	strUser = _ 
	 _ 
	request.cookies("cookie_name")("scuserid")
	if strUser = "" then
	strUser = session("scuserid")
	end if
	
	if AutoLogin then
	bLoggedin = True
	session("loggedin") = true
	end if
end function

function SetCookie()
	response.cookies("cookie_name").expires = date + _ 
	30
 _ 
		response.cookies("cookie_name")("scuserid") = strUser
 _ 
		response.cookies("cookie_name")("username") = strUserName
if request.form("loggedin") = "yes" then
 _ 
		response.cookies("cookie_name")("savestate") = True
else
 _ 
		response.cookies("cookie_name")("savestate") = False						
end if
end function

function ClearCookie()
 _ 
		response.cookies("cookie_name")("scuserid") = ""
 _ 
		response.cookies("cookie_name")("username") = ""
 _ 
		response.cookies("cookie_name")("savestate") = False
	session("loggedin") = False
	session("admin") = false
end function

' functions used in page
function GetThisPath()
dim ThisPath
ThisPath = _ 
	Split(lcase(Request.ServerVariables("PATH_INFO")), _ 
	"/")
if ThisPath(ubound(ThisPath)) = "default.asp" then
GetThisPath = ThisPath(ubound(ThisPath)-1)
	if GetThisPath = "" then
		GetThisPath = "/"
	end if
else
GetThisPath = ThisPath(ubound(ThisPath))
end if
end function

function GetHTTPHost()
GetHTTPHost = "http://" & _ 
	request.servervariables("HTTP_HOST")
end function

function CheckBad(strIn, Pattern)
' basic regexp pattern matching
dim objRE
set objRE = New RegExp
objRE.pattern = Pattern
CheckBad = objRE.Test(strIn)
set objRE = nothing
end function
'*************************************
' end of functions.asp
%>

<%
'**************************************
'code for logon_code.asp
<%
' include file for checking user details in database
' form include for collecting data is _ 
	/include/inc_login_form.asp
dim strUserName
dim strPassword
dim strUser
dim KeepLoggedIn
dim AutoLogin
dim bLoggedIn
dim frmLoginAction
dim bError
dim ErrorMessage
dim UserLevel
dim bUsePaging
dim strThisScript

strThisScript = _ 
	lcase(mid(request.servervariables("SCRIPT_NAME"), _ 
	 _ 
	instrrev(request.servervariables("SCRIPT_NAME"),"/")+1))

const strError = "Login error: "

if lcase(request.querystring("logout")) = _ 
	"yes" then
ClearCookie()
end if

	GetCookie()

'g_Key = mid(strUserName,1,MsgLen)
'	if session("session") = "" then
	if session("usepaging") <> true then
		bUsePaging = true
	else
		session("usepaging") = true
		bUsePaging = false
	end if
'		bUsePaging = false

if session("loggedin") = true then
	GetCookie()
	bLoggedIn = True
else
	bLoggedIn = False
end if


if not bLoggedIn then
if request.form("log_in") <> "" _ 
	then
	frmLoginAction = lcase(request.form("log_in"))
	strUserName = request.form("username")
	if CheckBad(strUserName,"[=;'" & chr(34) _ 
	&"]") then
		bError = True
	end if  '   (checkbad)
	if not bError then
	if request.form("password") <> "" _ 
	then 	
	strPassword = request.form("password")
	if VarType(CheckUser(strUserName,strPassword))  = VBString _ 
	then
		ErrorMessage = CheckUser(strUserName,strPassword)
		bError = True
	elseif VarType(CheckUser(strUserName,strPassword))  = _ 
	VBBoolean then
		strUser = CheckUser(strUserName,strPassword)
		bLoggedIn = True
		session("loggedin") = True
		session("scuserid") = strUser
		SetCookie()
	end if
	else
		bError = True
		ErrorMessage = "Password cannot be blank"
	end if   '  (not blank password)
	end if   ' (not bError)
end if  '   (login not blank)
' this section of code used to redirect to a login form
	if strThisScript <> "login.asp" then
'	response.redirect("login.asp")
	else
	
	end if

end if

	if bLoggedIn then
		GetCookie()
		KeepLoggedIn = "checked='checked' "
	else
		KeepLoggedIn = " "
	end if  '   keep logged in


'*************************************************
' end of logon_code.asp
%>

<%
'*************************************************
' code for logon_form.asp
'  include page for user login to be
' used on pages where no existing form is available
%>
<%
dim UserFullName
dim ScriptParts
ScriptParts = Split(ScriptName(),"?")
with response
if bError then
	.write "<span class='red'>"
	.write strError
	.write "<br >"
	.write ErrorMessage
	.write "</span>"
end if


if bLoggedIn then
UserFullName = GetFullUserName(strUserName)
		.write "Logged in as"
		.write "<br>" & vbCrLf
		.write "<br>" & vbCrLf
		.write Proper(UserFullName)
		.write "<br>" & vbCrLf
		.write "<br>" & vbCrLf
' change these lines between tags to add to the navigation
%>
<a href="/" title="">Home _ 
	Page</a>
<%
		.write "<br>" & vbCrLf
		.write "<br>" & vbCrLf
		.write "<a href='"
		.write ScriptParts(0)
		.write "?logout=yes"
if ubound(ScriptParts)  > 0 then		
		.write "&"
		.write ScriptParts(1)
end if
		.write "'>" & vbCrLf
		.write "Logout"
		.write "</a>" & vbCrLf			
		.write "<br>" & vbCrLf
		
		.write "<br>" & vbCrLf
	else
		.write "<form action='"
		.write ScriptParts(0)
		.write "' method='post' name='login'>" & _ 
	vbCrLf
		.write "<table class='small left' _ 
	border='0'>" & vbCrLf
		.write "<tr>" & vbCrLf
		.write "<td class='reduced' colspan='2'>" _ 
	& vbCrLf
		.write "Login: "
		.write "</td>" & vbCrLf
		.write "</tr>" & vbCrLf
		.write "<tr>" & vbCrLf
		.write "<td class='reduced' _ 
	>username:</td>" & vbCrLf
		.write "</tr>" & vbCrLf
		.write "<tr>" & vbCrLf
		.write "<td class='reduced' >" & vbCrLf
		.write "<input class='nav' type='text' _ 
	name='username' size='10' maxlength='12' >" & vbCrLf
		.write "</td>" & vbCrLf
		.write "</tr>" & vbCrLf
		.write "<tr>" & vbCrLf
		.write "<td class='reduced' _ 
	>password:</td>" & vbCrLf
		.write "</tr>" & vbCrLf
		.write "<tr>" & vbCrLf
		.write "<td class='reduced' >" & vbCrLf
		.write "<input class='nav' type='password' _ 
	name='password' size='10' maxlength='12' >" & vbCrLf
		.write "</td>" & vbCrLf
		.write "</tr>" & vbCrLf
		.write "<tr>" & vbCrLf
		.write "<td class='reduced' colspan='2'>" _ 
	& vbCrLf
		.write "<input class='reduced' "
		.write "type='checkbox' "
		.write "name='loggedin' "
		.write "title='Save to cookie and logon at each _ 
	visit' "
		.write KeepLoggedIn
		.write " value='yes' >" & vbCrLf
		.write "Remember Me"
		.write "</td>" & vbCrLf
		.write "</tr>" & vbCrLf
		.write "<tr>" & vbCrLf
		.write "<td class='center' colspan='2'>" & _ 
	vbCrLf
		.write "<input class='nav reduced' type='submit' _ 
	name='log_in' id='log_in' value='Log In' >" & vbCrLf
		.write "</td>" & vbCrLf
		.write "</tr>" & vbCrLf
		.write "</table>" & vbCrLf
		.write "</form>" & vbCrLf
end if
end with

 _ 
	'**********************************************************************
' end of logon_form.asp
%>

Valid HTML 4.01! Valid CSS! copyright © C and S Design 2004 - 2005
Website Design and SE Friendly Coding C and S Design