'------------------------------------------------- ---------------------
' 函數功能： 屏蔽HTML程式碼
' 參數： StrInput 使用者輸入訊息
'------------------------------------------------- ---------------------
function FunInput(StrInput)
if not isnull(Str) then
StrInput=RePlace(StrInput,<,<)
StrInput=replace(StrInput,>,>)
StrinPut=replace(Strinput,chr(32), )
strinput=replace(strinput,chr(34),)
strinput=replace(strinput,chr(39),')
strinput=replace(strinput,chr(13),)
FunInput=strinput
end if
end function
'------------------------------------------------- ---------------------
' 函數功能： 防止ＳＱＬ注入
' 參數： StrValue 使用者提交的數據
' BloType 資料類型
' 參數值: true 數值型數據
' false 字元型數據
'------------------------------------------------- ---------------------
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
'------------------------------------------------- -------------------------
' 函數功能： 常用型別轉換
' 參數: _Type 資料類型
' _Value 數據
' 參數值: _Type 1 : 轉換成數值型數據
' _Type 2 : 轉換成字元型數據
' _Type 3 : 轉換成布林型數據
'------------------------------------------------- -------------------------
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=請指定FunSwitch 中要轉達換成的資料型別！)
end select
if err.number<>0 then
response.redirect(Error.asp?err=資料轉換時產生未知錯誤！)
err.clear
end if
end function
''------------------------------------------------ ----------------------
' 函數功能： 驗證是資料是否來自外部
' 參數： 無
'------------------------------------------------- ---------------------
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
''------------------------------------------------ ----------------------
' 函數功能： JS提示框
' 參數： StrURL : 點選確定後回到的頁面位址
' StrMSG : 對話框的提示訊息
'------------------------------------------------- ---------------------
Function FunMsg(StrURL,StrMSG)
Response.write <script language='javascript'>&_
Vbcrlf&alert(&StrMSG&);&_
Vbcrlf&window.location=&StrURL&;&_
Vbcrlf&</script>
End Function
'------------------------------------------------- -------------------------
' 函數功能： 一般分頁
' 參數: Intpagecount 總頁數
' Intmypage 目前頁數
' Intrecordcount 記錄總數
' Intpagesize 每頁顯示的記錄數
'------------------------------------------------- -------------------------
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='最前頁' class='no'><font face='Webdings'>9</font></a>
funpage=funpage&<a href='&action&?&temp&page=&Intmypage-1 & ' title='上一頁' 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 '-------讓目前頁文字為紅色，且不可點擊
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='後一頁' class='no'><font face='Webdings'>8</font></a>
funpage=funpage &<a href='&action&?&temp&page=& Intpagecount & ' title='最後頁' 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> 目前第&Intmypage&頁&Intpagesize&條/頁共&Intpagecount&頁/&Intrecordcount&筆記錄< /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=分頁函數出錯，請與管理員聯絡！|)
end if
end function
'************************************************* **
'函數名稱：Highlight
'功能:搜尋的關鍵字以高亮的顏色顯示
'參數strText是要被高亮顯示的字串或變數所在的字符串或變數
'strFind是要被高亮顯示的字串或變數,
'strBefore被高亮顯示的HTML程式碼前綴如：<font color=red>
'strAfter被高亮顯示的HTML程式碼的後綴:</font>
'************************************************* ****
Function Highlight(strText, strFind, strBefore, strAfter)
Dim nPos
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