%option explicit%>
<%
setsess "currenturl","shopcusttracking.asp"
'************************************************
' VP-ASP 6.50 Tracking Format for Customer
' Use myconn March 26, 2004
''************************************************
dim customerid
CustCheckAdmin customerid
If getconfig("Xtrackingcustomerread")="Yes" or getconfig("Xtrackingcustomerwrite")="Yes" Then
else
shoperror getlang("LangCustNotAllowed")
end if
Dim sAction, oid, myconn
dim my_to, my_toaddress,my_system,my_from,my_fromaddress,my_subject,mailtype
dim mailer, my_attachment, emailformat
dim body
dim trackingemail, trackingname, trackingcomment, trackingtemplate
'
Openorderdb myconn
Oid=request("oid")
If not isnumeric(oid) then
Shoperror getlang("LangOrderNone") & "
"
end if
locateorder oid, customerid
sAction=Request("Action")
If sAction="" then
sAction=Request("Action.x")
end if
Serror=""
ShopPageHeader
if getconfig("xbreadcrumbs") = "Yes" then
response.write "
" & vbCrLf
end if
Response.Write "" & getlang("langtrackingcomment") & "
" & vbCrLf
If sAction = "" Then
DisplayForm()
Else
ValidateData()
if sError = "" Then
UpdateTrackingRecord
SendTrackingEmail
Writeinfo
else
DisplayForm
end if
end if
ShopCloseDatabase myconn
shoppagetrailer
'
Sub LocateOrder (oid, cid)
dim strsql, orders
strsql = "select * from orders where orderid=" & oid & " AND ocustomerid=" & cid
set Orders=myconn.execute(strsql)
If Orders.eof then
closerecordset orders
shopclosedatabase myconn
Shoperror getlang("LangOrderNone") & "
"
end if
stremail=orders("oemail")
closerecordset orders
end sub
'
Sub DisplayForm()
If getconfig("Xtrackingcustomerwrite")="Yes" then
If sError <> "" Then shopwriteerror sError
shopwriteheaderpic getlang("LangTrackingPrompt"), "images/icons/mail.gif"
Response.Write("")
end if
If getconfig("Xtrackingcustomerread")="Yes" then
shopFormattracking myconn, oid,""
end if
End Sub
Sub ValidateData()
oid = Request.Form("oid")
'VP-ASP 6.09 - Security Fix
if not isnumeric(oid) then
oid = 0
end if
'VP-ASP 6.50 - Precautionary Security Fix
trackingcomment = cleanchars(Request("trackingcomment"))
stremail=cleanchars(request("stremail"))
trackingname=cleanchars(request("trackingname"))
If trackingname="" then
sError = sError & getlang("LangYourName") & getlang("Langcustrequired") & "
"
end if
If stremail="" then
sError = sError & getlang("LangLoginEmail") & getlang("Langcustrequired") & "
"
end if
If trackingcomment="" then
sError = sError & getlang("Langtrackingcomment") & getlang("Langcustrequired") & "
"
end if
'VP-ASP 6.50 - validate email address
If Not InStr(strEmail, "@") > 1 Then
Serror=Serror & getlang("langInvalidEmail") & "
"
end if
end sub
'VP-ASP 6.50 - tidy up display
Sub WriteInfo%>
| <%=getlang("langyourname")%> |
<%=trackingname%>
|
| <%=getlang("langloginemail")%> |
<%=strEmail%>
|
| <%=getlang("langmenucomment")%> |
| <%=trackingcomment%> |
<%= getlang("langcommoncontinue")%>
<%
end sub
'
Sub SendTrackingEmail
ShopTrackingEmailToMerchant myconn, oid, trackingname, stremail
end sub
'
Sub UpdateTrackingRecord
dim sql, trackview
trackview=1
trackingname=replace(trackingname,"'","''")
trackingcomment=replace(trackingcomment,"'","''")
stremail=replace(stremail,"'","")
sql="insert into ordertracking (orderid, trackdate, tracktime,trackcomment, trackname,trackview, trackemail) values ("
sql= sql & oid & "," & datedelimit(date())
sql= sql & "," & timedelimit(time())
sql = sql & "," & "'" & trackingcomment & "'"
sql = sql & "," & "'" & trackingname & "'"
sql = sql & "," & trackview
sql = sql & "," & "'" & stremail & "'"
sql=sql & ")"
myconn.execute(sql)
end sub
%>