<%option explicit%> <% '******************************************************* ' Version 6.50 with Billing ' Allow customer to purchase service or other none product goods ' Used to allow login to pay for project bills ' Sept 13, 2004 fix getsess '******************************************************* Dim sAction Dim dbc ' ********************************************************************** ' Set defaults here '********************************************************************** setsess "CurrentURL","shopprojectlogin.asp" setsess "FollowonURL","shopaddtocart.asp" sAction=Request("Action") if saction="" then saction=request("action.x") end if If sAction="" Then ' no came from customer logic Shopinit DisplayEverything Else sError="" ValidateData() ' need to validate anything, nothing is required IF sError="" then AddItemToCart strpid, strpemail End if if sError = "" Then ResponseRedirect getsess("FollowonURL") else DisplayEverything end if end if Sub AddItemToCart(strpid, strpemail) ProjectLocate strpid, strpemail If Serror="" Then ProjectAddToCart end if End Sub ' Sub DisplayEveryThing ShopPageHeader ' Normal page header Displayerrors ' any input errors DisplayForm ' display customer ShopPageTrailer ' Normal page trailer end Sub Sub ValidateData() 'VP-ASP 6.50 - precautionary security fix strpEmail = cleanchars(Request.Form("strpemail")) strpid=cleanchars(request("strpid")) If strpEmail = "" Then sError = sError & getlang("LangCustEmail") & " " & getlang("Langcustrequired") & "
" end if If strpid= "" Then sError = sError & getlang("LangProjectNumber") & " " & getlang("Langcustrequired") & "
" else If not isnumeric(strpid) then sError = sError & getlang("LangProjectNumber") & " " & getlang("Langcustrequired") & "
" end if End If 'VP-ASP 6.50 - validate email address If Not InStr(strpEmail, "@") > 1 Then Serror=Serror & getlang("langInvalidEmail") & "
" end if end sub Sub DisplayForm Response.Write("

") shopwriteheader getlang("Langprojectprompt") Response.Write tabledef CreateCustRow getlang("LangProjectNumber"), "strpid", strpid,"Yes" CreateCustRow getlang("LangCustEmail"), "strpemail", strpemail,"Yes" Response.write tabledefend & "
" If Getconfig("xbuttoncontinue")="" then Response.Write("") else Response.Write("") end if addwebsessform Response.write "

" end sub Sub DisplayErrors if sError<> "" then shopwriteError SError Serror="" end if end Sub Sub ProjectPaid (conn,pid) dim strsql strsql="update projects set paid=1, datepaid=" & datedelimit(date()) strsql=strsql & "where pid=" & pid conn.execute(strsql) end sub %>