<%
'*****************************************************************
' call by shopthanks and numerous other places
' to format an order
' Version 4.50
' June 10, 2002
'*******************************************************************
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 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 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 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")
end sub
' Format details
Sub FormatDetails
if boooprocessed<>0 then
WriteInfo LangFormatProcessed
end if
if boolcustomercancel<>0 then
WriteInfo LangCancelCustomer
end if
Response.write FOrderNumber & "" & LangProductOrderNumber & lngOrderid & "" & " - " & shopdateformat(datODate,getconfig("xdateformat")) & " " & strotime & FOrderNumberEnd & "
"
Response.write FOrdertable
Response.write ForderRow
FormatHeader LangProductProduct
FormatHeader LangProductQuantity
If getconfig("xDisplayPrices")<>"No" then
FormatHeader LangProductUnitPrice
FormatHeader LangProductTotal
if getconfig("xdualprice")="Yes" then
FormatHeader LangDualPrice
FormatHeader 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", quantity
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 "
"
end sub
Sub AddField (percent, alignment, fieldvalue)
%>
<%=fieldvalue%> |
<%
end sub
Sub FormatCustomer
Dim Encryptkey
Response.write ForderTable
EncryptKey=GetEncryptKey
DoHeader LangFormatCustomerInformation
Dofield LangCustFirstName, stroFirstName
DoField LangCustLastName, stroLastName
DoField LangCustAddress ,stroAddress
DoField LangCustCity, stroCity
DoField LangCustState , stroState
DoField LangCustPostCode,stroPostCode
DoField LangCustCountry,strocountry
DoField LangCustEmail,stroemail
DoField LangCustPhone,strophone
DoField LangCustFax,strofax
DoField LangCustCompany,strocompany
DoField LangVatNumber,strovatnumber
FormatcustomerotherFields
If getconfig("XdisplayPrices")="Yes" then
DoHeader LangFormatPaymentInformation
DoField LangCheckoutPaymentType,strocardtype
DoField LangCoupon,strocoupon
Dofield LangGiftCertificate,strogiftcertificate
end if
If AdminFlag="Admin" then
DoField 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 LangCheckoutCardNumber,strocardno
DoField LangCheckoutExpiry,strocardexpires
DoField LangCheckoutAddress,strocardaddress
DoField LangCheckoutAuthorization,stroauthorization
DoField LangAff,stroaffid
end if
Doheader LangFormatShippingInformation
DoField LangShippingMethod,stroshipmethodtype
' DoField "Shipping Price", curoshipcost
DoField LangShipName,stroshipname
Dofield LangShipAddress,stroshipaddress
DoField LangShipCity,stroshiptown
DoField LangShipState,stroshipstate
Dofield LangShipPostcode,stroshipzip
Dofield LangShipCompany,stroshipcompany
DoField LangShipCountry,stroshipcountry
FormatShippingotherFields
%>
<%
If Orders("ocomment") <> "" then
Response.write "" & 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 & langcustphone & " " & rsus("phonenumber") & fordercompanyend & "
"
response.write fordercompany & langcustfax & " " & rsus("faxnumber") & fordercompanyend & "
"
response.write fordercompany & 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 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 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 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 LangProductShippingCost, shipcost, strodualshipping
Total=Total+shipcost
ForDualtotal=Fordualtotal+strodualshipping
end if
end if
end sub
Sub FormatProductTotal (isubtotal)
DisplayRow langProductCost, isubtotal, fordualsubtotal
end sub
Sub FormatTotal (total)
FormatTotalRow 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 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 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
%>