<% Option Explicit %> <% Dim CLASS_cCast %> <% Class cCast Public SDRegExFilters Sub Class_Initialize() Set SDRegExFilters = CreateObject("Scripting.Dictionary") setSDRegExFilters End Sub Sub Class_Terminate() set SDRegExFilters = nothing End Sub 'Set Common Filters for use in RegExp object Public Sub setSDRegExFilters 'Safe email from a list of emails delimited with a semi colon, as used by most mail programs SDRegExFilters.Add "EmailList", "[^0-9a-zA-Z._\-;@]" 'Safe filename which adheres to seo principles, not as flexible as windows standard, safer inhouse standard SDRegExFilters.Add "Filename", "[^0-9a-zA-Z._\-]" 'HTML - Tags all html in string SDRegExFilters.Add "HTML", "<[^>]*>" 'HTML,XHTML Strict & XHTML Transitional Line Breaks SDRegExFilters.Add "HTML_br", "]*>" 'PST - Matches an occurence of PST. Paypal dates include pst, must be removed for safedatetime to work SDRegExFilters.Add "Date_PST", "\PST" 'Full URL/Web Address Validation SDRegExFilters.Add "URL", "(?:http://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?)(?:/(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;:@&=])*)(?:/(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;:@&=])*))*)(?:\?(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;:@&=])*))?)?)|(?:ftp://(?:(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;?&=])*)(?::(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;?&=])*))?@)?(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?))(?:/(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[?:@&=])*)(?:/(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[?:@&=])*))*)(?:;type=[AIDaid])?)?)|(?:news:(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;/?:&=])+@(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3})))|(?:[a-zA-Z](?:[a-zA-Z\d]|[_.+-])*)|\*))|(?:nntp://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?)/(?:[a-zA-Z](?:[a-zA-Z\d]|[_.+-])*)(?:/(?:\d+))?)|(?:telnet://(?:(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;?&=])*)(?::(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;?&=])*))?@)?(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?))/?)|(?:gopher://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?)(?:/(?:[a-zA-Z\d$\-_.+!*'(),;/?:@&=]|(?:%[a-fA-F\d]{2}))(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),;/?:@&=]|(?:%[a-fA-F\d]{2}))*)(?:%09(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;:@&=])*)(?:%09(?:(?:[a-zA-Z\d$\-_.+!*'(),;/?:@&=]|(?:%[a-fA-F\d]{2}))*))?)?)?)?)|(?:wais://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?)/(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))*)(?:(?:/(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))*)/(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))*))|\?(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;:@&=])*))?)|(?:mailto:(?:(?:[a-zA-Z\d$\-_.+!*'(),;/?:@&=]|(?:%[a-fA-F\d]{2}))+))|(?:file://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))|localhost)?/(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[?:@&=])*)(?:/(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[?:@&=])*))*))|(?:prospero://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?)/(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[?:@&=])*)(?:/(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[?:@&=])*))*)(?:(?:;(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[?:@&])*)=(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[?:@&])*)))*)|(?:ldap://(?:(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?))?/(?:(?:(?:(?:(?:(?:(?:[a-zA-Z\d]|%(?:3\d|[46][a-fA-F\d]|[57][Aa\d]))|(?:%20))+|(?:OID|oid)\.(?:(?:\d+)(?:\.(?:\d+))*))(?:(?:%0[Aa])?(?:%20)*)=(?:(?:%0[Aa])?(?:%20)*))?(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))*))(?:(?:(?:%0[Aa])?(?:%20)*)\+(?:(?:%0[Aa])?(?:%20)*)(?:(?:(?:(?:(?:[a-zA-Z\d]|%(?:3\d|[46][a-fA-F\d]|[57][Aa\d]))|(?:%20))+|(?:OID|oid)\.(?:(?:\d+)(?:\.(?:\d+))*))(?:(?:%0[Aa])?(?:%20)*)=(?:(?:%0[Aa])?(?:%20)*))?(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))*)))*)(?:(?:(?:(?:%0[Aa])?(?:%20)*)(?:[;,])(?:(?:%0[Aa])?(?:%20)*))(?:(?:(?:(?:(?:(?:[a-zA-Z\d]|%(?:3\d|[46][a-fA-F\d]|[57][Aa\d]))|(?:%20))+|(?:OID|oid)\.(?:(?:\d+)(?:\.(?:\d+))*))(?:(?:%0[Aa])?(?:%20)*)=(?:(?:%0[Aa])?(?:%20)*))?(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))*))(?:(?:(?:%0[Aa])?(?:%20)*)\+(?:(?:%0[Aa])?(?:%20)*)(?:(?:(?:(?:(?:[a-zA-Z\d]|%(?:3\d|[46][a-fA-F\d]|[57][Aa\d]))|(?:%20))+|(?:OID|oid)\.(?:(?:\d+)(?:\.(?:\d+))*))(?:(?:%0[Aa])?(?:%20)*)=(?:(?:%0[Aa])?(?:%20)*))?(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))*)))*))*(?:(?:(?:%0[Aa])?(?:%20)*)(?:[;,])(?:(?:%0[Aa])?(?:%20)*))?)(?:\?(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))+)(?:,(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))+))*)?)(?:\?(?:base|one|sub)(?:\?(?:((?:[a-zA-Z\d$\-_.+!*'(),;/?:@&=]|(?:%[a-fA-F\d]{2}))+)))?)?)?)|(?:(?:z39\.50[rs])://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?)(?:/(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))+)(?:\+(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))+))*(?:\?(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))+))?)?(?:;esn=(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))+))?(?:;rs=(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))+)(?:\+(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))+))*)?))|(?:cid:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;?:@&=])*))|(?:mid:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;?:@&=])*)(?:/(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[;?:@&=])*))?)|(?:vemmi://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?)(?:/(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[/?:@&=])*)(?:(?:;(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[/?:@&])*)=(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[/?:@&])*))*))?)|(?:imap://(?:(?:(?:(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[&=~])+)(?:(?:;[Aa][Uu][Tt][Hh]=(?:\*|(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[&=~])+))))?)|(?:(?:;[Aa][Uu][Tt][Hh]=(?:\*|(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[&=~])+)))(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[&=~])+))?))@)?(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?))/(?:(?:(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[&=~:@/])+)?;[Tt][Yy][Pp][Ee]=(?:[Ll](?:[Ii][Ss][Tt]|[Ss][Uu][Bb])))|(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[&=~:@/])+)(?:\?(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[&=~:@/])+))?(?:(?:;[Uu][Ii][Dd][Vv][Aa][Ll][Ii][Dd][Ii][Tt][Yy]=(?:[1-9]\d*)))?)|(?:(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[&=~:@/])+)(?:(?:;[Uu][Ii][Dd][Vv][Aa][Ll][Ii][Dd][Ii][Tt][Yy]=(?:[1-9]\d*)))?(?:/;[Uu][Ii][Dd]=(?:[1-9]\d*))(?:(?:/;[Ss][Ee][Cc][Tt][Ii][Oo][Nn]=(?:(?:(?:[a-zA-Z\d$\-_.+!*'(),]|(?:%[a-fA-F\d]{2}))|[&=~:@/])+)))?)))?)|(?:nfs:(?:(?://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?)(?:(?:/(?:(?:(?:(?:(?:[a-zA-Z\d\$\-_.!~*'(),])|(?:%[a-fA-F\d]{2})|[:@&=+])*)(?:/(?:(?:(?:[a-zA-Z\d\$\-_.!~*'(),])|(?:%[a-fA-F\d]{2})|[:@&=+])*))*)?)))?)|(?:/(?:(?:(?:(?:(?:[a-zA-Z\d\$\-_.!~*'(),])|(?:%[a-fA-F\d]{2})|[:@&=+])*)(?:/(?:(?:(?:[a-zA-Z\d\$\-_.!~*'(),])|(?:%[a-fA-F\d]{2})|[:@&=+])*))*)?))|(?:(?:(?:(?:(?:[a-zA-Z\d\$\-_.!~*'(),])|(?:%[a-fA-F\d]{2})|[:@&=+])*)(?:/(?:(?:(?:[a-zA-Z\d\$\-_.!~*'(),])|(?:%[a-fA-F\d]{2})|[:@&=+])*))*)?)))" 'Other Pattern Matches - For possible use '\%[^\s+$]* - matches a character starting a word, up until the next whitespace. This matches a % to start. End Sub 'Converts similar/identical functioning commands from one database type to another Public Function ResolveSQLCommand(byval p_how,byval p_function, byval p_data) dim retVal dim dbaccess dim dbsqlserver 'Basic 'Converts commands from one database to another, of same function 'E.g. Access = Now() >> SQL Server = GetDate() 'Advanced 'We may have to alter the structure completely to do the same thing, p_data field is to handle this 'Each command may handle data differently so there is no strict format for this 'p_data can be an array or just one text field 'General 'p_how - convert to which database type, dbaccess | dbsqlserver | dbmysql (soon) 'p_function - function to convert 'p_data - extra information in array or single text form needed for some conversions 'Function to expand based on need over time dbaccess = false dbsqlserver = false p_how = lcase(p_how) if p_how = "dbaccess" then dbaccess = true elseif p_how = "dbsqlserver" then dbsqlserver = true End If p_function = lcase(p_function) Select Case p_function Case "now()","now","getdate()","getdate" if dbaccess then retVal = "Now()" elseif dbsqlserver then retVal = "GETDATE()" End If Case Else if dbaccess then elseif dbsqlserver then End If End Select ResolveSQLCommand = retVal End Function 'Valid Web Address Format public function IsValidUrl(byval p_url) 'Create a regular expression object Dim regEx Set regEx = New RegExp regEx.Global = true regEx.Pattern = SDRegExFilters.item("URL") IsValidUrl = regEx.Test(p_url) 'First test with regex if isvalidurl = true then 'Check there is at least one full stop, if not, fail it. if instr(p_url,".") = 0 then isvalidurl = false end if end function 'Checks if it is an integer/long. Descriminates againsts Doubles, unlike isNumeric Function isInt(input) on error resume next Dim Tem Tem = Clng(input) if err <> 0 then isInt = false else if(Tem <> input) then isInt = false else isInt = true end if end if on error goto 0 End Function 'Returns if its a date, taking into account our NULL/blank fix. 1900/1/1 or = null. Function IsActualDate(byval p_date) if (p_date = "1/1/1900" or p_date = "01/01/1900") or (p_date="1900/1/1" or p_date="1900/01/01") or (p_date = "") Then IsActualDate = False else IsActualDate = isdate(p_date) End If End Function 'Decode/Remove urlencoded characters Function URLDecode(str) Dim i Dim sT Dim sR str = Replace(str, "+", " ") For i = 1 To Len(str) sT = Mid(str, i, 1) If sT = "%" Then If i+2 < Len(str) Then sR = sR & _ Chr(CLng("&H" & Mid(str, i+1, 2))) i = i+2 End If Else sR = sR & sT End If Next URLDecode = sR End Function 'Return an s if the value is plural Public Function Plural(byval p_value) p_value = cast(p_value,"lng","") if p_value > 1 then Plural = "s" else Plural = "" End If End Function 'Finds the top of the array, based on it having content. Returns -1 if the array is devoid of content Public Function ActualUBound(byval p_array,byval p_dimension,byval p_num) dim intCnt dim lngFound lngFound = -1 if p_dimension = 1 then ' response.Write("["&ubound(p_array)&"]") if ubound(p_array,1) > 0 then ' response.Write(">0") for intCnt = 0 to ubound(p_array,1) if p_array(intCnt) = "" or isnull(p_array(intCnt)) then if lngFound = -1 then lngFound = intCnt else lngFound = -1 End If next if lngFound = -1 then lngfound=ubound(p_array,1) else lngfound = lngfound -1 end if else if p_array(0) = "" then lngfound = -1 else lngfound = 0 end if end if ElseIf p_dimension > 1 then if ubound(p_array,p_dimension) > 0 then for intCnt = 0 to ubound(p_array,p_dimension) if p_array(p_num,intCnt) = "" or isnull(p_array(p_num,intCnt)) then if lngFound = -1 then lngFound = intCnt else lngFound = -1 End If next if lngFound = -1 then lngfound=ubound(p_array,p_dimension) else lngfound = lngfound -1 end if else if p_Array(p_num,0) = "" then lngfound = -1 else lngfound = 0 end if end if End If ActualUbound = lngFound End Function 'Cuts off the end of a piece of text, and adds ... and a title field with full original text Public Function Truncate(byval p_string, byval p_length) Dim strTemp p_length = Cast(p_length,"lng","") If len(p_string) > p_length then strTemp = mid(p_string,1,p_length) strTemp = "
"&strTemp&"...
" else strTemp = p_string End If Truncate = strTemp End Function 'Format safe date time for universal date comparisons and date/time added to database. YYYY/MM/DD hh:mm:ss PM Public Function SafeDateTime(byval p_dt,byval p_mode) p_mode = lcase(p_mode) p_dt = trim(lcase(p_dt)) If p_mode = "" or p_mode = "0" Then p_mode = "dateandtime" 'Safe - Date only If p_mode = "date" Then SafeDateTime = year(p_dt) & "/" &right("0" & month(p_dt), 2) & "/"&_ right("0" & day(p_dt),2) 'Safe - Time only ElseIf p_mode = "time" Then SafeDateTime = formatdatetime(p_dt,3) 'Safe date and time (default) Else SafeDateTime = year(p_dt) & "/" &right("0" & month(p_dt), 2) & "/"&_ right("0" & day(p_dt),2) & " " & formatdatetime(p_dt,3) End If End Function 'Describes the type of input box for output to user Public Function DescriptiveType(byval p_type) Select Case lcase(p_type) Case "string" DescriptiveType = "String/Text" Case "long" DescriptiveType = "Number (long)" Case "integer" DescriptiveType = "Number (integer)" Case "single" DescriptiveType = "Number (single)" Case "byte" DescriptiveType = "Number (byte)" Case "double" DescriptiveType = "Number (double)" Case "boolean" DescriptiveType = "True or False" Case "date" DescriptiveType = "Date" Case "currency" DescriptiveType = "Currency" Case "binary" DescriptiveType = "Binary/Data" Case "array" DescriptiveType = "Array" End Select End Function 'Drop down of all data types Public Function getHTMLDropDownDataTypes(byval p_name) dim strHTML dim arrDataTypes dim intCnt dim strSelected strHTML = "" strSelected = "" arrDataTypes=array("String", "Long", "Boolean", "Date", "Double", "Byte" , "Integer", "Single", "Currency", "Binary", "Array") for intCnt = 0 to ubound(arrDataTypes) if lcase(p_name) = lcase(arrDataTypes(intcnt)) then strSelected = "selected=""selected""" else strSelected = "" strHTML = strHTML & "" next getHTMLDropDownDataTypes = strHTML End Function 'Removes/filters a string based on a RegEx Pattern, commonly used with the RegEx Patterns defined in this class public function RegExFilter(byval p_string,byval p_filter,byval p_replacewith) 'Create a regular expression object Dim regEx Set regEx = New RegExp regEx.Global = true RegEx.IgnoreCase = True regEx.Pattern = p_filter RegExFilter = regEx.Replace(p_string, p_replacewith) end function 'Remove SQL Injection commands Function RemoveSQLInjection(byval p_Input) Dim arrBadChars, intCounter Dim arrBadCharsAlt Dim strInput strInput = p_input 'Set IllegalChars to False RemoveSQLInjection=False 'Create an array of illegal characters and words arrBadChars=array("select", "drop", "--", "insert", "delete", "xp_") arrBadCharsAlt=array("se1ect", "dr0p", "", "1nsert", "de1ete", "") 'Loop through array sBadChars using our counter & UBound function For intCounter = 0 to uBound(arrBadChars) strInput = replace(p_input,arrBadChars(intcounter), arrBadCharsAlt(intcounter)) Next RemoveSQLInjection = strInput End function 'Remove all none alpha numerics public function RemoveNoneAlphaNumerics(byval p_string) 'Create a regular expression object Dim regEx Set regEx = New RegExp regEx.Global = true regEx.Pattern = "[^0-9a-zA-Z]" RemoveNoneAlphaNumerics = regEx.Replace(p_string, "") end function 'Converts one type of data to another Public Function ConvertToType(byval vInput, byval strType) ' Set error trapping on so I can catch failures! On Error Resume Next ' if (NOT strType = "bin") AND (NOT strType = "binary") then vInput = trim(""&vinput) ' Do the appropriate conversion Select Case LCase(strType) Case "bol", "bool", "boolean","bln" if vInput = "1" or lcase(vinput)="true" then vInput = True Elseif vInput = "0" or lcase(vinput) = "false" then vInput = False End if 'allow boolean to also represent as nothing, true, false, indifferent Case "byte" If Not IsNumeric(vinput) and not vinput = "" then Err.Raise 1 Else vInput = CByte("0"&vInput) end if Case "int", "integer" If Not IsNumeric(vinput) and not vinput = "" then Err.Raise 1 Else vInput = CInt("0"&vInput) End If Case "lng", "long" If Not IsNumeric(vinput) and not vinput = "" then Err.Raise 1 Else vInput = CLng("0"&vInput) End If Case "sng", "single" If Not IsNumeric(vinput) and not vinput = "" then Err.Raise 1 Else vInput = CSng("0"&vInput) End If Case "dbl", "double" If Not IsNumeric(vinput) and not vinput = "" then Err.Raise 1 Else vInput = cdbl("0"&vInput) End if Case "cur", "currency" vInput = CCur("0"&vInput) Case "date" '1/1/1900 represents a practical null for the date field if (vinput = "1/1/1900" or vinput = "01/01/1900") or (vinput="1900/1/1" or vinput="1900/01/01") or (vinput = "") Then vInput = "1900/1/1" else vInput = SafeDateTime(vInput,"0") end if Case "str", "string" vInput = CStr(""&vInput) ' Case "bin", "binary" ' vInput = vInput Case "like" vInput = CStr(""&vInput) ' Case "arr","array" ' vInput = vInput Case Else ' If the specified type isn't handled error out. Err.Raise 1 End Select ' If the specified conversion failed set our return ' value to something we can check for. If Err.number <> 0 Then ConvertToType = "CastError" Err.Clear else ConvertToType = vInput End If 'Response.Write TypeName(vTemp) & "
" & vbCrLf End Function 'Format a piece of data into a certain data type and also into a certain usage type, such as database or input public function cast(byval p_value,byval p_cast,byval p_type) 'Casts - REQUIRED '----- '"bol" or "bool" or "boolean" '"byte" '"int" or "integer" '"lng" or "long" '"sng" or "single" '"dbl" or "double" '"cur" or "currency" '"date" '"str" or "string" '"bin" or "binary" 'TYPES - OPTIONAL - if no type specified then simple variable cast/case occurrs. '----- 'screen - for raw dumping to / tags 'input - for form element safe values 'db - makes db safe + adds the correct parantheses around content i.e. for text - 'valuehere', with single quotes returned 'dbsimple - returns db safe values but without the above parentheses i.e. valuehere if (NOT p_cast = "bin") AND (NOT p_cast = "binary") then p_value = trim(""&p_value) if not p_cast = "" then p_value = ConvertToType(p_value,p_cast) end if select case p_type case "screen" Select Case p_cast case "date" if (p_value = "1/1/1900" or p_value = "01/01/1900") or (p_value="1900/1/1" or p_value="1900/01/01") then p_value = "" End Select p_value = server.htmlencode(p_value) p_value = Replace(p_value, vblf, "") p_value = Replace(p_value, vbcr, "
") p_value = Replace(p_value, chr(09), "    ") case "input" Select Case p_cast case "date" if (p_value = "1/1/1900" or p_value = "01/01/1900") or (p_value="1900/1/1" or p_value="1900/01/01") then p_value = "" End Select p_value = server.htmlencode(p_value) case "db","dbaccess","dbsqlserver" select case p_cast case "date" p_value = RemoveSQLInjection(p_value) if p_type = "dbsqlserver" then p_value = "'"&SafeDateTime(p_value,"datetime")&"'" elseif p_type = "dbaccess" then p_value = "#"&SafeDateTime(p_value,"datetime")&"#" end if case "bol","bool","boolean" p_value = RemoveSQLInjection(p_value) if p_type = "dbsqlserver" then if lcase(p_value) = "true" Or lcase(p_value) = "1" then p_value = "1" elseif lcase(p_value) = "false" Or lcase(p_value) = "0" then p_value = "0" end if elseif p_type = "dbaccess" then if lcase(p_value) = "true" or lcase(p_value) = "1" then p_value = "True" elseif lcase(p_value) = "false" or lcase(p_value) = "0" then p_value = "False" end if end if case "bin", "binary" case "cur","currency" p_value = RemoveSQLInjection(p_value) p_value = "'"&server.URLEncode(p_value)&"'" case "int","integer","lng","long","sng","single","dbl","double","byte" p_value = RemoveSQLInjection(p_value) case "str", "string" p_value = RemoveSQLInjection(p_value) p_value = replace(p_value,"'","''") p_value = replace(p_value,"`","``") p_value = replace(p_value,"",server.HTMLEncode("")) p_value = "'"&p_value&"'" case "like" p_value = RemoveSQLInjection(p_value) p_value = replace(p_value,"'","''") p_value = replace(p_value,"`","``") p_value = "'%"&p_value&"%'" case else p_value = RemoveSQLInjection(p_value) p_value = "'"&server.URLEncode(p_value)&"'" end select case "dbsimple", "dbaccesssimple","dbsqlserversimple" select case p_cast case "date" p_value = RemoveSQLInjection(p_value) if p_type = "dbsqlserver" then p_value = p_value elseif p_type = "dbaccess" then p_value = "#"&p_value&"#" end if case "bol","bool","boolean" p_value = RemoveSQLInjection(p_value) if p_type = "dbsqlserver" then if lcase(p_value) = "true" Or lcase(p_value) = "1" then p_value = "1" elseif lcase(p_value) = "false" Or lcase(p_value) = "0" then p_value = "0" end if elseif p_type = "dbaccess" then if lcase(p_value) = "true" or lcase(p_value) = "1" then p_value = "True" elseif lcase(p_value) = "false" or lcase(p_value) = "0" then p_value = "False" end if end if case "cur","currency" p_value = RemoveSQLInjection(p_value) p_value = server.URLEncode(p_value) case "int","integer","lng","long","sng","single","dbl","double","byte" p_value = RemoveSQLInjection(p_value) case "str", "string" p_value = RemoveSQLInjection(p_value) p_value = replace(p_value,"'","''") p_value = replace(p_value,"`","``") p_value = replace(p_value,"",server.HTMLEncode("")) case else p_value = RemoveSQLInjection(p_value) p_value = server.URLEncode(p_value) end select case "slash" select case p_cast case "cur","currency" p_value = server.URLEncode(p_value) case "str", "string" p_value = replace(p_value,"\","\\") p_value = replace(p_value,"'","\'") p_value = replace(p_value,"""","\""") p_value = replace(p_value,"`","``") case else p_value = server.htmlencode(p_value) end select case "code" select case p_cast case "cur","currency" p_value = server.URLEncode(p_value) case "str", "string" p_value = replace(p_value,"""","""""") case else p_value = server.URLEncode(p_value) end select case else end select cast=p_value end function End Class %> <% set CLASS_cCast = new cCast 'Please do not change Dim sConnString 'Please do not change Dim sDATABASE_Type 'Please do not change 'DATABASE Type 'Choose either MS Access or SQL Server 'Important: If choosing MS SQL Server, please run 'sqlscript.sql' found in the root/main folder prior to using the site and setting the connect string. SqlScript.sql, must be executed within the SQL Server Program via 'SQL Server Management Studio Express' downloadable here http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=C243A5AE-4BD1-4E3D-94B8-5A0F62BF7796 sDATABASE_Type="dbaccess" 'sDATABASE_Type="dbsqlserver" 'Note you may want to move the database into a more secure folder so you can 'adjust the connection string accordingly to point to your database 'The default connection string 'sConnString' uses the OLEDB Provider and the virtual path 'MS Access Connection Strings '---------------------------- 'MS Access ODBC using virtual path to members database 'sConnString = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.mappath("/members/members.mdb") 'MS Access ODBC using physical path to members database 'sConnString = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=c:\inetpub\members\members.mdb" 'MS Access OLEDB using virtual path to members database sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.mappath("/members/members.mdb") 'MS Access OLEDB using physical path to members database 'sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\inetpub\members\members.mdb" 'MS SQL Server Connection Strings - Remember to fill in database & login details '---------------------------- 'SQL Server 7/2000 Database 'sConnString = "Driver={SQL Server};Server=ServerName;Database=DatabaseName;UID=Username;PWD=Password;" 'sConnString = "Provider=SQLOLEDB;Server=82.71.52.45;Database=master;UID=sa;PWD=brush001;" 'SQL Server 2005 / 2005 Express 'sConnString = "Driver={SQL Native Client};Server=ServerName;Database=DatabaseName;UID=Username;PWD=Password;" 'sConnString = "Provider=SQLNCLI;Data Source=localhost;Initial Catalog=DatabaseName;UID=Username;PWD=Password;" 'sConnString = "Provider=SQLOLEDB;Data Source=localhost;Initial Catalog=DatabaseName;UID=Username;PWD=Password;" %> Memberships

[an error occurred while processing this directive]
<% 'declare your variables Dim oConnection, oRecordset, sSQL Dim iMembershipOptionID, sMembershipOptionDescription, sMembershipName 'Create an instance of the ADO Connection and Recordset objects Set oConnection = Server.CreateObject("ADODB.Connection") Set oRecordset = Server.CreateObject("ADODB.Recordset") 'Set an active Connection to the Connection object oConnection.Open sConnString 'Create a variable called sSQL which holds an SQL statement to query against the database sSQL = "SELECT * FROM codefixermp_tblMemberShipOptions WHERE ACTIVE='Y'" 'Query the database and return a Recordset oRecordset.Open sSQL, oConnection If oRecordset.eof Then Response.write "

Sorry there are currently no membership options.

" Else %>
The Real Public Radio Membership

For Paid Membership the join process is completed in 3 stages.

1. click on the "subscribe button" below,
2. fill out our join form and then...
3. make payment through PayPal.


Once you have made payment you will taken to the login page and sent a password to your email.



<% Do while not oRecordset.eof %> <% iMembershipOptionID=oRecordset("membershipOptionID") sMembershipOptionDescription=oRecordset("membershipOptionDescription") sMembershipName=oRecordset("membershipName") Response.write "" & sMembershipName & "
" Response.write sMembershipOptionDescription & "
" %>

subscribe now
<% oRecordset.movenext Loop End If 'close the Connection and Recordset objects and free up resources. oRecordset.Close Set oRecordset = Nothing oConnection.Close Set oConnection = Nothing %>