Skip to content

Instantly share code, notes, and snippets.

@jlbruno
Created October 3, 2013 11:53
Show Gist options
  • Save jlbruno/6808618 to your computer and use it in GitHub Desktop.
Save jlbruno/6808618 to your computer and use it in GitHub Desktop.
Some old ASP functions for the early 2000's....just posting for backup
<%
'on error resume next
'******************************************************************************
' db_subs.asp '
' '
'******************************************************************************
dim dbSyc, DBcmd
'*****************************************************************************
'subroutines that open and close the database CONNECTION object
'example: call open_DB("forms", "webteam", "password")
sub open_DB(strDBName, uid, pwd)
set dbSyc = server.CreateObject("ADODB.CONNECTION")
dbSyc.Provider = "SQLOLEDB"
dbSyc.ConnectionString = "Driver={SQL Server};server=(local);database=" & strDBName & ";uid=" & uid & ";pwd=" & pwd & ";"
dbSyc.Open
end sub
'example: call close_DB()
sub close_DB()
dbSyc.close
set dbSyc = nothing
end sub
'*****************************************************************************
'subroutines that open and close the database RECORDSET object
dim rsName
sub open_myRS(ByRef rsName, strSQL)
set rsName = server.CreateObject("ADODB.RECORDSET")
rsName.Open strSQL, dbSyc
end sub
sub close_myRS(ByRef rsName)
rsName.close
set rsName = nothing
end sub
'*****************************************************************************
'subroutine that executes a command on the database
sub run_cmd(strSQL)
set DBcmd = server.CreateObject("ADODB.COMMAND")
DBcmd.ActiveConnection = dbSyc
DBcmd.CommandText = strSQL
DBcmd.Execute
set DBcmd = nothing
end sub
'*****************************************************************************
%>
<%
'*********************************************************************
' Name : ShowLastModified
' Desc : Shows the Last Modified Date of a Document
' params : filespec - Name of asp page or section that received error
Function ShowLastModified(filespec)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(filespec)
ShowLastModified = f.DateLastModified
end Function
' create an instance of the Browser Capabilities component
dim browserdetect
Set browserdetect = Server.CreateObject("MSWC.BrowserType")
' find some properties of the browser being used to view this page
dim browser, version, majorver, minorver, platform, frames, tables, cookies, javascript, plat3
browser=browserdetect.Browser
version=browserdetect.Version
majorver=browserdetect.Majorver
minorver=browserdetect.Minorver
platform=browserdetect.Platform
frames=browserdetect.Frames
tables=browserdetect.Tables
cookies=browserdetect.Cookies
javascript=browserdetect.JavaScript
plat3 = lcase(Left(platform,3))
'alert(plat3)
'*********************************************************************
'*********************************************************************
' Name : isValidUser
' Desc : returns true or false based on the current user versus the users passed in
' params : strUsers - string of users who are "valid"
' example:
' IF isvalidUser("username1,username2,username3") THEN
' ---code you want to display to authorized users---
' ELSE
' ---code you want to display to unauthorized users---
' END IF
' author: JRL
function isValidUser(strUsers)
isValidUser = false
Username = Request.ServerVariables("AUTH_USER")
findslash = instr(Username,"\")
user = lcase(trim(mid(Username,findslash+1)))
k=0
'give access to users that are in list of authorized users
checkUsers = split(strUsers,",")
for k = 0 to ubound(checkUsers)
if user = checkUsers(k) then
isValidUser = true
end if
next
end function
'*********************************************************************
'*********************************************************************
' Name : cleanFormStr
' Desc : doubles apostrophes in strings for use in a SQL statement
' params : myString - the string being cleaned
function cleanFormStr(myString)
Dim tempStr
tempStr=Trim(myString)
if inStr(tempStr,"'") then
tempStr = Replace(tempStr,"'","''")
end if
cleanFormStr=tempStr
end function
'*********************************************************************
'*********************************************************************
' Name : checkBit
' Desc : checked a bit value to return true or false
' params : fieldName - the name of the field being checked
function checkBit(fieldName)
if fieldName <> "" then
if (CInt(fieldName) = 1) or (fieldName = true) then
checkBit = true
else
checkBit = false
end if
else
checkBit = false
end if
end function
'*********************************************************************
'*********************************************************************
' Name : refServer
' Desc : checks whether the refering server is staging or www
' params : none
function refServer()
posDot = (InStr(8,Request.ServerVariables("HTTP_REFERER"),".") - 8)
refServer = lcase(Mid(Request.ServerVariables("HTTP_REFERER"),8,posDot))
'this if statement takes care of when someone is browsing using http://example.com/
if refServer = "example" then
refServer = "www"
else
refServer = refServer
end if
end function
'*********************************************************************
%>
<%
'*********************************************************************
' Name : alert
' Desc : Function to use javascript alert
' params : strMsg - message to to display in alert box
sub alert(strMsg)
%><script>alert("<%=strMsg%>");</script><%
end sub
'*********************************************************************
'*********************************************************************
' Name : emailError
' Desc : Function to use javascript alert
' Params : strErrorPage - Name of asp page or section that received error
' strEmailAddr - Destination email address
' strUserID - user id of user who received the error
' example: call emailError("Event Registration", "webservices@skillsoft.com", Request.ServerVariables("AUTH_USER"))
sub emailError(strErrorPage, strEmailAddr, strUserID)
Dim ObjSendMail
Dim iConf
Dim Flds
Set ObjSendMail = Server.CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
Flds("http://schemas.microsoft.com/cdo/configuration/sendusing") = 1
'**** Path below may need to be changed if it is not correct
Flds("http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirectory") = "c:\inetpub\mailroot\pickup"
Flds.Update
Set ObjSendMail.Configuration = iConf
ObjSendMail.From = "error@example.com"
ObjSendMail.To = strEmailAddr
'ObjSendMail.CC = "someone@someone.net"
ObjSendMail.Subject = strErrorPage & " Error - Received by " & strUserID
' we are sending a text email.. simply switch the comments around to send an html email instead
'ObjSendMail.HTMLBody = "this is the body"
ObjSendMail.TextBody = strUserID & " has received an error in " & strErrorPage & ":" & VbCrLf & err.description & vbcrlf & "Date Time: " & now()
ObjSendMail.Send
Set ObjSendMail = Nothing
end sub
'*********************************************************************
'*********************************************************************
' old version with CDONTS
sub emailError2(strErrorPage, strEmailAddr, strUserID)
Dim MailerError
set MailerError = Server.CreateObject("CDONTS.Newmail")
MailerError.FromName = strErrorPage & " Error"
MailerError.FromAddress = "error@example.com"
MailerError.To = strEmailAddr
MailerError.AddCC "sw_errors@example.com"
MailerError.Subject = strErrorPage & " Error - Received by " & strUserID
MailerError.BodyText = strUserID & " has received an error in " & strErrorPage & ":" & VbCrLf & err.description & vbcrlf & "Date Time: " & now()
MailerError.SendMail
set MailerError = nothing
end sub
'*********************************************************************
'*********************************************************************
' Name : WriteFormVars
' Desc : Writes out the statements needed for form processing
' params :
' notes :
sub WriteFormVars(wReplace)
'Automatically write out the statement to set variables = to form values, along with the replace statement on apostrophes
for each variable_name in Request.Form
'variable_value = Replace(Request.Form(variable_name),"'","''")
if wReplace = true then
var = """'"",""''"""
response.write variable_name & " = " & "cleanFormStr(Request.Form(""" & variable_name & """))<br>"
else
response.write variable_name & " = " & "Request.Form(""" & variable_name & """)<br>"
end if
next
End sub
'*********************************************************************
'*********************************************************************
' Name : WriteFormVariables
' Desc : Writes out the statements needed for form processing
' params :
' notes :
sub WriteFormVariables(wReplace)
'Automatically write out the statement to set variables = to form values, along with the replace statement on apostrophes
for each variable_name in Request.Form
'variable_value = Replace(Request.Form(variable_name),"'","''")
if wReplace = true then
var = """'"",""''"""
response.write variable_name & " = " & "Replace(Request.Form(""" & variable_name & """)," & var & ")<br>"
else
response.write variable_name & " = " & "Request.Form(""" & variable_name & """)<br>"
end if
next
End sub
'*********************************************************************
%>
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment