<%

'func_admin_login(target_username, target_password)
Private function func_admin_login(target_username, target_password)
    dim login_data
    Set login_data = Server.CreateObject("ADODB.RecordSet")
    login_data.Open "SELECT * FROM ul_user_list WHERE ul_username = '"& target_username &"' AND ul_password = '"& target_password &"' ", Connect, adopenstatic, adlockreadonly
    if login_data.RecordCount = 1 then
        func_admin_login = "success"
    else
        func_admin_login = "failed"
    end if
end function

'func_date_format
Private function func_date_format(date_input, target_length)
    dim date_info
    date_info = date_input
    if len(date_info) = target_length then
        func_date_format = date_info
        exit function
    else if target_length = "2" then
        if len(date_info) = 2 then
            func_date_format = date_info
        else if len(date_info) < 2 then
            date_info = "0"&date_info
            func_date_format = date_info
        else
            date_info = "01"
            func_date_format = date_info
        end if
        end if
        exit function
    else if target_length = "4" then
        if len(date_info) <> 4 then
            date_info = year(date)
            func_date_format = date_info
        else
            func_date_format = date_info
        end if
        exit function
    end if
    end if
    end if
end function

'func_date_get_day
Private function func_date_get_day(serial_input)
    if len(serial_input) <> 8 then
        func_date_get_day = day(date)
    else
        func_date_get_day = right(serial_input, 2)
    end if
end function

'func_date_get_month
Private function func_date_get_month(serial_input)
    if len(serial_input) <> 8 then
        func_date_get_month = month(date)
    else
        func_date_get_month = mid(serial_input, 5, 2)
    end if
end function

'func_date_get_year
Private function func_date_get_year(serial_input)
    if len(serial_input) <> 8 then
        func_date_get_year = int(year(date))
    else
        func_date_get_year = int(left(serial_input, 4))
    end if
end function

'func_date_make_serial
Private function func_date_make_serial(date_input)
    Dim datearrayln, datearray, date_day, date_month, date_year
    datearray = split(date_input, "/", -1)
        datearrayln = Ubound(datearray)
        if datearrayln = 2 then
            date_month = func_date_format(int(datearray(0)), "2")
            date_day = func_date_format(int(datearray(1)), "2")
            date_year = func_date_format(int(datearray(2)), "4")
            func_date_make_serial = date_year & date_month & date_day
        else
            func_date_make_serial = func_date_format(year(date), "4") & func_date_format(month(date), "2") & func_date_format(day(date), "2")
        end if
end function

'func_date_serial_2_regular
Private function func_date_serial_2_regular(serial_input)
    if len(serial_input) <> 8 then
        func_date_serial_2_regular = func_date_format(month(date), "2") & "/" & func_date_format(day(date), "2") & "/" & func_date_format(year(date), "4")
    else
        func_date_serial_2_regular = func_date_get_month(serial_input) & "/" & func_date_get_day(serial_input) & "/" & func_date_get_year(serial_input)
    end if
end function

'func_date_serial_2_regular_long
Private function func_date_serial_2_regular_long(serial_input)
    if len(serial_input) <> 8 then
        func_date_serial_2_regular_long = func_date_format(month(date), "2") & "/" & func_date_format(day(date), "2") & "/" & func_date_format(year(date), "4")
    else
        func_date_serial_2_regular_long = FormatDateTime(func_date_serial_2_regular(serial_input), vbLongDate)
    end if
end function


'func_onlynumbers
Private function func_onlynumbers(input_string)
    dim regEx, strTagLess
    strTagless = func_clearhtml(input_string)
    set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = "([^0-9])"
    strTagLess = regEx.Replace(strTagLess, "")
    set regEx = nothing
    if strTagLess = "" then
        strTagLess = "0"
    else
    end if
    func_onlynumbers = strTagLess
end function

'func_currency
Private function func_currency(input_string)
    dim regEx, strTagLess
    strTagless = func_clearhtml(input_string)
    set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = "([^0-9\s\.\,])"
    strTagLess = regEx.Replace(strTagLess, "")
    set regEx = nothing
    if strTagLess = "" then
        strTagLess = "0"
    else
    end if
    func_currency = strTagLess
end function

'func_clearhtml(strHTML)
Private function func_clearhtml(strHTML)

        dim regEx, strTagLess
        strTagless = trim(strHTML)
        if strTagLess = "" then
        else
            'strTagless = replace(strTagless, "`", "&rsquo;")
            strTagless = replace(strTagless, "'", "`")
                set regEx = New RegExp
                regEx.IgnoreCase = True
                regEx.Global = True
                regEx.Pattern = "<[^>]*>"
                if tb_allow_html = "no" then
                    strTagLess = regEx.Replace(strTagLess, "")
                else
                end if
        end if
        set regEx = nothing
        func_clearhtml = trim(strTagLess)
end function

