<%Option explicit%>
<%
Const RestoreRedirectUrl="shopaddtocart.asp"
const RestoreCategory="No"
'Const RestoreRedirectUrl=""
' if set to "" then only message is produced
Dim customerid
CustCheckAdmin Customerid
'*********************************************************
' Version 4.00 Sept 8, 2001
' called by shopstatus to view or restore an order
' If status has not verified the customer details, displays
' are suppressed
' We are only restoring info from oitems table so category is not
' restored.
'************************************************************
Dim RestOrders, dbc
Dim View, restore, Restoid
Dim restdbc, proddbc
Restore=Request("Restore")
View=Request("View")
RestOid=request("oid")
OpenOrderdb dbc
LocateOrder restoid, customerid
If Serror="" then
If Restore<>"" then
PerformRestoreOrder restoid
shoppageheader
else
FormatRestore
ShopFormatOrder dbc,restoid, ""
end if
else
ShopPageHeader
end if
If Serror<>"" then
DisplayErrors
end if
ShopPageTrailer
Shopclosedatabase dbc
'
Sub LocateOrder (oid, cid)
dim sql
strsql = "select * from orders where orderid=" & oid & " AND ocustomerid=" & cid
set Orders=dbc.execute(strsql)
If Orders.eof then
Serror=LangOrderNone & "
"
end if
CloseRecordset Orders
end sub
Sub DisplayErrors
Response.write getconfig("xfont") & Serror & ""
end sub
Sub PerformRestoreOrder (oid)
If Restorecategory="Yes" then
shopopendatabase proddbc
end if
strsql = "select * from orders where orderid=" & oid
set RestOrders=dbc.execute(strsql)
RestoreItems oid
If Serror<>"" then
restorders.close
set restorders=nothing
exit sub
end if
GetCustomerSessionData
RestoreShipping RestOrders
UpdateCustomerSessionData
Restorders.close
Set Restorders=nothing
If RestoreCategory="Yes" then
shopclosedatabase proddbc
end if
If RestoreRedirecturl<>"" then
Response.redirect RestoreRedirectUrl
end if
Serror=LangCartRestored & " " & oid
end sub
Sub RestoreItems (oid)
Dim scartitem, arrcart, nameincart, quantity
dim catalogid, dualprice, strsql, category
Dim ProductAddress, DeliveryArray
dim pos
strSQL = "select * FROM oitems where orderid = " & oid
Set Items = dbc.Execute(strSQL)
if Items.EOF then
items.close
set items=nothing
Serror=LangFormatMissing
exit sub
end if
arrCart = GetSessA("CartArray")
scartItem = GetSess("CartCount")
Do While Not Items.EOF
nameincart= items("itemname")
productaddress=items("address")
pos=instr(nameincart,LangGiftCertificate)
if pos>0 then
SError=LangGiftFail
items.close
set items=nothing
exit sub
end if
quantity=items("numitems")
unitprice=items("unitprice")
catalogid=items("catalogid")
dualprice=items("dualprice")
category=0
If restorecategory="Yes" then
GetRestoreCategory catalogid, category
end if
scartitem=scartitem+1
arrCart(cProductid,scartItem) = catalogID
arrCart(cProductCode,scartItem) = ""
arrCart(cProductname,scartItem) = NameInCart
arrCart(cQuantity,scartItem) = Clng(quantity)
arrCart(cOriginalPrice,scartItem) = UnitPrice
arrCart(cUnitPrice,scartItem) = UnitPrice
if getconfig("XdualPrice")="Yes" then
arrCart(cDualPrice,scartItem) = Dualprice
else
arrCart(cDualPrice,scartItem) = 0
end if
If getconfig("XDeliveryAddress")="Yes" and Not isnull(ProductAddress) then
ConvertDeliveryToArray Deliveryarray, Productaddress
arrCart(cDelivery,scartItem) = DeliveryArray
end if
items.movenext
arrCart(cCategory,scartItem) = category
arrCart(cDiscount,scartItem) = ""
' debugwrite "category=" & category
Loop
SetSessA "CartArray",arrCart
SetSess "CartCount",scartitem
items.close
set items=nothing
end sub
Sub GetRestoreCategory (catalogid, category)
dim catsql, catrs
catsql="select ccategory from products where catalogid=" & catalogid
Set catrs=proddbc.execute(catsql)
if not catrs.eof then
category=catrs("ccategory")
end if
catrs.close
set catrs=nothing
end sub
'
'
Sub RestoreShipping (RS)
strshipname=rs("oshipname")
strshipaddress=rs("oshipaddress")
strshiptown=rs("oshiptown")
strshipzip=rs("oshipzip")
strshipstate=rs("oshipstate")
strshipcountry=rs("oshipcountry")
strshipcompany=rs("oshipcompany")
strshipmethodtype=rs("oshipmethodtype")
strshipcost=rs("oshipcost")
end sub
'
Sub FormatRestore
ShopPageHeader
if getconfig("xallowRestoreOrder")<>"Yes" then exit sub
%>
<%=langrestoreorder%>
<%
end sub
%>