<%Option Explicit%><%

' DB Access
Dim objConn
Dim acDSN
Dim sWebServer

sWebServer = Request.ServerVariables("SERVER_NAME")
sWebServer = "sql7.globalgold.co.uk"

acDSN = "PROVIDER=SQLOLEDB; DATA SOURCE=" & sWebServer & ";Uid=pchelpcentre;Pwd=helpPC;DataBase=pchelpcentre"

' Misc
Const lEncryptKey = 72
Const sBaseURL = "http://www.pchelpcentre.com/"
Const sBaseDir = "/"
Const sAdminEmail = "sales@pchelpcentre.com"
' Const sAdminEmail = "martin@aclweb.com"
Const bDebug = False

' Logins
Const sAdminLogin = "administrator"
Const sAdminPassword = "faxtree"

' Payment Methods
Const lPaymentOnline = 1
Const lPaymentFax = 2
Const lPaymentCheque = 3

' Currency
Const lCurrPounds = 1
Const lCurrDollars = 2
Const lCurrEuro = 3

' Settings (From tblSettings)
Const lSettingDownloadDays = 1
Const lSettingDownloadTimes = 2

' Order Status
Const lOrderStatusNotProcessed = 1
Const lOrderStatusCleared = 2
Const lOrderStatusDeclined = 3
Const lOrderStatusReadyToShip = 4
Const lOrderStatusDespatched = 5

' Shipment Types
Const lShipmentDelivery = 1
Const lShipmentDownload = 2

' Products
Const lProdClassicSupport = 1
Const lProdClassicSupportDaraR = 2
Const lProdNetworkSupport = 3
Const lProdPremiumSupport = 4
Const lProdReviverDataR = 5
Const lProdReviver = 6

' WorldPay
Const wpDelayDay = 1
Const wpDelayWeek = 2
Const wpDelayMonth = 3
Const wpDelayYear = 4

Function OpenDB()

    If VarType(objConn) = vbString Then 
        ' It's already been set to a string, which means that the database 
        ' object has been set and/ or the object contains a connection string
        
        If objConn.State = adStateOpen Then
            ' Already open - no need to open again
            OpenDB = True
            Exit Function
        End If
        
    End If

    ' On Error Resume Next    
    Set objConn = Server.CreateObject("ADODB.Connection")
    objConn.Open acDSN
    OpenDB = (Err = 0)
    
End Function

Function CloseDB()

    If VarType(objConn) = vbString Then
        ' On Error Resume Next
        
        If objConn.State = adStateOpen Then
            objConn.Close
        End If
        
        Set objConn = Nothing
        CloseDB = (Err = 0)
    End If

End Function

Sub PrevNextNav(ByVal sPrevPage, ByVal sNextPage)

    ' Navigates using default buttons and pages passed in

    Dim sTimeString
    Dim lPrevVal
    Dim lNextVal
    Dim bDefault

    sTimeString = "dDate=" & Server.URLEncode(Now)

    If InStr(sPrevPage, "?") > 0 Then
        sPrevPage = sPrevPage & "&" & sTimeString
    ElseIf InStr(sPrevPage, "&") > 0 Then
        sPrevPage = sPrevPage & "&" & sTimeString
    Else
        sPrevPage = sPrevPage & "?" & sTimeString
    End If

    If InStr(sNextPage, "?") > 0 Then
        sNextPage = sNextPage & "&" & sTimeString
    ElseIf InStr(sNextPage, "&") > 0 Then
        sNextPage = sNextPage & "&" & sTimeString
    Else
        sNextPage = sNextPage & "?" & sTimeString
    End If

    lPrevVal = Request.Form("cmdBack.x")
    lNextVal = Request.Form("cmdNext.x")
    bDefault = (lPrevVal = "0" Or lNextVal = "0")

    If bDefault And sNextPage <> "" Then
        Response.Redirect sNextPage
    End If
    
    If Not IsEmpty(Request.Form("cmdBack.x")) And sPrevPage <> "" Then
        Response.Redirect sPrevPage
    ElseIf Not IsEmpty(Request.Form("cmdNext.x")) And sNextPage <> "" Then
        Response.Redirect sNextPage
    End If

End Sub

Function GetCounties()

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetCounties"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    Set GetCounties = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetPlatforms()

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetPlatforms"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    Set GetPlatforms = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetUserName()
    Dim sFirstName, sLastName
    GetUser lCurrentuserID, Null, Null, Null, Null, Null, Null, Null, sFirstName, sLastName
    GetUserName = MakeNameEmail(Null, sFirstName, sLastName)
End Function

Function GetProducts()

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetProducts"
    cmdSQLProc.CommandType = adCmdStoredProc
    Set GetProducts = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetProductsPreSelected(sProductIDs, ByVal lCurrencyID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetProducts"
    cmdSQLProc.CommandType = adCmdStoredProc
    
    If IsVoid(lCurrencyID) Then
        lCurrencyID = Null
    End If
    
    cmdSQLProc.Parameters("@lCurrencyID") = lCurrencyID
    cmdSQLProc.Parameters("@sProductIDs") = sProductIDs
    
    Set GetProductsPreSelected = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetCountries()

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetCountries"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    Set GetCountries = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetPaymentMethods()

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetPaymentMethods"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    Set GetPaymentMethods = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Sub GetCountyCountry(lCountyID, lCountryID, sCountyName, sCountry)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetCountyCountry"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lCountyID") = lCountyID
    cmdSQLProc.Parameters("@lCountryID") = lCountryID
    cmdSQLProc.Execute
    sCountyName = cmdSQLProc.Parameters("@sCountyName")
    sCountry = cmdSQLProc.Parameters("@sCountry")

    Set cmdSQLProc = Nothing
End Sub

Function SendConfirmEmail()



End Function

Function MakeProductSummary2(lOrderTotal, lOrderTotalGBP, lMonthlyTotal, lMonthlyTotalGBP, sSelectedProductIDs, lCurrencyID)

    Dim sOutput
    Dim lProductID
    Dim lQuantity
    Dim lProductLoop
    Dim rsProducts
    
    Dim lPrice      ' Item subtotal 
    Dim lPriceGBP   ' Item subtotal GBP
    
    Dim lMonthly    ' Monthly item subtotal
    Dim lMonthlyGBP ' Monthly item subtotal GBP
    
    Dim bStart
    Dim sSymbol
    
    Dim bMonthly ' True if there are any monthly payments involved
            
    Set rsProducts = GetProductsPreSelected(sSelectedProductIDs, lCurrencyID)
    lOrderTotal = 0
    lOrderTotalGBP = 0
    
    lMonthlyTotal = 0
    lMonthlyTotalGBP = 0
    
    bStart = True
    bMonthly = False
    
    If bDebug Then Response.Write "lCurrencyID = " & lCurrencyID & "<BR>"
        
    For lProductLoop = 1 To 2
    
        While Not rsProducts.EOF
        
            If bStart Then
                sSymbol = rsProducts("sSymbol")
                bStart = False
            End If
    
            lProductID = rsProducts("lProductID")
            
            If bDebug Then Response.Write "QueryString = " & Request.QueryString & "<BR>"
            If bDebug Then Response.Write "sSelectedProductIDs = " & sSelectedProductIDs & "<BR>"
    
            If rsProducts("bSelected") = 1 Then
                
                lQuantity = Val(Request.QueryString("txtQty" & lProductID))
                                
                lPrice = lQuantity * rsProducts("lPrice")
                lPriceGBP = lQuantity * rsProducts("lPriceGBP")
                
                If bDebug Then Response.Write "lProductID = " & lProductID & "<BR>"
                If bDebug Then Response.Write "lPrice = " & lPrice & "<BR>"
                If bDebug Then Response.Write "lQuantity = " & lQuantity & "<BR>"
                
                lMonthly = lQuantity * rsProducts("lMonthly")
                lMonthlyGBP = lQuantity * rsProducts("lMonthlyGBP")
                                
                If rsProducts("lMonthly") > 0 Then
                    bMonthly = True
                    sOutput = sOutput & rsProducts("sProductName") & _
                        " (x" & lQuantity & ") " & _
                        sSymbol & FormatNumber(lMonthly) & " / month" & vbCrLf
                End If
                
                If rsProducts("lPrice") > 0 Then
                    sOutput = sOutput & rsProducts("sProductName") & _
                        " (x" & lQuantity & ") " & _
                        sSymbol & FormatNumber(lPrice) & vbCrLf
                End If    
                
                lMonthlyTotal = lMonthlyTotal + lMonthly
                lMonthlyTotalGBP = lMonthlyTotalGBP + lMonthlyGBP

                lOrderTotal = lOrderTotal + lPrice + lMonthly
                lOrderTotalGBP = lOrderTotalGBP + lPriceGBP + lMonthlyGBP
                
                If bDebug Then Response.Write "lPrice = " & lPrice & "<BR>"
                
            End If

            rsProducts.moveNext
        Wend
    
        If lProductLoop = 1 Then
            Set rsProducts = rsProducts.NextRecordset
        End If
    
    Next
    
    If bDebug Then Response.Write "lOrderTotal = " & lOrderTotal & "<BR>"
    If bDebug Then Response.Write "sSelectedProductIDs = " & sSelectedProductIDs & "<BR>"
    If bDebug Then Response.End

    
    sOutput = sOutput & vbCrLf & vbCrLf & "Total: " & sSymbol & FormatNumber(lOrderTotal, 2) & vbCrLf
    If bMonthly Then
        sOutput = sOutput & "(Includes initial monthly cost of: " & sSymbol & FormatNumber(lMonthlyTotal, 2) & ")" & vbCrLf
    End If
    MakeProductSummary2 = sOutput
    
End Function

Function MakeProductSummaryEmail(lOrderID, bDownloadable, sName, sEmail, sPassword)

    Dim sOutput
    Dim lProductID
    Dim lQuantity
    Dim lProductLoop
    Dim rsProducts
    
    Dim lPrice      ' Item subtotal 
    Dim lPriceGBP   ' Item subtotal GBP
    
    Dim lMonthly    ' Monthly item subtotal
    Dim lMonthlyGBP ' Monthly item subtotal GBP
    
    Dim bStart
    Dim sSymbol
    
    Dim bMonthly ' True if there are any monthly payments involved
    
    Dim lOrderTotalGBP, lMonthlyTotal, lMonthlyTotalGBP, sSelectedProductIDs, lCurrencyID
            
    Set rsProducts = GetOrder(lOrderID)
    
    lOrderTotal = 0
    lOrderTotalGBP = 0
    
    lMonthlyTotal = 0
    lMonthlyTotalGBP = 0
    
    bStart = True
    bMonthly = False
    bDownloadable = False

    While Not rsProducts.EOF
    
        If bStart Then
            sSymbol = rsProducts("sSymbol")
            sName = MakenameEmail("", rsProducts("sFirstName"), rsProducts("sLastName"))
            sEmail = rsProducts("sEmail")
            sPassword = rsProducts("sPassword")
            bStart = False
        End If
    
        lProductID = rsProducts("lProductID")
    
        If rsProducts("bSelected") = 1 Then
                
            lQuantity = rsProducts("lQuantity")
                
            lPrice = lQuantity * rsProducts("lPrice") / rsProducts("lToGB")
            lPriceGBP = lQuantity * rsProducts("lPrice")
                
            lMonthly = lQuantity * rsProducts("lMonthly") / rsProducts("lToGB")
            lMonthlyGBP = lQuantity * rsProducts("lMonthly")
                                
            If rsProducts("lMonthly") > 0 Then
                bMonthly = True
                sOutput = sOutput & rsProducts("sProductName") & _
                    " (x" & lQuantity & ") " & _
                    sSymbol & FormatNumber(lMonthly) & " / month" & vbCrLf
            End If
                
            If rsProducts("lPrice") > 0 Then
                sOutput = sOutput & rsProducts("sProductName") & _
                    " (x" & lQuantity & ") " & _
                    sSymbol & FormatNumber(lPrice) & vbCrLf
            End If
            
            If rsProducts("lShipmentTypeID") = lShipmentDownload And _
                Not IsNull(rsProducts("sDownloadFile")) Then
                bDownloadable = True
            End If
                
            lMonthlyTotal = lMonthlyTotal + lMonthly
            lMonthlyTotalGBP = lMonthlyTotalGBP + lMonthlyGBP

            lOrderTotal = lOrderTotal + lPrice + lMonthly
            lOrderTotalGBP = lOrderTotalGBP + lPriceGBP + lMonthlyGBP
                
        End If

        rsProducts.MoveNext
    Wend
        
    sOutput = sOutput & vbCrLf & vbCrLf & "Total: " & sSymbol & FormatNumber(lOrderTotal, 2) & vbCrLf
    If bMonthly Then
        sOutput = sOutput & "(Includes initial monthly cost of: " & sSymbol & FormatNumber(lMonthlyTotal, 2) & ")" & vbCrLf
    End If
    
    MakeProductSummaryEmail = sOutput
    
End Function

Sub SaveUser(lUserID, sCompanyName, sFirstName, sLastName, sAddress1, _
    sAddress2, sAddress3, sTown, lCountyID, sStateProvince, sPostCode, lCountryID, _
    sTelephone, sModem, bMonthlyReport, sEmail, sPassword)

    Dim cmdSQLProc
    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPSaveUser"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    
    If IsEmpty(lUserID) Then lUserID = Null

    cmdSQLProc.Parameters("@lUserID") = lUserID
    cmdSQLProc.Parameters("@sCompanyName") = sCompanyName
    cmdSQLProc.Parameters("@sFirstName") = sFirstName
    cmdSQLProc.Parameters("@sLastName") = sLastName
    cmdSQLProc.Parameters("@sAddress1") = sAddress1
    cmdSQLProc.Parameters("@sAddress2") = sAddress2
    cmdSQLProc.Parameters("@sAddress3") = sAddress3
    cmdSQLProc.Parameters("@sTown") = sTown
    cmdSQLProc.Parameters("@lCountyID") = lCountyID
    cmdSQLProc.Parameters("@sStateProvince") = sStateProvince
    cmdSQLProc.Parameters("@sPostCode") = sPostCode
    cmdSQLProc.Parameters("@lCountryID") = lCountryID
    cmdSQLProc.Parameters("@sTelephone") = sTelephone
    cmdSQLProc.Parameters("@sModem") = sModem
    cmdSQLProc.Parameters("@bMonthlyReport") = bMonthlyReport
    cmdSQLProc.Parameters("@sEmail") = sEmail
    cmdSQLProc.Parameters("@sPassword") = sPassword

    cmdSQLProc.Execute

    lUserID = cmdSQLProc.Parameters("@lUserID")

    Set cmdSQLProc = Nothing
End Sub

Sub SaveOrder(lOrderID, lUserID, lPaymentMethodID, dStartDate, lShipmentTypeID, sPlatform, lCurrencyID, sOther)

	Dim cmdSQLProc
	Set cmdSQLProc = Server.CreateObject("ADODB.Command")
	Set cmdSQLProc.ActiveConnection = objConn
	cmdSQLProc.CommandText = "acSPSaveOrder"
	cmdSQLProc.CommandType = adCmdStoredProc
	cmdSQLProc.Parameters.Refresh
	
    If IsEmpty(lOrderID) Then lOrderID = Null


	cmdSQLProc.Parameters("@lOrderID") = lOrderID
	cmdSQLProc.Parameters("@lUserID") = lUserID
	cmdSQLProc.Parameters("@lPaymentMethodID") = lPaymentMethodID
	cmdSQLProc.Parameters("@dStartDate") = dStartDate
	cmdSQLProc.Parameters("@lShipmentTypeID") = lShipmentTypeID
	cmdSQLProc.Parameters("@sPlatform") = sPlatform
	cmdSQLProc.Parameters("@lCurrencyID") = lCurrencyID
	cmdSQLProc.Parameters("@sOther") = sOther

	cmdSQLProc.Execute

	lOrderID = cmdSQLProc.Parameters("@lOrderID")
	Set cmdSQLProc = Nothing
End Sub

Sub SaveOrderItem(lOrderID, lProductID, lQuantity)

	Dim cmdSQLProc
	Set cmdSQLProc = Server.CreateObject("ADODB.Command")
	Set cmdSQLProc.ActiveConnection = objConn
	cmdSQLProc.CommandText = "acSPSaveOrderItem"
	cmdSQLProc.CommandType = adCmdStoredProc
	cmdSQLProc.Parameters.Refresh

	cmdSQLProc.Parameters("@lOrderID") = lOrderID
	cmdSQLProc.Parameters("@lProductID") = lProductID
	cmdSQLProc.Parameters("@lQuantity") = lQuantity

	cmdSQLProc.Execute

	lOrderID = cmdSQLProc.Parameters("@lOrderID")
	Set cmdSQLProc = Nothing
End Sub

Sub SaveOrderItems(lOrderID)

    Dim sItem
    Dim lProductID
    Dim lQuantity

    For Each sItem In Request.QueryString

        If Left(sItem, 6) = "txtQty" Then
    
            lProductID = Val(Mid(sItem, 7))
    
            If Val(Request.QueryString("radPackage")) = lProductID Or _
                Val(Request.QueryString("chkProduct" & lProductID)) = lProductID Then
                
                lQuantity = Val(Request.QueryString(sItem))
                SaveOrderItem lOrderID, lProductID, lQuantity

            End If
             
        End If
        
    Next

End Sub

Function GetOrderSummary(dStartDate, dEndDate, bCleared, bDeclined, bManual, bReadyToShip, bDespatched)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetOrderSummary"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@dStartDate") = dStartDate
    cmdSQLProc.Parameters("@dEndDate") = dEndDate
    cmdSQLProc.Parameters("@bCleared") = bCleared
    cmdSQLProc.Parameters("@bDeclined") = bDeclined
    cmdSQLProc.Parameters("@bManual") = bManual
    cmdSQLProc.Parameters("@bReadyToShip") = bReadyToShip
    cmdSQLProc.Parameters("@bDespatched") = bDespatched
    Set GetorderSummary = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetUser(lUserID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetUser"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lUserID") = lUserID
    Set GetUser = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetUserOrders(lUserID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetUserOrders"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lUserID") = lUserID
    Set GetUserOrders = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetOrder(lOrderID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetOrder"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lOrderID") = lOrderID
    Set GetOrder = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetOrderStatus(lOrderID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetOrderStatus"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lOrderID") = lOrderID
    cmdSQLProc.Execute
    GetOrderStatus = cmdSQLProc.Parameters("@lOrderStatusID")

    Set cmdSQLProc = Nothing
