<% ' 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. ' upgrade.asp - Upgrade the eShop database. ' This module automatically detects and upgrades the eShop database to ' the current version. It's operation is benign if the database is already ' up-to-date. ' ' As a precaution to system failure during the upgrade, we strongly recommend ' that you backup your eShop database before running this module. Dim rsCountry, ID, CurrentDataBaseVersion, ErrorMsg, oFile Public Sub UpgradeDataBase() Dim SQL, rs, x, rsProducts, rsOrderDetails Dim PaymentMethods ' Disallow upgrades to Beta versions ... If (InStr(LCase(gblVersionNo), "beta") <> 0) Then ErrorMsg = ErrorMsg & "Sorry, you cannot upgrade to a beta version.
" Exit Sub End If ' Delete error log file... will be obsolete after upgrade completes ... Call DeleteFile(GetLogFileName()) ' Connect to the database ... Set Conn = dbOpen("rw") ' Get current database version -------------------------------------- CurrentDataBaseVersion = GetCurrentDataBaseVersion() If (NeedsUpgradeToVersion("2.1.1")) Then ' Clean up old, unused files ... Call DeleteFileWarn("eShop.inc") Call DeleteFileWarn("parms.inc") Call DeleteFileWarn("parms.asp") Call DeleteFileWarn("adovbs.inc") Call DeleteFileWarn("lib/branding.inc") Call DeleteFileWarn("lib/bldparms.inc") Call DeleteFileWarn("lib/calcship.inc") Call DeleteFileWarn("lib/ccvalid.inc") Call DeleteFileWarn("lib/eorder.inc") Call DeleteFileWarn("lib/funcs.inc") Call DeleteFileWarn("lib/mtest.inc") Call DeleteFileWarn("lib/search.inc") Call DeleteFileWarn("lib/strings.inc") Call DeleteFileWarn("lib/tabedit.inc") Call DeleteFileWarn("lib/upgrade.inc") Call DeleteFileWarn("lib/upload.inc") ' Benign attempt to rename file, will fail if dest exists. x = MoveFile("userexit.inc", "userexit.asp") If (ErrorMsg <> "") Then ErrorMsg = ErrorMsg & "
Please manually remove the files listed above then try again." ErrorMsg = ErrorMsg & "
Your eShop has not been upgraded." dbClose(Conn) Exit Sub End If Call AddField("Parms", "Group", "Text", "nVarChar", 12, "") Call AddField("Parms", "SelectList", "Memo", "ntext", 0, "") Call AddField("Orders", "Survey1", "Text", "nVarChar", 255, "") Call AddField("Orders", "Survey2", "Text", "nVarChar", 255, "") Call AddField("Orders", "Survey3", "Text", "nVarChar", 255, "") Call AddField("Orders", "SalesTax1", "Currency", "float", 0, "") Call AddField("Orders", "ShipDate", "Date", "datetime", 0, "") Call AddField("Orders", "CVV2", "Text", "nVarChar", 5, "") Call AddField("OrderDetails", "TotalPrice", "Currency", "float", 0, "") Call AddField("Products", "ProductDescriptionLong", "Memo", "ntext", 0, "") Call AddField("Products", "StockStatus", "Text", "nVarChar", 255, "") Call AddTable("Countries") Call AddField("Countries", "Name", "Text", "nVarChar", 50, "") Call AddField("Countries", "UPSCode", "Text", "nVarChar", 2, "") Call AddField("Countries", "System", "Text", "nVarChar", 3, "") Call AddField("Countries", "LastUpdated","Date", "datetime", 0, "") Call AddCountries() ' Add shipper code for UPS lookup ... Call AddField("ShippingMethods", "ShipperCode", "Text", "nVarChar", 10, "") Call AddField("ShippingMethods", "Gateway", "Text", "nVarChar", 10, "") Call AddField("ShippingMethods", "System", "Text", "nVarChar", 3, "") ' Schema modifications ... Call ModifyField("Parms", "Parameter", "Text", "nVarChar", 50) Call ModifyField("ShippingMethods", "ShippingMethod", "Text", "nVarChar", 50) Call ModifyField("Products", "ProductCode", "Text", "nVarChar", 15) Call ModifyField("Products", "ProductSortCode", "Text", "nVarChar", 15) Call ModifyField("Products", "ProductName", "Text", "nVarChar", 60) SQLExecute("DELETE FROM ShippingMethods WHERE Gateway = 'UPS' AND System = 'Yes'") Call AddShippingMethod("UPS01", 101, "UPS: Next Day Air Early AM", "1DM", "UPS") Call AddShippingMethod("UPS02", 102, "UPS: Next Day Air", "1DA", "UPS") Call AddShippingMethod("UPS03", 103, "UPS: Next Day Air Intra (Puerto Rico)", "1DAPI", "UPS") Call AddShippingMethod("UPS04", 104, "UPS: Next Day Air Saver", "1DP", "UPS") Call AddShippingMethod("UPS05", 105, "UPS: 2nd Day Air AM", "2DM", "UPS") Call AddShippingMethod("UPS06", 106, "UPS: 2nd Day Air", "2DA", "UPS") Call AddShippingMethod("UPS07", 107, "UPS: 3 Day Select", "3DS", "UPS") Call AddShippingMethod("UPS08", 108, "UPS: Ground", "GND", "UPS") Call AddShippingMethod("UPS09", 109, "UPS: Canada Standard", "STD", "UPS") Call AddShippingMethod("UPS10", 110, "UPS: Worldwide Express", "XPR", "UPS") Call AddShippingMethod("UPS11", 111, "UPS: Worldwide Express Plus", "XDM", "UPS") Call AddShippingMethod("UPS12", 112, "UPS: Worldwide Expedited", "XPD", "UPS") End If If (NeedsUpgradeToVersion("2.2.0")) Then Call AddTable("Discounts") Call AddField("Discounts", "Name", "Text", "nVarChar", 35, "") Call AddField("Discounts", "MinQty", "Integer", "Int", 0, "") Call AddField("Discounts", "MaxQty", "Integer", "Int", 0, "") Call AddField("Discounts", "DiscountType", "Text", "nVarChar", 15, "") Call AddField("Discounts", "DiscountValue", "Double", "Float", 0, "") Call AddField("Discounts", "LastUpdated", "Date", "datetime", 0, "") Call AddField("Products", "MinQty", "Integer", "Int", 0, "1") Call AddField("Products", "DiscountName", "Text", "nVarChar", 35, "") Call AddField("OrderDetails", "ProductCode", "Text", "nVarChar", 15, "") Call AddField("OrderDetails", "ProductName", "Text", "nVarChar", 60, "") Call AddField("OrderDetails", "ProductDescription", "Memo", "nText", 0, "") ' Fill in values from Customer Table ... set rsOrderDetails = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM OrderDetails" rsOrderDetails.Open SQL, Conn, adOpenKeyset, adLockOptimistic Do While (Not rsOrderDetails.EOF) If (Not IsNull(rsOrderDetails("ProductID"))) Then set rsProducts = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM Products WHERE ProductID = " & rsOrderDetails("ProductID") rsProducts.Open SQL, Conn, adOpenKeyset, adLockOptimistic If (rsProducts.RecordCount = 1) Then If IsNull(rsOrderDetails("ProductCode")) Then rsOrderDetails("ProductCode") = rsProducts("ProductCode") End If If IsNull(rsOrderDetails("ProductName")) Then rsOrderDetails("ProductName") = rsProducts("ProductName") End If If IsNull(rsOrderDetails("ProductDescription")) Then rsOrderDetails("ProductDescription") = rsProducts("ProductDescription") End If End If rsProducts.Close End If rsOrderDetails.MoveNext Loop rsOrderDetails.Close set rsOrderDetails = Nothing set rsProducts = Nothing ' Convert selected double fields to currency ... Call ModifyField("Products", "UnitPrice", "Currency", "Money", 0) Call ModifyField("Products", "ShippingUnits", "Double", "Float", 0) Call ModifyField("Options", "CostAdjust", "Currency", "Money", 0) Call ModifyField("Options", "ShippingUnits", "Double", "Float", 0) Call ModifyField("ShippingByOrderValue", "MinOrderValue", "Currency", "Money", 0) Call ModifyField("ShippingByOrderValue", "MaxOrderValue", "Currency", "Money", 0) Call ModifyField("ShippingByOrderValue", "CostForMethod1", "Currency", "Money", 0) Call ModifyField("ShippingByOrderValue", "CostForMethod2", "Currency", "Money", 0) Call ModifyField("ShippingByOrderValue", "CostForMethod3", "Currency", "Money", 0) Call ModifyField("ShippingByOrderValue", "CostForMethod4", "Currency", "Money", 0) Call ModifyField("ShippingByOrderValue", "CostForMethod5", "Currency", "Money", 0) Call ModifyField("ShippingRegions", "CostPerUnitMethod1", "Currency", "Money", 0) Call ModifyField("ShippingRegions", "CostPerUnitMethod2", "Currency", "Money", 0) Call ModifyField("ShippingRegions", "CostPerUnitMethod3", "Currency", "Money", 0) Call ModifyField("ShippingRegions", "CostPerUnitMethod4", "Currency", "Money", 0) Call ModifyField("ShippingRegions", "CostPerUnitMethod5", "Currency", "Money", 0) End If If (NeedsUpgradeToVersion("2.3.0")) Then Call AddField("Products", "DownloadFileName", "Text", "nVarChar", 255, "") Call AddField("OrderDetails", "DownloadFileName", "Text", "nVarChar", 255, "") Call AddField("Options", "DownloadFileName", "Text", "nVarChar", 255, "") End If If (NeedsUpgradeToVersion("3.0")) Then Call AddField("Products", "AllowAmountEdit", "Text", "nVarChar", 3, "") Call AddField("Products", "ListPrice", "Currency", "Money", 0, "") Call AddField("Products", "SalePrice", "Currency", "Money", 0, "") Call AddField("Products", "TaxOverride", "Text", "nVarChar", 3, "") Call AddTable("CategoryIndex") Call AddField("CategoryIndex", "Category", "Text", "nVarChar", 255, "") Call AddField("CategoryIndex", "ProductID", "Integer", "Int", 0, "") Call AddField("CategoryIndex", "LastUpdated", "Date", "datetime", 0, "") Call AddField("Orders", "PurchaseOrderNumber", "Text", "nVarChar", 50, "") End If If (NeedsUpgradeToVersion("3.1")) Then Call AddField("Orders", "CreditCardAuthorizationDate", "Date", "datetime", 0, "") Call AddField("CategoryIndex", "Hidden", "Text", "nVarChar", 3, "") End If If (NeedsUpgradeToVersion("3.2")) Then Call AddField("Orders", "ShippingMethodDescription", "Text", "nVarChar", 255, "") Call AddField("Orders", "PaymentMethodDescription", "Text", "nVarChar", 50, "") Call AddField("Orders", "Password", "Text", "nVarChar", 16, "") Call AddField("Customers", "OptIn", "Text", "nVarChar", 3, "Yes") Call AddTable("Coupons") Call AddField("Coupons", "CouponCode", "Text", "nVarChar", 35, "") Call AddField("Coupons", "CouponDescription","Text", "nVarChar", 255, "") Call AddField("Coupons", "CouponType", "Text", "nVarChar", 35, "") Call AddField("Coupons", "CouponCategories", "Text", "nVarChar", 255, "") Call AddField("Coupons", "CouponValue", "Double", "Float", 0, "") Call AddField("Coupons", "CouponMinOrder", "Currency", "Money", 0, "") Call AddField("Coupons", "CouponMaxRedeem", "Currency", "Money", 0, "") Call AddField("Coupons", "CouponActive", "Text", "nVarChar", 3, "") Call AddField("Coupons", "CouponStartDate", "Date", "datetime", 0, "") Call AddField("Coupons", "CouponEndDate", "Date", "datetime", 0, "") Call AddField("Coupons", "LastUpdated", "Date", "datetime", 0, "") Call AddField("Products", "ProductCoupons", "Text", "nVarChar", 255,"") Call ModifyField("Orders", "CVV2", "Text", "nVarChar", 7) ' Convert state names to mixed case ... set rs = Server.CreateObject("ADODB.Recordset") rs.Open "SELECT * FROM ShippingRegions", Conn, adOpenKeyset, adLockOptimistic Do While Not rs.EOF If (LCase(Trim(rs("StateName"))) = "d.c.") Then rs("StateName") = "D.C." Else rs("StateName") = PCase(rs("StateName")) End If rs.Update rs.MoveNext Loop rs.Close Set rs = Nothing End If If (NeedsUpgradeToVersion("3.3")) Then ' Other-Not shown moved from code to table ... set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM Countries WHERE UPSCode = 'XX'" rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic x = rs.RecordCount rs.Close set rs = Nothing If (x = 0) Then set rs = Server.CreateObject("ADODB.Recordset") rs.Open "Countries", Conn, adOpenKeyset, adLockOptimistic rs.AddNew rs("Name") = "Other-Not Shown" rs("UPSCode") = "ZZ" rs("LastUpdated") = Date() rs.Update rs.Close set rs = Nothing set rs = Server.CreateObject("ADODB.Recordset") rs.Open "ShippingRegions", Conn, adOpenKeyset, adLockOptimistic rs.AddNew rs("StateName") = "Other-Not Shown" rs("StateCode") = "ZZ" rs("CostPerUnitMethod1") = 0 rs("CostPerUnitMethod2") = 0 rs("CostPerUnitMethod3") = 0 rs("CostPerUnitMethod4") = 0 rs("CostPerUnitMethod5") = 0 rs("LastUpdated") = Date() rs.Update rs.Close set rs = Nothing End If Call ModifyField("Customers", "EmailAddress", "Text", "nVarChar", 255) Call AddField("PaymentMethods", "PaymentGateway", "Text", "nVarChar", 255, "None") Call AddField("PaymentMethods", "PaymentGatewayID", "Text", "nVarChar", 255, "None") Call AddField("PaymentMethods", "PaymentGatewayOptions", "Text", "nVarChar", 255, "") End If If (NeedsUpgradeToVersion("4.0")) Then Call DropField("Countries", "UPSCode") Call ModifyField("ShippingMethods", "ShippingMethod", "Text", "nVarChar", 100) Call ModifyField("ShippingMethods", "ShipperCode", "Text", "nVarChar", 25) Call ModifyField("ShippingMethods", "ShippingOrderBy", "Text", "nVarChar", 10) Call ModifyField("Parms", "Group", "Text", "nVarChar", 30) Call AddField("ShippingMethods", "ShippingAllowFree", "Text", "nVarChar", 3, "No") Call AddField("Countries", "ISOA2", "Text", "nVarChar", 2, "") Call AddField("Countries", "ISOA3", "Text", "nVarChar", 3, "") Call AddField("Countries", "ISONum", "Text", "nVarChar", 3, "") Call AddField("Parms", "Installed", "Text", "nVarChar", 3, "") Call AddField("Orders", "FreeShipping", "Text", "nVarChar", 3, "") Call AddField("Orders", "IPAddress", "Text", "nVarChar", 20, "") Call AddField("Orders", "Language", "Text", "nVarChar", 20, "") ' Correct problem with missing PaymentMethodsDescription field in Orders table. ' This causes orders taken with pre version 3.2 eShops to not display ' orders after upgrading. ' Begin by caching payment methods table in table ... Set PaymentMethods = CreateObject("Scripting.Dictionary") Set rs = Server.CreateObject("ADODB.Recordset") rs.Open "PaymentMethods", Conn, adOpenKeyset, adLockOptimistic Do While (Not rs.EOF) PaymentMethods(CStr(rs("PaymentMethodID"))) = Trim(rs("PaymentMethod")) rs.MoveNext Loop rs.Close : Set rs = Nothing ' Finish by scanning orders table for records with missing PaymentMethodDescription field, ' then populate from our cache ... Set rs = Server.CreateObject("ADODB.Recordset") rs.Open "Orders", Conn, adOpenKeyset, adLockOptimistic Do While (Not rs.EOF) If (Trim((rs("PaymentMethodDescription")) & "") = "") Then rs("PaymentMethodDescription") = PaymentMethods(Trim(CStr(rs("PaymentMethodID") & ""))) End If rs.MoveNext Loop ' Clean up record sets, release table storage ... rs.Close : Set rs = Nothing PaymentMethods.RemoveAll : Set PaymentMethods = Nothing End If If (NeedsUpgradeToVersion("4.1")) Then Call AddField("PaymentMethods", "PaymentAuthTime", "Text", "nVarChar", 15, "None") End If If (NeedsUpgradeToVersion("4.2")) Then Call AddField("Countries", "Notes", "Text", "nVarChar", 255, "") Call AddField("Coupons", "Notes", "Text", "nVarChar", 255, "") Call AddField("Customers", "Notes", "Text", "nVarChar", 255, "") Call AddField("Discounts", "Notes", "Text", "nVarChar", 255, "") Call AddField("Options", "Notes", "Text", "nVarChar", 255, "") Call AddField("OptionTypes", "Notes", "Text", "nVarChar", 255, "") Call AddField("Orders", "NotesAdm", "Text", "nVarChar", 255, "") Call AddField("Parms", "Notes", "Text", "nVarChar", 255, "") Call AddField("PaymentMethods", "Notes", "Text", "nVarChar", 255, "") Call AddField("Products", "Notes", "Text", "nVarChar", 255, "") Call AddField("ShippingByOrderValue", "Notes", "Text", "nVarChar", 255, "") Call AddField("ShippingMethods", "Notes", "Text", "nVarChar", 255, "") Call AddField("ShippingRegions", "Notes", "Text", "nVarChar", 255, "") Call AddField("Orders", "TrackingNo", "Text", "nVarChar", 35, "") Call AddField("Orders", "AffiliateID", "Text", "nVarChar", 35, "") Call AddField("Products", "OptionsUseProductCode", "Text", "nVarChar", 15, "") Call AddField("OptionTypes", "WriteIn", "Text", "nVarChar", 3, "No") Call ModifyField("Options", "ProductCode", "Text", "nVarChar", 15) End If If (NeedsUpgradeToVersion("4.3")) Then Call AddTable("TaxRules") Call AddField("TaxRules", "TaxRuleNo", "Integer", "Int", 0, "") Call AddField("TaxRules", "TaxRuleCountry", "Text", "nVarChar", 255, "") Call AddField("TaxRules", "TaxRuleState", "Text", "nVarChar", 255, "") Call AddField("TaxRules", "TaxRuleCity", "Text", "nVarChar", 255, "") Call AddField("TaxRules", "TaxRulePostalCode", "Text", "nVarChar", 255, "") Call AddField("TaxRules", "TaxRuleTax1", "Text", "nVarChar", 255, "") Call AddField("TaxRules", "TaxRuleTax2", "Text", "nVarChar", 255, "") Call AddField("TaxRules", "TaxRuleNotes", "Text", "nVarChar", 255, "") Call AddField("TaxRules", "LastUpdated", "Date", "datetime", 0, "") Call AddTable("CrossSells") Call AddField("CrossSells", "CrossSellProductCode", "Text", "nVarChar", 15, "") Call AddField("CrossSells", "CrossSellRecommends", "Text", "nVarChar", 15, "") Call AddField("CrossSells", "CrossSellSortCode", "Text", "nVarChar", 15, "") Call AddField("CrossSells", "CrossSellNotes", "Text", "nVarChar", 255, "") Call AddField("CrossSells", "LastUpdated", "Date", "datetime", 0, "") Call AddField("Orders", "SalesTax2", "Currency", "float", 0, "") Call AddField("Products", "CrossSellUseProductCode", "Text", "nVarChar", 15, "") Call ModifyField("Products", "TaxOverride", "Text", "nVarChar", 7) Call AddField("Products", "OnHandInv", "Integer", "Int", 0, "") Call AddField("Products", "MinInv", "Integer", "Int", 0, "") Call AddField("Products", "MaxInv", "Integer", "Int", 0, "") Call DropField("Customers", "PaysStateTax") Call DropField("Orders", "SalesTaxRate") End If If (NeedsUpgradeToVersion("4.3.1")) Then Call DeleteFileWarn(AdminFolder & "\" & "$Secure.htm") If (Not StrIsEmpty(FormErrorMsg)) Then ' Error, cannot continue ... Exit Sub End If End If If (NeedsUpgradeToVersion("4.4")) Then Call ModifyField("ShippingMethods", "ShipperCode", "Text", "nVarChar", 35) Call AddTable("Forms") Call AddField("Forms", "FormConfigName", "Text", "nVarChar", 255, "") Call AddField("Forms", "FormPageName", "Text", "nVarChar", 255, "") Call AddField("Forms", "FormDefinition", "Memo", "ntext", 0, "") Call AddField("Forms", "LastUpdated", "Date", "datetime", 0, "") End If If (NeedsUpgradeToVersion("4.6")) Then Call AddField("Products", "ProductShipsFree", "Text", "nVarChar", 3, "") Call AddTable("ShippingByQtyRates") Call AddField("ShippingByQtyRates", "ByQtyMinItemCount", "Integer", "Int", 0, "") Call AddField("ShippingByQtyRates", "ByQtyMaxItemCount", "Integer", "Int", 0, "") Call AddField("ShippingByQtyRates", "ByQtyCostForMethod1", "Currency", "Money", 0, "") Call AddField("ShippingByQtyRates", "ByQtyCostForMethod2", "Currency", "Money", 0, "") Call AddField("ShippingByQtyRates", "ByQtyCostForMethod3", "Currency", "Money", 0, "") Call AddField("ShippingByQtyRates", "ByQtyCostForMethod4", "Currency", "Money", 0, "") Call AddField("ShippingByQtyRates", "ByQtyCostForMethod5", "Currency", "Money", 0, "") Call AddField("ShippingByQtyRates", "ByQtyNotes", "Text", "nVarChar", 255, "") Call AddField("ShippingByQtyRates", "LastUpdated", "Date", "datetime", 0, "") Call AddTable("ShippingMethodRules") Call AddField("ShippingMethodRules", "SMRuleName", "Text", "nVarChar", 35, "") Call AddField("ShippingMethodRules", "SMRuleCountry", "Text", "nVarChar", 255, "") Call AddField("ShippingMethodRules", "SMRuleState", "Text", "nVarChar", 255, "") Call AddField("ShippingMethodRules", "SMRuleCity", "Text", "nVarChar", 255, "") Call AddField("ShippingMethodRules", "SMRulePostalCode", "Text", "nVarChar", 255, "") Call AddField("ShippingMethodRules", "SMRuleNotes", "Text", "nVarChar", 255, "") Call AddField("ShippingMethodRules", "SMRuleMinShipUnits", "Double", "Float", 0, "") Call AddField("ShippingMethodRules", "SMRuleMaxShipUnits", "Double", "Float", 0, "") Call AddField("ShippingMethodRules", "LastUpdated", "Date", "datetime", 0, "") Call AddField("ShippingMethods", "ShippingDestRuleName", "Text", "nVarChar", 35, "") ' Change to match product name length when used in cart product name fields... Call ModifyField("Coupons", "CouponDescription", "Text", "nVarChar", 60) Call ModifyField("Discounts", "Name", "Text", "nVarChar", 60) End If If (NeedsUpgradeToVersion("5.0")) Then Call AddField("Orders", "DownloadFolderLink", "Text", "nVarChar", 255, "") End If If (NeedsUpgradeToVersion("5.1")) Then Call AddField("Customers", "ShipContactFirstName", "Text", "nVarChar", 50, "") Call AddField("Customers", "ShipContactLastName", "Text", "nVarChar", 50, "") Call AddField("Customers", "ShipCompanyName", "Text", "nVarChar", 50, "") Call AddField("Customers", "ShipOrganization", "Text", "nVarChar", 50, "") Call AddField("Customers", "ShipAddress1", "Text", "nVarChar", 255, "") Call AddField("Customers", "ShipAddress2", "Text", "nVarChar", 255, "") Call AddField("Customers", "ShipCity", "Text", "nVarChar", 50, "") Call AddField("Customers", "ShipStateOrProvince", "Text", "nVarChar", 50, "") Call AddField("Customers", "ShipPostalCode", "Text", "nVarChar", 20, "") Call AddField("Customers", "ShipCountry", "Text", "nVarChar", 50, "") Call AddField("Customers", "ShipPhoneNumber", "Text", "nVarChar", 30, "") Call AddField("ShippingMethods", "ShippingPercentAdd", "Double", "Float", 0, "") Call AddField("ShippingMethods", "ShippingAmountAdd", "Currency", "Money", 0, "") Call AddField("Orders", "TransitTime", "Text", "nVarChar", 50, "") End If ' Rebuild the parm database ------------------------------------------ Call RebuildParmsTable() ' Install optional features ------------------------------------------ Call InstallOptionalFeatures() ' Update Database version -------------------------------------------- set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM Parms WHERE VariableName = 'cstDatabaseVersion'" rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic rs("Value") = gblVersionNo rs.Update rs.Close SQL = "SELECT * FROM Parms WHERE VariableName = 'cstUpgradeFileCRC'" rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic rs("Value") = GetCRC(ReadFile("\lib\upgrade.asp")) rs.Update rs.Close : Set rs = Nothing dbClose(Conn) End Sub ' RebuildParmsTable() - Rebuild Parms Table from Parms.txt file Public Sub RebuildParmsTable() Dim FileObj, FileIn, Line, FieldName, FieldValue Dim Pos, RecordIsNew, SortCounter, SQL, rs Dim ClearText ' Clean old parms during release build ... If (Session("mFix-ReleaseBuild") = "True") Then Conn.Execute("DELETE FROM Parms") End If Set FileObj = Server.CreateObject("Scripting.FileSystemObject") Set FileIn = FileObj.OpenTextFile(Server.MapPath("Parms.txt"), ForReading, False) SortCounter = 100 Set rs = Server.CreateObject("ADODB.Recordset") Do While Not FileIn.AtEndOfStream Line = Trim(FileIn.ReadLine) Response.Flush If ((Trim(Line) <> "") AND (Left(Line,1) <> "'")) Then Pos = InStr(Line, ":") FieldName = Trim(Left(Line, Pos - 1)) FieldValue = Trim(Mid(Line, Pos + 2)) If (FieldName = "VariableName") Then SQL = "SELECT * FROM Parms WHERE VariableName = '" & FieldValue & "'" rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic Select Case rs.RecordCount Case 0 rs.AddNew rs("VariableName") = FieldValue RecordIsNew = True Case 1 RecordIsNew = False Case Else wl("Upgrade.asp: Fatal error loading Parms table.") dbClose(Conn) Response.End End Select rs("SortOrder") = SortCounter SortCounter = SortCounter + 1 Else If ((FieldName <> "Value") OR RecordIsNew) Then rs(FieldName) = FieldValue End If ' Got the last field for this record, update and close it. If (FieldName = "VariableType") Then rs("LastUpdated") = Date() rs.Update rs.Close End If End If End If Loop FileIn.Close set FileObj = Nothing set FileIn = Nothing ' Remove old configuration records, no longer used. ' We do this by removing all records that don't contain ' today's date. set rs = Server.CreateObject("ADODB.Recordset") rs.Open "Parms", Conn, adOpenKeyset, adLockOptimistic Do While (Not rs.EOF) If (rs("LastUpdated") <> Date()) Then rs.Delete End If rs.MoveNext Loop rs.Close set rs = Nothing ' Make sure this operation has not left the encryption key in plain text ... Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM Parms WHERE (VariableName = 'cstEncryptionKey') And (LastUpdated = " & FormatDateConst(Date()) & ")" rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic If (rs.RecordCount <> 0) Then ClearText = Crypt(rs("Value"), KeyEncoder, "dec") rs("Value") = Crypt(ClearText, KeyEncoder, "enc") rs.Update End If rs.Close : Set rs = Nothing End Sub ' EnableParms() - Make parms in this group visible to user ... Public Sub EnableParms(ByVal argGroupName) Dim rs, SQL Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM Parms WHERE {fn LCase(Parms.[Group])} LIKE '%" & LCase(argGroupName) & "%'" rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic Do While (Not rs.EOF) rs("Installed") = "Yes" rs.MoveNext Loop rs.Close Set rs = Nothing End Sub ' SetParmEnable() - Set parameter enable flag ... Public Sub SetParmEnable(ByVal argVariableName, ByVal argOnOff) Dim rs, SQL Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM Parms WHERE {fn LCase(Parms.VariableName)} = '" & LCase(argVariableName) & "'" rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic If (rs.RecordCount <> 0) Then rs("Installed") = IIF(argOnOff, "Yes", "No") rs.Update End If rs.Close : Set rs = Nothing End Sub ' InstallOptionalFeatures() - Install any and all optional features ... Public Sub InstallOptionalFeatures() Dim Feature, FeatureList ' Suppress features add during release build ... If (Session("mFix-ReleaseBuild") = "True") Then : Exit Sub FeatureList = FeatureInstalled.Keys For Each Feature in FeatureList FeatureInstalled(Feature).Install Next End Sub ' NeedsUpgradeToVersion() - True if this eShop needs an upgrade ... Public Function NeedsUpgradeToVersion(ByVal argVersionNumber) NeedsUpgradeToVersion = CBool(ExpandVersionNo(CurrentDataBaseVersion) < ExpandVersionNo(argVersionNumber)) End Function ' DeleteFileWarn() - Delete file and warn on failure ... Public Sub DeleteFileWarn(ByVal argFileName) If (Not DeleteFile(argFileName)) Then FormErrorMsg = FormErrorMsg & "File '" & argFileName & "' could not be deleted, please remove manually.
" End If End Sub ' AddCountries() - Load Country table with UPS country codes ... Public Sub AddCountries() SQLExecute("DELETE FROM Countries WHERE System = 'Yes'") ID = 0 set rsCountry = Server.CreateObject("ADODB.Recordset") rsCountry.Open "Countries", Conn, adOpenKeyset, adLockOptimistic Call AddCountry("Albania", "AL") Call AddCountry("Algeria", "DZ") Call AddCountry("American Samoa", "AS") Call AddCountry("Andorra", "AD") Call AddCountry("Angola", "AO") Call AddCountry("Anguilla", "AI") Call AddCountry("Antigua & Barbuda", "AG") Call AddCountry("Argentina", "AR") Call AddCountry("Armenia", "AM") Call AddCountry("Aruba", "AW") Call AddCountry("Australia", "AU") Call AddCountry("Austria", "AT") Call AddCountry("Azerbaijan", "AZ") Call AddCountry("Azores", "AP") Call AddCountry("Bahamas", "BS") Call AddCountry("Bahrain", "BH") Call AddCountry("Bangladesh", "BD") Call AddCountry("Barbados", "BB") Call AddCountry("Belrus", "BY") Call AddCountry("Belgium", "BE") Call AddCountry("Belize", "BZ") Call AddCountry("Benin", "BJ") Call AddCountry("Bermuda", "BM") Call AddCountry("Bolivia", "BO") Call AddCountry("Bonaire", "BL") Call AddCountry("Bosnia", "BA") Call AddCountry("Botswana", "BW") Call AddCountry("Brazil", "BR") Call AddCountry("British Virgin Isles", "VG") Call AddCountry("Brunei", "BN") Call AddCountry("Bulgaria", "BG") Call AddCountry("Burkina Faso", "BF") Call AddCountry("Burundi", "BI") Call AddCountry("Cambodia", "KH") Call AddCountry("Cameroon", "CM") Call AddCountry("Canada", "CA") Call AddCountry("Canary Islands", "IC") Call AddCountry("Cape Verde", "CV") Call AddCountry("Cayman Islands", "KY") Call AddCountry("Central African Republic", "CF") Call AddCountry("Chad", "TD") Call AddCountry("Channel Islands", "CD") Call AddCountry("Chile", "CL") Call AddCountry("Colombia", "CO") Call AddCountry("Cook Islands", "CK") Call AddCountry("Costa Rica", "CR") Call AddCountry("Cote D'Ivoire", "CI") Call AddCountry("Croatia", "HR") Call AddCountry("Curacao", "CB") Call AddCountry("Cyprus", "CY") Call AddCountry("Czech Republic", "CZ") Call AddCountry("Dem Rep of Congo", "ZR") Call AddCountry("Denmark", "DK") Call AddCountry("Djibouti", "DJ") Call AddCountry("Dominica", "DM") Call AddCountry("Dominican Republic", "DO") Call AddCountry("Ecuador", "EC") Call AddCountry("Egypt", "EG") Call AddCountry("El Salvador", "SV") Call AddCountry("England", "EN") Call AddCountry("Equitorial Guinea", "GQ") Call AddCountry("Eritrea", "ER") Call AddCountry("Estonia", "EE") Call AddCountry("Ethiopia", "ET") Call AddCountry("Faeroe Islands", "FO") Call AddCountry("Fiji", "FJ") Call AddCountry("Finland", "FI") Call AddCountry("France", "FR") Call AddCountry("French Guiana", "GF") Call AddCountry("French Polynesia", "PF") Call AddCountry("Gabon", "GA") Call AddCountry("Gambia", "GM") Call AddCountry("Georgia", "GE") Call AddCountry("Germany", "DE") Call AddCountry("Ghana", "GH") Call AddCountry("Gibraltar", "GI") Call AddCountry("Greece", "GR") Call AddCountry("Greenland", "GL") Call AddCountry("Grenada", "GD") Call AddCountry("Guadeloupe", "GP") Call AddCountry("Guam", "GU") Call AddCountry("Guatemala", "GT") Call AddCountry("Guinea", "GN") Call AddCountry("Guinea-Bissau", "GW") Call AddCountry("Guyana", "GY") Call AddCountry("Haiti", "HT") Call AddCountry("Holland", "HO") Call AddCountry("Honduras", "HN") Call AddCountry("Hong Kong", "HK") Call AddCountry("Hungary", "HU") Call AddCountry("Iceland", "IS") Call AddCountry("India", "IN") Call AddCountry("Indonesia", "ID") Call AddCountry("Israel", "IL") Call AddCountry("Italy", "IT") Call AddCountry("Jamaica", "JM") Call AddCountry("Japan", "JP") Call AddCountry("Jordan", "JO") Call AddCountry("Kazakhstan", "KZ") Call AddCountry("Kenya", "KE") Call AddCountry("Kiribati", "KI") Call AddCountry("Kosrae", "KO") Call AddCountry("Kuwait", "KW") Call AddCountry("Kyrgyzstan", "KG") Call AddCountry("Laos", "LA") Call AddCountry("Latvia", "LV") Call AddCountry("Lebanon", "LB") Call AddCountry("Lesotho", "LS") Call AddCountry("Liberia", "LR") Call AddCountry("Liechtenstein", "LI") Call AddCountry("Lithuania", "LT") Call AddCountry("Luxembourg", "LU") Call AddCountry("Macau", "MO") Call AddCountry("Macedonia", "MK") Call AddCountry("Madagascar", "MG") Call AddCountry("Madeira", "ME") Call AddCountry("Malawi", "MW") Call AddCountry("Malaysia", "MY") Call AddCountry("Maldives", "MV") Call AddCountry("Mali", "ML") Call AddCountry("Malta", "MT") Call AddCountry("Marshall Islands", "MH") Call AddCountry("Martinique", "MQ") Call AddCountry("Mauritania", "MR") Call AddCountry("Mauritius", "MU") Call AddCountry("Mexico", "MX") Call AddCountry("Micronesia", "FM") Call AddCountry("Moldova", "MD") Call AddCountry("Monaco", "MC") Call AddCountry("Mongolia", "MN") Call AddCountry("Montserrat", "MS") Call AddCountry("Morocco", "MA") Call AddCountry("Mozambique", "MZ") Call AddCountry("Myanmar", "MM") Call AddCountry("N. Mariana Islands", "MP") Call AddCountry("Namibia", "NA") Call AddCountry("Nepal", "NP") Call AddCountry("Netherlands", "NL") Call AddCountry("Netherlands Antilles", "AN") Call AddCountry("New Caledonia", "NC") Call AddCountry("New Zealand", "NZ") Call AddCountry("Nicaragua", "NI") Call AddCountry("Niger", "NE") Call AddCountry("Nigeria", "NG") Call AddCountry("Norfolk Island", "NF") Call AddCountry("Northern Ireland", "NB") Call AddCountry("Norway", "NO") Call AddCountry("Oman", "OM") Call AddCountry("Pakistan", "PK") Call AddCountry("Palau", "PW") Call AddCountry("Panama", "PA") Call AddCountry("Papua New Guinea", "PG") Call AddCountry("Paraguay", "PY") Call AddCountry("Peoples Rep of China", "CN") Call AddCountry("Peru", "PE") Call AddCountry("Philippines", "PH") Call AddCountry("Poland", "PL") Call AddCountry("Ponape", "PO") Call AddCountry("Portugal", "PT") Call AddCountry("Puerto Rico", "PR") Call AddCountry("Qatar", "QA") Call AddCountry("Republic of Congo", "CG") Call AddCountry("Republic of Ireland", "IE") Call AddCountry("Republic of Yemen", "YE") Call AddCountry("Reunion", "RE") Call AddCountry("Romania", "RO") Call AddCountry("Rota", "RT") Call AddCountry("Russia", "RU") Call AddCountry("Rwanda", "RW") Call AddCountry("Saba", "SS") Call AddCountry("Saipan", "SP") Call AddCountry("San Marino", "SM") Call AddCountry("Saudi Arabia", "SA") Call AddCountry("Scotland", "SF") Call AddCountry("Senegal", "SN") Call AddCountry("Seychelles", "SC") Call AddCountry("Sierra Leone", "SL") Call AddCountry("Singapore", "SG") Call AddCountry("Slovakia", "SK") Call AddCountry("Slovenia", "SI") Call AddCountry("Solomon Islands", "SB") Call AddCountry("South Africa", "ZA") Call AddCountry("South Korea", "KR") Call AddCountry("Spain", "ES") Call AddCountry("Sri Lanka", "LK") Call AddCountry("St. Vincent/Grenadine", "VC") Call AddCountry("St. Barthelemy", "NT") Call AddCountry("St. Christopher", "SW") Call AddCountry("St. Croix", "SX") Call AddCountry("St. Eustatius", "EU") Call AddCountry("St. John", "UV") Call AddCountry("St. Kitts & Nevis", "KN") Call AddCountry("St. Lucia", "LC") Call AddCountry("St. Maarten", "MB") Call AddCountry("St. Martin", "TB") Call AddCountry("St. Thomas", "VL") Call AddCountry("Suriname", "SR") Call AddCountry("Swaziland", "SZ") Call AddCountry("Sweden", "SE") Call AddCountry("Switzerland", "CH") Call AddCountry("Syria", "SY") Call AddCountry("Tahiti", "TA") Call AddCountry("Taiwan", "TW") Call AddCountry("Tajikistan", "TJ") Call AddCountry("Tanzania", "TZ") Call AddCountry("Thailand", "TH") Call AddCountry("Tinian", "TI") Call AddCountry("Togo", "TG") Call AddCountry("Tonga", "TO") Call AddCountry("Tortola", "TL") Call AddCountry("Trinidad & Tobago", "TT") Call AddCountry("Truk", "TU") Call AddCountry("Tunisia", "TN") Call AddCountry("Turkey", "TR") Call AddCountry("Turkmenistan", "TM") Call AddCountry("Turks & Caicos Islands", "TC") Call AddCountry("Tuvalu", "TV") Call AddCountry("Uganda", "UG") Call AddCountry("Ukraine", "UA") Call AddCountry("Union Island", "UI") Call AddCountry("United Arab Emirates", "AE") Call AddCountry("United Kingdom", "GB") Call AddCountry("United States", "US") Call AddCountry("Uruguay", "UY") Call AddCountry("US Virgin Islands", "VI") Call AddCountry("Uzbekistan", "UZ") Call AddCountry("Vanuatu", "VU") Call AddCountry("Vatican City State", "VA") Call AddCountry("Venezuela", "VE") Call AddCountry("Vietnam", "VN") Call AddCountry("Virgin Gorda", "VR") Call AddCountry("Wake Island", "WK") Call AddCountry("Wales", "WL") Call AddCountry("Wallis & Futuna Islands", "WF") Call AddCountry("Western Samoa", "WS") Call AddCountry("Yap", "YA") Call AddCountry("Zambia", "ZM") Call AddCountry("Zimbabwe", "ZW") Call AddCountry("Other-Not Shown", "XX") rsCountry.Close set rsCountry = Nothing End Sub ' AddCountry() - Add country to country table ... Public Sub AddCountry(ByVal argName, ByVal argUPSCode) rsCountry.AddNew If (Not isSQLServer()) Then ID = ID + 1 rsCountry("ID") = ID End If rsCountry("Name") = argName rsCountry("UPSCode") = argUPSCode rsCountry("System") = "Yes" rsCountry("LastUpdated") = Date() rsCountry.Update End Sub ' AddShippingMethod() - Add to the Shipping Method table ... Public Sub AddShippingMethod(ByVal argShippingOrderBy, ByVal argMethodID, ByVal argMethod, ByVal argShipperCode, ByVal argGateway) Dim rs set rs = Server.CreateObject("ADODB.Recordset") rs.Open "ShippingMethods", Conn, adOpenKeyset, adLockOptimistic rs.AddNew rs("ShippingMethodID") = argMethodID rs("ShippingMethod") = argMethod rs("ShipperCode") = argShipperCode rs("Gateway") = argGateway rs("ShippingOrderBy") = argShippingOrderBy rs("ShippingMethodActive") = "Yes" rs("System") = "Yes" rs("LastUpdated") = Date() rs.Update rs.Close set rs = Nothing End Sub ' AddTable() - Add a table to the database, if necessary ... Public Sub AddTable(ByVal argName) If (Not DBHasTable(argName)) Then If (Not isSQLServer()) Then SQLExecute("CREATE TABLE " & argName) SQLExecute("ALTER TABLE " & argName & " ADD ID Long Integer") Else SQLExecute("CREATE TABLE [dbo].[" & argName & "] ([ID] [int] IDENTITY (1,1) NOT NULL) ON [PRIMARY]") End If End If End Sub ' AddField() - Add field to existing table (if missing) Public Sub AddField(ByVal argTable, ByVal argField, ByVal argTypeAccess, ByVal argTypeSQL, ByVal argSize, ByVal argDefaultValue) Dim Size, SQL, rs If (argSize <> 0) Then Size = "(" & argSize & ")" Else Size = "" End If If (Not TableHasField(argTable, argField)) Then If (Not isSQLServer()) Then SQLExecute("ALTER TABLE " & argTable & " ADD " & argField & " " & argTypeAccess & Size & " Null") Else SQLExecute("ALTER TABLE " & argTable & " ADD " & argField & " " & argTypeSQL & Size & " Null") End If If (argDefaultValue <> "") Then ' Fill in default values for new field set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM " & argTable rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic Do While (Not rs.EOF) If (IsNull(rs(argField))) Then rs(argField) = argDefaultValue End If rs.MoveNext Loop rs.Close set rs=Nothing End If End If End Sub ' ModifyField() - Modify field to new parameters ... Public Sub ModifyField(ByVal argTable, ByVal argField, ByVal argTypeAccess, ByVal argTypeSQL, argSize) Dim Size If (argSize <> 0) Then Size = "(" & argSize & ")" Else Size = "" End If If (Not isSQLServer()) Then SQLExecute("ALTER TABLE " & argTable & " ALTER " & argField & " " & argTypeAccess & Size & " Null") Else SQLExecute("ALTER TABLE " & argTable & " ALTER COLUMN [" & argField & "] " & argTypeSQL & Size & " Null") End If End Sub ' DropField() - Drop field from table Public Sub DropField(ByVal argTable, ByVal argField) Dim Size If (TableHasField(argTable, argField)) Then If (Not isSQLServer()) Then SQLExecute("ALTER TABLE " & argTable & " DROP " & argField) Else SQLExecute("ALTER TABLE " & argTable & " DROP COLUMN " & argField) End If End If End Sub ' DBHasTable() - Returns TRUE if the database contains the given table. Public Function DBHasTable(ByVal argTable) Dim SQL, rs On Error Resume Next SQL = "SELECT * FROM " & argTable set rs = Server.CreateObject("ADODB.Recordset") rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic If (Err) Then DBHasTable = False Else rs.Close set rs = Nothing DBHasTable = True End If End Function ' TableHasField() - Returns TRUE if the given table contains the given field. Public Function TableHasField (ByVal argTableName, ByVal argFieldName) Dim x, rs TableHasField = False set rs = Server.CreateObject("ADODB.Recordset") rs.Open argTableName, Conn, adOpenKeyset, adLockOptimistic For Each x in rs.Fields if (x.Name = argFieldName) Then TableHasField = True rs.close set rs = Nothing Exit Function End If Next rs.close set rs = Nothing End Function ' UpdateCountries() - Update the country table from the current ISO list ... Public Sub UpdateCountries() Dim FileObj, FileIn, Line Dim Country, ISOA2, ISOA3, ISONum Set FileObj = Server.CreateObject("Scripting.FileSystemObject") Set FileIn = FileObj.OpenTextFile(Server.MapPath("isoccode.txt"), ForReading, False) SQLExecute("DELETE FROM Countries WHERE System = 'Yes'") ID = 0 set rsCountry = Server.CreateObject("ADODB.Recordset") rsCountry.Open "Countries", Conn, adOpenKeyset, adLockOptimistic Do While (Not FileIn.AtEndOfStream) Line = Trim(FileIn.ReadLine) ' Select country code lines only for processing ... If (isMatch(Line, "[A-Z]{2} +[A-Z]{3} +[0-9]{3}$")) Then Country = Trim(Mid(Line, 1, 48)) ISOA2 = Mid(Line, 49, 2) ISOA3 = Mid(Line, 57, 3) ISONum = Mid(Line, 65, 3) rsCountry.AddNew If (Not isSQLServer()) Then ID = ID + 1 rsCountry("ID") = ID End If ' Handles problem in PCase ... Country = Replace(Country, "(", "( ") Country = Replace(Country, ".", ". ") Country = PCase(Country) Country = Replace(Country, "( ", "(") Country = Replace(Country, ". ", ".") rsCountry("Name") = Country rsCountry("ISOA2") = ISOA2 rsCountry("ISOA3") = ISOA3 rsCountry("ISONum") = ISONum rsCountry("System") = "Yes" rsCountry("LastUpdated") = Date() rsCountry.Update End If Loop FileIn.Close set FileObj = Nothing set FileIn = Nothing ' Add "Other-Not Shown" to country list ... rsCountry.AddNew rsCountry("Name") = "Other-Not Shown" rsCountry("ISOA2") = "ZZ" rsCountry("ISOA3") = "ZZZ" rsCountry("ISONum") = "000" rsCountry("System") = "Yes" rsCountry("LastUpdated") = Date() rsCountry.Update rsCountry.Close : Set rsCountry = Nothing End Sub ' SQLExecute() - Excute SQL command ... Public Sub SQLExecute(ByVal argCommand) ' Debug only ... ' Response.Write("SQLExecute: " & argCommand & "" & "
" & vbCrLf) Conn.Execute(argCommand) End Sub %>