<%
' Copyright (C) 1998-2005 CyberStrong Internet Services, Inc. All Rights Reserved
'
' This file has been seeded with unique information at point of sale and
' is traceable to its purchaser.
'
' Your license agreement forbids the removal of this notice.
'
' Expand.asp - Display product with option selections
'
Dim rsProduct, rsItem, rsOption, rsOptionType
Dim SQL, iCount, FormErrMsg, x, s
Dim OptionsAdd, PriceAdd, ShippingUnitsAdd, OptionalDownloadFileName
Dim OptionNameList : ReDim OptionNameList(0)
Dim ReturnValue
' ExpandGetProductName() - Used to fill in the title bar on 10Expand.asp
Public Function ExpandGetProductName()
Dim tmpConn, SQL, rs
On Error Resume Next
ExpandGetProductName = ""
If (Not strIsEmpty(GetURLValue("ProductCode"))) Then
' No database connection available at this point, create a temporary one ...
tmpConn = dbOpen("r")
SQL = "SELECT * FROM Products WHERE {fn UCASE(ProductCode)} = '" & CleanSQL(UCase(GetURLValue("ProductCode")), "a") & "'"
set rs = Server.CreateObject("ADODB.Recordset")
rs.Open SQL, tmpConn, adOpenKeyset, adLockOptimistic
ExpandGetProductName = rs("ProductName")
rs.Close : Set rs = Nothing
dbClose(tmpConn)
End If
End Function
' Option support ---------------------------------------------------------
' FormatCostAdjust() - Format cost adjustment for pull down menu
Public Function FormatCostAdjust(argCostAdjust)
Select Case True
Case argCostAdjust = 0
FormatCostAdjust = ""
Case argCostAdjust > 0
FormatCostAdjust = " (Add " & OurFormatCurrency(argCostAdjust) & ")"
Case argCostAdjust < 0
FormatCostAdjust = " (Subtract " & (OurFormatCurrency(argCostAdjust * -1)) & ")"
End Select
End Function
' DisplayOption() - Display a single option for customer selection
Public Sub DisplayOption(ByVal argProductCode, ByVal argOptionType, ByVal argSeq)
Dim rsOptions, rsOptionTypes, OptionText, SQL, ControlName, Selected
SQL = "SELECT * FROM Options " & _
"WHERE ProductCode = '" & CleanSQL(argProductCode, "a") & "' AND TypeID = " & CleanSQL(argOptionType, "i") & " " & _
"ORDER BY SortCode, Description"
Set rsOptions = Server.CreateObject("ADODB.Recordset")
rsOptions.Open SQL, Conn, adOpenKeyset, adLockOptimistic
SQL = "SELECT * FROM OptionTypes WHERE ID = " & CleanSQL(argOptionType, "i")
Set rsOptionTypes = Server.CreateObject("ADODB.Recordset")
rsOptionTypes.Open SQL, Conn, adOpenKeyset, adLockOptimistic
' Display option box title ...
wl("
" & rsOptionTypes("Description") & " ")
Select Case (LCase(rsOptionTypes("WriteIn")) = "yes")
Case True
' Write-in option ...
wl("")
wl("")
Case False
' Pull down option ...
ControlName = "Fld" & argSeq & "-Select-" & argProductCode
wl("")
If (Not cstOptionsUseRadio) Then
wl(" ")
End If
End Select ' (LCase(rsOptionTypes("WriteIn")) = "yes")
wl("
")
rsOptions.Close
set rsOptions = Nothing
rsOptionTypes.Close
set rsOptionTypes = Nothing
End Sub
' DisplayOptions() - Display one or more option selection boxes for this product
Public Sub DisplayOptions(argProductCode)
Dim rsOptions, SQL, Seq
SQL = "SELECT DISTINCT Options.TypeID, OptionTypes.Active, OptionTypes.SortCode FROM Options " & _
"INNER JOIN OptionTypes ON Options.TypeID = OptionTypes.ID " & _
"WHERE ({fn LCASE(OptionTypes.Active)} <> 'no') AND " & _
" ({fn UCASE(Options.ProductCode)} = '" & CleanSQL(Ucase(argProductCode), "a") & "') " & _
"ORDER BY OptionTypes.SortCode"
set rsOptions = Server.CreateObject("ADODB.Recordset")
rsOptions.Open SQL, Conn, adOpenKeyset, adLockOptimistic
If (Not rsOptions.EOF) Then
wl("
")
Seq = 0
Do While Not rsOptions.EOF
Call DisplayOption(argProductCode, rsOptions("TypeID"), ZeroFill(Seq, 3))
Seq = Seq + 1
rsOptions.MoveNext
Loop
wl("
")
End If
rsOptions.Close
set rsOptions = Nothing
' Pass ProductCode through form for processing ...
wl("")
End Sub
' End of option support -------------------------------------------------------
' Main: -----------------------------------------------------------------------------------------
' Lock cart out for maintenance ...
If (isLocked() Or (Not isDataBaseCurrent())) Then
Call DisplayMaintPage()
Response.End
End If
' Recover session variables ...
If (Session(sesItemCount) <> "") Then
iCount = Session(sesItemCount)
aryCart = Session(sesShoppingCart)
End If
' Remember ReturnTo URL ...
If (GetURLValue("ReturnTo") <> "") Then
OurSession("ReturnTo") = GetURLValue("ReturnTo")
End If
' Create shopping cart if necessary ...
Call crtCreate()
' Open a connection to the database ...
Set Conn = dbOpen("rwl")
SQL = "SELECT * FROM Products WHERE {fn UCASE(ProductCode)} = '" & CleanSQL(Ucase(GetURLValue("ProductCode")), "a") & "'"
set rsProduct = Server.CreateObject("ADODB.Recordset")
rsProduct.Open SQL, Conn, adOpenKeyset, adLockOptimistic
' Process button presses ...
Select Case LCase(GetFormAction())
Case ""
If (rsProduct.RecordCount = 0) Then
FormErrMsg = FormErrMsg + _
"The item you have selected is presently unavailable. "
End If
Case "continue"
s = OurSession("ReturnTo")
OurSession("ReturnTo") = ""
If ((s <> "") AND (LCase(Left(s, 10)) <> "msetup.asp")) Then
dbClose(Conn)
Response.Redirect(s)
Else
OurSession("txtCategory") = Request.Form("txtCategory")
OurSession("txtSearchString") = Trim(Request.Form("txtSearchString"))
dbClose(Conn)
Response.Redirect(cstBrowseStartPageURL)
End If
Case "confirmselection"
' Make sure that all available options have been selected ...
For Each x in Request.Form
Select Case True
Case strContains(x, "-FieldPresent")
If (CInt(Request.Form(Replace(x, "FieldPresent", "Select"))) = 0) Then
FormErrMsg = "Please select from the options below."
End If
End Select
Next
If (FormErrMsg = "") Then
' Add product to shopping cart ...
SQL = "SELECT * FROM Products WHERE {fn UCASE(ProductCode)} = '" & CleanSQL(Ucase(GetFormFieldValue("ProductCode")), "a") & "'"
set rsItem = Server.CreateObject("ADODB.Recordset")
rsItem.Open SQL, Conn, adOpenKeyset, adLockOptimistic
If Not IsEmpty(rsItem) Then
' Cycle through form fields, pick up options, apply to order
OptionsAdd = ""
ShippingUnitsAdd = 0
PriceAdd = 0
OptionalDownloadFileName = ""
' Collect selected options from form and sort ...
For Each x In Request.Form
If (Left(x, 3) = "Fld") Then
Call AddArray(OptionNameList, x)
End If
Next
Call SortArray(OptionNameList, "Asc")
' Add options to cart ...
For Each x in OptionNameList
Select Case True
Case strContains(UCase(x), "SELECT-")
SQL = "SELECT * FROM Options WHERE ID = " & CleanSQL(Request.Form(x), "i")
set rsOption = Server.CreateObject("ADODB.Recordset")
rsOption.Open SQL, Conn, adOpenKeyset, adLockOptimistic
wl(SQL&" ")
SQL = "SELECT * FROM OptionTypes WHERE ID = " & CleanSQL(rsOption("TypeID"), "i")
set rsOptionType = Server.CreateObject("ADODB.Recordset")
rsOptionType.Open SQL, Conn, adOpenKeyset, adLockOptimistic
wl(SQL&" ")
OptionsAdd = OptionsAdd & _
"[" & rsOptionType("Description") & ":" & rsOption("Description") & "]"
wl(OptionsAdd&" ")
PriceAdd = PriceAdd + rsOption("CostAdjust")
If (cstShippingUnitsEnabled AND (Not IsNull(rsOption("ShippingUnits")))) Then
ShippingUnitsAdd = ShippingUnitsAdd + rsOption("ShippingUnits")
End If
' Only one option may contain a downloadable, in case of conflict,
' use the last one encountered ...
If (Trim(rsOption("DownloadFileName")) <> "") Then
OptionalDownloadFileName = rsOption("DownloadFileName")
End If
rsOption.Close
set rsOption = Nothing
rsOptionType.Close
set rsOptionType = Nothing
Case strContains(UCase(x), "WRITEIN-VALUE")
OptionsAdd = OptionsAdd & _
"[" & Request.Form(Replace(UCase(x), "VALUE", "DESCRIPTION")) & ":" & stripHTML(Request.Form(x)) & "]"
wl(OptionsAdd&"")
End Select
Next
'************coded inserted sep 6,2005**********start
dim lartmpopt
lartmpopt=""
For Each x In Request.Form
If (Left(x, 3) = "Fld") Then
if lartmpopt="" then
lartmpopt=Request.Form(x)
else
lartmpopt=lartmpopt &","& Request.Form(x)
end if
End If
Next
Session.Contents("larWidth")=""
Session.Contents("larHeight")=""
Session.Contents("larCustom")=""
if lartmpopt<>"" then
SQL = "SELECT Options.ID, Products.ProductCode, Products.HeightInches, Options.Width,Options.Description FROM Products INNER JOIN Options ON Products.ProductCode = Options.ProductCode WHERE ID IN ("& lartmpopt &")"
lartmpopt=""
set rsOption = Server.CreateObject("ADODB.Recordset")
rsOption.Open SQL, Conn, adOpenKeyset, adLockOptimistic
do while not rsOption.EOF
if Right(rsOption.Fields("Description"),1)="""" then
' Session.Contents("larWidth")=Left(rsOption.Fields("Description"),Len(rsOption.Fields("Description"))-1)
Session.Contents("larWidth")=rsOption.Fields("Width")
elseif rsOption.Fields("Description")="Yes" then
lartmpopt=rsOption.Fields("Description")
Session.Contents("larHeight")=rsOption.Fields("HeightInches")
Session.Contents("larCustom")="Yes"
end if
rsOption.moveNext
loop
' Response.Write SQL
' Response.Write Session.Contents("larHeight")
' Response.Write Session.Contents("larWidth")
' Response.End()
end if
'************coded inserted sep 6,2005**********end
aryCartData(cartProductID) = rsItem("ProductID")
aryCartData(cartProductCode) = rsItem("ProductCode")
aryCartData(cartProductName) = rsItem("ProductName")
aryCartData(cartProductDescription) = rsItem("ProductDescription")
aryCartData(cartProductDescriptionLong) = rsItem("ProductDescriptionLong")
aryCartData(cartCategory) = rsItem("ProductCategory")
aryCartData(cartCoupons) = rsItem("ProductCoupons")
aryCartData(cartProductShipsFree) = rsItem("ProductShipsFree")
aryCartData(cartShippingUnits) = rsItem("ShippingUnits") + ShippingUnitsAdd
aryCartData(cartOptions) = OptionsAdd
aryCartData(cartDiscountName) = rsItem("DiscountName")
aryCartData(cartAllowAmountEdit) = rsItem("AllowAmountEdit")
aryCartData(cartTaxOverride) = rsItem("TaxOverride")
aryCartData(cartNotes) = rsItem("Notes")
aryCartData(cartNSN) = rsItem("NSN")
aryCartData(cartPackaging) = rsItem("Packaging")
aryCartData(cartSKU) = rsItem("SKU")
If (cstSalePriceEnabled AND (Not IsNullOrZero(rsItem("SalePrice")))) Then
aryCartData(cartUnitPrice) = rsItem("SalePrice") + PriceAdd
Else
aryCartData(cartUnitPrice) = rsItem("UnitPrice") + PriceAdd
End If
If (cstMinOrderQtyEnabled AND (Not IsNull(rsItem("MinQty")))) Then
aryCartData(cartItemQuantity) = rsItem("MinQty")
aryCartData(cartMinQuantity) = rsItem("MinQty")
Else
aryCartData(cartItemQuantity) = 1
aryCartData(cartMinQuantity) = 1
End If
' Force min qty if this product has no options.
' If OptionsAdd is empty, the could not have been any options displayed ...
If (OptionsAdd = "") Then
aryCartData(cartItemQuantity) = aryCartData(cartMinQuantity)
Else
aryCartData(cartItemQuantity) = 1
End If
' Use downloadable name from Options table first, default to
' name in Products table if needed ...
If (Trim(OptionalDownloadFileName) = "") Then
aryCartData(cartDownloadFileName) = rsItem("DownloadFileName")
Else
aryCartData(cartDownloadFileName) = OptionalDownloadFileName
End If
aryCartData(cartItemType) = "usr"
'************coded inserted august 24,2005**********start
aryCartData(larryNotes)=Session("larrytmpcart")
Session("larrytmpcart")=""
'************coded inserted august 24,2005**********end
' Add this item to the shopping cart ...
crtAddToCart(aryCartData)
rsItem.Close
set rsItem = Nothing
End If ' Product info not null.
Session(sesItemCount) = iCount
Session(sesShoppingCart) = aryCart
dbClose(Conn)
'************coded inserted sep 6,2005**********end
if lartmpopt="Yes" then
Response.Redirect("nameplate.asp")
else
'************coded inserted sep 6,2005**********end
Response.Redirect("20Review.asp")
'************coded inserted sep 6,2005**********end
end if
'************coded inserted sep 6,2005**********end
End If ' FormErrMsg <> ""
Case "viewcart"
dbClose(Conn)
Response.Redirect("20Review.asp")
Case Else
Response.Write("10Expand.asp: Unknown button press. Contact Store Master" & " " & vbCrLf)
Response.End
End Select
' usrInsert() - Call back from user editable template page...
Private Sub usrInsert(ByVal argWhat)
If (rsProduct.RecordCount = 0) Then Exit Sub
Select Case argWhat
Case "FormErrorMsg"
If (Not strIsEmpty(FormErrMsg)) Then
wl(FormErrMsg)
End If
Case "NewFlag"
If ((cstNewUntilDateEnabled) AND (Not IsNull(rsProduct("NewUntil")))) Then
If (rsProduct("NewUntil") > Now()) Then
wl("")
End If
End If
Case "ProductName"
wl("" & rsProduct("ProductName") & "")
Case "ProductImage"
wl("")
Case "ProductDescription"
wl("" & GetLongDescription(rsProduct("ProductDescription"), rsProduct("ProductDescriptionLong")) & "")
Case "MinimumQty"
If ((cstMinOrderQtyEnabled) AND (rsProduct("MinQty") <> 1)) Then
wl("(Minimum order: " & rsProduct("MinQty") & ") ")
End If
Case "ProductCode"
wl("Product Code: " & GetURLValue("ProductCode") & "")
Case "NSN"
if rsProduct("NSN") <> "" And rsProduct("NSN") <> " " then
wl("NSN: " & rsProduct("NSN") & "")
End If
Case "SKU"
if rsProduct("SKU") <> "" And rsProduct("SKU") <> " " then
wl("SKU: " & rsProduct("SKU") & "")
End If
Case "Packaging"
if rsProduct("Packaging") <> "" And rsProduct("Packaging") <> " " then
wl("Packaging: " & rsProduct("Packaging") & "")
End If
Case "StockStatus"
Call DisplayStockStatus(rsProduct)
Case "Pricing"
Call DisplayProductPrices(rsProduct)
Case "DiscountLink"
If ((cstDiscountsEnabled) AND ((Trim(rsProduct("DiscountName") & "")) <> "")) Then
wl("")
wl("Discount Schedule")
wl("")
End If
Case "Options"
If (cstSharedOptionsEnabled And (Not strIsEmpty(rsProduct("OptionsUseProductCode")))) Then
Call DisplayOptions(rsProduct("OptionsUseProductCode"))
Else
Call DisplayOptions(rsProduct("ProductCode"))
End If
Case "ContinueButton"
wl("")
Case "ViewCartButton"
If (iCount > 0) Then
wl("")
End If
Case "ConfirmSelectionButton"
'************coded inserted august 23,2005**********start
Dim slqlar,rslar
sqllar="SELECT Customize FROM Products WHERE ProductCode='" & request("ProductCode") & "'"
set rslar = Server.CreateObject("ADODB.Recordset")
rslar.Open sqllar, Conn, 0,1
if Request.Form("larForm")="LastForm" then
wl("")
elseIf not rslar.EOF and (rslar("Customize")="1" or rslar("Customize")="2" or rslar("Customize")="3" or rslar("Customize")="4") then
' wl("wala munang confirm selection")
Else
'************coded inserted august 23,2005**********end
wl("")
'************coded inserted august 23,2005**********start
End if
'************coded inserted august 23,2005**********end
Case "GiftRegistryLink"
Call UserExit(usrLinkToGiftReg, Conn, rsProduct, 0, 0, ReturnValue)
End Select
End Sub
' Write the page...
if session("Username") = "" then
wl("")
dbClose(Conn)
%>
")
End If
End If
Case "ProductName"
wl("" & rsProduct("ProductName") & "")
Case "ProductImage"
wl("