End Function

Sub SaveOrderStatus(lOrderID, lOrderStatusID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPSaveOrderStatus"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lOrderID") = lOrderID
    cmdSQLProc.Parameters("@lOrderStatusID") = lOrderStatusID
    cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Sub

Function GetOrderStatusList()

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetOrderStatusList"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    Set GetOrderStatusList = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetCurrencies(lCurrencyID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetCurrencies"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lCurrencyID") = lCurrencyID
    Set GetCurrencies = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Sub SaveCurrency(lCurrencyID, lToGB)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPSaveCurrency"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lCurrencyID") = lCurrencyID
    cmdSQLProc.Parameters("@lToGB") = lToGB
    cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Sub

Sub SaveSetting(lSettingID, sSetting)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPSaveSetting"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lSettingID") = lSettingID
    cmdSQLProc.Parameters("@sSetting") = sSetting
    cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Sub

Function GetSettings(lSettingID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetSettings"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lSettingID") = lSettingID
    Set GetSettings = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetOrderTotal(lOrderID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetOrderTotal"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lOrderID") = lOrderID
    cmdSQLProc.Execute
    GetOrderTotal = cmdSQLProc.Parameters("@lTotal")

    Set cmdSQLProc = Nothing
End Function

Function GetOrderSummaryFAX(lOrderID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetOrderSummaryFAX"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lOrderID") = lOrderID
    Set GetOrderSummaryFAX = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetUserFromOrderID(lOrderID)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetUserFromOrderID"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lOrderID") = lOrderID
    Set GetUserFromOrderID = cmdSQLProc.Execute

    Set cmdSQLProc = Nothing
End Function

Function GetUserID(sEmail, sPassword)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetUserID"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@sEmail") = sEmail
    cmdSQLProc.Parameters("@sPassword") = sPassword
    cmdSQLProc.Execute
    GetUserID = cmdSQLProc.Parameters("@lUserID")

    Set cmdSQLProc = Nothing
End Function

Function GetOrderID(sEmail, sPassword)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPGetOrderID"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@sEmail") = sEmail
    cmdSQLProc.Parameters("@sPassword") = sPassword
    cmdSQLProc.Execute
    GetOrderID = cmdSQLProc.Parameters("@lOrderID")

    Set cmdSQLProc = Nothing
End Function

Sub CheckDownload(lUserID, lProductID, sDownloadFile, sMessage)

    Dim cmdSQLProc
    Dim rsResults

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPCheckDownload"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@lUserID") = lUserID
    cmdSQLProc.Parameters("@lProductID") = lProductID
    cmdSQLProc.Execute
    sDownloadFile = cmdSQLProc.Parameters("@sDownloadFile")
    sMessage = cmdSQLProc.Parameters("@sMessage")

    Set cmdSQLProc = Nothing
End Sub

Function CheckEmail(sEmail)

    Dim cmdSQLProc
    Dim bExists

    Set cmdSQLProc = Server.CreateObject("ADODB.Command")
    Set cmdSQLProc.ActiveConnection = objConn
    cmdSQLProc.CommandText = "acSPCheckEmail"
    cmdSQLProc.CommandType = adCmdStoredProc
    cmdSQLProc.Parameters.Refresh
    cmdSQLProc.Parameters("@sEmail") = sEmail
    cmdSQLProc.Execute
    CheckEmail = Not cmdSQLProc.Parameters("@bExists")

    Set cmdSQLProc = Nothing
End Function

Sub CheckAdminLogin()

    Dim sLogin
    Dim sPassword
    
    sLogin = Request.Cookies("sLogin")
    sPassword = Request.Cookies("sPassword")
    
    If Not (sLogin = sAdminLogin And sPassword = sAdminPassword) Then
       Response.Redirect sBaseURL 
    End if

End Sub

Function GetFuturePayDate(ByVal dDate)

    Dim sOutput
    Dim sDay, sMonth, sYear
    
    dDate = CDate(dDate)
    
    sDay = Day(dDate)
    sMonth = Month(dDate)
    sYear = Year(dDate)
    
    sOutput = sYear & "-" & sMonth & "-" & sDay
    
    GetFuturePayDate = sOutput

End Function

Function GetWPCurrencyID(lCurrencyID)
    Select Case lCurrencyID
        Case lCurrPounds
            GetWPCurrencyID = "GBP"
        Case lCurrDollars
            GetWPCurrencyID = "USD"
        Case lCurrEuro
            GetWPCurrencyID = "EUR"
    End Select
End Function

Function GetWPCountryID(lCurrencyID)
    Select Case lCurrencyID
        Case lCurrPounds
            GetWPCountryID = "GB"
        Case lCurrDollars
            GetWPCountryID = "US"
        Case lCurrEuro
            GetWPCountryID = "EU" ' Not sure this is correct
    End Select
End Function



