<% ' 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("" & OptionText & "
") Case False : wl("" & OptionText & "") End Select rsOptions.MoveNext Loop 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 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")="" 'aryCartData(larryNotes)="" 'Dim arylar,ilar,addlar 'addlar=0 'if Session("larrytmpcart")<>"" then ' response.Write "meronglarrytmpcart " ' if Session("alarrycart")="" or IsEmpty(Session("alarrycart")) then'emptylarrycart" ' Session("alarrycart")=Session("larrytmpcart") ' aryCartData(larryNotes)=Session("larrytmpcart") ' response.Write "newlarrycartstarted " ' elseif Session("alarrycart")<>"" then'findduplicate" ' response.Write "loadlarrycartold " ' aryCartData(larryNotes)=Session("larrytmpcart") ' arylar=Split(Session("alarrycart"),"") ' for ilar=LBOund(arylar) to UBound(arylar) ' if arylar(ilar)=Session("larrytmpcart") then'duplicatefound" ' response.Write "larrycartquantityadd " ' addlar=1 ' exit for ' end if ' next ' if addlar=0 then ' response.Write "noduplicateaddnew " ' Session("alarrycart")=Session("alarrycart") &""& Session("larrytmpcart")'noduplicateaddnew" ' addlar=2 ' aryCartData(cartProductID)=rsItem("ProductID") &"_force_add_to_cart" ' else'duplicatenoadd ' response.Write "larrycartquantityadd " ' Session("alarrycart")=Session("alarrycart") ' aryCartData(larryNotes)=Session("larrytmpcart") ' end if ' end if 'end if 'Session.Contents.Remove("larrytmpcart") '************coded inserted august 24,2005**********end ' Add this item to the shopping cart ... crtAddToCart(aryCartData) '************coded inserted august 24,2005**********start 'If addlar=2 then'addnewsuccess" ' aryCart(cartProductID, iCount)=rsItem("ProductID") 'end if '************coded inserted august 24,2005**********end rsItem.Close set rsItem = Nothing End If ' Product info not null. Session(sesItemCount) = iCount Session(sesShoppingCart) = aryCart dbClose(Conn) 'Response.End() Response.Redirect("20Review.asp") 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(" New!

") 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 sqllar1,rslar1,imgStamp 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" 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) %>