<%Option explicit%>
<%
Const RestoreRedirectUrl="shopaddtocart.asp"
const RestoreCategory="No"
'Const RestoreRedirectUrl=""
' if set to "" then only message is produced
Dim customerid
'
'*********************************************************
' Version 6.50 Nov 12, 2005
' called by Administrator to restore order
'
'************************************************************
Dim RestOrders, dbc
Dim View, restore, Restoid
Dim restdbc, proddbc
shopcheckadmin ""
Restore=Request("Restore")
Restore="Yes"
View=Request("View")
RestOid=request("oid")
'VP-ASP 6.09 - precautionary security fix
if restoid > "" then
if not isnumeric(RestOid) then
shoperror "Order ID must be numeric"
end if
end if
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
else
setsess "adminrestore","Yes"
end if
ShopPageTrailer
Shopclosedatabase dbc
'
Sub LocateOrder (oid, cid)
dim sql
strsql = "select * from orders where orderid=" & oid
set Orders=dbc.execute(strsql)
If Orders.eof then
Serror= getlang("LangOrderNone") & "
"
end if
CloseRecordset Orders
end sub
Sub DisplayErrors
Response.write errorinfostart & Serror & errorinfoend
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
Restorders.close
Set Restorders=nothing
If RestoreCategory="Yes" then
shopclosedatabase proddbc
end if
setsess "adminrestore","Yes"
setsess "adminorderid",oid
If RestoreRedirecturl<>"" then
Responseredirect RestoreRedirectUrl
end if
Serror= getlang("LangCartRestored") & " " & oid
end sub
Sub RestoreItems (oid)
Dim scartitem, arrcart, nameincart, quantity
dim catalogid, dualprice, strsql, category
Dim ProductAddress, DeliveryArray
dim rsupplierid, rfeatures
dim pos
strSQL = "select * FROM oitems where orderid = " & oid
Set Items = dbc.Execute(strSQL)
if Items.EOF then
items.close
set items=nothing
Serror= getlang("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, getlang("LangGiftCertificate"))
if pos>0 then
SError= getlang("LangGiftFail")
items.close
set items=nothing
exit sub
end if
quantity=items("numitems")
unitprice=items("unitprice")
catalogid=items("catalogid")
dualprice=items("dualprice")
rsupplierid=items("supplierid")
rfeatures=items("features")
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) = ""
arrcart(cProductfeatures,scartItem) = rfeatures
arrCart(csupplierid,scartItem) = rsupplierid
' debugwrite "category=" & category
Loop
SetSess "CartCount",scartitem
SetSessA "CartArray",arrCart
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
%>
<%= getlang("langrestoreorder")%>
<%
end sub
%>