'
'// Written by Donn Edwards 
'   Version 1.06 (c) 2009-2010 Black and White Inc. All rights reserved.
'   This is the VB.NET version. The VBA version uses Long instead of Integer
'
' ---------------------------------------------------------------------------
' From www.developerdotstar.com:
'
' Principled Programming:
' =======================
'
' Personal Character
' ------------------
' Write your code so that it reflects, or rises above, the best parts of your
' personal character.
'
' Aesthetics
' ----------
' Strive for beauty and elegance in every aspect of your work.
'
' Clarity
' -------
' Value clarity equally with correctness. Utilize the proven techniques that
' will produce clarity in your code. Correctness will likely follow suit.
'
' Layout
' ------
' Use the visual layout of your code to communicate the structure of your code
' to human readers.
'
' Explicitness
' ------------
' Always favour the explicit over the implicit.
'
' Self-Documenting Code
' ---------------------
' The most reliable document of software is the code itself. In many cases,
' the code is the *only* documentation. Therefore, strive to make your code
' self-documenting, and where you can't, add comments.
'
' Comments
' --------
' Comment in full sentences in order to summarize and communicate intent.
'
' Assumptions
' -----------
' Take reasonable steps to test, document, and otherwise draw attention to the
' assumptions made in every module and routine.
'
' User Interaction
' ----------------
' Never make the user feel stupid.
'
' Going Back
' ----------
' The time to write good code is at the time you are writing it.
'
' Other People's Time and Money
' -----------------------------
' A true professional does not waste the time and money of other people by
' handing over software that is not reasonably free of obvious bugs; that has
' not undergone minimal unit testing; that does not meet the specifications and
' requirements; that is gold-plated with unnecessary features; or that looks
' like junk.
'
' Written by Daniel Read www.developerdotstar.com>
'
' -----------------------------------------------------------------------------


Imports Microsoft.VisualBasic
Imports System.Web.Configuration
Imports System.Data
Imports System.Data.SqlClient