'func_no_html(strHTML)
Private function func_no_html(strHTML)
        dim regEx, strTagLess
        strTagless = strHTML
        if strTagLess = "" then
        else
            'strTagless = replace(strTagless, "`", "&rsquo;")
            strTagless = replace(strTagless, "'", "`")
                set regEx = New RegExp
                regEx.IgnoreCase = True
                regEx.Global = True
                regEx.Pattern = "<[^>]*>"
                strTagLess = regEx.Replace(strTagLess, "")
        end if
        set regEx = nothing
        func_no_html = trim(strTagLess)
end function

'HTMLDecode(sText)
Private function HTMLDecode(sText)
    Dim I
    sText = Replace(sText, """, Chr(34))
    sText = Replace(sText, "<" , Chr(60))
    sText = Replace(sText, ">" , Chr(62))
    sText = Replace(sText, "&" , Chr(38))
    sText = Replace(sText, "&nbsp;", Chr(32))
    For I = 1 to 255
    sText = Replace(sText, "&#" & I & ";", Chr(I))
    Next
    HTMLDecode = sText
End Function

'func_tags_select_numeric_range
Private function func_tags_select_numeric_range(start_num, end_num, default_entry, desired_name)
    if start_num = "" OR end_num = "" OR start_num >= end_num then
        func_tags_select_numeric_range = "<font color='red'>Failure -- Bad Input</font>"
    else
        Dim http_stream, counter
        http_stream = ""
        counter = int(start_num)
            if desired_name = "" then
                desired_name = "form_numeric_range"
            else
            end if
                http_stream = "<select name='" & desired_name & "'>"
                    do while counter <= int(end_num)
                        http_stream = http_stream & "<option "
                            if counter = int(default_entry) then
                                http_stream = http_stream & "selected "
                            else
                            end if
                        if len(counter) = 1 OR len(counter) = 2 then
                            counter = func_date_format(counter, "2")
                        else
                            counter = func_date_format(counter, "4")
                        end if
                        http_stream = http_stream & "value='" & counter & "'>" & counter & "</option>"
                    counter = counter+1
                    loop
                    http_stream = http_stream & "</select>"
        func_tags_select_numeric_range = http_stream
    end if
end function

'func_tags_select_pic(target_folder, default_entry, desired_name)
Private function func_tags_select_pic(target_folder, default_entry, desired_name)
    if target_folder = "" then
        response.Redirect("error.asp?err=func_tags_select_pic Function -- Bad target_folder")
    else if default_entry = "" then
        response.Redirect("error.asp?err=func_tags_select_pic Function -- Bad default_entry")
    else if desired_name = "" then
        response.Redirect("error.asp?err=func_tags_select_pic Function -- Bad desired_name")
    else
        Dim filesys, pic_data, http_stream, work_folder, work_path, work_files, file
            work_path = Server.Mappath("/custom/" & target_folder)
        Set filesys = CreateObject("scripting.filesystemobject")
            If filesys.FolderExists(work_path) = True Then
                Set work_folder = filesys.GetFolder(work_path)
                    Set work_files = work_folder.files
                        if desired_name = "" then
                            desired_name = "form_picture"
                        else
                        end if
                    http_stream = "<select name='" & desired_name & "'>"
                        for each file in work_files
                            http_stream = http_stream & "<option "
                            if default_entry = file.Name then
                                http_stream = http_stream & "selected "
                            else
                            end if
                        http_stream = http_stream & "value='" & file.Name & "'>" & file.Name & "</option>"
                        next
                    http_stream = http_stream & "</select>"
                Set work_folder = nothing
                Set work_files = nothing
                Set filesys = nothing
            else
                response.Redirect("error.asp?err=func_tags_select_pic Function -- target_folder doesnt exist --- " & work_path)
            end if
        func_tags_select_pic = http_stream
    end if
    end if
    end if
end function

'func_tags_spacer
Private function func_tags_spacer(width, height)
    Dim http_stream
        http_stream = "<img height='" & height & "' width='" & width & "' src='images/spacer.gif' class='invisible_img' alt='" & tb_status & "'>"
        func_tags_spacer = http_stream
end function

'func_show_html(strHTML)
Private function func_show_html(strHTML)
    dim strTagLess
    strTagless = trim(strHTML)
    if tb_convert_breaks = "yes" then
        strTagless = replace(strTagless, vbcrlf, "<br>")
    else
    end if
    if len(strTagless) > 0 then
     strTagless = replace(strTagless, "�", "'")
     func_show_html = trim(strTagLess)
    end if
end function

'func_show_code(strHTML)
Private function func_show_code(strHTML)
    dim strTagLess
    strTagless = trim(strHTML)
    if tb_convert_breaks = "yes" then
        strTagless = replace(strTagless, "<br>", vbcrlf)
    else
    end if
    if len(strTagless) > 0 then
        strTagless = replace(strTagless, "'", "�")
    else
        strTagless = strTagless
    end if
    func_show_code = trim(strTagLess)
end function

%>