<% ' 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. ' FuncsAdm.asp - Shared functions for admin area only. ' Encryption key encoder ... Const KeyEncoder = "kRi3754kGF962Kfpi8Dr" ' CryptString() - EnCryptString/DeCryptString a string using the given key ... Public Function CryptString(ByVal argString, ByVal argKey, ByVal argMode) Dim iKeyChar, iKeyLen, iKeyPos, iStringChar Dim iCryptStringChar, Version, CryptStringString, i Dim VersionPrefix ' No string or key supplied, do nothing ... If (strIsEmpty(argString) OR strIsEmpty(argKey)) Then CryptString = argString Exit Function End If ' CryptString method version number for future backward compatibility ... VersionPrefix = Chr(27) & Chr(01) ' Decode? Remove CryptString version prefix, discard for now ... Select Case argMode Case "dec" If (Left(argString, 1) = Left(VersionPrefix, 1)) Then ' Remove version prefix ... Version = Left(argString, 2) CryptStringString = Mid(argString, 3) Else ' Already in clear text ... CryptString = argString Exit Function End If Case "enc" CryptStringString = argString End Select ' Encode/Decode ... iKeyLen = Len(argKey) For i = 1 to Len(CryptStringString) iKeyPos = (i MOD iKeyLen) + 1 iKeyChar = Asc(mid(argKey, iKeyPos, 1)) iStringChar = Asc(mid(CryptStringString, i, 1)) iCryptStringChar = iKeyChar XOR iStringChar CryptString = CryptString & Chr(iCryptStringChar) Next ' Encode? Add version prefix for future backward compatibility ... If (argMode = "enc") Then CryptString = VersionPrefix & CryptString End If End Function ' DisplayOrderSelectionFields() - Display fields for order selection ... Public Sub DisplayOrderSelectionFields() Dim m, s, e, i ' Temp variables for date calculations ' JavaScript to move dates into user input fields ... wl("") wl("") ' Display drop down menu ... wl("") wl("-- Select dates --") wl("" & "Today" & "") wl("" & "Yesterday" & "") wl("" & "Last 3 days" & "") wl("" & "Last 10 days" & "") wl("" & "Last 30 days" & "") wl("All dates") For i = 0 To 12 m = Month(Date) s = DateSerial(Year(Date()), m - i, 1) e = DateSerial(Year(Date()), Month(Date) - i + 1, 1) - 1 wl("" & MonthName(Month(s)) & "") Next wl("") ' Display fields ... If (BrowserIsMSIE) Then wl("From: " & Form.DisplayTextBox("StartDate", 8, 10, "") & "") wl("To: " & Form.DisplayTextBox("EndDate", 8, 10, "") & "") wl("Not Shipped: " & Form.DisplayCheckBox("NotShipped") & "") wl("Search: " & Form.DisplayTextBox("Search", 20, 20, "") & "") Else wl("From: " & Form.DisplayTextBox("StartDate", 6, 10, "") & "") wl("To: " & Form.DisplayTextBox("EndDate", 6, 10, "") & "") wl("Not Shipped: " & Form.DisplayCheckBox("NotShipped") & "") wl("Search: " & Form.DisplayTextBox("Search", 15, 20, "") & "") End If End Sub ' ExpandVersionNo() - Expand eShop version number for comparison purposes ... Public Function ExpandVersionNo(ByVal argVersionNumber) Dim VersionNumber, s, i VersionNumber = Trim(argVersionNumber) If (Not IsNumeric(Right(VersionNumber, 1))) Then ' Version number has alpha suffix ... separate it with a dot too ... VersionNumber = Left(VersionNumber, Len(VersionNumber) - 1) & "." & Right(VersionNumber, 1) Else ' Add a "blank" alpha suffix when none exists ... VersionNumber = VersionNumber & ". " End If s = Split(VersionNumber, ".") ExpandVersionNo = "" For i = 0 To UBound(s) Step 1 If (IsNumeric(s(i))) Then ExpandVersionNo = ExpandVersionNo & Replace(Space(3 - Len(s(i))), " ", 0) & s(i) & "." Else ExpandVersionNo = ExpandVersionNo & s(i) & "." End If If (i = 1) Then Select Case UBound(s) Case 1 ExpandVersionNo = ExpandVersionNo & "000" & "." Case 2 If (Not IsNumeric(s(2))) Then ExpandVersionNo = ExpandVersionNo & "000" & "." End If End Select End If Next End Function ' GetCurrentDatabaseVersion() - Returns the current version of this database ... Public Function GetCurrentDatabaseVersion() Dim SQL, rs, dbConnection Set dbConnection = dbOpen("r") Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM Parms WHERE VariableName = 'cstDatabaseVersion'" rs.Open SQL, dbConnection, adOpenKeyset, adLockOptimistic If (rs.RecordCount = 1) Then GetCurrentDataBaseVersion = rs("Value") Else GetCurrentDataBaseVersion = "0.0.0" End If rs.Close : Set rs = Nothing dbClose(dbConnection) End Function ' PCase() - Convert a string to proper case ... Private Function PCase(strInput) Dim iPosition ' Our current position in the string (First character = 1) Dim iSpace ' The position of the next space after our iPosition Dim strOutput ' Our temporary string used to build the function's output iPosition = 1 Do While InStr(iPosition, strInput, " ", 1) <> 0 iSpace = InStr(iPosition, strInput, " ", 1) strOutput = strOutput & UCase(Mid(strInput, iPosition, 1)) strOutput = strOutput & LCase(Mid(strInput, iPosition + 1, iSpace - iPosition)) iPosition = iSpace + 1 Loop strOutput = strOutput & UCase(Mid(strInput, iPosition, 1)) strOutput = strOutput & LCase(Mid(strInput, iPosition + 1)) PCase = strOutput End Function ' UpdateCategoryIndex() - Update CategoryIndex Table with new category info ... Public Sub UpdateCategoryIndex(ByVal argRSProducts) Dim rs, Category, CategoryList ' If categories are not in use, this build is not required ... If (Not cstCategoriesEnabled) Then Exit Sub End If ' Remove records for this product already on file ... Conn.Execute("DELETE FROM CategoryIndex WHERE ProductID = " & argRSProducts("ProductID")) ' Put category on list only if this item is enabled for display ... If (Trim(argRSProducts("ProductCategory")) <> "") Then set rs = Server.CreateObject("ADODB.Recordset") rs.Open "CategoryIndex", Conn, adOpenKeyset, adLockOptimistic CategoryList = Split(argRSProducts("ProductCategory") & ",", ",") For Each Category in CategoryList If (Trim(Category) <> "") Then rs.AddNew rs("Category") = Trim(Category) rs("ProductID") = argRSProducts("ProductID") If ( _ ((Not cstDisplayDatesEnabled) OR IsNull(argRSProducts("ProductStartDate")) OR (argRSProducts("ProductStartDate") <= Date())) AND _ ((Not cstDisplayDatesEnabled) OR IsNull(argRSProducts("ProductEndDate")) OR (argRSProducts("ProductEndDate") >= Date())) AND _ ((Not cstProductHideEnabled) OR (LCase(Trim(argRSProducts("ProductHide"))) <> "yes")) _ ) Then rs("Hidden") = "No" Else rs("Hidden") = "Yes" End If rs("LastUpdated") = Date() rs.Update End If Next rs.Close Set rs = Nothing End If End Sub ' UpdateCategoryIndexAll() - Rebuild CategoryIndex table from scratch ... Public Sub UpdateCategoryIndexAll() Dim rs ' Remove all old category selects records ... Conn.Execute("DELETE FROM CategoryIndex") ' Rebuild all category selects records ... Set rs = Server.CreateObject("ADODB.Recordset") rs.Open "Products", Conn, adOpenKeyset, adLockOptimistic Do While Not rs.EOF Call UpdateCategoryIndex(rs) rs.MoveNext Loop rs.Close Set rs = Nothing End Sub ' ReportProgress() - Report progress in interval seconds ... Dim ReportProgressBefore ReportProgressBefore = Now() Public Sub ReportProgress(ByVal argString, ByVal argInterval) If (Abs(DateDiff("s", Now(), ReportProgressBefore)) > argInterval) Then wl(argString) ReportProgressBefore = Now() End If End Sub ' GetXMLNodeValue() - Parse XML string for specific value (Recursive) ... Public Function GetXMLNodeValue(ByVal argNode, argValue) Dim ChildNode, ChildNodeList, NodeName, Remainder, p p = InStr(argValue, "/") If (p = 0) Then NodeName = argValue Remainder = "" Else NodeName = Left(argValue, p - 1) Remainder = Mid(argValue, p + 1) End If Set ChildNodeList = argNode.ChildNodes For Each ChildNode In ChildNodeList If (ChildNode.NodeName = NodeName) Then Select Case (Remainder = "") Case True : GetXMLNodeValue = ChildNode.Text Case False : GetXMLNodeValue = GetXMLNodeValue(ChildNode, Remainder) End Select Exit Function End If Next End Function ' XMLToTable() - Convert XML stream to table ... Public Sub XMLToTable(ByVal argXMLString, ByVal argElementName, ByVal argIndexName, ByVal argValueName, ByRef argTable) Dim XMLDoc, Element, ElementList ' Create an XML document from file ... Set XMLDoc = Server.CreateObject("Msxml2.DOMDocument") XMLDoc.LoadXML(argXMLString) ' Parse reply ... Set ElementList = XMLDoc.GetElementsByTagName(argElementName) For Each Element in ElementList argTable(GetXMLNodeValue(Element, argIndexName)) = _ GetXMLNodeValue(Element, argValueName) Next ' Clean up ... Set ElementList = Nothing : Set XMLDoc = Nothing End Sub ' SetShipDate() - Set ship date on order range ... Public Sub SetShipDate(ByVal argOrderNoLow, ByVal argOrderNoHigh, ByVal argSendShippedMail, ByRef argCount) Dim Body, SQL, rs, Template, ReturnValue ' Create a record set ... Set rs = Server.CreateObject("ADODB.Recordset") ' Set "Shipped Date" to today, clear CC Info if required ... SQL = "Select * FROM Orders " & _ "WHERE OrderID >= " & argOrderNoLow & " AND OrderID <= " & argOrderNoHigh rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic argCount = 0 Do While Not rs.EOF rs("ShipDate") = Date() ' Clear CC Info if enabled ... If (cstDeleteCCInfoAfterUse) Then Call ClearCCInfo(rs) End If argCount = argCount + 1 rs.MoveNext Loop rs.Close ' Send shipped e-mail if required ... If (argSendShippedMail) Then ' Retrieve this order record from the data base ... SQL = "SELECT " & _ "Orders.OrderID AS OrderNo, " & _ "Orders.TrackingNo AS TrackingNo, " & _ "Orders.OrderDate AS OrderDate, " & _ "Orders.PaymentAmount AS PaymentAmount, " & _ "Customers.ContactFirstName AS BillToFirstName, " & _ "Customers.ContactLastName AS BillToLastName, " & _ "Customers.CompanyName AS BillToCompanyName, " & _ "Customers.BillingAddress1 AS BillToAddress1, " & _ "Customers.BillingAddress2 AS BillToAddress2, " & _ "Customers.City AS BillToCity, " & _ "Customers.StateOrProvince AS BillToStateOrProvince, " & _ "Customers.PostalCode AS BillToPostalCode, " & _ "Customers.Country AS BillToCountry, " & _ "Customers.PhoneNumber AS BillToPhone, " & _ "Customers.EmailAddress AS BillToEMail, " & _ "Orders.ShipContactFirstName AS ShipToFirstName, " & _ "Orders.ShipContactLastName AS ShipToLastName, " & _ "Orders.ShipCompanyName AS ShipToCompanyName, " & _ "Orders.ShipOrganization AS ShipToOrganization, " & _ "Orders.ShipAddress1 AS ShipToAddress1, " & _ "Orders.ShipAddress2 AS ShipToAddress2, " & _ "Orders.ShipCity AS ShipToCity, " & _ "Orders.ShipStateOrProvince AS ShipToStateOrProvince, " & _ "Orders.ShipPostalCode AS ShipToPostalCode, " & _ "Orders.ShipCountry AS ShipToCountry, " & _ "Orders.ShipPhoneNumber AS ShipToPhone " & _ "FROM Orders, Customers " & _ "WHERE Orders.CustomerID = Customers.CustomerID AND " & _ " OrderID >= " & argOrderNoLow & " AND OrderID <= " & argOrderNoHigh rs.Open SQL, Conn, adOpenKeyset, adLockOptimistic Template = ReadFile("\custom\cart\tShipped.txt") Do While Not rs.EOF ' Substitute user variables ... Body = Template Body = Replace(Body, "$(OrderNo)", rs("OrderNo") + cstOrderStartNo) Body = Replace(Body, "$(TrackingNo)", rs("TrackingNo") & "") Body = Replace(Body, "$(OrderDate)", FormatDateTime(rs("OrderDate"), vbShortDate)) Body = Replace(Body, "$(TodayDate)", FormatDateTime(Date(), vbShortDate)) Body = Replace(Body, "$(CatalogName)", cstCatalogName) Body = Replace(Body, "$(HomeURL)", cstHomeURL) Body = Replace(Body, "$(BillToFirstName)", rs("BillToFirstName")) Body = Replace(Body, "$(BillToLastName)", rs("BillToLastName")) Body = Replace(Body, "$(BillToCompanyName)", rs("BillToCompanyName")) Body = Replace(Body, "$(BillToAddress1)", rs("BillToAddress1")) Body = Replace(Body, "$(BillToAddress2)", rs("BillToAddress2")) Body = Replace(Body, "$(BillToCity)", rs("BillToCity")) Body = Replace(Body, "$(BillToStateOrProvince)", rs("BillToStateOrProvince")) Body = Replace(Body, "$(BillToPostalCode)", rs("BillToPostalCode")) Body = Replace(Body, "$(BillToCountry)", rs("BillToCountry")) Body = Replace(Body, "$(BillToPhone)", rs("BillToPhone")) Body = Replace(Body, "$(ShipToFirstName)", rs("ShipToFirstName")) Body = Replace(Body, "$(ShipToLastName)", rs("ShipToLastName")) Body = Replace(Body, "$(ShipToCompanyName)", rs("ShipToCompanyName")) Body = Replace(Body, "$(ShipToAddress1)", rs("ShipToAddress1")) Body = Replace(Body, "$(ShipToAddress2)", rs("ShipToAddress2")) Body = Replace(Body, "$(ShipToCity)", rs("ShipToCity")) Body = Replace(Body, "$(ShipToStateOrProvince)", rs("ShipToStateOrProvince")) Body = Replace(Body, "$(ShipToPostalCode)", rs("ShipToPostalCode")) Body = Replace(Body, "$(ShipToCountry)", rs("ShipToCountry")) Body = Replace(Body, "$(ShipToPhone)", rs("ShipToPhone")) ' Call user exit for ship message adjustment or replacement ... Call UserExit(usrShipMsgAdjust, Conn, 0, 0, 0, Body) ' Send it ... Call SendEMail(cstFromEMailAddress, rs("BillToEMail"), "Your order has shipped", Body) ' Call user exit for possible affiliate notification ... Call UserExit(usrShipNotify, Conn, _ CLng(Request.QueryString("OrderID") - cstOrderStartNo), _ rs("PaymentAmount"), _ rs, _ ReturnValue) rs.MoveNext Loop rs.Close End If Set rs = Nothing End Sub %>