Public Class clsText
    '
    '// Text handling functions
    '
    'Private oTxt As New clsText
    '
    Const HIDE_KEY As String = "..Zo.LD.Ts.D8.ps.ok.DJ.Ui.DY.oB.s4.gt.Rw.LM.fn.1Y.lj.yX.bu.vY.yP.c0.cU.eC.77.p8.6p.7N.W6.Mg.zS.Ez.7s.dw.hm.nY.Ix.x5.TQ.pf.IB.3Y.hO.8a.S1.Aa.la.H2.og.8j.N7.R1.0J.CD.jt.ue.7n.Zc.yT.a5.wZ.sV.gH.iF.Vq.28.cN.Of.rI.fq.a7.c3.5j.7q.uT.cd.cr.ii.iF.s3.nX.vL.YQ.wt.Ns.3b.6j.xv.Pt.4n.Ht.SE." ' Demo
    Const HIDE_LETTERS As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890_!@#$%^&*,.'          "
	'
	' How to create your own HIDE_KEY string:
	' Visit https://www.grc.com/passwords.htm and get 3 consecutive passwords from the 63 random alpha-numeric characters (a-z, A-Z, 0-9) box
    ' Put them n the key as shown above, with two dots at the beginning, and a dot after every 2 characters.
    ' Test the entire alphabet as follows
    ' debug.print xUnHide(xHide("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890_!@#$%^&*,.'")
    ' If you don't get the same pattern back, then there are duplicate letter pairs.
    '
    Public Function strAlphaOnly(ByVal pstrText As String) As String
        '// Extract just the Alpha chars from a string, plus limited puctuation
        '   Version 1.67.33 (c) 2003 Black and White Inc
        Dim strTemp As String
        Dim i AS Integer
        strTemp = ""
        For i = 1 To Len(pstrText)
            If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz 1234567890_!@#$%^&/,.+-'", Mid$(pstrText, i, 1)) > 0 Then
                strTemp = strTemp & Mid$(pstrText, i, 1)
            End If
        Next i
        strTemp = Trim(Replace(strTemp, "  ", " "))
        strTemp = Trim(Replace(strTemp, "--", "")) ' -- not allowed
        strTemp = Trim(Replace(strTemp, "  ", " "))
        strAlphaOnly = strTemp
    End Function ' strAlphaOnly
    '
    Public Function AlphaSort(ByVal strIn As String) As String
        '// Returns one copy of each letter in the string, in alphabetical order
        '   ? alphasort("alphabet") returns
        '   ABEHLPT
        '   Version 1.81.16 (c) 2004, 2006 Black and White Inc
        Const ALPHA As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
        Dim strOut As String, n As Integer
        strOut = ""
        strIn = UCase(strIn)
        For n = 1 To Len(ALPHA)
            If InStr(1, strIn, Mid$(ALPHA, n, 1)) > 0 Then
                strOut = strOut & Mid$(ALPHA, n, 1)
            End If
        Next n
        AlphaSort = strOut
    End Function
    '
    Public Function xSQL(ByVal strIn As String) As String
        '// Make sure the data will work in a SQL query
        '   Version 1.83.14 (c) 2005-2007 Black and White Inc
        xSQL = Replace(Replace(Replace(strIn, "'", "''"), "''''", "''"),";","")
    End Function
    '
    Public Function strLong(ByVal pstrText As String) As String
        '// Extract just the 0-9 chars from a string
        '   Version 1.67.33 (c) 2003 Black and White Inc
        Dim strTemp As String
        Dim i AS Integer
        strTemp = ""
        For i = 1 To Len(pstrText)
            If InStr(1, "1234567890", Mid$(pstrText, i, 1)) > 0 Then
                strTemp = strTemp & Mid$(pstrText, i, 1)
            End If
        Next i
        strLong = Left(strTemp, 20)
    End Function ' strLong
    '
    Public Function strCharField(ByVal pstrText As String, ByVal intLen As Integer) As String
        '// Extract just the Alpha chars from a string
        '   Version 1.67.33 (c) 2003 Black and White Inc
        Dim strTemp As String
        Dim i AS Integer
        strTemp = ""
        For i = 1 To Len(pstrText)
            If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890", Mid$(pstrText, i, 1)) > 0 Then
                strTemp = strTemp & Mid$(pstrText, i, 1)
            End If
        Next i
        strCharField = "'" & UCase(Left(strTemp, intLen)) & "'"
    End Function ' strCharField
    '
    Public Function xChangeCase(ByVal strIn As String, _
        ByVal strUpperLowerTitle As String) As String
        '// Return string with case set to upper, lower or mixed
        '   Version 1.83.31 (c) 2003-2008 Black and White Inc
        '   U - Upper case
        '   L - Lower case
        '   F - The first letter must be caps, thereafter who cares.
        '   N - Name case: The first letter must be caps, except for certain surnames,
        '       like van der Merwe.
        '   A - Address case: First letter of each word in caps,
        '       plus fix up p.o.box to P O Box
        '   S - Sentence case: mostly lower case but force a capital at the start of each
        '       sentence. Lower case is not forced
        '   T - Title case: force lower case, but with the first letter caps,
        '       except for "the", "an", "a", "and"
        '   D - Digital: only allow numbers and some numeric punctuation like ./-
        '       to cater for dates and negative numbers
        '   0 - 0..9 only, and ;
        '   Note that a ~ at the end will preserve the formatting as styped, but the ~
        '   itself is dropped. To keep the tilde, use \~
        Dim strTemp As String, n As Integer
        strUpperLowerTitle = UCase(Left$(strUpperLowerTitle & ".", 1))
        If InStr(1, ".FDULNATSO0", strUpperLowerTitle) <= 1 Then strUpperLowerTitle = "U"
        strTemp = " " & Trim(strIn)
        n = Len(strTemp)
        If Mid$(strTemp, n) = "~" Then '~
            If n > 1 Then If Mid$(strTemp, n - 1, 2) <> "\~" Then strTemp = Left(strTemp, n - 1)
        Else '~
            strTemp = strIn & " "
            strTemp = Replace(strTemp, "'", "' ") ' O'Reilly
            strTemp = Replace(strTemp, ".", ". ")
            strTemp = Replace(strTemp, " .", ".")
            strTemp = Replace(strTemp, ",", ", ")
            strTemp = Replace(strTemp, " ,", ",")
            strTemp = Replace(strTemp, "/", "/ ")
            strTemp = Replace(strTemp, "(", "( ")
            strTemp = Replace(strTemp, " /", "/")
            strTemp = Replace(strTemp, "--", " — ")
            strTemp = Replace(strTemp, "-", " - ")
            strTemp = Replace(strTemp, "  ", " ")
            '// Decide how to change the case
            Select Case strUpperLowerTitle
                Case "D" ' Digital/Date
                    strTemp = strNoAlpha(strTemp)
                Case "O", "0" ' Digital/Date
                    strTemp = strDigits(strTemp, False, ";")
                Case "U" : strTemp = UCase(strTemp) ' UPPER
                Case "L" : strTemp = LCase(strTemp) ' lower
                Case "F" ' First letter (notes, etc.)
                    strTemp = UCase(Left$(strTemp, 1)) & Mid$(strTemp, 2)
                Case "N", "A" ' Name, Address capitalisation
                    '
                    '// Name, Address capitalisation
                    '
                    strTemp = " " & LCase(Trim(strTemp))
                    n = InStr(1, strTemp, " ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 1)) & Mid$(strTemp, n + 2)
                        n = InStr(n + 1, strTemp, " ")
                    End While ' n
                    '// Quotes
                    n = InStr(1, strTemp, """")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 1)) & Mid$(strTemp, n + 2)
                        n = InStr(n + 1, strTemp, """")
                    End While ' n
                    '// Quotes follwed by a space
                    n = InStr(1, strTemp, "!"" ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 3)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 1, strTemp, "!"" ")
                    End While ' n
                    '// Quotes follwed by a space
                    n = InStr(1, strTemp, "?"" ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 3)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 1, strTemp, "?"" ")
                    End While ' n
                    '// Quotes follwed by a space
                    n = InStr(1, strTemp, "."" ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 3)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 1, strTemp, "."" ")
                    End While ' n
                    strTemp = Replace(strTemp, " po box ", " P O Box ")
                    strTemp = Replace(strTemp, " pobox ", " P O Box ")
                    strTemp = Replace(strTemp, " p. o. box ", " P O Box ")
                    strTemp = Replace(strTemp, " p. o box ", " P O Box ")
                    strTemp = Replace(strTemp, " p/ bag ", " P/Bag ")
                    strTemp = Replace(strTemp, "' s ", "'s ") ' Donn's
                    strTemp = Replace(strTemp, " ' n ", " 'n ") ' Rock 'n Roll
                    '// Surnames
                    'strTemp = Replace(strTemp, " de ", " de ")
                    strTemp = Replace(strTemp, " van ", " van ")
                    strTemp = Replace(strTemp, " van de ", " van de ")
                    strTemp = Replace(strTemp, " van der ", " van der ")
                    strTemp = Replace(strTemp, " van den ", " van den ")

                    '// Some roman numerals and the letter I
                    strTemp = Replace(strTemp, " i ", " I ") ' I
                    strTemp = Replace(strTemp, " ii ", " II ") ' II
                    strTemp = Replace(strTemp, " iii ", " III ") ' III
                    strTemp = Replace(strTemp, " iv ", " IV ") ' IV
                    strTemp = Replace(strTemp, " v ", " V ") ' V

                    strTemp = Replace(strTemp, " cc ", " CC ") ' CC

                    '// McDonald and Macdonald
                    ' Don't forget the Mc's (McDonald, McMullan, etc.)
                    n = InStr(1, strTemp, " Mc")
                    While n > 0
                        strTemp = Left$(strTemp, n + 2) & UCase(Mid$(strTemp, n + 3, 1)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 3, strTemp, " Mc")
                    End While ' n
                    strTemp = Replace(strTemp, " McH", " Mch") ' Mchunu
                    strTemp = Replace(strTemp, " McU", " Mcu") ' Mcube

                    strTemp = Trim(strTemp) ' Trim the leading space(s)
                    strTemp = UCase(Left$(strTemp, 1)) & Mid$(strTemp, 2) ' first letter must be caps
                    ' Name, Address capitalisation
                Case "T" ' Title Case
                    '
                    '// Title Case
                    '   From Treble and Vallins, "ABC of English Usage"
                    '   The first word of the title always begins with a capital,
                    '   and the other chief words of the title
                    '   (e.g. nouns, verbs, descriptive adjectives):
                    '   A Tale of Two Cities
                    '   The Ring and the Book
                    '   It is Never too Late to Mend
                    '   Much Ado about Nothing
                    '
                    strTemp = " " & LCase(Trim(strTemp))
                    n = InStr(1, strTemp, " ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 1)) & Mid$(strTemp, n + 2)
                        n = InStr(n + 1, strTemp, " ")
                    End While ' n
                    '// Quotes
                    n = InStr(1, strTemp, """")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 1)) & Mid$(strTemp, n + 2)
                        n = InStr(n + 1, strTemp, """")
                    End While ' n
                    '// Quotes follwed by a space
                    n = InStr(1, strTemp, "!"" ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 3)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 1, strTemp, "!"" ")
                    End While ' n
                    '// Quotes follwed by a space
                    n = InStr(1, strTemp, "?"" ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 3)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 1, strTemp, "?"" ")
                    End While ' n
                    '// Quotes follwed by a space
                    n = InStr(1, strTemp, "."" ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 3)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 1, strTemp, "."" ")
                    End While ' n
                    strTemp = Replace(strTemp, "' s ", "'s ") ' Donn's
                    strTemp = Replace(strTemp, " ' n ", " 'n ") ' Rock 'n Roll

                    '// Small words
                    strTemp = Replace(strTemp, " the ", " the ")
                    strTemp = Replace(strTemp, " a ", " a ")
                    strTemp = Replace(strTemp, " an ", " an ")
                    strTemp = Replace(strTemp, " is ", " is ")

                    strTemp = Replace(strTemp, " to ", " to ")
                    strTemp = Replace(strTemp, " too ", " too ")
                    strTemp = Replace(strTemp, " of ", " of ")

                    '// Conjunction: and but or
                    strTemp = Replace(strTemp, " and ", " and ")
                    strTemp = Replace(strTemp, " but ", " but ")
                    strTemp = Replace(strTemp, " or ", " or ")
                    strTemp = Replace(strTemp, " as ", " as ")

                    '// Preposition: to from at in
                    strTemp = Replace(strTemp, " to ", " to ")
                    strTemp = Replace(strTemp, " from ", " from ")
                    strTemp = Replace(strTemp, " at ", " at ")
                    strTemp = Replace(strTemp, " in ", " in ")

                    '// Some roman numerals and the letter I
                    strTemp = Replace(strTemp, " i ", " I ") ' I
                    strTemp = Replace(strTemp, " ii ", " II ") ' II
                    strTemp = Replace(strTemp, " iii ", " III ") ' III
                    strTemp = Replace(strTemp, " iv ", " IV ") ' IV
                    strTemp = Replace(strTemp, " v ", " V ") ' V

                    strTemp = Replace(strTemp, " cc ", " CC ") ' CC

                    '// McDonald and Macdonald
                    ' Don't forget the Mc's (McDonald, McMullan, etc.)
                    n = InStr(1, strTemp, " Mc")
                    While n > 0
                        strTemp = Left$(strTemp, n + 2) & UCase(Mid$(strTemp, n + 3, 1)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 3, strTemp, " Mc")
                    End While ' n

                    strTemp = Trim(strTemp)
                    strTemp = UCase(Left$(strTemp, 1)) & Mid$(strTemp, 2)
                    ' Title Case
                Case "S" ' Sentence
                    '
                    '// Sentence
                    '
                    strTemp = " " & Trim(strTemp)
                    '// Look for full stop
                    n = InStr(1, strTemp, ".")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 2)) & Mid$(strTemp, n + 3)
                        n = InStr(n + 1, strTemp, ".")
                    End While ' n
                    '// Look for Question
                    n = InStr(1, strTemp, "?")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 2)) & Mid$(strTemp, n + 3)
                        n = InStr(n + 1, strTemp, "?")
                    End While ' n
                    '// Look for Exclamation
                    n = InStr(1, strTemp, "!")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 2)) & Mid$(strTemp, n + 3)
                        n = InStr(n + 1, strTemp, "!")
                    End While ' n
                    '// Quotes
                    n = InStr(1, strTemp, """")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 1)) & Mid$(strTemp, n + 2)
                        n = InStr(n + 1, strTemp, """")
                    End While ' n
                    '// Quotes follwed by a space
                    n = InStr(1, strTemp, "!"" ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 3)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 1, strTemp, "!"" ")
                    End While ' n
                    '// Quotes follwed by a space
                    n = InStr(1, strTemp, "?"" ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 3)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 1, strTemp, "?"" ")
                    End While ' n
                    '// Quotes follwed by a space
                    n = InStr(1, strTemp, "."" ")
                    While n > 0
                        strTemp = Left$(strTemp, n) & UCase(Mid$(strTemp, n + 1, 3)) & Mid$(strTemp, n + 4)
                        n = InStr(n + 1, strTemp, "."" ")
                    End While ' n
                    strTemp = Replace(strTemp, "' s ", "'s ") ' Donn's
                    strTemp = Replace(strTemp, " ' n ", " 'n ") ' Rock 'n Roll

                    '// Some roman numerals and the letter I
                    strTemp = Replace(strTemp, " i ", " I ") ' I
                    strTemp = Replace(strTemp, " ii ", " II ") ' II
                    strTemp = Replace(strTemp, " iii ", " III ") ' III
                    strTemp = Replace(strTemp, " iv ", " IV ") ' IV
                    strTemp = Replace(strTemp, " v ", " V ") ' V

                    strTemp = Replace(strTemp, " cc ", " CC ") ' CC

                    strTemp = Trim(strTemp)
                    strTemp = UCase(Left$(strTemp, 1)) & Mid$(strTemp, 2)
                    'Sentence
            End Select
            strTemp = Replace(strTemp, " - ", "-")
            strTemp = Replace(strTemp, "( ", "(")
            strTemp = Replace(strTemp, "' ", "'")
            '
            strTemp = Replace(strTemp, ". 0", ".0") ' numbers
            strTemp = Replace(strTemp, ". 1", ".1") ' numbers
            strTemp = Replace(strTemp, ". 2", ".2") ' numbers
            strTemp = Replace(strTemp, ". 3", ".3") ' numbers
            strTemp = Replace(strTemp, ". 4", ".4") ' numbers
            strTemp = Replace(strTemp, ". 5", ".5") ' numbers
            strTemp = Replace(strTemp, ". 6", ".6") ' numbers
            strTemp = Replace(strTemp, ". 7", ".7") ' numbers
            strTemp = Replace(strTemp, ". 8", ".8") ' numbers
            strTemp = Replace(strTemp, ". 9", ".9") ' numbers
            '
            strTemp = Replace(strTemp, ", 0", ",0") ' numbers
            strTemp = Replace(strTemp, ", 1", ",1") ' numbers
            strTemp = Replace(strTemp, ", 2", ",2") ' numbers
            strTemp = Replace(strTemp, ", 3", ",3") ' numbers
            strTemp = Replace(strTemp, ", 4", ",4") ' numbers
            strTemp = Replace(strTemp, ", 5", ",5") ' numbers
            strTemp = Replace(strTemp, ", 6", ",6") ' numbers
            strTemp = Replace(strTemp, ", 7", ",7") ' numbers
            strTemp = Replace(strTemp, ", 8", ",8") ' numbers
            strTemp = Replace(strTemp, ", 9", ",9") ' numbers
        End If '~
        xChangeCase = Trim(strTemp)
    End Function

    Public Function strNoAlpha(ByVal pstrText As String, Optional ByVal blnPunctuation As Boolean = False) As String
        '// Extract just the 0-9 plus optional punctuation chars from a string
        '   Version 1.68.35 (c) 2003 Black and White Inc
        'Dim nLevel as integer
        'nLevel = DbugIn("strAlphaOnly " & pstrText
        Dim strTemp As String
        Dim i AS Integer
        strTemp = ""
        For i = 1 To Len(pstrText)
            If InStr(1, "01234567890./-" & IIf(blnPunctuation, "!@#$%^&*()_+-={}|[]\:""'<>?,./~`", ""), Mid$(pstrText, i, 1)) > 0 Then
                strTemp = strTemp & Mid$(pstrText, i, 1)
            End If
        Next i
        strNoAlpha = strTemp
        'dbugout nLevel strTemp
    End Function
    '
    Public Function strDigits(ByVal pstrText As String, Optional ByVal blnDecimal As Boolean = False, Optional ByVal strExtra As String = "") As String
        '// Extract just the 0-9 digits from a string
        '   Version 1.76.33 (c) 1999-2004 Black and White Inc
        'Dim nLevel as integer
        'nLevel = DbugIn("strDigits " & pstrText)
        Dim strTemp As String
        Dim i AS Integer
        strTemp = ""
        For i = 1 To Len(pstrText)
            If InStr(1, "1234567890" & strExtra & IIf(blnDecimal, ".+-", ""), Mid$(pstrText, i, 1)) > 0 Then
                strTemp = strTemp & Mid$(pstrText, i, 1)
            End If
        Next i
        strDigits = strTemp
        'dbugout nLevel strTemp
    End Function
    
    Public Function lngPasswordTest(ByVal pstrTestText As String, ByVal intMinLength As Integer) AS Integer
        '// Returns value for each of password containing 1 upper case, 1 lower case, 1 number, 1 punctuation
        '   Version 1.83.46 (c) 2009 Black and White Inc
        Dim blnUpperCase As Boolean, blnLowerCase As Boolean, blnNumeric As Boolean, blnPunctuation As Boolean
        Dim n AS Integer, i AS Integer, blnIllegal As Boolean
        pstrTestText = Trim(pstrTestText)
        n = Len(pstrTestText)
        blnUpperCase = False
        blnLowerCase = False
        blnNumeric = False
        blnPunctuation = False
        blnIllegal = False
        If n < intMinLength Then GoTo Results ' no checking if password is too short
        '// Test for unwanted characters _!@#$%^&*,.
        For i = 1 To n
            If InStr(1, """()-+={}|[]\;:<>?/~` ", Mid$(pstrTestText, i, 1), vbBinaryCompare) > 0 Then
                blnIllegal = True ' Found one!
                GoTo Results
            End If
        Next
        '
        '// Test for upper case
        For i = 1 To n
            If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid$(pstrTestText, i, 1), vbBinaryCompare) > 0 Then
                blnUpperCase = True ' Found one!
                GoTo Lowercase
            End If
        Next
Lowercase:  '// Test for lower case
        For i = 1 To n
            If InStr(1, "abcdefghijklmnopqrstuvwxyz", Mid$(pstrTestText, i, 1), vbBinaryCompare) > 0 Then
                blnLowerCase = True ' Found one!
                GoTo Numeric
            End If
        Next
Numeric:  '// Test for numbers
        For i = 1 To n
            If InStr(1, "1234567890", Mid$(pstrTestText, i, 1), vbBinaryCompare) > 0 Then
                blnNumeric = True ' Found one!
                GoTo Punctuation
            End If
        Next
Punctuation:  '// Test for punctuation _!@#$%^&*,.' - Make sure ;=<> are excluded /* --
        For i = 1 To n
            If InStr(1, "_!@#$%^&*,.'", Mid$(pstrTestText, i, 1), vbBinaryCompare) > 0 Then
                blnPunctuation = True ' Found one!
                GoTo Results
            End If
        Next
Results: i = 0
        If blnUpperCase Then i = i + 1
        If blnLowerCase Then i = i + 1
        If blnNumeric Then i = i + 1
        If blnPunctuation Then i = i + 1
        If blnIllegal Then i = -1
        lngPasswordTest = i
    End Function ' lngPasswordTest  

    Public Function blnYN(ByVal pstrText As String) As Boolean
        '// Extract just the True/False chars from a string
        '   Version 1.83.46 (c) 2009 Black and White Inc
        Dim strTemp As String
        Dim i AS Integer
        pstrText = Trim(pstrText & " ")
        strTemp = ""
        For i = 1 To Len(pstrText)
            If InStr(1, "TtYy1FfNn0", Mid$(pstrText, i, 1)) > 0 Then
                strTemp = strTemp & Mid$(pstrText, i, 1)
            End If
        Next i
        strTemp = Left(Trim(strTemp) & "0", 1)
        '                        1234567890
        blnYN = CBool(InStr(1, "TtYy1", strTemp) > 0) ' Return True or False (default is false)
    End Function ' blnYN

    Public Function xHexString(ByVal strIn As String) As String
        '// Turn a normal string into a hex string
        '   Version 1.68.42 (c) 2002-2003 Black and White Inc
        Dim n As Integer, strOut As String
        strOut = ""
        For n = 1 To Len(strIn)  ' FOR 1
            strOut = strOut & Right$("0" & Hex(ASc(Mid$(strIn, n, 1))), 2)
        Next  ' FOR 1
        xHexString = strOut
    End Function

    Public Function xDeHexString(ByVal strIn As String) As String
        '// Turn a hex string into a normal string
        '   Version 1.83.46 (c) 2002-2009 Black and White Inc
        Dim n As Integer, strOut As String, strTemp As String
        strTemp = ""
        For n = 1 To Len(strIn)
            If InStr(1, "1234567890ABCDEFabcdef", Mid$(strIn, n, 1)) > 0 Then
                strTemp = strTemp & UCase(Mid$(strIn, n, 1))
            End If
        Next n
        strOut = ""
        For n = 1 To Len(strTemp) Step 2 ' FOR 1
            strOut = strOut & Chr(CByte("&H" & Mid$(strTemp, n, 2)))
        Next  ' FOR 1
        xDeHexString = strOut
    End Function

    '---------------- Hide/Unhide ------------------------
    '
    Public Function xHide(ByVal pstrText As String) As String
        '// Hide standard alphabet in collection of random 2-letter pairs
        '   Version 1.83.46 (c) 2009 Black and White Inc
        Dim strTemp As String
        Dim i As Integer, n As Integer
        strTemp = ""
        For i = 1 To Len(pstrText)
            n = InStr(1, HIDE_LETTERS, Mid$(pstrText, i, 1), vbBinaryCompare)
            If n = 75 Then n = 75 + Rnd() * 10 ' Spaces get special treatment: up to 10 random pairs
            If n > 0 Then
                strTemp = strTemp & Mid$(HIDE_KEY, n * 3, 2)
            End If
        Next i
        xHide = strTemp
    End Function

    Public Function xUnHide(ByVal pstrText As String) As String
        '// Retrieve standard alphabet from collection of random 2-letter pairs
        '   Version 1.83.46 (c) 2009 Black and White Inc
        Dim strTemp As String
        Dim i As Integer, n As Integer
        strTemp = ""
        For i = 1 To Len(pstrText) / 2
            n = InStr(1, HIDE_KEY, "." & Mid$(pstrText, (i * 2) - 1, 2) & ".", vbBinaryCompare)
            If n > 0 Then
                n = Int((n + 1) / 3)
                strTemp = strTemp & Mid$(HIDE_LETTERS, n, 1)
            End If
        Next i
        xUnHide = strTemp
    End Function
    '
    Public Function NewESN(ByVal strInc As String, ByVal strPK As String, ByVal iInc As Integer) As Integer
        '// Increment a simple Extended Serial Number value
        '   Version 1.84.55 (c) 2010 Black and White Inc
        Dim myConnect As New SqlConnection
        Dim strConnect As String = WebConfigurationManager.ConnectionStrings("dbConnectionString").ConnectionString
        Dim mySQLcmd As New SqlCommand
        Dim myReader As SqlDataReader
        Dim n As Long = 0
        myConnect.ConnectionString = strConnect
        Try
            myConnect.Open()
            mySQLcmd.Connection = myConnect
            mySQLcmd.CommandText = "SELECT * FROM " & strInc & " WHERE zpk = '~ZREC~'"
            myReader = mySQLcmd.ExecuteReader

            If myReader.HasRows Then
                myReader.Read()
                n = Val(myReader("zsn"))
            Else
                myConnect.Close()
                myConnect.Open()
                mySQLcmd.Connection = myConnect
                mySQLcmd.CommandText = "INSERT INTO " & strInc & " (zpk,zsn) VALUES('~ZREC~',0)"
                If mySQLcmd.ExecuteNonQuery > 0 Then
                    n = 0
                End If
            End If
            myConnect.Close()
            n = n + iInc
            myConnect.Open()
            mySQLcmd.Connection = myConnect
            mySQLcmd.CommandText = "UPDATE " & strInc & " SET zsn=" & CStr(n)
            If mySQLcmd.ExecuteNonQuery = 0 Then
                n = -1
            End If
        Catch ex As Exception
            n = -1
        Finally
            myConnect.Close()
        End Try
        NewESN = n
    End Function ' NewESN
    '
    Public Function ReadESN(ByVal strInc As String, ByVal strPK As String, ByVal iInc As Integer) As Integer
        '// Read a simple Extended Serial Number value
        '   Version 1.84.55 (c) 2010 Black and White Inc
        Dim myConnect As New SqlConnection
        Dim strConnect As String = WebConfigurationManager.ConnectionStrings("dbConnectionString").ConnectionString
        Dim mySQLcmd As New SqlCommand
        Dim myReader As SqlDataReader
        Dim n As Long = 0
        myConnect.ConnectionString = strConnect
        Try
            myConnect.Open()
            mySQLcmd.Connection = myConnect
            mySQLcmd.CommandText = "SELECT * FROM " & strInc & " WHERE zpk = '~ZREC~'"
            myReader = mySQLcmd.ExecuteReader

            If myReader.HasRows Then
                myReader.Read()
                n = Val(myReader("zsn"))
            Else
                myConnect.Close()
                myConnect.Open()
                mySQLcmd.Connection = myConnect
                mySQLcmd.CommandText = "INSERT INTO " & strInc & " (zpk,zsn) VALUES('~ZREC~',0)"
                If mySQLcmd.ExecuteNonQuery > 0 Then
                    n = 0
                End If
            End If
            myConnect.Close()
            '
        Catch ex As Exception
            n = -1
        Finally
            myConnect.Close()
        End Try
        ReadESN = n
    End Function ' ReadESN
End Class