%@ LANGUAGE="VBSCRIPT" %>
<%
Option Explicit
Server.ScriptTimeout = 3600
Response.Buffer = True
%>
<%
' Initialize my stuff
Dim myLoop1
Dim strTemp
Dim strTemp2
Dim CrLf
Dim strParameters
Dim strDatabaseDSN
Dim strScriptURL
Dim strScriptBaseURL
Dim strScriptBasePath
Dim strScriptLogPath
Dim strHeadersBasePath
Dim strFootersBasePath
Dim strUploadPath
Dim strImagePath
Dim strImageRelativePath
Dim strLoginUsername
Dim strLoginPassword
Dim lngCookieKey
Dim lngAccessLevel
Dim Upload
Dim flagUpload
Dim strCommand
Dim strCriteria
Dim fltRetailPercentage
Dim fltWholesalePercentage
Dim lngCategoryColumnWidth
Dim lngManufacturerColumnWidth
Dim lngProductColumnWidth
Dim cellcount
Dim rstImport
Dim rstProductsForImport
Dim strAdminUsername
Dim strAdminPassword
Dim intLoginFailureThreshold
Dim intLoginMinutes
Dim flagTemp
' * Initialize variables
intLoginFailureThreshold = 5
intLoginMinutes = 60
lngCategoryColumnWidth = 250
lngManufacturerColumnWidth = 250
lngProductColumnWidth = 0
cellcount = 3
CrLf = chr(13) & chr(10)
fltRetailPercentage = 1.00
fltWholesalePercentage = 0.20
strDatabaseDSN = "DRIVER={SQL Server};SERVER=BITSBROTHER.PLAYBOARD.COM;UID=pageplusonline;PWD=diesel;DATABASE=PagePlusOnline;"
strScriptURL = "ProductPage.asp"
strScriptBaseURL = "/scripts/"
strScriptBasePath = "C:\HostedWebSites\instant-mobile\scripts\"
strScriptLogPath = "C:\HostedWebSites\instant-mobile\LogFiles\"
strHeadersBasePath = "C:\HostedWebSites\instant-mobile\SiteHeader.html"
strFootersBasePath = "C:\HostedWebSites\instant-mobile\SiteFooter.html"
strUploadPath = "C:\temp"
strImagePath = "C:\HostedWebSites\instant-mobile\ProductImages\"
strImageRelativePath = "../ProductImages/"
strAdminUsername = "pageplus11"
strAdminPassword = "diesel2244"
'Temporary ASP fix
strLoginUsername = ""
strLoginPassword = ""
lngAccessLevel = 0
lngCookieKey = 0
' Deal with pricing
if Session("wholesaleprice") <> "Y" then
if Session("retailprice") <> "N" then
Session("retailprice") = "Y"
end if
end if
if Request.ServerVariables("REQUEST_METHOD") = "POST" then
' * Get anything posted with form
Set Upload = Server.CreateObject("Persits.Upload.1")
Upload.OverwriteFiles = False ' Generate unique names
Upload.SetMaxSize 1048576,true ' Truncate files above 1MB
Upload.Save strUploadPath
flagUpload = 1
strCommand = Upload.Form("command")
if len(Upload.Form("criteria")) > 0 then
strCriteria = Upload.Form("criteria")
Session("criteria") = strCriteria
else
if len(Upload.Form("ProductProtocol")) > 0 then
MakeSearchCriteria
else
strCriteria = Session("criteria")
end if
end if
if len(Upload.Form("CookieKey")) > 0 then
strLoginUsername = Upload.Form("LoginUsername")
CheckSecurity strLoginUsername, Upload.Form("CookieKey"),1,2
end if
else
flagUpload = 0
strCommand = request("command")
if len(request("criteria")) > 0 then
strCriteria = request("criteria")
Session("criteria") = strCriteria
else
if len(request("ProductProtocol")) > 0 then
MakeSearchCriteria
else
strCriteria = Session("criteria")
end if
end if
if len(request("CookieKey")) > 0 then
strLoginUsername = request("LoginUsername")
CheckSecurity strLoginUsername, request("CookieKey"),1,2
end if
end if
sub AddSpellCheckFunction()
' Spell checker function
'**************************************
' Name: Spell Checker
' Description:Use Microsoft word spell checker utility
' By: Anil Paranganat
'
'
' Inputs:None
'
' Returns:None
'
'Assumes:Client machine has word 2000
'Browser is I.E.
'Activex scripting is enabled
'
'Side Effects:none
'This code is copyrighted and has limited warranties.
'Please see http://www.Planet-Source-Code.com/xq/ASP/txtCodeId.6561/lngWId.4/qx/vb/scripts/ShowCode.htm
'for details.
'**************************************
Response.Write "" & CrLf
end sub
' intAction 1 Add a login attempt
' 2 Delete all login attempts
Function LoginAttempt(ByVal intAction)
Dim rst
Dim strQuery
Dim OBJdbConn
Dim intAttempt
' Create and open connection object
set OBJdbConn = Server.CreateObject("ADODB.Connection")
OBJdbConn.Mode = adModeShareDenyNone
OBJdbConn.Open(strDatabaseDSN)
If intAction = 1 Then
' Check our login attempts
strQuery = "SELECT Failures,LastAttemptDateTime FROM tblLoginAttempt WHERE IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'"
set rst = OBJdbConn.Execute(strQuery)
If rst.EOF Then
' First attempt
intAttempt = 1
Else
If DateDiff("n", rst("LastAttemptDateTime").value, Now()) > intLoginMinutes Then
intAttempt = 0
Else
intAttempt = rst("Failures").value + 1
End If
End If
' Close
rst.close()
set rst = Nothing
' If our time expired, then reset login attempts
If intAttempt = 0 Then
' Delete all login attempts
strQuery = "DELETE FROM tblLoginAttempt WHERE IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'"
set rst = OBJdbConn.Execute(strQuery)
intAttempt = 1
End If
If intAttempt = 1 Then
' Add a login attempt
strQuery = "INSERT INTO tblLoginAttempt (IPAddress,Failures,LastAttemptDateTime) VALUES ('" & Request.ServerVariables("REMOTE_ADDR") & "',1,'" & Now() & "')"
set rst = OBJdbConn.Execute(strQuery)
Else
' Update login attempt
strQuery = "UPDATE tblLoginAttempt SET Failures = " & intAttempt & ", LastAttemptDateTime = '" & Now() & "' WHERE IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'"
set rst = OBJdbConn.Execute(strQuery)
End If
Else
' Delete all login attempts
strQuery = "DELETE FROM tblLoginAttempt WHERE IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'"
set rst = OBJdbConn.Execute(strQuery)
intAttempt = 0
End If
' Return
LoginAttempt = intAttempt
End Function
Function VerifyWholesalerUsernamePassword(ByVal username, ByVal password, ByVal showflag)
Dim strQuery
Dim rst
Dim returnflag
Dim OBJdbConn
' Create and open connection object
set OBJdbConn = Server.CreateObject("ADODB.Connection")
OBJdbConn.Mode = adModeShareDenyNone
OBJdbConn.Open(strDatabaseDSN)
' Add a login attempt
If LoginAttempt(1) > intLoginFailureThreshold Then
Response.Write("
Your login has been blocked for a security violation!
" & CrLf)
Response.End()
End If
' Open recordset
strQuery = "SELECT WholesalerID, CompanyName, ContactName, Address1, Address2, City, State, Zip, Telephone, Fax, EmailAddress, Username, Password, PercentageAdjust, AffiliateEnabled, AffiliateID, AffiliatePercentage FROM Wholesalers WHERE ((ApprovedDate > '5/22/1971') AND (Username = '" & username & "') AND (Password = '" & password & "'));"
set rst = OBJdbConn.Execute(strQuery)
If rst.EOF Then
returnflag = -1
If showflag = 1 Then
Response.Write("
That username/password does not match any approved wholesaler in the database.
")
End If
Else
rst.MoveFirst()
If showflag = 1 Then
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Wholesaler ID
" & CrLf)
Response.Write("
" & rst.Fields("WholesalerID").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Company Name
" & CrLf)
Response.Write("
" & rst.Fields("CompanyName").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Contact Name
" & CrLf)
Response.Write("
" & rst.Fields("ContactName").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Address 1
" & CrLf)
Response.Write("
" & rst.Fields("Address1").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Address 2
" & CrLf)
Response.Write("
" & rst.Fields("Address2").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
City
" & CrLf)
Response.Write("
" & rst.Fields("City").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
State
" & CrLf)
Response.Write("
" & rst.Fields("State").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Zip
" & CrLf)
Response.Write("
" & rst.Fields("Zip").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Telephone
" & CrLf)
Response.Write("
" & rst.Fields("Telephone").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Fax
" & CrLf)
Response.Write("
" & rst.Fields("Fax").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Email Address
" & CrLf)
Response.Write("
" & rst.Fields("EmailAddress").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Percentage Adjust
" & CrLf)
Response.Write("
" & rst.Fields("PercentageAdjust").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
AffiliateEnabled
" & CrLf)
Response.Write("
" & rst.Fields("AffiliateEnabled").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
AffiliateID
" & CrLf)
Response.Write("
" & rst.Fields("AffiliateID").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
Affiliate Percentage
" & CrLf)
Response.Write("
" & rst.Fields("AffiliatePercentage").value & "
" & CrLf)
Response.Write("
" & CrLf)
Response.Write("
" & CrLf)
End If
Session("wholesaleprice") = "Y"
Session("WholesalerID") = rst.Fields("WholesalerID").value
Session("WholesalerUsername") = rst.Fields("Username").value
Session("WholesalerPassword") = rst.Fields("Password").value
Session("WholesalerCompanyName") = rst.Fields("CompanyName").value
Session("WholesalerPercentageAdjust") = rst.Fields("PercentageAdjust").value
Session("WholesalerAffiliateEnabled") = rst.Fields("AffiliateEnabled").value
Session("WholesalerAffiliatePercentage") = rst.Fields("AffiliatePercentage").value
returnflag = 0
' Successful login, reset login attempts
LoginAttempt(2)
End If
' Close recordset and cleanup
rst.close()
Session("returnflag") = returnflag
VerifyWholesalerUsernamePassword = returnflag
end function
'* ReportError
function ReportError(strError,lngFlag,strReferrer)
Dim Mail
Set Mail = Server.CreateObject("Persits.MailSender")
Mail.From = "WebserverEmail@playboard.com"
Mail.FromName = "WebserverEmail"
Mail.AddAddress "wpryder@playboard.com"
Mail.Subject = "Script Error (ProductManagementSystem.asp)"
Mail.Body = strError
Mail.Queue = True
On Error Resume Next
Mail.Send
If Err.Number <> 0 then
Response.Write "Unable to send error report email...Please contact website administrator (Err.Number = " & Err.Number & ")"
end if
on error goto 0
Set Mail = nothing
end function
'* PrintPageHeader
Function PrintPageHeader
Dim strFilename
Dim fso
Dim f
Dim tf
dim boolFlag
' Get our page header filename
strFilename = strHeadersBasePath
' Open the header page file
set fso = CreateObject("Scripting.FileSystemObject")
' If the header file isn't there, report error
on error resume next
if not fso.FileExists(strFilename) then
ReportError "Header File Not Found (" & strFilename & ").",1,Request.ServerVariables("HTTP_REFERRER")
on error goto 0
else
on error goto 0
' Display the header
set f = fso.GetFile(strFilename)
set tf = f.OpenAsTextStream(1)
do while not tf.AtEndOfStream
Response.Write tf.ReadLine & chr(13) & chr(10)
loop
' Clean up and close files
tf.Close
set tf = nothing
set f = nothing
set fso = nothing
end if
end function
'* PrintPageFooter
Function PrintPageFooter
Dim strFilename
Dim fso
Dim f
Dim tf
' Get our page footer filename
strFilename = strFootersBasePath
' Open the header page file
set fso = CreateObject("Scripting.FileSystemObject")
' If the header file isn't there, report error
on error resume next
if not fso.FileExists(strFilename) then
on error goto 0
ReportError "Footer File Not Found (" & strFilename & ").",1,Request.ServerVariables("HTTP_REFERRER")
else
on error goto 0
' Display the header
set f = fso.GetFile(strFilename)
set tf = f.OpenAsTextStream(1)
do while not tf.AtEndOfStream
Response.Write tf.ReadLine & chr(13) & chr(10)
loop
' Clean up and close files
tf.Close
set tf = nothing
set f = nothing
set fso = nothing
end if
end function
function RemoveQuotes(strFixString)
Dim strTemp
Dim loop1
loop1 = 1
strTemp = ""
while (loop1 <= len(strFixString))
if mid(strFixString,loop1,1) = chr(34) then
strTemp = strTemp & """
else
if mid(strFixString,loop1,1) = "'" then
strTemp = strTemp & "&lsquo"
else
strTemp = strTemp & mid(strFixString,loop1,1)
end if
end if
loop1 = loop1 + 1
wend
RemoveQuotes = strTemp
end function
function FixQuotes(strFixString)
Dim strTemp
Dim loop1
loop1 = 1
strTemp = ""
while (loop1 <= len(strFixString))
if mid(strFixString,loop1,1) = "'" then
strTemp = strTemp & "''"
else
strTemp = strTemp & mid(strFixString,loop1,1)
end if
loop1 = loop1 + 1
wend
FixQuotes = strTemp
end function
function FormatPrice(fltPrice)
Dim strTemp
Dim intTemp
strTemp = cstr(round(fltPrice,2))
intTemp = instr(strTemp,".")
if intTemp = 0 then
strTemp = "$" & strTemp & ".00"
else
if (len(strTemp) - intTemp) = 2 then
strTemp = "$" & strTemp
else
if (len(strTemp) - intTemp) = 1 then
strTemp = "$" & strTemp & "0"
else
strTemp = "$" & strTemp & ".00"
end if
end if
end if
FormatPrice = strTemp
end function
function MakeLogEntry(strLogEntry)
Dim fso
Dim f
Dim fname
Dim strTemp
' Get log filename
fname = strScriptLogPath & year(now())
if month(now()) < 10 then fname = fname & "0"
fname = fname & month(now())
if day(now()) < 10 then fname = fname & "0"
fname = fname & day(now()) & ".txt"
' Append the log file for today
set fso = CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile(fname,8,true) 'ForAppending = 8
strTemp = formatDateTime(now(),0) & "(" & strLoginUsername & "):" & strLogEntry
f.Write strTemp & CrLf
Session("LogString") = strTemp & CrLf & Session("LogString")
Session("LogStringLast") = strTemp
f.Close
' Close and clean up
set f = nothing
set fso = nothing
end function
Function CheckSecurity(strUsername, strPassword, intAccessLevel,flagDisplay)
Dim returnflag
Dim sConnectionString, SQLQuery, OutputString
Dim OBJdbConn
Dim RsUsers
' Create and open connection object
Set OBJdbConn = Server.CreateObject("ADODB.Connection")
OBJdbConn.Mode = adModeShareDenyNone
OBJdbConn.Open strDatabaseDSN
' Setup our query and open recordset of tblEmailListMembers
SQLQuery = "SELECT * FROM tblUsers WHERE UserName = '" & strUsername & "'"
Set RsUsers = OBJdbConn.Execute(SQLQuery)
' if no records found, let them know
if RsUsers.eof then
OutputString = "Your username (" & strUsername & ") does not exist. Access denied."
strLoginUsername = ""
strLoginPassword = ""
lngAccessLevel = 0
returnflag = -1
else
if flagDisplay = 2 then
if RsUsers("CookieKey") <> CLng(strPassword) then
OutputString = "Your cookie is invalid (" & CLng(strPassword) & "). Access denied."
strLoginUsername = ""
strLoginPassword = ""
lngAccessLevel = 0
returnflag = -1
else
if RsUsers("CookieIP") <> Request.ServerVariables("REMOTE_ADDR") then
OutputString = "Your cookie is invalid (" & Request.ServerVariables("REMOTE_ADDR") & ". Access denied."
strLoginUsername = ""
strLoginPassword = ""
lngAccessLevel = 0
returnflag = -1
else
' IP and cookie key matched, log them in
' Get the stuff we need
OutputString = "User (" & strUsername & ") logged in with access level " & RsUsers("UserAccessLevel") & "."
strLoginUsername = RsUsers("UserName")
strLoginPassword = RsUsers("UserPassword")
lngAccessLevel = RsUsers("UserAccessLevel")
returnflag = 0
end if
end if
else
if strPassword <> RsUsers("UserPassword") then
OutputString = "Your password is not correct for username (" & strUsername & "). Access denied."
strLoginUsername = ""
strLoginPassword = ""
lngAccessLevel = 0
returnflag = -1
else
if intAccessLevel > RsUsers("UserAccessLevel") then
OutputString = "Your access level (" & RsUsers("AccessLevel") & ") is not high enough to access this function."
strLoginUsername = ""
strLoginPassword = ""
lngAccessLevel = 0
returnflag = -1
else
' Get the stuff we need
OutputString = "User (" & strUsername & ") logged in with access level " & RsUsers("UserAccessLevel") & "."
strLoginUsername = RsUsers("UserName")
strLoginPassword = RsUsers("UserPassword")
lngAccessLevel = RsUsers("UserAccessLevel")
returnflag = 0
end if
end if
end if
end if
' Update cookie with info
if returnflag = 0 then
Randomize Now
lngCookieKey = int((rnd * 999999))
RsUsers.close
SQLQuery = "UPDATE tblUsers SET CookieKey = " & lngCookieKey & " , CookieIP = '" & Request.ServerVariables("REMOTE_ADDR") & "' WHERE UserName = '" & strUsername & "'"
Set RsUsers = OBJdbConn.Execute(SQLQuery)
else
RsUsers.close
end if
' Close the recordset and connection to the database
OBJdbConn.close
set RsUsers = nothing
set OBJdbConn = nothing
if returnflag <> 0 then
if ((flagDisplay = 0) or (flagDisplay = 2)) then
Session("errormessage") = OutputString
else
Response.Write "
" & OutputString & "
"
end if
end if
if flagDisplay <> 0 then
MakeLogEntry(OutputString)
end if
Session("returnflag") = returnflag
end function
' flagDisplay 0 strInput match returned
' 1 strInput match for viewing
' 2 strInput match in select for form
' 11 Return productID
' 12 Return ProductQuantity
' 51 Return WholesalePrice1to50
' 52 Return WholesalePrice51to100
' 53 Return WholesalePrice100plus
' 54 Return RetailPrice
function GetProductID(strInput,flagDisplay)
Dim rstProducts
Dim strQuery
Dim lngProductID
Dim lngTemp
Dim OBJdbConn
Dim flagLoop
Dim strReturnValue
' Create and open connection object
Set OBJdbConn = Server.CreateObject("ADODB.Connection")
OBJdbConn.Mode = adModeShareDenyNone
OBJdbConn.Open strDatabaseDSN
' Initialize values
flagLoop = 0
lngProductID = 0
' Instantiate a Recordset object and open a recordset using the Open method
if flagDisplay = 0 then
strQuery = "SELECT ProductID FROM Products ORDER BY ProductID DESC;"
else
if len(strInput) > 0 then
if flagDisplay > 10 then
strQuery = "SELECT * FROM Products WHERE ProductID = " & strInput
else
strQuery = "SELECT * FROM Products WHERE ProductName = '" & strInput & "'"
end if
else
strQuery = "SELECT * FROM Products"
end if
end if
Set rstProducts = OBJdbConn.Execute(strQuery)
if rstProducts.eof then
if flagDisplay = 1 then
Response.Write "No products in database."
end if
else
if flagDisplay = 2 then
Response.Write "" & CrLf
else
if flagDisplay = 1 then
Response.Write "" & CrLf
end if
end if
end if
' Close and clean up
rstProducts.close
set rstProducts = nothing
OBJdbConn.close
set OBJdbConn = nothing
' Return what we found
GetProductID = strReturnValue
end function
' flagDisplay 0 strInput match returned
' 1 strInput match for viewing
' 2 strInput match in select for form
' 3 strInput match for viewing on side column
function GetManufacturerID(strInput,flagDisplay)
Dim rstManufacturers
Dim strQuery
Dim strTemp
Dim intLoop
Dim lngManufacturerID
Dim lngTemp
Dim OBJdbConn
Dim lngPreselectedManufacturerID
' Determine preselected
if Instr(strCriteria,"ProductManufacturerID=") = 0 then
lngPreselectedManufacturerID = 0
else
intLoop = instr(strCriteria,"ProductManufacturerID=")+22
strTemp = ""
while ((intLoop <= len(strCriteria)) and ((mid(strCriteria,intLoop,1) >= "0") and (mid(strCriteria,intLoop,1) <= "9")))
strTemp = strTemp & mid(strCriteria,intLoop,1)
intLoop = intLoop + 1
wend
if len(strTemp) < 1 then
lngPreselectedManufacturerID = 0
else
lngPreselectedManufacturerID = CLng(strTemp)
end if
end if
' Create and open connection object
Set OBJdbConn = Server.CreateObject("ADODB.Connection")
OBJdbConn.Mode = adModeShareDenyNone
OBJdbConn.Open strDatabaseDSN
' Initialize values
lngManufacturerID = 0
' Instantiate a Recordset object and open a recordset using the Open method
if len(strInput) > 0 then
strQuery = "SELECT * FROM [Product Manufacturers] WHERE ProductManufacturerName = '" & strInput & "'"
else
strQuery = "SELECT * FROM [Product Manufacturers]"
end if
Set rstManufacturers = OBJdbConn.Execute(strQuery)
if rstManufacturers.eof then
if flagDisplay = 1 then
Response.Write "No product manufacturers in database."
end if
else
if flagDisplay = 2 then
Response.Write "