'------------------------------------------------ --------------------------
'Function: Shield HTML code
'Parameter: StrInput user input information
'------------------------------------------------ --------------------------
function FunInput(StrInput)
if not isnull(Str) then
StrInput=RePlace(StrInput,<,<)
StrInput=replace(StrInput,>,>)
StrinPut=replace(Strinput,chr(32), )
stringinput=replace(strinput,chr(34),)
stringinput=replace(strinput,chr(39),')
stringinput=replace(strinput,chr(13),)
FunInput=string
end if
end function
'------------------------------------------------ --------------------------
'Function: Prevent SQL injection
'Parameter: StrValue user-submitted data
'BloType data type
'Parameter value: true numeric data
' false character data
'------------------------------------------------ --------------------------
function FunSQL(StrValue,BloType)
if BloType then
if Isnumeric(StrValue) then
FunSQL=clng(StrValue)
else
StrValue=0
end if
else
if not isnull(StrValue) then
StrValue=lcase(StrValue)
StrValue=Replace(StrValue,','')
StrValue=replace(StrValue,select,)
StrValue=replace(StrValue,update,)
StrValue=replace(StrValue,insert,)
StrValue=replace(StrValue,delete,)
StrValue=replace(StrValue,;,)
StrValue=replace(StrValue, ,)
StrValue=replace(StrValue,chr(255),)
StrValue=replace(StrValue,*,)
StrValue=replace(StrValue,%,)
end if
end if
FunSQL=StrValue
end function
'------------------------------------------------ -----------------------
'Function: Common type conversion
' Parameter: _Type data type
' _Value data
'Parameter value: _Type 1: Convert to numeric data
' _Type 2: Convert to character data
' _Type 3: Convert to Boolean data
'------------------------------------------------ -----------------------
function FunSwitch(Value_,Type_)
on error resume next
select case Type_
case 1
if isnumeric(Value_) then
if not isnull(Value_) then
FunSwitch=clng(Value_)
else
FunSwitch=0
end if
else
FunSwitch=0
end if
case 2
if not isnull(Value_) then
FunSwitch=cstr(Value_)
else
FunSwitch=
end if
case 3
if not isnull(Value_) and isnumeric(Value_) then
FunSwitch=cbool(Value_)
else
FunSwitch=false
end if
case else
response.redirect(Error.asp?err=Please specify the data type to be transferred in FunSwitch!)
end select
if err.number<>0 then
response.redirect(Error.asp?err=An unknown error occurred during data conversion!)
err.clear
end if
end function
''------------------------------------------------ -----------------------
' Function: Verify whether the data comes from outside
' Parameters: None
'------------------------------------------------ --------------------------
function checkfrom()
server_v1=Cstr(Request.ServerVariables(HTTP_REFERER))
server_v2=Cstr(Request.ServerVariables(SERVER_NAME))
if mid(server_v1,8,len(server_v2))<>server_v2 then
checkfrom=true
else
checkfrom=false
end if
end function
''------------------------------------------------ -----------------------
'Function: JS prompt box
' Parameters: StrURL: The page address to return to after clicking OK
'StrMSG: dialog box prompt information
'------------------------------------------------ --------------------------
Function FunMsg(StrURL,StrMSG)
Response.write <script language='javascript'>&_
Vbcrlf&alert(&StrMSG&);&_
Vbcrlf&window.location=&StrURL&;&_
Vbcrlf&</script>
End Function
'------------------------------------------------ -----------------------
'Function: Universal paging
'Parameter: Intpagecount total number of pages
'Intmypage current page number
'Intrecordcount total number of records
'Intpagesize The number of records displayed on each page
'------------------------------------------------ -----------------------
function funpage(Intpagecount,Intmypage,Intrecordcount,Intpagesize)
'on error resume next
dim Intfor,Intlist,intlist_b
Dim query, a, x, temp
action = http:// & Request.ServerVariables(HTTP_HOST) & Request.ServerVariables(SCRIPT_NAME)
query = Split(Request.ServerVariables(QUERY_STRING), &)
For Each x In query
a = Split(x, =)
If StrComp(a(0), page, vbTextCompare) <> 0 Then
temp = temp & a(0) & = & a(1) & &
End If
Next
if intmypage>1 then
funpage=funpage & <a href='&action&?&temp&page=1' title='Top page' class='no'><font face='Webdings'>9</font></a>
funpage=funpage&<a href='&action&?&temp&page=&Intmypage-1 & ' title='Previous Page' class='no'><font face='Webdings'>7</font></a>
else
funpage=funpage &<font face='Webdings'>9</font>
funpage=funpage&<font face='Webdings'>7</font>
end if
if Intlist<>0 then
if cintmypage= Intlist then
Intlist=Intlist+5
end if
else
Intlist=Intmypage+5
end if
if intlist-9<1 then
intlist_b=1
else
intlist_b=intlist-9
end if
for Intfor=intlist_b to Intlist
if intfor<=Intpagecount then
if intfor=Intmypage then '-------make the text on the current page red and not clickable
funpage =funpage & strMode& <font color='#FF0000'><b>& Intfor & </b></font>
else
funpage=funpage & strMode & <a href='&action&?&temp&page= & Intfor &' class='no'> & Intfor & </a>
end if
end if
strMode= <font color='#BBBBBB'>|</font>
next
if intmypage<intpagecount then
funpage=funpage& <a href='&action&?&temp&page=& Intmypage+1 &' title='Next page' class='no'><font face='Webdings'>8</font></a>
funpage=funpage &<a href='&action&?&temp&page=& Intpagecount & ' title='Last Page' class='no'><font face='Webdings'>:</font></a>
else
funpage=funpage& <font face='Webdings'>8</font>
funpage=funpage &<font face='Webdings'>:</font></a>
end if
funpage=<table width='100%' border='0' cellspacing='0' cellpadding='0'><tr>&_
vbcrlf&<td width='40%' style=font:14px> Current &Intmypage& page&Intpagesize& records/page total &Intpagecount& pages/&Intrecordcount& records</td>&_
vbcrlf&<td width='60%' align='right'>&_
vbcrlf&<table width='360' border='0' cellspacing='0' cellpadding='0'><tr>&_
vbcrlf&<td align='right' style=font:14px>&funpage& </td>&_
vbcrlf&</tr></table></td></tr>&_
vbcrlf&</table>
if err.number<>0 then
err.clear
response.redirect(error.asp?err=An error occurred in the paging function, please contact the administrator!|)
end if
end function
'************************************************ **
'Function name: Highlight
'Function: The searched keywords are displayed in highlighted colors
'The parameter strText is the string or variable containing the string or variable to be highlighted
'strFind is the string or variable to be highlighted,
'strBeforeThe highlighted HTML code prefix is: <font color=red>
'strAfterThe suffix of the highlighted HTML code:</font>
'************************************************ ****
Function Highlight(strText, strFind, strBefore, strAfter)
DimPos
Dim nLen
Dim nLenAll
nLen = Len(strFind)
nLenAll = nLen + Len(strBefore) + Len(strAfter) + 1
Highlight = strText
If nLen > 0 And Len(Highlight) > 0 Then
nPos = InStr(1, Highlight, strFind, 1)
Do While nPos > 0
Highlight = Left(Highlight, nPos - 1) & _
strBefore & Mid(Highlight, nPos, nLen) & strAfter & _
Mid(Highlight, nPos + nLen)
nPos = InStr(nPos + nLenAll, Highlight, strFind, 1)
Loop
End If
End Function