<%
'*****************************************************************
' call by shopthanks and numerous other places
' to format an order
' Version 5.00
' May 3, 2003
'*******************************************************************
dim totalprice
dim quantity
dim unitprice
dim itemname
Dim total
Dim isubtotal
Dim ForDualtotal
Dim ForDualsubtotal
dim Fordualproductprice
dim Newcardno
'
Dim Orders
Dim Items
Dim strSQL
Dim lngOrderid
Dim lngOcustomerid
Dim datOdate
Dim curOrderamount
Dim strOfirstname
Dim strOlastname
Dim strOemail
Dim strOaddress
Dim strOcity
Dim strOpostcode
Dim strOstate
Dim strOcountry
Dim strOphone
Dim strOfax
Dim strOcompany
Dim strOcardtype
Dim strOcardno
Dim strOcardname
Dim strOcardexpires
Dim strOcardaddress
Dim booOprocessed
Dim strOcomment
Dim curOtax
Dim datOpromisedshipdate
Dim datOshippeddate
Dim lngOshipmethod
Dim curOshipcost
Dim strOshipname
Dim strOshipcompany
Dim strOshipemail
Dim strOshipmethodtype
Dim strOshipaddress
Dim strOshiptown
Dim strOshipzip
Dim strOshipstate
Dim strOshipcountry
Dim lngOpaymethod
Dim strOther1
Dim strOther2
Dim StroDiscount
Dim stroauthorization
Dim stroaffid
Dim strodualtotal
Dim strodualshipping
Dim strodualtaxes
Dim strodualdiscount
dim strotime
Dim strohandling
dim strodualhandling
dim strocoupon, strocoupondiscount, strocoupondiscountdual
dim strogiftcertificate, strogiftdiscount, strogiftdiscountdual
dim DeliveryAddress, DeliveryArray
dim boolcustomercancel
dim strovatnumber
dim stropending
dim stroshipmessage
dim oid
dim rc
Dim AdminFlag
dim ydecimalpoint
'************************************************************
'Format Order
' Version 4.0
'***********************************************************
Sub ShopFormatOrder (conn,orderid, iAdminflag)
AdminFlag=iAdminflag
ydecimalpoint=getconfig("xdecimalpoint")
oid=orderid
OpenOrder conn, oid ' pen orders and items
FormatDetails
FormatCustomer
If AdminFlag<>"Admin" then
GetCompanyInfo conn
end if
closerecordset orders
closerecordset items
end sub
'
Sub OpenOrder (conn,oid)
dim sql
strsql = "select * from orders where orderid=" & oid
Set Orders = Server.CreateObject("ADODB.Recordset")
Orders.open strSQL, conn, adopenkeyset, adlockoptimistic
if (Orders.BOF and Orders.EOF) then
WriteInfo getlang("LangFormatNone")
rc=4
exit sub
else
GetOrderData
strSQL = "select * FROM oitems where orderid = " & Orders("orderid")
Set Items = conn.Execute(strSQL)
if Items.EOF then
writeInfo getlang("LangFormatMissing")
end if
end if
end sub
Sub GetOrderData
lngorderid = orders("orderid")
lngocustomerid = orders("ocustomerid")
datodate = orders("odate")
curorderamount = orders("orderamount")
strofirstname = orders("ofirstname")
strolastname = orders("olastname")
stroemail = orders("oemail")
stroaddress = orders("oaddress")
strocity = orders("ocity")
stropostcode = orders("opostcode")
strostate = orders("ostate")
strocountry = orders("ocountry")
strophone = orders("ophone")
strofax = orders("ofax")
strocompany = orders("ocompany")
strocardtype = orders("ocardtype")
strocardno = orders("ocardno")
strocardname = orders("ocardname")
strocardexpires = orders("ocardexpires")
strocardaddress = orders("ocardaddress")
boooprocessed = orders("oprocessed")
strocomment = orders("ocomment")
curotax = orders("otax")
datopromisedshipdate = orders("opromisedshipdate")
datoshippeddate = orders("oshippeddate")
lngoshipmethod = orders("oshipmethod")
curoshipcost = orders("oshipcost")
stroshipname = orders("oshipname")
stroshipcompany = orders("oshipcompany")
stroshipemail = orders("oshipemail")
stroshipmethodtype = orders("oshipmethodtype")
stroshipaddress = orders("oshipaddress")
stroshiptown = orders("oshiptown")
stroshipzip = orders("oshipzip")
stroshipstate = orders("oshipstate")
stroshipcountry = orders("oshipcountry")
lngopaymethod = orders("opaymethod")
strother1 = orders("other1")
strother2 = orders("other2")
strodiscount=orders("odiscount")
stroauthorization=orders("oauthorization")
stroaffid=orders("oaffid")
if stroaffid=0 then
stroaffid=""
end if
strotime=orders("otime")
strodualtotal=orders("odualtotal")
strodualshipping=orders("odualshipping")
strodualtaxes=orders("odualtaxes")
strodualdiscount=orders("odualdiscount")
strodualhandling=orders("odualhandling")
strohandling=orders("ohandling")
if isnull(strodualtotal) then
strodualtotal=0
strodualshipping=0
strodualtaxes=0
strodualdiscount=0
strodualhandling=0
end if
strocoupon=orders("coupon")
strocoupondiscount=orders("coupondiscount")
strocoupondiscountdual=orders("coupondiscountdual")
strogiftcertificate=orders("giftcertificate")
strogiftdiscount=orders("giftamountused")
strogiftdiscountdual=orders("giftamountuseddual")
boolcustomercancel=orders("customercancel")
if isnull(boolcustomercancel) then
boolcustomercancel=0
end if
strovatnumber=orders("vatnumber")
stropending=orders("opending")
stroshipmessage=orders("shipmessage")
strhearaboutus=orders("hearaboutus")
end sub
' Format details
Sub FormatDetails
if boooprocessed<>0 then
WriteInfo getlang("LangFormatProcessed")
end if
if boolcustomercancel<>0 then
WriteInfo getlang("LangCancelCustomer")
end if
Response.write FOrderNumber & "" & getlang("LangProductOrderNumber") & " " & lngOrderid & "" & " - " & shopdateformat(datODate,getconfig("xdateformat")) & " " & strotime & FOrderNumberEnd & "
"
Response.write FOrdertable
Response.write ForderRow
FormatHeader getlang("LangProductProduct")
FormatHeader getlang("LangProductQuantity")
If getconfig("xDisplayPrices")<>"No" then
FormatHeader getlang("LangProductUnitPrice")
FormatHeader getlang("LangProductTotal")
if getconfig("xdualprice")="Yes" then
FormatHeader getlang("LangDualPrice")
FormatHeader getlang("LangDualTotal")
end if
end if
response.write ""
FormatItemDetails
end sub
'
Sub FormatHeader (title)
Response.write CartTitleColumn & Title & CartTitleColumnEnd
End sub
Sub FormatItemDetails
dim fordualprice
dim fordualproducttotal
Do While Not Items.EOF
itemname= items("itemname")
deliveryaddress=items("address")
quantity=items("numitems")
unitprice=items("unitprice")
totalprice=quantity*unitprice
fordualprice=items("dualprice")
if isnull(fordualprice) then
fordualprice=0
end if
If getconfig("XdeliveryAddress")="Yes" then
If not isnull(Deliveryaddress) and Deliveryaddress<>"" then
ConvertDeliveryToArray DeliveryArray, Deliveryaddress
GetDeliveryName Itemname, DeliveryArray
end if
end if
fordualproducttotal=quantity*fordualprice
response.write CartRow
AddField "50%","left", CartFontDesc & itemname & CartFontEnd
AddField "10%","center", CartFontQuantity & quantity & cartfontend
If getconfig("XDisplayPrices")<>"No" then
AddField "10%","right", CartFontUnitPrice & shopformatcurrency(UnitPrice,ydecimalpoint) & CartFontEnd
AddField "10%","right", CartFontPriceTotal & shopformatcurrency(totalprice,ydecimalpoint)& CartFontEnd
if getconfig("xDualPrice")="Yes" then
AddField "10%","right",CartFontDualPrice & FormatNumber(fordualprice,ydecimalpoint)& CartFontEnd
AddField "10%","right", cartFontDualTotal & FormatNumber(fordualproducttotal,ydecimalpoint)& cartfontEnd
fordualsubtotal=fordualsubtotal + fordualproducttotal
end if
end if
response.write ""
isubtotal=isubtotal+totalprice
Items.MoveNext
Loop
AddOtherItems isubtotal, fordualsubtotal
Response.write "
"
AddShippingMessage
end sub
Sub AddField (percent, alignment, fieldvalue)
%>
<%=fieldvalue%> |
<%
end sub
Sub FormatCustomer
Dim Encryptkey
Response.write ForderTable
EncryptKey=GetEncryptKey
DoHeader getlang("LangFormatCustomerInformation")
Dofield getlang("LangCustFirstName"), stroFirstName
DoField getlang("LangCustLastName"), stroLastName
DoField getlang("LangCustAddress") ,stroAddress
DoField getlang("LangCustCity"), stroCity
DoField getlang("LangCustState"), stroState
DoField getlang("LangCustPostCode"),stroPostCode
DoField getlang("LangCustCountry"),strocountry
DoField getlang("LangCustEmail"),stroemail
DoField getlang("LangCustPhone"),strophone
DoField getlang("LangCustFax"),strofax
DoField getlang("LangCustCompany"),strocompany
DoField getlang("Langhearaboutus"),strhearaboutus
DoField getlang("LangVatNumber"),strovatnumber
FormatcustomerotherFields
If getconfig("XdisplayPrices")="Yes" then
DoHeader getlang("LangFormatPaymentInformation")
DoField getlang("LangCheckoutPaymentType"),strocardtype
DoField getlang("LangCoupon"),strocoupon
Dofield getlang("LangGiftCertificate"),strogiftcertificate
end if
If AdminFlag="Admin" then
DoField getlang("LangCheckoutCardName"),strocardname
If getconfig("XencryptCreditCard")="Yes" and EncryptKey<>"" and strocardno<>"" then
if not Isnumeric(strocardno) then
Newcardno=EnDecrypt(strocardno,encryptkey)
strocardno=Newcardno
end if
end if
Dofield getlang("LangCheckoutCardNumber"),strocardno
DoField getlang("LangCheckoutExpiry"),strocardexpires
DoField getlang("LangCheckoutAddress"),strocardaddress
DoField getlang("LangCheckoutAuthorization"),stroauthorization
DoField getlang("LangAff"),stroaffid
DoField getlang("LangstatusStatus"),stropending
end if
Doheader getlang("LangFormatShippingInformation")
DoField getlang("LangShippingMethod"),stroshipmethodtype
' DoField "Shipping Price", curoshipcost
DoField getlang("LangShipName"),stroshipname
Dofield getlang("LangShipAddress"),stroshipaddress
DoField getlang("LangShipCity"),stroshiptown
DoField getlang("LangShipState"),stroshipstate
Dofield getlang("LangShipPostcode"),stroshipzip
Dofield getlang("LangShipCompany"),stroshipcompany
DoField getlang("LangShipCountry"),stroshipcountry
FormatShippingotherFields
%>
<%
If Orders("ocomment") <> "" then
Response.write "" & getlang("LangOrderComments") & "
"
response.write FOrderComment & Orders("ocomment") & "
" & Fordercommentend
end if
End Sub
Sub WriteInfo (msg)
Response.write FOrderInfo & msg & ForderInfoEnd
end sub
'
Sub DoHeader (mytext)
Response.write FOrderRow
Response.write FOrderHeaderColumn & mytext & ForderHeaderColumnEnd
Response.write ForderRowEnd
end sub
Sub DoField (fieldname,fieldvalue)
if fieldvalue="" or isNull(fieldvalue) then
exit sub
end if
Response.write ForderFieldRow
Response.write ForderFieldLeft & fieldname & FOrderFieldLeftEnd
Response.write FOrderFieldRight & fieldvalue & Forderfieldrightend
end sub
'*********************
Sub GetCompanyInfo (conn)
Dim rsus
Set rsus = Server.CreateObject ("ADODB.Recordset")
rsus.Open "mycompany", conn, adOpenForwardOnly,adLockReadOnly, adCmdTable
if rsus.eof then
Closerecordset rsus
exit sub
end if
response.write "
"
response.write fordercompany & rsus("companyname") & fordercompanyend & "
"
response.write fordercompany & rsus("address") & fordercompanyend & "
"
response.write fordercompany & rsus("city") & " " & rsus("state") & " " & rsus("postalcode") & fordercompanyend & "
"
response.write fordercompany & rsus("country") & "
"
response.write fordercompany & getlang("langcustphone") & " " & rsus("phonenumber") & fordercompanyend & "
"
response.write fordercompany & getlang("langcustfax") & " " & rsus("faxnumber") & fordercompanyend & "
"
response.write fordercompany & getlang("langcustemail") & " " & rsus("myemail") & fordercompanyend & "
"
Closerecordset rsus
End Sub
'
Sub AddOtherItems (isubtotal, dualsubtotal)
If getconfig("xDisplayPrices")="No" then exit sub
Dim total
total=isubtotal
ForDualtotal=dualsubtotal
FormatProductTotal total
FormatShipping total
FormatHandling total
FormatTax total
FormatDiscount total
FormatCouponDiscount total
FormatGiftCertificate total
FormatTotal total
end sub
Sub FormatTax (total)
Dim Taxes
Taxes=curotax
If IsNull(taxes) then exit sub
if Taxes<>"" then
If Taxes<>0 then
DisplayRow getlang("LangProductTax"), taxes, strodualtaxes
If getconfig("xtaxincludedinprice")="Yes" then
else
Total=Total+taxes
fordualtotal=ForDualTotal+strodualtaxes
end if
end if
end if
end sub
Sub FormatHandling (total)
Dim Handling
Handling=strohandling
If IsNull(handling) then exit sub
if handling<>"" then
If handling<>0 then
DisplayRow getlang("LangProductHandling"), handling, strodualhandling
Total=Total+handling
fordualtotal=ForDualTotal+strodualhandling
end if
end if
end sub
Sub FormatDiscount (total)
' cart discount is coming from database
dim discount
Discount=strodiscount
If isnull(discount) then exit sub
if discount<>"" then
If stroDiscount<>0 then
DisplayRow getlang("LangProductDiscount"), -Discount, -strodualdiscount
Total=Total-discount
fordualtotal=ForDualTotal-strodualdiscount
end if
end if
end sub
'
Sub DisplayRow (msg, amount, dualamount)
response.write " | "
response.write CartSubTotalRowLeft & msg & carttotalrowleftend
response.write CartSubTotalRowRight & shopformatcurrency(amount,ydecimalpoint)& carttotalrowRightend
If getconfig("xdualprice")="Yes" then
response.write " | "
response.write CartSubTotalRowRight & FormatNumber(dualamount,2) &cartTotalrowrightend
end if
response.write "
"
end Sub
Sub FormatShipping (total)
dim shipcost
shipcost=curoshipcost
if isnull(shipcost) then exit sub
if shipcost<>"" then
If shipcost> 0 then
DisplayRow getlang("LangProductShippingCost"), shipcost, strodualshipping
Total=Total+shipcost
ForDualtotal=Fordualtotal+strodualshipping
end if
end if
end sub
Sub FormatProductTotal (isubtotal)
DisplayRow getlang("langProductCost"), isubtotal, fordualsubtotal
end sub
Sub FormatTotal (total)
FormatTotalRow getlang("langProductTotal"), total, fordualtotal
End Sub
'
Sub FormatTotalRow (title, total, dualtotal)
Response.write " | "
Response.write CartTotalRowLeft & title & CartTotalRowLeftEnd
Response.write CartTotalRowRight & shopformatcurrency(total,ydecimalpoint) & carttotalrowrightend
If getconfig("xdualprice")="Yes" then
response.write " | "
response.write CartTotalRowRight & FormatNumber(dualtotal,2) & Carttotalrowrightend
end if
response.write "
"
end sub
Sub FormatCouponDiscount (total)
' cart discount is coming from database
dim discount
Discount=strocoupondiscount
If isnull(discount) then exit sub
if discount<>"" then
If discount<>0 then
DisplayRow getlang("LangCouponDiscount"), -Discount, -strocoupondiscountdual
Total=Total-discount
ForDualtotal=Fordualtotal-strocoupondiscountdual
end if
end if
end sub
Sub FormatGiftCertificate (total)
' cart discount is coming from database
Dim Discount, discountdual
discount=strogiftdiscount
if isnull(discount) then exit sub
if Discount <>"" then
If Discount<>0 then
DisplayRow getlang("LangGiftCertificate"), -Discount, -strogiftdiscountdual
Total=Total-discount
ForDualtotal=Fordualtotal-strogiftdiscountdual
end if
end if
end sub
Sub FormatCustomerOtherFields
dim fieldvalue
If getconfig("Xcustomerotherfieldsinorder")<>"Yes" then exit sub
if Getconfig("xCustomerOtherFields")="" then exit sub
dim words,wordcount, captions, capcount,customervalues,i
redim words(Getconfig("xCustomerMaxotherfields"))
redim captions(getconfig("xCustomerMaxotherfields"))
Parserecord Getconfig("xcustomerOtherFields"), words, wordcount,","
Parserecord getconfig("xcustomerOtherCaptions"), captions, capcount,","
for i = 0 to wordcount-1
fieldvalue=orders(words(i))
dofield captions(i),fieldvalue
next
end sub
Sub FormatShippingOtherFields
dim fieldvalue
if Getconfig("xshippingOtherFields")="" then exit sub
dim words,wordcount, captions, capcount,shippingvalues,i
redim words(Getconfig("xCustomerMaxotherfields"))
redim captions(getconfig("xCustomerMaxotherfields"))
Parserecord Getconfig("xshippingOtherFields"), words, wordcount,","
Parserecord getconfig("xshippingOtherCaptions"), captions, capcount,","
for i = 0 to wordcount-1
if getconfig("xdebug")="Yes" then
debugwrite "Shipping field=" & words(i)
end if
fieldvalue=orders(words(i))
dofield captions(i),fieldvalue
next
end sub
Sub AddShippingMessage
if isnull(stroshipmessage) then exit sub
Response.write ""
response.write FOrderComment & stroshipmessage & "
" & Fordercommentend
response.write "
"
end sub
%>