<%option explicit%> <% '************************************************************************** ' Making an Offer ' VP-ASP 6.50 March26, 2004 ' shopmakeanoffer.asp?id=xxx ' April 26, 2005 add translate '************************************************************************* Dim CR CR=GetMailCR Dim strMessage Dim sAction Dim my_to Dim my_toaddress Dim my_from Dim my_fromaddress Dim my_subject,mailtype Dim my_system Dim mailer Dim my_attachment Dim body Dim strCustName Dim strCustEmail Dim strFriendsName Dim strFriendsEmail Dim id Dim extDescription dim dbc, prs dim mailid, ProductMessage Dim TellafriendSubject sError="" dim strcustphone, strhousenumber, strquantity, stroffer dim cprice,cname,ccode Dim url '======================= ' Entry Point '======================= if getconfig("xproductmakeanoffer")<>"Yes" then shoperror getlang("LangCustNotAllowed") end if ShopopendatabaseP dbc id=request("id") If id="" then serror=getlang("LangNoCatalogID") else If not isnumeric(id) then Serror=getlang("LangNoCatalogID") id="" end if end if If serror="" then GetProductInfo prs end if ShopPageHeader if getconfig("xbreadcrumbs") = "Yes" then if ucase(getconfig("xCrossLinkurl"))="SHOPEXD.ASP" then url= xMYSITE & "shopexd.asp?id=" & id else url= xMYSITE & "shopquery.asp?catalogid=" & id end if response.write "" end if Response.Write "

" & getlang("langmakeanoffer") & "

" If sError<>"" then HandleError else sAction=Request("Action") if sAction="" then sAction=Request("Action.x") end if If sAction = "" Then DisplayForm() Else ValidateData() if sError = "" Then SendMail WriteInfoMessage else DisplayForm end if end if end if If id<>"" then closerecordset prs end if ShopPageTrailer shopclosedatabase dbc '======================= ' Sub DisplayForm '======================= Sub DisplayForm() If serror<>"" then shopwriteerror serror end if WriteProductdetails prs Response.Write("

") shopwriteheaderpic getlang("LangFormatCustomerInformation"), "images/icons/user.gif" Response.Write "

" Response.Write(TableDef) CreateCustRow getlang("langYourName"), "Custname", strCustname,"No" CreateCustRow getlang("langYourEmail"), "Custemail", strCustemail,"No" CreateCustRow getlang("langcustPhone"), "phone", strcustphone,"No" Response.Write(tabledefend) Response.Write "

" shopwriteheaderpic getlang("langmakeanoffer"), "images/icons/cashier.gif" Response.Write "

" Response.Write(TableDef) CreateCustRow getlang("LangProductQuantity"), "quantity", strquantity,"No" CreateCustRow getlang("langproductoffer"), "Offer", strOffer,"No" Response.Write(tabledefend) Response.Write "

" Response.Write "

" shopbutton Getconfig("xbuttoncontinue"), getlang("Langmakeanoffer"),"action" Response.Write "

" addwebsessform Response.Write("

") end Sub '======================= ' Sub ValidateData '======================= Sub ValidateData() Validatefield getlang("langYourName"), "Custname", strCustname,"No" Validatefield getlang("langYourEmail"), "Custemail", strCustemail,"No" Validatefield getlang("langcustPhone"), "phone", strcustphone,"No" Validatefield getlang("langproductquantity"), "quantity", strquantity,"No" Validatefield getlang("langproductoffer"), "Offer", strOffer,"No" If serror="" then If not isnumeric(strquantity) then serror=serror & getlang("langproductquantity") &"
" end if end if If Serror<>"" then Serror= getlang("LangCommonRequired") & "
" & SError strquantity="" exit sub end if If Not InStr(strcustemail, "@") > 1 Then Serror=Serror & getlang("LangInvalidEmail") & "
" end if If not isnumeric(stroffer) then serror=serror & getlang("LangUserPriceError") & " " & getlang("Langmakeanoffer") & "
" end if End sub Sub ValidateField(caption, fieldname, fieldvalue,other) 'VP-ASP 6.50 - precautionary security fix fieldvalue=cleanchars(request(fieldname)) If fieldvalue="" Then sError = sError & caption & "
" End If end sub '======================= ' Sub SendMail '======================= Sub SendMail dim url, ProductMessage, emailformat, acount dim xmysite Emailformat="Text" Body="" Mailfield Getlang("langproductname"),"xxx", cname,"No" Mailfield getlang("langproductcode"), "xxx", ccode,"No" Mailfield getlang("langproductprice"), "xxx", cprice,"No" body=body & vbcrlf body=body & getlang("LangFormatCustomerInformation") & vbcrlf Mailfield Getlang("LangCommonName"), "Custname", strCustname,"No" Mailfield getlang("langcustemail"), "Custemail", strCustemail,"No" Mailfield getlang("langcustPhone"), "phone", strcustphone,"No" body=body & vbcrlf body=body & getlang("langmakeanoffer") & vbcrlf Mailfield getlang("langproductquantity"), "quantity", strquantity,"No" Mailfield getlang("langproductoffer"), "Offer", strOffer,"No" 'debugwrite body mailtype=getconfig("xemailtype") my_from=strCustName my_fromaddress=strCustEmail my_toaddress=getconfig("xemail") my_to=getconfig("xemailname") my_system=getconfig("xemailsystem") my_subject=getlang("langmakeanoffer") & " " & getlang("langproductcode") & "=" & ccode acount=0 ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,emailformat,My_attachment,acount end sub Sub Mailfield (caption, other, fieldvalue,other1) 'Debugwrite "mail=" & fieldvalue body=body & caption & ": " & fieldvalue & vbcrlf end sub Sub WriteInfoMessage shopwriteheader getlang("LangTellafriendinfo") end sub Sub GetProductInfo (prs) Dim sql sql = "select * from products where catalogid = " & id set prs = dbc.execute(sql) If prs.eof then serror=getlang("LangErrorNoProduct") & " catalogid=" & id exit sub end if cprice=prs("cprice") cprice=shopformatcurrency(cprice,Getconfig("xdecimalpoint")) cname=prs("cname") cname=translatelanguage(dbc, "products", "cname","catalogid", id, cname) ccode=prs("ccode") end sub Sub WriteProductdetailsnormal (prs) Response.write tabledef response.write "

" Shopwriteheader "You are making an offer on." response.write "
" response.write "" & getlang("langproductcode") & " : " & ccode & "
" response.write "" & getlang("langproductname") & " : " & cname & "
" response.write "" & getlang("langproductprice") & " : " & cprice & "
" response.write "

" response.write tabledefend end sub Sub HandleError shopwriteerror serror end sub Sub WriteProductdetails (prs) dim template, orc template=Getconfig("xproductoffertemplate") ShopTemplateWrite template,prs, orc end sub %>