%
'******************************************************
' VP-ASP 6.50 Order Tracking Subroutines
' shopformattracking
' shoptrackingemailCustomer
' shoptrackingemailMerchant
' March 22, 2003
' Oct 2, 2004 fix line 57 check for email address
'*****************************************************
Sub ShopFormattracking (dbc,orderid, iAdminflag)
dim tsql, fields(10),fieldcount, tRs
tsql="select * from ordertracking where orderid=" & orderid
If iadminflag="" then
tsql=tsql & " and trackview<>0"
end if
tsql=tsql & " order by trackid desc"
set trs=dbc.execute(tsql)
If trs.eof then
closerecordset trs
exit sub
end if
DisplaytrackingHeader fields,fieldcount
Do While Not tRS.EOF
DisplayTrackingRow tRS, fields, fieldcount, iadminflag
tRS.MoveNext
Loop
Response.write reporttableend
closerecordset trs
end sub
'
Sub DisplaytrackingRow (trs, fields, fieldcount,adminflag)
dim fieldvalue, fieldcomment, i, name, emailaddr
dim editresponder, my_link
editresponder="shopa_editrecord.asp"
fieldcomment=trs("trackcomment")
response.write "
"
for i = 0 to fieldcount
'debugwrite trs("trackdate")
Select Case ucase(fields(i))
Case "TRACKID"
fieldvalue=trs(fields(i))
If adminflag<>"" Then
my_link=editresponder & "?which=" & fieldvalue & "&idfield=trackid&table=ordertracking"
fieldvalue="" & fieldvalue & ""
end if
Case "TRACKCOMMENT"
fieldvalue=fieldcomment
Case "TRACKTIME"
fieldvalue=trs(fields(i))
fieldvalue=formatdatetime(fieldvalue,vbshorttime)
Case "TRACKNAME"
If adminflag="" then
fieldvalue=trs(fields(i))
else
name=trs("trackname")
emailaddr=trs("trackemail")
if not isnull(trs("trackemail")) then
fieldvalue="" & name & ""
else
fieldvalue=name
end if
end if
Case else
fieldvalue=trs(fields(i))
end select
response.write ReportDetailColumn & fieldvalue & ReportDetailcolumnEnd
next
response.write "
"
end sub
'
Sub DisplaytrackingHeader (fields, fieldcount)
dim captions(10)
dim i
Fields(0)="trackid"
Fields(1)="trackdate"
Fields(2)="tracktime"
Fields(3)="trackname"
Fields(4)="trackcomment"
Captions(0)="trackid"
Captions(1)= getlang("LangDisplayDate")
captions(2)= getlang("LangDisplaytime")
Captions(3)= getlang("LangCommonName")
Captions(4)= getlang("LangTrackingcomment")
fieldcount=4
shopwriteheader getlang("LangTrackingcomment")
response.write ReportTableDef
response.write ReportHeadRow
for i = 0 to fieldcount
Response.write ReportHeadColumn & Captions(i) & ReportHeadColumnEnd
next
response.write ReportRowEnd
end sub
' mail to customer
Sub ShopTrackingEmailToCustomer (dbc, oid, name)
dim template, rs, sql, trackid, bodymessage, emailformat
dim strname, stremail, CR
dim acount, attachments
acount=0
CR=getmailCR
template=getconfig("xtrackingmessagetemplate")
'template="tmp_trackingmessage.txt"
sql="select * from ordertracking where orderid=" & oid & " and trackname='" & name & "'"
sql=sql & " order by trackid desc "
set rs=dbc.execute(sql)
if rs.eof then
closerecordset rs
exit sub
end if
FormatOtherMail Template, RS, BodyMessage
Closerecordset rs
'
template=getconfig("XtrackingMerchanttemplate")
sql="select * from orders where orderid=" & oid
set rs=dbc.execute(sql)
if not rs.eof then
strname=rs("ofirstname") & " " & rs("olastname")
stremail=rs("oemail")
SetupEmailformat template,emailformat
FormatOtherMail Template, RS, Body
Closerecordset rs
body=bodymessage & "
" & Body
if emailformat<>"HTML" then
body=replace(body,"
", CR)
end if
mailtype=getconfig("xemailtype")
my_from=getconfig("xemailname")
my_fromaddress=getconfig("xemail")
my_toaddress=strEmail
my_to=strname
my_system=getconfig("xemailsystem")
my_subject= getlang("LangTrackingcomment") & " " & getlang("langproductorderNumber") & " " & oid
'
ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,emailformat,attachments, acount
ShopWriteheader getlang("LangMailMailing") & my_to & " " & my_toaddress
else
ShopWriteheader "ERROR: No order exists with that ID"
end if
end sub
Sub ShopTrackingEmailToMerchant (dbc, oid, name, email)
dim template, rs, sql, trackid, bodymessage
dim strname, stremail, CR
dim acount, attachments
acount=0
CR=getmailCR
'template="tmp_trackingmessage.txt"
template=getconfig("xtrackingmessagetemplate")
sql="select * from ordertracking where orderid=" & oid & " and trackname='" & name & "'"
sql=sql & " order by trackid desc "
set rs=dbc.execute(sql)
if rs.eof then
closerecordset rs
exit sub
end if
FormatOtherMail Template, RS, BodyMessage
Closerecordset rs
'
template=getconfig("XtrackingCustomertemplate")
sql="select * from orders where orderid=" & oid
set rs=dbc.execute(sql)
strname=name
stremail=email
SetupEmailformat template,emailformat
FormatOtherMail Template, RS, Body
Closerecordset rs
body=bodymessage & "
" & Body
if emailformat<>"HTML" then
body=replace(body,"
", CR)
end if
mailtype=getconfig("xemailtype")
my_to=getconfig("xemailname")
my_toaddress=getconfig("xemail")
my_fromaddress=strEmail
my_from=strname
my_system=getconfig("xemailsystem")
my_subject= getlang("LangTrackingcomment") & " " & getlang("langproductorderNumber") & " " & oid
'
ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,emailformat,attachments, acount
shopwriteheader getlang("LangMailMailing") & my_to & " " & my_toaddress
end sub
%>