%>
<%Dim sListBoxWidthsListBoxWidth = ""' For date drop downsDim lDefaultStartYearlDefaultStartYear = Year(Date) - 1Dim objDynSQLProcSub DynamicSPSetup( sProcName )    On Error Resume Next    Set objDynSQLProc = Server.CreateObject("ADODB.Command")    Set objDynSQLProc.ActiveConnection = objConn    objDynSQLProc.CommandText = CStr(sProcName)    objDynSQLProc.CommandType = adCmdStoredProc    objDynSQLProc.Parameters.RefreshEnd SubSub DynamicSPParams( sParamName, ByVal sParamValue )    On Error Resume Next    If ( IsVoid(sParamValue) = True ) Then        sParamValue = Null    End If    objDynSQLProc.Parameters(CStr(sParamName)) = sParamValueEnd SubSub DynamicSPExec()    On Error Resume Next    objDynSQLProc.Execute    Set objDynSQLProc = NothingEnd SubSub DebugPrint(sOutputText) Response.Write "<!--" Response.Write sOutputText Response.Write "-->" & vbCrLfEnd SubFunction IISRedirect( sMyURL)    Response.Buffer = True    Response.Clear    Response.Status = "301 Moved"    Response.AddHeader "Location" , sMyURL    Response.EndEnd FunctionFunction ZeroPad(lInputNumber, lLength)    ' Pads a number out to make sure it contains a specific number of preceding zeros    Dim lInputLength    Dim lZerosToAdd    Dim sZeros        sZeros = ""    If IsVoid(lInputNumber) Then lInputNumber = 0    lInputNumber = CStr(lInputNumber)    lInputLength = Len(lInputNumber)    If lInputLength < lLength Then        lZerosToAdd = lLength - lInputLength        sZeros = String(lZerosToAdd, "0")    End If    ZeroPad = sZeros & lInputNumber    End FunctionFunction SpacePad(ByVal sInput, lLength)    ' Pads a number out to make sure it contains a specific number of preceding spaces    Dim lInputLength    Dim lSpacesToAdd    Dim sSpaces        sSpaces = ""    If IsVoid(sInput) Then sInput = ""    sInput = CStr(sInput)    lInputLength = Len(sInput)    If lInputLength < lLength Then        lSpacesToAdd = lLength - lInputLength        sSpaces = String(lSpacesToAdd, " ")    End If    SpacePad = sInput & sSpaces    End FunctionFunction SpacePadR(ByVal sInput, lLength)    ' Reverse of the above        Dim lInputLength    Dim lSpacesToAdd    Dim sSpaces        sSpaces = ""    If IsVoid(sInput) Then sInput = ""    sInput = CStr(sInput)    lInputLength = Len(sInput)    If lInputLength < lLength Then        lSpacesToAdd = lLength - lInputLength        sSpaces = String(lSpacesToAdd, " ")    End If    SpacePadR = sSpaces & sInput    End FunctionFunction IsVoid( lParameter )    ' Thanks Ryan...    If ( IsEmpty( lParameter ) = True ) Then        IsVoid = True    ElseIf ( IsNull( lParameter ) = True ) Then        IsVoid = True    ElseIf ( Trim(lParameter) = "" ) Then        IsVoid = True    Else        IsVoid = False    End IfEnd FunctionFunction IIf(bArgument, sValueIfTrue, sValueIfFalse)    ' Same functionality as IIf in VB    ' Puts conditional value into 1 line of code        If bArgument Then        IIf = sValueIfTrue    Else        IIf = sValueIfFalse    End IfEnd FunctionFunction ReplaceNull(ByVal sInputString, sReplaceWith)        If IsNull(sInputString) Then        sInputString = sReplaceWith    End If        ReplaceNull = sInputStringEnd FunctionFunction ReplaceEmpty(ByVal sInputString, sReplaceWith)        If IsEmpty(sInputString) Then        sInputString = sReplaceWith    End If        ReplaceEmpty = sInputStringEnd FunctionFunction ReplaceVoid(ByVal sInputString, sReplaceWith)        If IsVoid(sInputString) Then        sInputString = sReplaceWith    End If        ReplaceVoid = sInputStringEnd FunctionFunction MakeListBox(sListBoxName, rsResults, sKeyField, _                                           sDataField, ByVal sSelectedIndex, sNotSetValue)    Dim sSelected    Dim sComboText    Dim bIncludeNotSet        Dim sStyle        If sListBoxWidth <> "" Then        sStyle = "Style=""width=" & sListBoxWidth & "px"" "    Else        sStyle = ""    End If    bIncludeNotSet = Not IsVoid(sNotSetValue)    sSelectedIndex = ReplaceVoid(sSelectedIndex, 0)        If Clng(sSelectedIndex) = 0 Or Clng(sSelectedIndex) = -1 Then        sSelected = " SELECTED"    Else        sSelected = ""    End If    sComboText = "<SELECT " & sStyle & "size=1 name=""" & sListBoxName & """>" & vbCrLf        If bIncludeNotSet Then        sComboText = sComboText & "<OPTION Value=""0""" & sSelected & ">" & _          sNotSetValue & "</OPTION>" & vbCrLf    End If    While Not rsResults.EOF        If CLng(rsResults(sKeyField)) = CLng(sSelectedIndex) Then            sSelected = " SELECTED"        Else            sSelected = ""        End If        sComboText = sComboText & "<OPTION Value=""" & rsResults(sKeyField) & _            """" & sSelected & ">" & rsResults(sDataField) & "</OPTION>" & vbCrLf        rsResults.MoveNext    Wend        rsResults.Close    Set rsResults = Nothing        sComboText = sComboText & "</SELECT>" & vbCrLf    MakeListBox = sComboTextEnd FunctionFunction MakeListBoxMulti(sListBoxName, rsResults, sKeyField, _                                           sDataField, sSelectedField, lListSize)    Dim sSelected    Dim sComboText    Dim sStyle        If sListBoxWidth <> "" Then        sStyle = "Style=""width=" & sListBoxWidth & "px"" "    Else        sStyle = ""    End If        sComboText = "<SELECT " & sStyle & "multiple size=" & lListSize & " name=""" & sListBoxName & """>" & vbCrLf        While Not rsResults.EOF        If sSelectedField <> "" Then            If CBool(rsResults(sSelectedField)) Then                sSelected = " SELECTED"            Else                sSelected = ""            End If        End If        sComboText = sComboText & "<OPTION Value=""" & rsResults(sKeyField) & _            """" & sSelected & ">" & rsResults(sDataField) & "</OPTION>" & vbCrLf        rsResults.MoveNext    Wend        rsResults.Close    Set rsResults = Nothing        sComboText = sComboText & "</SELECT>" & vbCrLf    MakeListBoxMulti = sComboTextEnd FunctionFunction MakeListBoxColour(sListBoxName, rsResults, sKeyField, _                                           sDataField, ByVal sSelectedIndex, _                                           sNotSetValue, sGroupField, sGroupColour)    ' sGroupColour = Red,Green,Blue                                               Dim sSelected    Dim sComboText        Dim bIncludeNotSet        Dim lGroupID    Dim lPrevGroupID    Dim sStyle    sStyle = "style=""background-color: rgb(" & sGroupColour & ");"" "        bIncludeNotSet = Not IsVoid(sNotSetValue)    sSelectedIndex = ReplaceVoid(sSelectedIndex, 0)        If Clng(sSelectedIndex) = 0 Or Clng(sSelectedIndex) = -1 Then        sSelected = " SELECTED"    Else        sSelected = ""    End If    sComboText = "<SELECT size=1 name=""" & sListBoxName & """>" & vbCrLf        If bIncludeNotSet Then        sComboText = sComboText & "<OPTION Value=""0""" & sSelected & ">" & _          sNotSetValue & "</OPTION>" & vbCrLf    End If        lGroupID = 0    lPrevGroupID = 0    While Not rsResults.EOF        If CLng(rsResults(sKeyField)) = CLng(sSelectedIndex) Then            sSelected = " SELECTED"        Else            sSelected = ""        End If                lGroupID = rsResults(sGroupField)                If lGroupID <> lPrevGroupID Then            sComboText = sComboText & "<OPTION " & sStyle & "Value=""0""" & sSelected & ">" & _                rsResults(sGroupField) & "</OPTION>" & vbCrLf        End If                sComboText = sComboText & "<OPTION Value=""" & rsResults(sKeyField) & _            """" & sSelected & ">" & rsResults(sDataField) & "</OPTION>" & vbCrLf                    lPrevGroupID = lGroupID                    rsResults.MoveNext    Wend        rsResults.Close    Set rsResults = Nothing        sComboText = sComboText & "</SELECT>" & vbCrLf    MakeListBoxColour = sComboTextEnd FunctionFunction MakeListBoxP(sListBoxName, rsResults, sKeyField, _                                            sDataField, ByVal sSelectedIndex, _                                            sFormName, sNotSetValue)    ' Same as MakeListBox, but automatically posts form when item is clicked on    Dim sSelected    Dim sComboText    Dim bIncludeNotSet    bIncludeNotSet = Not IsVoid(sNotSetValue)        sSelectedIndex = ReplaceVoid(sSelectedIndex, 0)        If Clng(sSelectedIndex) = 0 Or Clng(sSelectedIndex) = -1 Then        sSelected = " SELECTED"    Else        sSelected = ""    End If    sComboText = "<SELECT size=1 name=""" & sListBoxName & """" & _                                        " language=javascript onchange=""document." & sFormName & ".submit();"">" & vbCrLf                                            If bIncludeNotSet Then        sComboText = sComboText & "<OPTION Value=""0""" & sSelected & ">" & sNotSetValue & "</OPTION>" & vbCrLf    End If    While Not rsResults.EOF        If CLng(rsResults(sKeyField)) = CLng(sSelectedIndex) Then            sSelected = " SELECTED"        Else            sSelected = ""        End If        sComboText = sComboText & "<OPTION Value=""" & rsResults(sKeyField) & """" & sSelected & ">" & rsResults(sDataField) & "</OPTION>" & vbCrLf        rsResults.MoveNext    Wend        rsResults.Close    Set rsResults = Nothing        sComboText = sComboText & "</SELECT>" & vbCrLf    MakeListBoxP = sComboTextEnd Function' Makes a list box but allows the caller to insert additional code for JavaScript.'' The sIncludeNotSet field is a value:display pair separated by a colon.' The left hand side of the colon is the value for the blank item and the right hand' side of the field is the display text. This can be passed in as blank and will not' be used. An example of usage is passing the text in quotes ':' which will set a blank' value at the start of the list or '0:Please select an item' which will insert an initial' item which is selected (unless sSelectedIndex is set).' This field is only used when sSelectedIndex is not passed and is used as a hint for the user' to select an item.Function MakeListBoxJS(sListBoxName, rsResults, sKeyField, _                                            sDataField, ByVal sSelectedIndex, _                                            sJSSource, sIncludeNotSet)    Dim sSelected    Dim sComboText    Dim sSelectHint        sSelectedIndex = ReplaceVoid(sSelectedIndex, 0)    sComboText = "<SELECT size=1 name=""" & sListBoxName & """" & _                                        " " & sJSSource & ">" & vbCrLf    If IsVoid(sIncludeNotSet) = False And sSelectedIndex = 0 Then        sSelectHint = Split( sIncludeNotSet, ":" )        sComboText = sComboText & "<OPTION Value=""" & sSelectHint(0) & """ SELECTED>" & sSelectHint(1) & "</OPTION>" & vbCrLf    End If    While Not rsResults.EOF        If StrComp( rsResults(sKeyField), sSelectedIndex, vbTextCompare ) = 0 Then            sSelected = " SELECTED"        Else            sSelected = ""        End If        sComboText = sComboText & "<OPTION Value=""" & rsResults(sKeyField) & """" & sSelected & ">" & rsResults(sDataField) & "</OPTION>" & vbCrLf        rsResults.MoveNext    Wend            sComboText = sComboText & "</SELECT>" & vbCrLf    MakeListBoxJS = sComboTextEnd FunctionFunction IsWildCard(sInput)    Dim lSqBracketStart    Dim lSqBracketEnd    ' Checks to see if a string contains wildcard characters for sql Like command        IsWildCard = False        If Not IsVoid(sInput) Then        If InStr(1,sInput,"%") > 0 Then IsWildCard = True        If InStr(1,sInput,"_") > 0 Then IsWildCard = True                lSqBracketStart = InStr(1, sInput, "[")        lSqBracketEnd = InStr(1, sInput, "]")        If lSqBracketStart < lSqBracketEnd Then IsWildCard = True            End IfEnd FunctionFunction TextToHtml(ByVal sInputText)    ' Converts plain text to html for viewing. Stops people putting javascript etc. in    ' adverts        If Not IsNull(sInputText) Then        sInputText = Replace(sInputText, "&", "&amp;")        sInputText = Replace(sInputText, "<", "&lt;")        sInputText = Replace(sInputText, ">", "&gt;")        sInputText = Replace(sInputText, """", "&quot;")        sInputText = Replace(sInputText, vbCrLf, vbCr)        sInputText = Replace(sInputText, vbLf, vbCr)        sInputText = Replace(sInputText, vbCr, "<BR>" & vbCr)    End If        TextToHtml = sInputTextEnd FunctionFunction HtmlToText(ByVal sInputText)    If Not IsNull(sInputText) Then        sInputText = Replace(sInputText, "<BR>" & vbCr, vbCr)        sInputText = Replace(sInputText, "<BR>", vbCr)        sInputText = Replace(sInputText, "&lt;", "<")        sInputText = Replace(sInputText, "&gt;", ">")        sInputText = Replace(sInputText, "&amp;", "&")        sInputText = Replace(sInputText, "&quot;", """")    End If        HtmlToText = sInputTextEnd FunctionFunction MakeNumberListBox(sListBoxName, lStart, lEnd, ByVal sSelectedIndex, sNotSetText)    Dim sSelected    Dim sNumberCombo    Dim lCount    Dim lStep    Dim bIncludeNotSet ' Adds 'not set' text to list box        bIncludeNotSet = Not IsVoid(sNotSetText)        If lStart > lEnd Then        lStep = -1    Else        lStep = 1    End If        sSelectedIndex = ReplaceVoid(sSelectedIndex, 0)        If Clng(sSelectedIndex) = 0 Or Clng(sSelectedIndex) = -1 Then        sSelected = " SELECTED"    Else        sSelected = ""    End If    sNumberCombo = "<SELECT size=1 name=""" & sListBoxName & """>" & vbCrLf    If bIncludeNotSet Then        sNumberCombo = sNumberCombo & "<OPTION Value=""0""" & sSelected & ">" & sNotSetText & "</OPTION>" & vbCrLf    End If    For lCount = lStart To lEnd Step lStep        If CLng(lCount) = CLng(sSelectedIndex) Then            sSelected = " SELECTED"        Else            sSelected = ""        End If        sNumberCombo = sNumberCombo & "<OPTION Value=""" & lCount & _            """" & sSelected & ">" & lCount & "</OPTION>" & vbCrLf    Next            sNumberCombo = sNumberCombo & "</SELECT>" & vbCrLf    MakeNumberListBox = sNumberComboEnd FunctionFunction FullWeekDay(lWeekDay)    If lWeekDay < 1 Or lWeekDay > 7 Then        FullWeekDay = "ERROR: Weekday value out of range: " & lWeekDay    Else        Select Case lWeekDay            Case 1    FullWeekDay = "Sunday"            Case 2    FullWeekDay = "Monday"            Case 3    FullWeekDay = "Tuesday"            Case 4    FullWeekDay = "Wednesday"            Case 5    FullWeekDay = "Thursday"            Case 6    FullWeekDay = "Friday"            Case 7    FullWeekDay = "Saturday"        End Select    End IfEnd FunctionFunction FullMonthName(lMonthName)    If lMonthName < 1 Or lMonthName > 12 Then        FullWeekDay = "ERROR: Month value out of range: " & lMonthName    Else        Select Case lMonthName            Case 1    FullMonthName = "January"            Case 2    FullMonthName = "February"            Case 3    FullMonthName = "March"            Case 4    FullMonthName = "April"            Case 5    FullMonthName = "May"            Case 6    FullMonthName = "June"            Case 7    FullMonthName = "July"            Case 8    FullMonthName = "August"            Case 9    FullMonthName = "September"            Case 10    FullMonthName = "October"            Case 11    FullMonthName = "November"            Case 12    FullMonthName = "December"        End Select    End IfEnd FunctionFunction ComboMonthList(sName, ByVal lDefault)    Dim MonthList(12)    Dim lLoop    Dim sSelected    Dim sCombo    sCombo = "<SELECT Name='" & sName & "'>"    If ( IsVoid(lDefault) = True ) Then        sCombo = sCombo & "<OPTION VALUE=""""></OPTION>"    End If        If IsNumeric(lDefault) Then        lDefault = CLng(lDefault)    End If    MonthList(0) = "January"    MonthList(1) = "February"    MonthList(2) = "March"    MonthList(3) = "April"    MonthList(4) = "May"    MonthList(5) = "June"    MonthList(6) = "July"    MonthList(7) = "August"    MonthList(8) = "September"    MonthList(9) = "October"    MonthList(10) = "November"    MonthList(11) = "December"    For lLoop = 0 To 11        If lDefault = (lLoop + 1) Then            sSelected=" SELECTED "        Else            sSelected=""        End If        sCombo = sCombo & "<OPTION Value=" & lLoop + 1 & sSelected & ">" & MonthList(lLoop) & "</OPTION>"    Next    sCombo = sCombo & "</SELECT>"    ComboMonthList = sComboEnd FunctionFunction ComboDateList(sName, ByVal lDefault)    Dim lLoop    Dim sSelected    Dim sCombo    sCombo = "<SELECT Name='" & sName & "'>"    If ( IsVoid(lDefault) = True ) Then        sCombo = sCombo & "<OPTION VALUE=""""></OPTION>"    End If    If IsNumeric(lDefault) Then        lDefault = CLng(lDefault)    End If     For lLoop = 1 To 31        If lDefault = lLoop Then            sSelected=" SELECTED "        Else            sSelected=""        End If        sCombo = sCombo & "<OPTION Value=" & lLoop & sSelected & ">" & lLoop & "</OPTION>"    Next     sCombo = sCombo & "</SELECT>"    ComboDateList = sComboEnd FunctionFunction ComboYearList(sName, lStartYear, lEndYear, ByVal lDefault)    Dim lLoop    Dim sSelected    Dim sCombo    sCombo = "<SELECT Name='" & sName & "'>"    If ( IsVoid(lDefault) = True ) Then        sCombo = sCombo & "<OPTION VALUE=""""></OPTION>"    End If    If IsNumeric(lDefault) Then        lDefault = CLng(lDefault)    End If    For lLoop = lStartYear To lEndYear        If lDefault = lLoop Then            sSelected=" SELECTED "        Else            sSelected=""        End If        sCombo = sCombo & "<OPTION Value=" & lLoop & sSelected & ">" & lLoop & "</OPTION>"    Next     sCombo = sCombo & "</SELECT>"    ComboYearList = sComboEnd FunctionFunction MakeDateCombo(sPrefix, ByVal dDate)    Dim sDateCombo    Dim sMonthCombo    Dim sYearCombo    Dim sDateComboName    Dim sMonthComboName    Dim sYearComboName    Dim dToday    Dim lCurrYear    Dim lCurrDate    Dim lCurrMonth    Dim lDate    Dim lMonth    Dim lYear    If IsDate(dDate) Then        dDate = CDate(dDate)        lDate = Day(dDate)        lMonth = Month(dDate)        lYear = Year(dDate)    End If    sDateComboName = "lst" & sPrefix & "Date"    sMonthComboName = "lst" & sPrefix & "Month"    sYearComboName = "lst" & sPrefix & "Year"    dToday = Date()    lCurrDate = Day(dToday)    lCurrMonth = Month(dToday)    lCurrYear = Year(dToday)'    lDate = ReplaceVoid(lDate, lCurrDate)'    lMonth = ReplaceVoid(lMonth, lCurrMonth)'    lYear = ReplaceVoid(lYear, lCurrYear)    sDateCombo = ComboDateList(sDateComboName, lDate)    sMonthCombo = ComboMonthList(sMonthComboName, lMonth)    sYearCombo = ComboYearList(sYearComboName, lDefaultStartYear, lCurrYear + 10, lYear)    MakeDateCombo = sDateCombo & "/" & sMonthCombo & "/" & sYearComboEnd FunctionFunction GetDateComboVals(sPrefix, sDate)    Dim sDateComboName    Dim sMonthComboName    Dim sYearComboName    Dim lDate    Dim lMonth    Dim lYear    On Error Resume Next    sDateComboName = "lst" & sPrefix & "Date"    sMonthComboName = "lst" & sPrefix & "Month"    sYearComboName = "lst" & sPrefix & "Year"    lDate = Request.Form(sDateComboName)    lMonth = Request.Form(sMonthComboName)    lYear = Request.Form(sYearComboName)    sDate = CStr(lDate) & " " & FullMonthName(lMonth) & " " & CStr(lYear)    If IsDate(sDate) Then        sDate = CDate(sDate)    Else        sDate = Null    End If    GetDateComboVals = IsDate(sDate)End FunctionFunction GetYN(ByVal bBoolean)    If IsVoid(bBoolean) Then        bBoolean = False    End If    bBoolean = CBool(bBoolean)   If bBoolean Then     GetYN = "Y"   Else     GetYN = "N"   End IfEnd FunctionFunction GetYesNo(ByVal bBoolean)    If IsVoid(bBoolean) Then        bBoolean = False    End If    bBoolean = CBool(bBoolean)   If bBoolean Then     GetYesNo = "Yes"   Else     GetYesNo = "No"   End IfEnd FunctionFunction GetMonthName(lMonthNumber)    ' Get the name of the month from the month number    Dim sDateName     sDateName = FormatDateTime("01" & "/" & CStr(lMonthNumber) & "/1999", vbLongDate)    GetMonthName = Mid(sDateName, 4, InStr(4, sDateName, " ") - 4)End FunctionFunction CountWords(sInput)    Dim lCount    CountWords = 0        If Len(sInput) = 0 Then Exit Function        CountWords = CountWords + 1        For lCount = 1 To Len(sInput)        If Mid(sInput, lCount, 1) = " " Then            CountWords = CountWords + 1        End If    NextEnd FunctionFunction MakeName(ByVal sTitle, ByVal sFirstName, ByVal sLastName)  ' Constructs a name from title, first name and last name  ' for displaying in HTML   If Not IsVoid(sTitle) then       sTitle = sTitle & "&nbsp;"   Else       sTitle = ""   End If   If Not IsVoid(sFirstName) then       sFirstName = sFirstName & "&nbsp;"   Else       sFirstName = ""   End If   sLastName = ReplaceVoid(sLastName, "")   MakeName = Trim(sTitle & sFirstName & sLastName)End FunctionFunction MakeNameEmail(sTitle, sFirstName, sLastName)  ' Constructs a name from title, first name and last name  ' for displaying in an email   MakeNameEmail = Trim(ReplaceVoid(sTitle & " ", "") & _                        ReplaceVoid(sFirstName & " ", "") & _                        ReplaceVoid(sLastName, ""))End FunctionFunction CreateDropDownFromList( sName, sIndexList, sValueList, sSelectedKey )    Dim sIndexArray    Dim sValueArray    Dim lIndex    Dim sCombo    'On Error Resume Next    Err.Clear    sCombo = "<SELECT NAME=""" & sName & """>"    ' If we have not been passed a selected item, then create an empty first item.    If IsVoid(sSelectedKey) Then        sCombo = sCombo & "<OPTION></OPTION>"    End If    sIndexArray = Split( sIndexList, "," )    sValueArray = Split( sValueList, "," )    If IsArray( sIndexArray ) Then        For lIndex = 0 To UBound(sIndexArray)            If ( IsVoid(sIndexArray(lIndex)) = False ) Then                If ( StrComp( sSelectedKey, sIndexArray(lIndex), vbTextCompare ) = 0 ) Then                    sCombo = sCombo & "<OPTION SELECTED VALUE=" & sIndexArray(lIndex) & ">"                Else                    sCombo = sCombo & "<OPTION VALUE=" & sIndexArray(lIndex) & ">"                End If                sCombo = sCombo & sValueArray(lIndex)                sCombo = sCombo & "</OPTION>"            End If        Next        sCombo = sCombo & "</SELECT>"    End If    CreateDropDownFromList = sComboEnd FunctionFunction UnderlineText(sText)  Dim lLen  lLen = Len(sText)    UnderlineText = sText & vbCrLf & _                  String(lLen, "-") & vbCrLfEnd FunctionFunction FormatCurrencyEMail(ByVal lValue)    ' Format specifically for HCOL    If Not IsVoid(lValue) Then        lValue = CLng(lValue)      FormatCurrencyEMail = acsMIMEPound & FormatNumber(lValue, 2)    Else        FormatCurrencyEMail = acsMIMEPound & "0.00"    End If    End FunctionSub GetObjectStats(frmScan, sObjectPrefix, lMinVal, lMaxVal, lCount)        ' Gets the minimm and maximum values and the count of objects in a form        ' with a specified prefix. Usually, Request.Form is passed in as the        ' form to scan (frmScan)        ' Only works with objects named as Prefix[Number]        ' Tries to differentiate between chk12 And chkOtherCheckBox12        Dim sElement        Dim lObjectValue        Dim bObjectMatch    ' True if we've found an object with matching prefix        lCount = 0        lMinVal = 0        lMaxVal = 0    For Each sElement In frmScan            If Left(sElement, Len(sObjectPrefix)) = sObjectPrefix And _            IsNumeric(Mid(sElement, (Len(sObjectPrefix) + 1))) Then            bObjectMatch = True        Else            bObjectMatch = False        End If          If bObjectMatch Then                      lObjectValue = frmScan(sElement)                If IsNumeric(lObjectValue) Then                    lObjectValue = CLng(lObjectValue)                Else                    lObjectValue = 0                End If                        lCount = lCount + 1        If lMinVal = 0 Then          lMinVal = lObjectValue        End If        If lMaxVal = 0 Then          lMaxVal = lObjectValue        End If        If lObjectValue < lMinVal Then          lMinVal = lObjectValue        End If        If lObjectValue > lMaxVal Then          lMaxVal = lObjectValue        End If              End If    Next    End SubPublic Function GetAlphaNumber(ByVal lNumber)  Dim lUnits  Dim lTens  Dim lTensAndUnits  Dim lHundreds  Dim lThousands    If lNumber > 9999 Then    GetAlphaNumber = CStr(lNumber)    Exit Function  ElseIf lNumber = 0 Then    GetAlphaNumber = "Zero"    Exit Function  End If    Dim sNumber  sNumber = CStr(lNumber)    lUnits = CInt(Right(sNumber, 1))    If Len(sNumber) > 1 Then    lTens = Left(Right(lNumber, 2), 1)  Else    lTens = 0  End If    If Len(sNumber) > 2 Then    lHundreds = Left(Right(lNumber, 3), 1)  Else    lHundreds = 0  End If    If Len(sNumber) > 3 Then    lThousands = Left(Right(lNumber, 4), 1)  Else    lThousands = 0  End If    lTensAndUnits = lUnits + lTens * 10    Select Case lTensAndUnits    Case 0      GetAlphaNumber = ""    Case 1, 2, 3, 4, 5, 6, 7, 8, 9      GetAlphaNumber = SingleDigitToText(lTensAndUnits)    Case 10      GetAlphaNumber = "ten"    Case 11      GetAlphaNumber = "eleven"    Case 12      GetAlphaNumber = "twelve"    Case 13      GetAlphaNumber = "thirteen"    Case 14      GetAlphaNumber = "fourteen"    Case 15      GetAlphaNumber = "fifteen"    Case 16      GetAlphaNumber = "sixteen"    Case 17      GetAlphaNumber = "seventeen"    Case 18      GetAlphaNumber = "eighteen"    Case 19      GetAlphaNumber = "nineteen"    Case Else      Select Case lTens        Case 2          GetAlphaNumber = "twenty" & GetAlphaNumber        Case 3          GetAlphaNumber = "thirty" & GetAlphaNumber        Case 4          GetAlphaNumber = "forty" & GetAlphaNumber        Case 5          GetAlphaNumber = "fifty" & GetAlphaNumber        Case 6          GetAlphaNumber = "sixty" & GetAlphaNumber        Case 7          GetAlphaNumber = "seventy" & GetAlphaNumber        Case 8          GetAlphaNumber = "eighty" & GetAlphaNumber        Case 9          GetAlphaNumber = "ninety" & GetAlphaNumber      End Select            If lUnits > 0 Then        GetAlphaNumber = GetAlphaNumber & " " & SingleDigitToText(lUnits)      End If        End Select    If lHundreds > 0 Then    GetAlphaNumber = SingleDigitToText(lHundreds) & " hundred and " & GetAlphaNumber  End If    If lThousands > 0 Then    GetAlphaNumber = SingleDigitToText(lThousands) & " thousand " & GetAlphaNumber  End If  End FunctionFunction SingleDigitToText(lNumber)  Select Case lNumber    Case 0      SingleDigitToText = ""    Case 1      SingleDigitToText = "one"    Case 2      SingleDigitToText = "two"    Case 3      SingleDigitToText = "three"    Case 4      SingleDigitToText = "four"    Case 5      SingleDigitToText = "five"    Case 6      SingleDigitToText = "six"    Case 7      SingleDigitToText = "seven"    Case 8      SingleDigitToText = "eight"    Case 9      SingleDigitToText = "nine"  End Select  End Function' This function returns False if any of the following tests fail.'    1, At least one character before the @ symbol (email alias).'    2, At least two characters are between the @ and . symbols (domain name, hp, ibm etc).'    3, At least two characters follow the . symbol (zone, for example .fr, .co.uk or .com.'    4, A non empty string is passed.Function IsEmailValid( sAddress )    Dim bValid    Dim lAtSymbol    Dim lFullStop    bValid = False    If ( Trim(sAddress) <> "" ) Then        ' Scan the email address to make sure that it is valid.        ' First look for an @ symbol.        lAtSymbol = InStr( 1, sAddress, "@", vbTextCompare )        ' Check for no @ symbol, or if it is the first character.        If ( lAtSymbol > 1 ) Then            ' OK so far. No check that a full stop follows the @ symbol somewhere.            ' Also check if the domain name was less than two characters.            lFullStop = InStr( lAtSymbol, sAddress, ".", vbTextCompare )            If ( lFullStop <> 0 And (lFullStop - lAtSymbol >= 3 ) ) Then                ' OK again, now check that the zone (.com, .co.uk or .fr)                ' is more than two characters.                If ( Len( sAddress ) - lFullStop >= 2 ) Then                    bValid = True                End If            End If        End If    End If    IsEmailValid = bValidEnd Function' CryptInt - This function encripts or decrypts an integer based upon the key provided.' To encrypt pass the value and key to the function. To decrypt, pass the encrypted integer' through the function again with the same key.Function CryptInt(lValue,lKey)    CryptInt = lValue Xor lKeyEnd Function' CryptString - This function encrypts or decrypts a string based upon the key provided.' To encrypt pass the value and key to the function. To decrypt, pass the encrypted string' through the function again with the same key.Function CryptString(sValue,lKey)    Dim lLoop 'Used in the FOR loop    Dim lSKey 'The key used to encrypt/decrypt the string.    Dim sCryptValue 'Used to hold the encrypted/decrypted string    lSKey = lKey Mod 56 '56 is a value chosen at random. Any value between 1 and 254 would do    For lLoop = 1 To Len(sValue)        sCryptValue = sCryptValue + Chr(Asc(Mid(sValue,lLoop,1)) Xor lSKey)    Next    CryptString = sCryptValueEnd FunctionFunction ScriptNameNoQS()    ' Gets the script name of the page but extracts the querystring at the end, if there is one    Dim lQSPos    Dim sScriptname    sScriptName = Request.ServerVariables("SCRIPT_NAME")    lQSPos = InStr(1, sScriptName, "?")    If lQSPos > 0 Then        sScriptName = Left(sScriptName, lQSPos - 1)    End If    ScriptNameNoQS = sScriptNameEnd FunctionFunction GetFields(rsInfo)    ' For use with GetRows. Saves having to use constants, ie:    ' sUserName = sUsers(dictFields("lUserID"), lRowNumber)    ' Instead of:    ' sUserName = sUsers(0, lRowNumber)    ' Set dictFields = GetFields(rsOrganisations)    Dim lFieldCount    Dim sFieldName        Set GetFields = Server.CreateObject("Scripting.Dictionary")    If Not rsInfo.EOF Then        For lFieldCount = 0 To rsInfo.Fields.Count - 1            sFieldName = rsInfo.Fields(lFieldCount).Name                        If Not GetFields.Exists(sFieldName) Then                GetFields.Add sFieldName, lFieldCount            End If        Next    End IfEnd FunctionFunction MakeOptionList(sOptionListName, rsResults, sKeyField, _                                           sDataField, ByVal sSelectedIndex, sNotSetValue)    Dim sSelected    Dim sOptionListText        Dim bIncludeNotSet        bIncludeNotSet = Not IsVoid(sNotSetValue)    sSelectedIndex = ReplaceVoid(sSelectedIndex, 0)        If Clng(sSelectedIndex) = 0 Or Clng(sSelectedIndex) = -1 Then        sSelected = " CHECKED"    Else        sSelected = ""    End If    sOptionListText = ""    If bIncludeNotSet Then        sOptionListText = sOptionListText & "<input type=radio name=""" & _            sOptionListName & """ value=""0""" & sSelected & ">" & sNotSetValue & "<BR>" & vbCrLf    End If    While Not rsResults.EOF        If CLng(rsResults(sKeyField)) = CLng(sSelectedIndex) Then            sSelected = " CHECKED"        Else            sSelected = ""        End If        sOptionListText = sOptionListText & "<input type=radio name=""" & _            sOptionListName & """ value=""" & rsResults(sKeyField) & """" & _            sSelected & ">" & rsResults(sDataField) & "<BR>" & vbCrLf        rsResults.MoveNext    Wend        rsResults.Close    Set rsResults = Nothing        MakeOptionList = sOptionListTextEnd FunctionFunction AddStyleToText(sText, sStyle)    Dim sOutput    sOutput = "<SPAN CLASS=""" & sStyle & """>"    sOutput = sOutput & sText    sOutput = sOutput & "</SPAN>"    AddStyleToText = sOutput    End FunctionFunction IsArrayTrue( arrArray )    On Error Resume Next     Dim lArray     lArray = UBound(arrArray)     IsArrayTrue = (Err = 0)End FunctionFunction CSVtoDict(sCSVList)    Dim sValueArray    Dim sIndexName    Dim lIndexCount    Set CSVtoDict = Server.CreateObject("Scripting.Dictionary")    sValueArray = Split(sCSVList, ",")    If IsArrayTrue(sValueArray) Then        For lIndexCount = 0 To UBound(sValueArray)            sIndexName = Trim(sValueArray(lIndexCount))            If Not CSVtoDict.Exists(sIndexName) Then                CSVtoDict.Add sIndexName, lIndexCount            End If        Next    End IfEnd FunctionFunction MakeCheckList(sCheckListName, rsResults, sKeyField, _                       sDataField, sSelectedField, sSelectedIndexList)    Dim sSelected    Dim sCheckListText    Dim dictSelectedIndexes    Dim sIndexName    Dim bSelected    Set dictSelectedIndexes = CSVtoDict(sSelectedIndexList)    sCheckListText = ""    bSelected = False    While Not rsResults.EOF        sIndexName = CStr(rsResults(sKeyField))        If sSelectedField <> "" Then            bSelected = rsResults(sSelectedField)        End If        If bSelected Or dictSelectedIndexes.Exists(sIndexName) Then            sSelected = " CHECKED"        Else            sSelected = ""        End If        sCheckListText = "<INPUT type=CHECKBOX name=""" & _            sCheckListName & """ value=""" & sIndexName & """" & _            sSelected & ">" & rsResults(sDataField) & "<BR>" & vbCrLf        rsResults.MoveNext    Wend        rsResults.Close    Set rsResults = Nothing        MakeCheckList = sCheckListTextEnd FunctionSub MakeCheckListDual(sCheckListName, rsResults, sKeyField, _                      sDataField, sSelectedField, sSelectedIndexList, _                      sCheckList1, sCheckList2)    Dim sSelected    Dim sCheckListText    Dim dictSelectedIndexes    Dim sIndexName    Dim bSelected    Dim bListToggle    bListToggle = False    Set dictSelectedIndexes = CSVtoDict(sSelectedIndexList)    sCheckListText = ""    sCheckList1 = ""    sCheckList2 = ""    bSelected = False    While Not rsResults.EOF        sIndexName = CStr(rsResults(sKeyField))        If sSelectedField <> "" Then            bSelected = CBool(rsResults(sSelectedField))        Else            bSelected = False        End If        If bSelected Or dictSelectedIndexes.Exists(sIndexName) Then            sSelected = " CHECKED"        Else            sSelected = ""        End If        sCheckListText = "<INPUT type=CHECKBOX name=""" & _            sCheckListName & """ value=""" & sIndexName & """" & _            sSelected & ">" & rsResults(sDataField) & "<BR>" & vbCrLf        If bListToggle Then            sCheckList2 = sCheckList2 & sCheckListText        Else            sCheckList1 = sCheckList1 & sCheckListText        End If        bListToggle = Not blistToggle        rsResults.MoveNext    Wend        rsResults.Close    Set rsResults = NothingEnd Sub' lComplexity:'  1 = A single word (requires database connection and supporting procs).'  2 = A random number (range is from lMinLen to lMaxLen).'  3 = Random alphanumeric.'  4 = Two unrelated random words (requires database).' lMinLen:'  Minimum number of characters that password should be, or lower limit if numeric only.' lMaxLen:'  Maximum number of characters that password should be, or upper limit if numeric only.Function GeneratePassPhrase( ByVal lComplexity, ByVal lMinLen, ByVal lMaxLen )    Dim sPassPhrase    Dim lIndex    Randomize    Select Case lComplexity        Case 1 ' A single word.'            sPassPhrase = GetRandomPhrase( 1, lMinLen, lMaxLen )        Case 2 ' Random number.            sPassPhrase = CStr(Int((lMaxLen - lMinLen + 1) * Rnd + lMinLen))        Case 3 ' Random alphanumeric            ' Make the length of the string random between min and max.            lMaxLen = Int((lMaxLen - lMinLen + 1) * Rnd + lMinLen)            sPassPhrase = ""            For lIndex = 1 To lMaxLen                ' Throw a dice to see if we should generate a char or number.                If ( Rnd < 0.33 ) Then                    ' A random lowercase character between a and z.                    sPassPhrase = sPassPhrase & Chr(Int((Asc("z") - Asc("a") + 1) * Rnd + Asc("a")))                ElseIf ( Rnd > 0.66 ) Then                    ' A random uppercase character between A and Z.                    sPassPhrase = sPassPhrase & Chr(Int((Asc("Z") - Asc("A") + 1) * Rnd + Asc("A")))                Else                    ' A random numeric character between 0 and 9.                    sPassPhrase = sPassPhrase & Chr(Int((Asc("9") - Asc("0") + 1) * Rnd + Asc("0")))                End If            Next        Case 4'            sPassPhrase = GetRandomPhrase( 1, lMinLen, lMaxLen )    End Select    GeneratePassPhrase = sPassPhraseEnd FunctionFunction DateWithoutTime(dDateIn)    Dim lDate    lDate = CLng(dDateIn)    DateWithoutTime = CDate(lDate)End FunctionSub sqlReplaceEmpties(cmdSQLProc)    Dim prm    For Each prm In cmdSQLProc.Parameters        If IsEmpty(prm.Value) Then            prm.Value = Null        End If    NextEnd SubSub SeparateIDs(ByVal sFormField, lID1, lID2, lPrefixLength)    ' Separates the name of hidden fields into separate IDs for comparing with other elements    ' Assumes that all IDs are separated by hyphens.    Dim lIDArray    Dim lCounter    lID1 = 0    lID2 = 0    sFormField = Mid(sFormField, lPrefixLength + 1)    lIDArray = Split(sFormField, "-")    For lCounter = 0 To UBound(lIDArray)        If lCounter = 0 Then            lID1 = lIDArray(0)        ElseIf lCounter = 1 Then            lID2 = lIDArray(1)        End If    Next    If ( IsNumeric( lID1 ) = True ) Then        lID1 = CLng(lID1)    Else        lID1 = Null    End If    If ( IsNumeric( lID2 ) = True ) Then        lID2 = CLng(lID2)    Else        lID2 = Null    End If        End Sub' Converts a Julian date to a standard Gregorian.' Julian base date from a constant.Function ToGregorian( lJulian, lDateFormat )    ToGregorian = FormatDateTime( DateAdd( "d", lJulian, acJulianBase ), lDateFormat )End FunctionFunction FileExists( sFilePath )    Dim objFileSystem    On Error Resume Next    Err.Clear     Set objFileSystem = CreateObject( "Scripting.FileSystemObject" )    FileExists = objFileSystem.FileExists( sFilePath )    Set objFileSystem = Nothing    If ( Err <> 0 ) Then        Err.Clear        FileExists = False    End IfEnd FunctionFunction MakeTableDataCell(ByVal sData, sLink, sColour, sStyle, ByVal sWidth, ByVal sHeight)    Dim sOutput    Dim sCellData        If sWidth <> "" Then        sWidth = " width=" & sWidth    End If        If sHeight <> "" Then        sHeight = " height=" & sHeight    End If        If sStyle <> "" Then        sData = AddStyleToText(sData, sStyle)    End If        If sLink <> "" Then        sCellData = "<A HREF=""" & sLink & """>" & sData & "</A>"    Else        sCellData = sData    End If    sOutput = sOutput & "<TD align=center valign=middle" & sWidth & sHeight & ">" & vbCrLf    sOutput = sOutput & sCellData & vbCrLf    sOutput = sOutput & "</TD>" & vbCrLf        MakeTableDataCell = sOutput    End FunctionFunction ErrorReport()    Dim lErrorLoop    ErrorReport =  vbCrLf & _                                 "<!--" & vbCrLf & _                                 "Error No: " & Err.number & vbCrLf & _                                 "Error Description: " & Err.description & vbCrLf                    ' Check if we need to report on ADO errors    If VarType(objConn) = vbString Then            ' Loop through the ADO errors collection. Usually, there is only one.        For lErrorLoop = 0 To objConn.Errors.Count - 1            ErrorReport = ErrorReport & "Error Count: " & lErrorLoop & vbCrLf            ErrorReport = ErrorReport & "Error Description: " & objConn.Errors(lErrorLoop).Description & vbCrLf            ErrorReport = ErrorReport & "Error Number: " & objConn.Errors(lErrorLoop).Number & vbCrLf        Next        End If        ErrorReport = ErrorReport & "-->" & vbCrLf        If Err <> 0 Then        Response.Write ErrorReport    End If    End FunctionFunction Val(lInput)    If IsNumeric(lInput) Then        Val = CSng(lInput)    Else        Val = 0    End IfEnd FunctionFunction FieldNameToDisplay(sInputField)    ' Attempts to convert a field name into something that looks presentable, for display    ' Assumes field name has 1 letter prefix, which is removed, and each word is capitalised        Dim sOutputField    Dim lCharInc    Dim lCharCode        If Len(sInputField) = 0 Then        Exit Function    End If        sOutputField = Mid(sInputField, 2)        lCharInc = 1    While lCharInc <= Len(sOutputField)        lCharCode = Asc(Mid(sOutputField, lCharInc, 1))                If lCharInc > 1 And _             lCharCode >= Asc("A") And _             lCharCode <= Asc("Z") And _             lCharInc < Len(sOutputField) Then            sOutputField = Left(sOutputField, lCharInc - 1) & " " & Mid(sOutputField, lCharInc)            lCharInc = lCharInc + 1        End If        lCharInc = lCharInc + 1    Wend        FieldNameToDisplay = sOutputField    End FunctionFunction URLDecode(sURLorFormData)    Dim lCounter    Dim sEncodedChar        If Len(sURLorFormData) > 0 Then        URLDecode = Replace(sURLorFormData, "+", " ")        lCounter = 1        While lCounter <= Len(URLDecode)            If Mid(URLDecode, lCounter, 1) = "%" Then                sEncodedChar = CInt("&H" & Mid(URLDecode, lCounter + 1, 2))                URLDecode = Replace(URLDecode, Mid(URLDecode, lCounter, 3), Chr(sEncodedChar))            End If            lCounter = lCounter + 1        Wend    End If    End FunctionFunction FormatPostData(sPostData)    ' Formats data in a form for emailing etc.        Dim sItemArray    Dim sPostArray    Dim sPostItem    Dim lCounter    Dim sItem    Dim sValue    sPostArray = Split(sPostData, "&")        ' If Not (UBound(sPostArray) = 0 And Len(sPostArray(0)) = 0) Then    If IsArrayTrue(sPostArray) Then            For lCounter = 0 To UBound(sPostArray)                    sItemArray = Null            sPostItem = sPostArray(lCounter)            sItemArray = Split(sPostItem, "=")                        If sItemArray(1) <> "" Then                ' Don't include submit buttons!                If Not (Instr(1, sItemArray(0), ".x") > 0 Or _                        Instr(1, sItemArray(0), ".y") > 0 Or _                        Left(sItemArray(0), 3) = "lst" Or _                        Left(sItemArray(0), 1) = "l" And Right(sItemArray(0), 2) = "ID" _                        ) Then                    sItemArray(0) = URLDecode(sItemArray(0))                    sItemArray(0) = SpacePad(sItemArray(0), 30)                    sItemArray(1) = URLDecode(sItemArray(1))                    FormatPostData = FormatPostData & sItemArray(0) & " : " & sItemArray(1) & vbCrLf                End If            End If                Next        End If    End FunctionFunction CheckCompulsaryCookies(sCompulsaryItems, objCookie)    Dim sItem    Dim dictFields    Dim sValue        ' Like CheckCompulsaryFields, but checks cookies. sCompulsaryItems is list of items within cookie        CheckCompulsaryCookies = False        If objCookie Is Nothing Then Exit Function        Set dictFields = CSVtoDict(sCompulsaryFields)    For Each sItem In dictFields            sValue = objCookie(sItem)                If Len(sValue) = 0 Then            CheckCompulsaryCookies = False        End If            NextEnd FunctionSub SaveFormFieldsToCookie(sCookieName)    Dim sField, sValue            For Each sField In Request.Form        sValue = Request.Form(sField)        Response.Cookies(sCookieName)(sField) = sValue    NextEnd SubSub CheckDownloadFormFilled()    If Not CheckCompulsaryCookies("Name,Email,Telephone,Where you heard from us") Then        Response.Cookies("LiteratureDownload")("Page") = GetScriptNameNoQS        Response.Redirect "./literaturedownlo.asp"    End If    End SubFunction CheckCompulsaryFields(sCompulsaryFields)    Dim sItem    Dim dictFields    Dim sValue        ' Checks the compulsary fields, from a comma separated list and outputs an error list        Set dictFields = CSVtoDict(sCompulsaryFields)    For Each sItem In Request.Form        If dictFields.Exists(sItem) Then            sValue = Request.Form(sItem)            If Len(sValue) = 0 then                CheckCompulsaryFields = CheckCompulsaryFields & _                    "<LI>&nbsp;" & sItem & " requires a value; please check."            End If        End If    NextEnd FunctionFunction AppendFile( sFilePath, sData )	Dim objFS	Dim objNewFile	On Error Resume Next	Err.Clear 	Set objFS = CreateObject( "Scripting.FileSystemObject" )	Set objNewFile = objFS.OpenTextFile( Server.MapPath( sFilePath ), ForAppending, True)	objNewFile.WriteLine( sData )	objNewFile.Close	Set objNewFile = Nothing	Set objFS = Nothing	If ( Err <> 0 ) Then		AppendFile = False	Else		AppendFile = True	End IfEnd Function'Description:    Opens a binary file stream, and writes it out in a browser'                understandable format'Input Params:    sSourceFile - Full path and file name to be read'Output Params:    Function returns either True or False depending on the'                success of the operationFunction BinaryToBrowserOld( sSourceFile )    Dim objFileMan    Dim objBinary    Dim sOutput    Err.Clear         Set objFileMan = CreateObject("SoftArtisans.FileManager")        Set objBinary = objFileMan.OpenBinaryFile( sSourceFile )    Response.BinaryWrite( objBinary.ReadAll )        objBinary.Close        BinaryToBrowser = (Err = 0)End FunctionFunction BinaryToBrowser(sSourceFile)    Const vbForReading = 1    Const vbForWriting = 2    Const vbForAppending = 8    Dim fsoStream    Dim fsoFile        Set fsoStream = CreateObject("Scripting.FileSystemObject")    Set fsoFile = fsoStream.OpenTextFile(sSourceFile, vbForReading, False, True)        Response.BinaryWrite fsoFile.ReadAll    fsoFile.Close        BinaryToBrowser = (Err = 0)End FunctionFunction GetFileExtension(sFileName)    Dim lDotPos    lDotPos = InStrRev(sFileName, ".")        If lDotPos > 0 Then        GetFileExtension = Mid(sFileName, lDotPos + 1)    Else        GetFileExtension = ""    End IfEnd FunctionFunction GetFileName(sInputPath)        Dim lCounter, sOutput, sChar        lCounter = Len(sInputPath)    While lCounter >= 1 And sChar <> "\"        sChar = Mid(sInputPath, lCounter, 1)        If sChar <> "\" Then sOutput = sChar & sOutput        lCounter = lCounter - 1    Wend        GetFileName = sOutput    End FunctionSub SetContentType(ByVal sExtension)    Dim sMimeType    sExtension = LCase(sExtension)    Select Case sExtension         Case "doc", "rtf", "txt"            Response.ContentType = "application/msword"         Case "xls"            Response.ContentType = "application/vnd.ms-excel"         Case "jpeg", "jpg"            Response.ContentType = "image/jpeg"         Case "gif"            Response.ContentType = "image/gif"         Case "mp3"            Response.ContentType = "audio/mpeg"         Case "tif"            Response.ContentType = "image/tiff"         Case "pdf"            Response.ContentType = "application/pdf"         Case "zip"            Response.ContentType = "application/x-zip-compressed"         Case "eps"            Response.ContentType = "application/postscript"    End Select    End Sub%><%'--------------------------------------------------------------------' Microsoft ADO'' Copyright (c) 1996-1998 Microsoft Corporation.'''' ADO constants include file for VBScript''--------------------------------------------------------------------'---- CursorTypeEnum Values ----Const adOpenForwardOnly = 0Const adOpenKeyset = 1Const adOpenDynamic = 2Const adOpenStatic = 3'---- CursorOptionEnum Values ----Const adHoldRecords = &H00000100Const adMovePrevious = &H00000200Const adAddNew = &H01000400Const adDelete = &H01000800Const adUpdate = &H01008000Const adBookmark = &H00002000Const adApproxPosition = &H00004000Const adUpdateBatch = &H00010000Const adResync = &H00020000Const adNotify = &H00040000Const adFind = &H00080000Const adSeek = &H00400000Const adIndex = &H00800000'---- LockTypeEnum Values ----Const adLockReadOnly = 1Const adLockPessimistic = 2Const adLockOptimistic = 3Const adLockBatchOptimistic = 4'---- ExecuteOptionEnum Values ----Const adAsyncExecute = &H00000010Const adAsyncFetch = &H00000020Const adAsyncFetchNonBlocking = &H00000040Const adExecuteNoRecords = &H00000080Const adExecuteStream = &H00000400'---- ConnectOptionEnum Values ----Const adAsyncConnect = &H00000010'---- ObjectStateEnum Values ----Const adStateClosed = &H00000000Const adStateOpen = &H00000001Const adStateConnecting = &H00000002Const adStateExecuting = &H00000004Const adStateFetching = &H00000008'---- CursorLocationEnum Values ----Const adUseServer = 2Const adUseClient = 3'---- DataTypeEnum Values ----Const adEmpty = 0Const adTinyInt = 16Const adSmallInt = 2Const adInteger = 3Const adBigInt = 20Const adUnsignedTinyInt = 17Const adUnsignedSmallInt = 18Const adUnsignedInt = 19Const adUnsignedBigInt = 21Const adSingle = 4Const adDouble = 5Const adCurrency = 6Const adDecimal = 14Const adNumeric = 131Const adBoolean = 11Const adError = 10Const adUserDefined = 132Const adVariant = 12Const adIDispatch = 9Const adIUnknown = 13Const adGUID = 72Const adDate = 7Const adDBDate = 133Const adDBTime = 134Const adDBTimeStamp = 135Const adBSTR = 8Const adChar = 129Const adVarChar = 200Const adLongVarChar = 201Const adWChar = 130Const adVarWChar = 202Const adLongVarWChar = 203Const adBinary = 128Const adVarBinary = 204Const adLongVarBinary = 205Const adChapter = 136Const adFileTime = 64Const adPropVariant = 138Const adVarNumeric = 139Const adArray = &H2000'---- FieldAttributeEnum Values ----Const adFldMayDefer = &H00000002Const adFldUpdatable = &H00000004Const adFldUnknownUpdatable = &H00000008Const adFldFixed = &H00000010Const adFldIsNullable = &H00000020Const adFldMayBeNull = &H00000040Const adFldLong = &H00000080Const adFldRowID = &H00000100Const adFldRowVersion = &H00000200Const adFldCacheDeferred = &H00001000Const adFldIsChapter = &H00002000Const adFldNegativeScale = &H00004000Const adFldKeyColumn = &H00008000Const adFldIsRowURL = &H00010000Const adFldIsDefaultStream = &H00020000Const adFldIsCollection = &H00040000'---- EditModeEnum Values ----Const adEditNone = &H0000Const adEditInProgress = &H0001Const adEditAdd = &H0002Const adEditDelete = &H0004'---- RecordStatusEnum Values ----Const adRecOK = &H0000000Const adRecNew = &H0000001Const adRecModified = &H0000002Const adRecDeleted = &H0000004Const adRecUnmodified = &H0000008Const adRecInvalid = &H0000010Const adRecMultipleChanges = &H0000040Const adRecPendingChanges = &H0000080Const adRecCanceled = &H0000100Const adRecCantRelease = &H0000400Const adRecConcurrencyViolation = &H0000800Const adRecIntegrityViolation = &H0001000Const adRecMaxChangesExceeded = &H0002000Const adRecObjectOpen = &H0004000Const adRecOutOfMemory = &H0008000Const adRecPermissionDenied = &H0010000Const adRecSchemaViolation = &H0020000Const adRecDBDeleted = &H0040000'---- GetRowsOptionEnum Values ----Const adGetRowsRest = -1'---- PositionEnum Values ----Const adPosUnknown = -1Const adPosBOF = -2Const adPosEOF = -3'---- BookmarkEnum Values ----Const adBookmarkCurrent = 0Const adBookmarkFirst = 1Const adBookmarkLast = 2'---- MarshalOptionsEnum Values ----Const adMarshalAll = 0Const adMarshalModifiedOnly = 1'---- AffectEnum Values ----Const adAffectCurrent = 1Const adAffectGroup = 2Const adAffectAllChapters = 4'---- ResyncEnum Values ----Const adResyncUnderlyingValues = 1Const adResyncAllValues = 2'---- CompareEnum Values ----Const adCompareLessThan = 0Const adCompareEqual = 1Const adCompareGreaterThan = 2Const adCompareNotEqual = 3Const adCompareNotComparable = 4'---- FilterGroupEnum Values ----Const adFilterNone = 0Const adFilterPendingRecords = 1Const adFilterAffectedRecords = 2Const adFilterFetchedRecords = 3Const adFilterConflictingRecords = 5'---- SearchDirectionEnum Values ----Const adSearchForward = 1Const adSearchBackward = -1'---- PersistFormatEnum Values ----Const adPersistADTG = 0Const adPersistXML = 1'---- StringFormatEnum Values ----Const adClipString = 2'---- ConnectPromptEnum Values ----Const adPromptAlways = 1Const adPromptComplete = 2Const adPromptCompleteRequired = 3Const adPromptNever = 4'---- ConnectModeEnum Values ----Const adModeUnknown = 0Const adModeRead = 1Const adModeWrite = 2Const adModeReadWrite = 3Const adModeShareDenyRead = 4Const adModeShareDenyWrite = 8Const adModeShareExclusive = &HcConst adModeShareDenyNone = &H10Const adModeRecursive = &H400000'---- RecordCreateOptionsEnum Values ----Const adCreateCollection = &H00002000Const adCreateStructDoc = &H80000000Const adCreateNonCollection = &H00000000Const adOpenIfExists = &H02000000Const adCreateOverwrite = &H04000000Const adFailIfNotExists = -1'---- RecordOpenOptionsEnum Values ----Const adOpenRecordUnspecified = -1Const adOpenOutput = &H00800000Const adOpenAsync = &H00001000Const adDelayFetchStream = &H00004000Const adDelayFetchFields = &H00008000Const adOpenExecuteCommand = &H00010000'---- IsolationLevelEnum Values ----Const adXactUnspecified = &HffffffffConst adXactChaos = &H00000010Const adXactReadUncommitted = &H00000100Const adXactBrowse = &H00000100Const adXactCursorStability = &H00001000Const adXactReadCommitted = &H00001000Const adXactRepeatableRead = &H00010000Const adXactSerializable = &H00100000Const adXactIsolated = &H00100000'---- XactAttributeEnum Values ----Const adXactCommitRetaining = &H00020000Const adXactAbortRetaining = &H00040000'---- PropertyAttributesEnum Values ----Const adPropNotSupported = &H0000Const adPropRequired = &H0001Const adPropOptional = &H0002Const adPropRead = &H0200Const adPropWrite = &H0400'---- ErrorValueEnum Values ----Const adErrProviderFailed = &Hbb8Const adErrInvalidArgument = &Hbb9Const adErrOpeningFile = &HbbaConst adErrReadFile = &HbbbConst adErrWriteFile = &HbbcConst adErrNoCurrentRecord = &HbcdConst adErrIllegalOperation = &Hc93Const adErrCantChangeProvider = &Hc94Const adErrInTransaction = &HcaeConst adErrFeatureNotAvailable = &Hcb3Const adErrItemNotFound = &Hcc1Const adErrObjectInCollection = &Hd27Const adErrObjectNotSet = &Hd5cConst adErrDataConversion = &Hd5dConst adErrObjectClosed = &He78Const adErrObjectOpen = &He79Const adErrProviderNotFound = &He7aConst adErrBoundToCommand = &He7bConst adErrInvalidParamInfo = &He7cConst adErrInvalidConnection = &He7dConst adErrNotReentrant = &He7eConst adErrStillExecuting = &He7fConst adErrOperationCancelled = &He80Const adErrStillConnecting = &He81Const adErrInvalidTransaction = &He82Const adErrUnsafeOperation = &He84Const adwrnSecurityDialog = &He85Const adwrnSecurityDialogHeader = &He86Const adErrIntegrityViolation = &He87Const adErrPermissionDenied = &He88Const adErrDataOverflow = &He89Const adErrSchemaViolation = &He8aConst adErrSignMismatch = &He8bConst adErrCantConvertvalue = &He8cConst adErrCantCreate = &He8dConst adErrColumnNotOnThisRow = &He8eConst adErrURLIntegrViolSetColumns = &He8fConst adErrURLDoesNotExist = &He8fConst adErrTreePermissionDenied = &He90Const adErrInvalidURL = &He91Const adErrResourceLocked = &He92Const adErrResourceExists = &He93Const adErrCannotComplete = &He94Const adErrVolumeNotFound = &He95Const adErrOutOfSpace = &He96Const adErrResourceOutOfScope = &He97Const adErrUnavailable = &He98Const adErrURLNamedRowDoesNotExist = &He99Const adErrDelResOutOfScope = &He9aConst adErrPropInvalidColumn = &He9bConst adErrPropInvalidOption = &He9cConst adErrPropInvalidValue = &He9dConst adErrPropConflicting = &He9eConst adErrPropNotAllSettable = &He9fConst adErrPropNotSet = &Hea0Const adErrPropNotSettable = &Hea1Const adErrPropNotSupported = &Hea2Const adErrCatalogNotSet = &Hea3Const adErrCantChangeConnection = &Hea4Const adErrFieldsUpdateFailed = &Hea5Const adErrDenyNotSupported = &Hea6Const adErrDenyTypeNotSupported = &Hea7Const adErrProviderNotSpecified = &Hea9'---- ParameterAttributesEnum Values ----Const adParamSigned = &H0010Const adParamNullable = &H0040Const adParamLong = &H0080'---- ParameterDirectionEnum Values ----Const adParamUnknown = &H0000Const adParamInput = &H0001Const adParamOutput = &H0002Const adParamInputOutput = &H0003Const adParamReturnValue = &H0004'---- CommandTypeEnum Values ----Const adCmdUnknown = &H0008Const adCmdText = &H0001Const adCmdTable = &H0002Const adCmdStoredProc = &H0004Const adCmdFile = &H0100Const adCmdTableDirect = &H0200'---- EventStatusEnum Values ----Const adStatusOK = &H0000001Const adStatusErrorsOccurred = &H0000002Const adStatusCantDeny = &H0000003Const adStatusCancel = &H0000004Const adStatusUnwantedEvent = &H0000005'---- EventReasonEnum Values ----Const adRsnAddNew = 1Const adRsnDelete = 2Const adRsnUpdate = 3Const adRsnUndoUpdate = 4Const adRsnUndoAddNew = 5Const adRsnUndoDelete = 6Const adRsnRequery = 7Const adRsnResynch = 8Const adRsnClose = 9Const adRsnMove = 10Const adRsnFirstChange = 11Const adRsnMoveFirst = 12Const adRsnMoveNext = 13Const adRsnMovePrevious = 14Const adRsnMoveLast = 15'---- SchemaEnum Values ----Const adSchemaProviderSpecific = -1Const adSchemaAsserts = 0Const adSchemaCatalogs = 1Const adSchemaCharacterSets = 2Const adSchemaCollations = 3Const adSchemaColumns = 4Const adSchemaCheckConstraints = 5Const adSchemaConstraintColumnUsage = 6Const adSchemaConstraintTableUsage = 7Const adSchemaKeyColumnUsage = 8Const adSchemaReferentialConstraints = 9Const adSchemaTableConstraints = 10Const adSchemaColumnsDomainUsage = 11Const adSchemaIndexes = 12Const adSchemaColumnPrivileges = 13Const adSchemaTablePrivileges = 14Const adSchemaUsagePrivileges = 15Const adSchemaProcedures = 16Const adSchemaSchemata = 17Const adSchemaSQLLanguages = 18Const adSchemaStatistics = 19Const adSchemaTables = 20Const adSchemaTranslations = 21Const adSchemaProviderTypes = 22Const adSchemaViews = 23Const adSchemaViewColumnUsage = 24Const adSchemaViewTableUsage = 25Const adSchemaProcedureParameters = 26Const adSchemaForeignKeys = 27Const adSchemaPrimaryKeys = 28Const adSchemaProcedureColumns = 29Const adSchemaDBInfoKeywords = 30Const adSchemaDBInfoLiterals = 31Const adSchemaCubes = 32Const adSchemaDimensions = 33Const adSchemaHierarchies = 34Const adSchemaLevels = 35Const adSchemaMeasures = 36Const adSchemaProperties = 37Const adSchemaMembers = 38Const adSchemaTrustees = 39Const adSchemaFunctions = 40Const adSchemaActions = 41Const adSchemaCommands = 42Const adSchemaSets = 43'---- FieldStatusEnum Values ----Const adFieldOK = 0Const adFieldCantConvertValue = 2Const adFieldIsNull = 3Const adFieldTruncated = 4Const adFieldSignMismatch = 5Const adFieldDataOverflow = 6Const adFieldCantCreate = 7Const adFieldUnavailable = 8Const adFieldPermissionDenied = 9Const adFieldIntegrityViolation = 10Const adFieldSchemaViolation = 11Const adFieldBadStatus = 12Const adFieldDefault = 13Const adFieldIgnore = 15Const adFieldDoesNotExist = 16Const adFieldInvalidURL = 17Const adFieldResourceLocked = 18Const adFieldResourceExists = 19Const adFieldCannotComplete = 20Const adFieldVolumeNotFound = 21Const adFieldOutOfSpace = 22Const adFieldCannotDeleteSource = 23Const adFieldReadOnly = 24Const adFieldResourceOutOfScope = 25Const adFieldAlreadyExists = 26Const adFieldPendingInsert = &H10000Const adFieldPendingDelete = &H20000Const adFieldPendingChange = &H40000Const adFieldPendingUnknown = &H80000Const adFieldPendingUnknownDelete = &H100000'---- SeekEnum Values ----Const adSeekFirstEQ = &H1Const adSeekLastEQ = &H2Const adSeekAfterEQ = &H4Const adSeekAfter = &H8Const adSeekBeforeEQ = &H10Const adSeekBefore = &H20'---- ADCPROP_UPDATECRITERIA_ENUM Values ----Const adCriteriaKey = 0Const adCriteriaAllCols = 1Const adCriteriaUpdCols = 2Const adCriteriaTimeStamp = 3'---- ADCPROP_ASYNCTHREADPRIORITY_ENUM Values ----Const adPriorityLowest = 1Const adPriorityBelowNormal = 2Const adPriorityNormal = 3Const adPriorityAboveNormal = 4Const adPriorityHighest = 5'---- ADCPROP_AUTORECALC_ENUM Values ----Const adRecalcUpFront = 0Const adRecalcAlways = 1'---- ADCPROP_UPDATERESYNC_ENUM Values ----'---- ADCPROP_UPDATERESYNC_ENUM Values ----'---- MoveRecordOptionsEnum Values ----Const adMoveUnspecified = -1Const adMoveOverWrite = 1Const adMoveDontUpdateLinks = 2Const adMoveAllowEmulation = 4'---- CopyRecordOptionsEnum Values ----Const adCopyUnspecified = -1Const adCopyOverWrite = 1Const adCopyAllowEmulation = 4Const adCopyNonRecursive = 2'---- StreamTypeEnum Values ----Const adTypeBinary = 1Const adTypeText = 2'---- LineSeparatorEnum Values ----Const adLF = 10Const adCR = 13Const adCRLF = -1'---- StreamOpenOptionsEnum Values ----Const adOpenStreamUnspecified = -1Const adOpenStreamAsync = 1Const adOpenStreamFromRecord = 4'---- StreamWriteEnum Values ----Const adWriteChar = 0Const adWriteLine = 1'---- SaveOptionsEnum Values ----Const adSaveCreateNotExist = 1Const adSaveCreateOverWrite = 2'---- FieldEnum Values ----Const adDefaultStream = -1Const adRecordURL = -2'---- StreamReadEnum Values ----Const adReadAll = -1Const adReadLine = -2'---- RecordTypeEnum Values ----Const adSimpleRecord = 0Const adCollectionRecord = 1Const adStructDoc = 2%><%Const sWindowClose = "window.top.close();"Dim sJavaScriptHeaderDim sJavaScriptFooterDim sJSDeleteConfirmDim sJSConfirmsJavaScriptHeader = vbCrLf & _                                        "<Script Language=""JavaScript"">" & vbCrLf & _                                        "<!--" & vbCrLfsJavaScriptFooter = "// -->" & vbCrLf & _                                        "</Script>" & vbCrLfsJSDeleteConfirm = "function ConfirmDelete()" & vbCrLf & _                                     "{" & vbCrLf & _                                     "   if (confirm(""Are you sure you want to Delete?"")){" & vbCrLf & _                                     "      return true;" & vbCrLf & _                                     "   }" & vbCrLf & _                                     "   else {" & vbCrLf & _                                     "      alert(""Delete cancelled"");" & vbCrLf & _                                     "      return false;" & vbCrLf & _                                     "   }" & vbCrLf & _                                     "}" & vbCrLf                                     sJSConfirm = "function Confirm()" & vbCrLf & _                                     "{" & vbCrLf & _                                     "   if (confirm(""Are you sure?"")){" & vbCrLf & _                                     "      return true;" & vbCrLf & _                                     "   }" & vbCrLf & _                                     "   else {" & vbCrLf & _                                     "      alert(""Cancelled"");" & vbCrLf & _                                     "      return false;" & vbCrLf & _                                     "   }" & vbCrLf & _                                     "}" & vbCrLf' onclick="return ConfirmDelete()"Function JavaAlert(ByVal sMessage)    ' Requires tools library    If Len(sMessage) > 0 Then        sMessage = Replace(sMessage, "<BR>", "\r\n")        JavaAlert = sJavaScriptHeader        JavaAlert = JavaAlert & "    alert(""" & sMessage & """);" & vbCrLf        JavaAlert = JavaAlert & sJavaScriptFooter    End IfEnd FunctionFunction JavaScriptConfirm(sMessage)    JavaScriptConfirm = sJavaScriptHeader    JavaScriptConfirm = JavaScriptConfirm & Replace(sJSConfirm, "Are you sure?", sMessage)    JavaScriptConfirm = JavaScriptConfirm & sJavaScriptFooterEnd FunctionFunction JavaSetFrame(sTargetPageName, sTargetFrameName)    ' Sets the contects of a specific frame    Dim sJavaScript        sJavaScript = sJavaScript & _        "window.open(""" & sTargetPageName & """, target=""" & sTargetFrameName & """);" & vbCrLf        JavaSetFrame = sJavaScript    End FunctionFunction JavaListBox(rsElementList, sIDField, sDescField, sJavaFuncName, _                                         sListName, sFormName, sTargetFrame, sTargetPage, _                                         sBlankPage, lListIndex, sJavaScript)    Dim sListBox    Dim sSelected        Dim lID    Dim sDesc        Dim lCount        If rsElementList.EOF Then Exit Function        ' Make Java function for redirection(s) in list box    ' dDateNow variable in javascript ensures that a new version of the page is fetched each time.        sJavaScript = sJavascript & "function " & sJavaFuncName & "() {" & vbCrLf    sJavascript = sJavaScript & "dDateNow = new Date();" & vbCrLf    sJavascript = sJavaScript & "dDateNow = escape(dDateNow);" & vbCrLf    sJavaScript = sJavaScript & "dDateNow = ""&dDateNow="" + dDateNow" & vbCrLf    sJavaScript = sJavascript & "if      (document." & sFormName & ".elements[""" & sListName & """].selectedIndex == 0)" & vbCrLf    sJavaScript = sJavascript & "  window.open(""" & sBlankPage & """, target=""" & sTargetFrame & """);" & vbCrLf    sListBox = vbCrLf & "<SELECT size=1 name=""" & sListName & """ language=""javascript"" onchange=""" & sJavaFuncName & "();"">" & vbCrLf    If CLng(lListIndex) = -1 Then        sListBox = sListBox & "<OPTION Value=""-1"" SELECTED>Select</OPTION>" & vbCrLf    Else        sListBox = sListBox & "<OPTION Value=""-1"">Select</OPTION>" & vbCrLf    End If    lCount = 0    While Not rsElementList.EOF        lCount = lCount + 1                lID = rsElementList(sIDField)        sDesc = ReplaceNull(rsElementList(sDescField), "Unknown")                            sJavaScript = sJavascript & "else if (document." & sFormName & ".elements[""" & sListName & """].selectedIndex == " & lCount & ")" & vbCrLf        sJavaScript = sJavascript & "  window.open(""" & sTargetPage & lID & """ + dDateNow, target=""" & sTargetFrame & """);" & vbCrLf        If CLng(lID) = CLng(lListIndex) Then            sSelected = " SELECTED"        Else            sSelected = ""        End If        sListBox = sListBox & "<OPTION Value=""" & lID & """" & sSelected & ">" & sDesc & "</OPTION>" & vbCrLf        rsElementList.MoveNext    Wend        sJavaScript = sJavaScript & "}" & vbCrLf    sListBox = sListBox & "</SELECT>"    JavaListBox = sListBox        rsElementList.Close    Set rsElementList = NothingEnd Function    %><%OpenDBIf Request.ServerVariables("REQUEST_METHOD") = "POST" ThenElseEnd If%><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"><HTML><HEAD><TITLE>Reviver Data Recovery</TITLE><META HTTP-EQUIV="Author" CONTENT="Access Communications - www.aclweb.com"><META HTTP-EQUIV="Designed by" CONTENT="Patrick Ooi - patricko@aclweb.com"><META NAME="GENERATOR" CONTENT="Freeway Pro 3.5.12"><STYLE TYPE="text/css"><!--p { margin-top:0px }.TextRedBold { font-family: Verdana; font-weight: bold; color: #c00; font-size: 10px; }.Text { font-family: Verdana; color: #000; font-size: 10px; }.style1000 { font-family: Verdana; color: #666; font-size: 10px; }li { list-style-image: url("../Resources/bullet.gif") }--></STYLE></HEAD><BODY TOPMARGIN=0 LEFTMARGIN=0 MARGINHEIGHT=0 MARGINWIDTH=0 BGCOLOR="#ffffff" LINK="#000000" ALINK="#000000" VLINK="#000000"><DIV ID="LayoutTable"><TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH=752>	<TR VALIGN=TOP>		<TD COLSPAN=6></TD>		<TD HEIGHT=8></TD>	</TR>	<TR VALIGN=TOP>		<TD></TD>		<TD>		<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH=236>			<TR VALIGN=TOP>				<TD COLSPAN=2><IMG SRC="../Resources/item3a1b1a-9.gif" BORDER=0 WIDTH=235 HEIGHT=53 ALT="Reviver&reg; Data Recovery"></TD>				<TD HEIGHT=53></TD>			</TR>			<TR VALIGN=TOP>				<TD COLSPAN=2></TD>				<TD HEIGHT=4></TD>			</TR>			<TR VALIGN=TOP>				<TD></TD>				<TD><IMG SRC="../Resources/item3a1b1a1c.gif" BORDER=0 WIDTH=50 HEIGHT=20 ALT=""></TD>				<TD HEIGHT=20></TD>			</TR>			<TR>				<TD WIDTH=185><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=185 HEIGHT=1 ALT=""></TD>				<TD WIDTH=50><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=50 HEIGHT=1 ALT=""></TD>				<TD WIDTH=1 HEIGHT=1><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=1 HEIGHT=1 ALT=""></TD>			</TR>		</TABLE>		</TD>		<TD></TD>		<TD ROWSPAN=2>		<P><SPAN CLASS="TextRedBold">Now you can have the same solution that Data Recovery Centres Use!</SPAN></P>		<P><SPAN CLASS="Text">It doesn&#146;t take much to lose your data.&nbsp; One careless push of a button or a failed hard drive can put your irreplaceable files and months of hard work in critical condition.&nbsp; Fortunately, with our 'ReviveR&copy;' Data Recovery, bringing your lost files back to life is just as easy.&nbsp; Whether you&#146;re faced with the inconvenience of a single lost file or a catastrophic hard-drive crash, our data recovery can save you from having to recreate files or spend a lot of money to send your hard drive to a data recovery centre.&nbsp;</SPAN></P>		<P><SPAN CLASS="Text">With our 'ReviveR&copy;' Data Recovery, we can where possible, quickly restore data, that has been accidentally or intentionally deleted and reclaim files from corrupted media caused by a disk crash or logical system failure.&nbsp; We can even recover data if the partition has been reformatted or if the (FAT) File Allocation Tables have been destroyed.&nbsp;&nbsp;</SPAN></P></TD>		<TD ROWSPAN=2></TD>		<TD ROWSPAN=3>		<P><SPAN CLASS="Text">As long as your disk is still spinning, our data recovery software can locate and recover almost any file, anywhere on your disk, it means you&#146;ll never have to worry about data loss again.</SPAN></P>		<P><SPAN CLASS="Text">pchelpcentre.com support system is designed to meet your specific needs, whatever and wherever they are. Our award winning combination from Aktech Research our sister company&nbsp; comprises of innovative hardware for system analysis and software management for fixing software problems remotely plus data recovery for the dreaded hard disk crash... </SPAN></P>		<P><SPAN CLASS="Text">Our 'ReviveR&copy;' Data Recovery Software program, is the safest and most effective way to recover lost data.&nbsp;</SPAN></P>		<P><SPAN CLASS="Text">This winning combination will eliminate down-time and recover almost any file, anywhere on a disk drive and ultimately get you up and running more quickly than any other support system.</SPAN></P>		<P><UL><LI><A HREF="../signup.asp"><IMG SRC="../Resources/signup1.gif" BORDER=0 WIDTH=102 HEIGHT=18 ALIGN=MIDDLE HSPACE=0 VSPACE=0 ALT="signup1"></A><SPAN CLASS="Text"></SPAN></UL></TD>		<TD HEIGHT=78></TD>	</TR>	<TR VALIGN=TOP>		<TD COLSPAN=3></TD>		<TD HEIGHT=214></TD>	</TR>	<TR VALIGN=TOP>		<TD COLSPAN=5></TD>		<TD HEIGHT=46></TD>	</TR>	<TR>		<TD WIDTH=8><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=8 HEIGHT=1 ALT=""></TD>		<TD WIDTH=236><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=236 HEIGHT=1 ALT=""></TD>		<TD WIDTH=18><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=18 HEIGHT=1 ALT=""></TD>		<TD WIDTH=235><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=235 HEIGHT=1 ALT=""></TD>		<TD WIDTH=18><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=18 HEIGHT=1 ALT=""></TD>		<TD WIDTH=235><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=235 HEIGHT=1 ALT=""></TD>		<TD WIDTH=2 HEIGHT=1><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=2 HEIGHT=1 ALT=""></TD>	</TR></TABLE><TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH=752>	<TR VALIGN=TOP>		<TD COLSPAN=2></TD>		<TD HEIGHT=16></TD>	</TR>	<TR VALIGN=TOP>		<TD></TD>		<TD>		<P><SPAN CLASS="style1000">Terms &amp; conditions - All prices can change without prior notice. All orders must be placed before 5.00pm to ensure next day delivery (applicable in the UK only). Copyright 2002 PC HELP CENTRE LIMITED. Patent# 96.11846.8 Reviver is a trademark of PC Help Centre Ltd.. Information on this data sheet is subject to change without notice. Copyright 1992 to 2002. All rights reserved. (*) Onsite visits are allocated to a maximum two hours, thereafter a charge may be levied. (**) Phone support has a maximum of ten minutes before it may be closed, to give other members equal support. If the support department is unable to resolve it in the ten minute period, they will phone, email or use the web to assist the provision of the solution. (***) The FREE members callout charge is subject to a 25 mile radius of your nearest Computer Surgeon.</SPAN></P></TD>		<TD HEIGHT=120></TD>	</TR>	<TR>		<TD WIDTH=262><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=262 HEIGHT=1 ALT=""></TD>		<TD WIDTH=488><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=488 HEIGHT=1 ALT=""></TD>		<TD WIDTH=2 HEIGHT=1><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=2 HEIGHT=1 ALT=""></TD>	</TR></TABLE><TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH=752>	<TR VALIGN=TOP>		<TD COLSPAN=2></TD>		<TD HEIGHT=13></TD>	</TR>	<TR VALIGN=TOP>		<TD></TD>		<TD BGCOLOR="#cc0000"><SPACER TYPE=BLOCK WIDTH=1 HEIGHT=1></TD>		<TD HEIGHT=1></TD>	</TR>	<TR>		<TD WIDTH=4><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=4 HEIGHT=1 ALT=""></TD>		<TD WIDTH=746><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=746 HEIGHT=1 ALT=""></TD>		<TD WIDTH=2 HEIGHT=1><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=2 HEIGHT=1 ALT=""></TD>	</TR></TABLE><TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH=752>	<TR VALIGN=TOP>		<TD COLSPAN=2></TD>		<TD HEIGHT=10></TD>	</TR>	<TR VALIGN=TOP>		<TD></TD>		<TD>		<P><A HREF="../aboutus.html"><SPAN CLASS="Text" STYLE="color:inherit">About Us</SPAN></A><SPAN CLASS="Text">&nbsp;| </SPAN><A HREF="../contactus.asp"><SPAN CLASS="Text" STYLE="color:inherit">Contact us</SPAN></A><SPAN CLASS="Text"> | </SPAN><A HREF="../partners.html"><SPAN CLASS="Text" STYLE="color:inherit">Partners</SPAN></A><SPAN CLASS="Text"> | </SPAN><A HREF="../supportspecialis.asp"><SPAN CLASS="Text" STYLE="color:inherit">Support Specialists</SPAN></A><SPAN CLASS="Text"> | </SPAN><A HREF="../friendlysites.html"><SPAN CLASS="Text" STYLE="color:inherit">Friendly Sites</SPAN></A><SPAN CLASS="Text"></SPAN></P>		<P><SPAN CLASS="Text">Copyright &copy;2001 PC Help Centre Ltd</SPAN></P>		<P><IMG SRC="../Resources/topbanner2.jpeg" BORDER=0 WIDTH=742 HEIGHT=92 ALIGN=MIDDLE HSPACE=0 VSPACE=0 ALT=""><SPAN CLASS="Text"></SPAN></P></TD>		<TD HEIGHT=144></TD>	</TR>	<TR>		<TD WIDTH=8><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=8 HEIGHT=1 ALT=""></TD>		<TD WIDTH=742><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=742 HEIGHT=1 ALT=""></TD>		<TD WIDTH=2 HEIGHT=1><IMG SRC="../Resources/_clear.gif" BORDER=0 WIDTH=2 HEIGHT=1 ALT=""></TD>	</TR></TABLE></DIV></BODY></HTML>