收集常用函數與寫法...
'獲取用戶真實IP函數
Function GetIP()
GetIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If GetIP = "" Then GetIP = Request.ServerVariables("REMOTE_ADDR")
End Function
'獲取完整地址欄地址
Function GetUrl()
GetUrl="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")
If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function
'獲取本頁文件名
Function SelfName()
SelfName = Mid(Request.ServerVariables("URL"),InstrRev(Request.ServerVariables("URL"),"/")+1)
End Function
'獲取文件後綴名
Function GetExt(filename)
GetExt = Mid(filename,InstrRev(filename,".")+1)
End Function
'過濾不良字符
Function ChkBadWords(fString)
Dim BadWords,bwords,i
BadWords = "|王八|洪志"
If Not(IsNull(BadWords) or IsNull(fString)) Then
bwords = Split(BadWords, "|")
For i = 0 to UBound(bwords)
fString = Replace(fString, bwords(i), string(Len(bwords(i)),"*"))
Next
ChkBadWords = fString
End If
End Function
'防止外部提交
Function ChkPost()
Dim URL1,URL2
ChkPost = False
URL1 = Cstr(Request.ServerVariables("HTTP_REFERER"))
URL2 = Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(URL1,8,Len(URL2))<>URL2 Then
ChkPost = False
Else
ChkPost = True
End If
End Function
'過濾HTML字符函數
Function HTMLEncode(fString)
If Not IsNull(fString) And fString <> "" Then
fString = Replace(fString, "&", "&")
fString = Replace(fString, ">", ">")
fString = Replace(fString, "<", "<")
fString = Replace(fString, Chr(32), " ")
fString = Replace(fString, Chr(9), " ")
fString = Replace(fString, Chr(34), """)
fString = Replace(fString, Chr(39), "'")
fString = Replace(fString, Chr(13), "")
fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")
fString = Replace(fString, Chr(10), "<BR>")
fString = Replace(fString, Chr(255), " ")
HTMLEncode = fString
End If
End Function
'清除HTML標記
Function stripHTML(strHTML)
Dim objRegExp,strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML,"")
strOutput = Replace(strOutput, "<","<")
strOutput = Replace(strOutput, ">",">")
stripHTML = strOutput
Set objRegExp = Nothing
End Function
===============================================================================
以下儲存為 editplus 之*.ctl檔
===============================================================================
#TITLE=ASP常用語法及函數
#INFO
ASP常用的一些語法及自定義函數
#SORT=n
#T= ===ASP常用語法===
#T=============================
#T=數據庫相關
#T= 連接ACCESS數據庫
<%
Dim DBName,Conn
DBName"^!" '定義數據庫路徑及名稱
SET Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DBName)
%>
#T= 連接MS SQL數據庫
<%
Dim Conn
SET Conn=Server.CreateObject("ADODB.connection")
Conn.Open "PROVIDER=SQLOLEDB;DATA SOURCE=SQL服務器名稱或IP地址;UID=數據庫登錄帳號;PWD=數據庫密碼;DATABASE=數據庫名稱"
%>
#T= 建立記錄集
SET ^!=Server.CreateObject("ADODB.recordset")
#T= 執行SQL命令
RS.Open SQL,conn,1,1
#T= 執行SQL命令
Conn.Execute("^!")
#T= RS直接執行SQL命令
SET RS = Conn.Execute("^!")
#T= 關閉記錄集
RS.CLOSE
SET RS=NOTHING
#T= 關閉數據庫
Conn.Close
SET Conn=Nothing
#T=============================
#T=ServerVariables相關
#T= 取上一頁地址
Request.ServerVariables("HTTP_REFERER")
#T= 取服務器的名稱1
Request.ServerVariables("SERVER_NAME")
#T= 取服務器的名稱2
Request.ServerVariables("HTTP_HOST")
#T= 取服務器IP
Request.ServerVariables("LOCAL_ADDR")
#T= 取用戶IP
Request.ServerVariables("Remote_Host")
#T= 取用戶真實IP1
Request.serverVariables("REMOTE_ADDR")
#T= 取用戶真實IP函數
Function GetRealIP()
GetRealIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
IF(GetRealIP = "")THEN GetRealIP = Request.ServerVariables("REMOTE_ADDR")
End Function
#T= 取服務器端口
Request.ServerVariables("SERVER_PORT")
#T= 取服務器操作系統
Request.ServerVariables("OS")
#T= 取服務器的絕對路徑
Request.ServerVariables("APPL_PHYSICAL_PATH")
#T= 取本文件的絕對路徑1
Requet.ServerVariables("PATH_TRANSLATED")
#T= 取本文件的絕對路徑2
Server.mappath(Request.ServerVariables("SCRIPT_NAME"))
#T= 取本文件的相對路徑1
Request.ServerVariables("URL")
#T= 取本文件的相對路徑2
Request.ServerVariables("SCRIPT_NAME")
#T= 取本文件的相對路徑3
Request.ServerVariables("PATH_INFO")
#T= 取地址欄後的參數
Request.ServerVariables("QUERY_STRING")
#T= 取服務器系統信息
Request.ServerVariables("HTTP_USER_AGENT")
#T= 服務器組件檢測
<%
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
SET xTestObj = Server.CreateObject(strClassString)
IF(0 = Err)THEN IsObjInstalled = True
SET xTestObj = Nothing
Err = 0
End Function
'IF(IsObjInstalled("Persits.Upload")=True)THEN
' Response.Write "支持AspUpload組件"
'ELSE
' Response.Write "不支持AspUpload組件"
'END IF
%>
#T= 取客戶端語言環境
^!Request.ServerVariables("HTTP_ACCEPT_LANGUAGE")
#T= 取客戶端信息:HTTP_USER_AGENT
^!Request.ServerVariables("HTTP_USER_AGENT")
#T= 取表單(Form)值元素值
Request.Form("^!")
#T= 取URL傳遞的值
Request.QueryString("^!")
#T= 取完整URL地址
Function GetUrl()
GetUrl="http://"&Request.ServerVariables("SERVER_N ... .ServerVariables("URL")
IF(Request.ServerVariables("QUERY_STRING")<>"")THEN GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function
#T=============================
#T=自定義函數
#T= 過濾HTML字符
<%
'過濾HTML字符函數
Function HTMLEncode(str)
IF(str <> "")THEN
str = Replace(str, "&", "&")
str = Replace(str, ">", ">")
str = Replace(str, "<", "<")
str = Replace(str, Chr(32), " ")
str = Replace(str, Chr(9), " ")
str = Replace(str, Chr(34), """)
str = Replace(str, Chr(39), "'")
str = Replace(str, Chr(13), "")
str = Replace(str, Chr(10) & Chr(10), "</P><P>")
str = Replace(str, Chr(10), "<BR>")
str = Replace(str, Chr(255), " ")
END IF
HTMLEncode = str
End Function
%>
#T= 檢測上頁是否從本站提交
<%
'檢測上頁是否從本站提交
'返回:True,False
'===============================================================
Function IsSelfRefer()
Dim sHttp_Referer, sServer_Name
sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
IF(Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name)THEN
IsSelfRefer = True
ELSE
IsSelfRefer = False
END IF
End Function
%>
#T= 清除所有HTML標記
<%
'清除HTML標記
Function stripHTML(htmlStr)
Dim regEx
SET regEx = New Regexp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "<.+?>"
htmlStr = regEx.Replace(htmlStr,"")
htmlStr = Replace(htmlStr, "<","<")
htmlStr = Replace(htmlStr, ">",">")
htmlStr = Replace(htmlStr,chr(10),"")
htmlStr = Replace(htmlStr,chr(13),"")
stripHTML = htmlStr
SET regEx = Nothing
End Function
%>
#T= 取字符串長度
<%
'求字符串長度函數
Function GetLength(str)
Dim Length
For i=1 to Len(str)
IF(Asc(Mid(str,i,1))<0 or Asc(Mid(str,i,1))>256)THEN
Length=Length+2
ELSE
Length=Length+1
END IF
Next
GetLength=Length
End Function
%>
#T= 截取指定長度字符串
<%
'截取指定長度的字符串,多餘的用...代替
Function StrLeft(str,strlen)
IF(str = "")THEN
StrLeft = ""
Exit Function
END IF
Dim l,t,c,i
str = Replace(Replace(Replace(Replace(str," "," "),""",chr(34)),">",">"),"<","<")
l=len(str)
t=0
For i=1 to l
c=Abs(Asc(Mid(str,i,1)))
IF(c>255)THEN
t=t+2
ELSE
t=t+1
END IF
IF(t>strlen)THEN
StrLeft = left(str,i) & "..."
Exit For
ELSE
StrLeft = str
END IF
Next
StrLeft = Replace(Replace(Replace(Replace(StrLeft," "," "),chr(34),"""),">",">"),"<","<")
End Function
%>
#T= 獲取安全的提交參數
<%
'===============================================================
'SQL Injection Check
'函數功能:過濾字符參數中的單引號,對於數字參數進行判斷,如果不是數值類型,則賦值0
'參數意義:str ---- 要過濾的參數
'strType ---- 參數類型,分為字符型和數字型,字符型為"s",數字型為"i"
'===============================================================
Function CheckStr(str,strType)
Dim strTmp
strTmp = ""
IF(strType ="s")THEN
strTmp = Replace(Trim(str),"'","''")
ELSEIF(strType="i")THEN
IF(IsNumeric(str)=False)THEN str=False
strTmp = str
ELSE
strTmp = str
End IF
CheckStr= strTmp
End Function
%>
#T= 過濾不良字符(BadWord)
<%
'過濾不良字符(BadWords)
Function ChkBadWords(fString)
Dim BadWords,bwords,i
BadWords = "王八|洪志"
IF(Not(IsNull(BadWords) or IsNull(fString)))THEN
bwords = Split(BadWords, "|")
For i = 0 to UBound(bwords)
fString = Replace(fString, bwords(i), string(Len(bwords(i)),"*"))
Next
ChkBadWords = fString
END IF
End Function
%>
#T= 生成隨機自定義長度密碼
<%
'生成隨機自定義長度密碼
Function makePassword(maxLen)
Dim strNewPass
Dim whatsNext, upper, lower, intCounter
Randomize
For intCounter = 1 To maxLen
whatsNext = Int((1 - 0 + 1) * Rnd + 0)
IF(whatsNext = 0)THEN
'character
upper = 90
lower = 65
ELSE
upper = 57
lower = 48
END IF
strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
Next
makePassword = strNewPass
End Function
'Response.Write makepassword(8)
%>
#T= 填入Textarea時保持格式inHTML
<%
'===============================================================
'去除Html格式,用於從數據庫中取出值填入輸入框時
'注意:value="?"這邊一定要用雙引號
'===============================================================
Function inHTML(str)
Dim sTemp
sTemp = str
inHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<br>",chr(13))
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, """, Chr(34))
inHTML = sTemp
End Function
%>
#T= 正則表表達式驗證函數
<%
'正則表表達式驗證函數 patrn-正則表達式 strng-需要驗證的字符串
'===============================================================
Function RegExpTest(patrn, strng)
Dim regEx, retVal ' 建立變量。
SET regEx = New RegExp ' 建立正則表達式。
regEx.Pattern = patrn ' 設置模式。
regEx.IgnoreCase = False ' 設置是否區分大小寫。
retVal = regEx.Test(strng) ' 執行搜索測試。
RegExpTest = retVal '返回值,不符合就返回false,符合為true
SET regEx = NOTHING
End Function
%>
#T= 生成隨機字符串
<%
'生成隨機字符串
Function RndCode()
Dim CodeSet,AmountSet
CodeSet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
AmountSet = 62 ' 文字數量
Randomize
Dim vCode(10), vCodes,i
For i = 0 To 9
vCode(i) = Int(Rnd * AmountSet)
vCodes = vCodes & Mid(CodeSet, vCode(i) + 1, 1)
Next
RndCode=vCodes
End Function
%>
#T=============================
#T=FSO相關操作
#T= 判斷目錄是否存在
<%
Function IsFloderExist(strFolderName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FolderExists(strFolderName))THEN
IsFloderExist = True
ELSE
IsFloderExist = False
END IF
SET FSO=NOTHING
End Function
%>
#T= 創建目錄
<%
Function CreateFolder(strFolderName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FolderExists(strFolderName) = False)THEN
FSO.CreateFolder(strFolderName)
END IF
SET FSO=NOTHING
END Function
%>
#T= 刪除目錄
<%
Function DeleteFolder(strFolderName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FolderExists(strFolderName))THEN
FSO.DeleteFolder(strFolderName)
END IF
SET FSO=NOTHING
END Function
%>
#T= 判斷文件是否存在
<%
Function IsFileExist(strFileName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FileExists(strFileName))THEN
IsFileExist = True
ELSE
IsFileExist = False
END IF
SET FSO=NOTHING
End Function
%>
#T= 刪除文件
<%
Function DeleteFile(strFileName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FileExists(strFileName))THEN
FSO.DeleteFile(strFileName)
END IF
SET FSO=NOTHING
END Function
%>
#T=============================
#T= ASP小偷常用的幾個函數
<%
Function ByteToStr(vIn)
Dim strReturn,i,ThisCharCode,innerCode,Hight8,Low8,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
IF(ThisCharCode < &H80)THEN
strReturn = strReturn & Chr(ThisCharCode)
ELSE
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
END IF
Next
ByteToStr = strReturn
End Function
Function GetHttpPageContent(url,Method,SendStr)
Dim Retrieval
SET Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open Method, url, False ,"" ,""
.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
.Send(SendStr)
GetHttpPageContent = .ResponseBody
End With
SET Retrieval = Nothing
GetHttpPageContent=ByteToStr(GetHttpPageContent)
End Function
Function RegExpText(strng,regStr)
Dim regEx,Match,Matches,RetStr
SET regEx = New RegExp
regEx.Pattern = regStr
regEx.IgnoreCase = True
regEx.Global = True
SET Matches = regEx.Execute(strng)
For Each Match in Matches
RetStr = RetStr & regEx.Replace(Match.Value,"$1") & ","
Next
RegExpText = RetStr
set regEx=nothing
End Function
Function StreamBytesToBstr(strBody, CodeBase)
Dim objStream
SET objStream = Server.CreateObject("Adodb.Stream")
With objStream
.Type = 1
.Mode = 3
.Open
.Write strBody
.Position = 0
.Type = 2
.Charset = CodeBase
StreamBytesToBstr = .ReadText
.Close
End With
SET objStream = Nothing
End Function
%>
來源:http://www.ironman.tw/article.asp?id=64
程序代碼
'獲取用戶真實IP函數
Function GetIP()
GetIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If GetIP = "" Then GetIP = Request.ServerVariables("REMOTE_ADDR")
End Function
'獲取完整地址欄地址
Function GetUrl()
GetUrl="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")
If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function
'獲取本頁文件名
Function SelfName()
SelfName = Mid(Request.ServerVariables("URL"),InstrRev(Request.ServerVariables("URL"),"/")+1)
End Function
'獲取文件後綴名
Function GetExt(filename)
GetExt = Mid(filename,InstrRev(filename,".")+1)
End Function
'過濾不良字符
Function ChkBadWords(fString)
Dim BadWords,bwords,i
BadWords = "|王八|洪志"
If Not(IsNull(BadWords) or IsNull(fString)) Then
bwords = Split(BadWords, "|")
For i = 0 to UBound(bwords)
fString = Replace(fString, bwords(i), string(Len(bwords(i)),"*"))
Next
ChkBadWords = fString
End If
End Function
'防止外部提交
Function ChkPost()
Dim URL1,URL2
ChkPost = False
URL1 = Cstr(Request.ServerVariables("HTTP_REFERER"))
URL2 = Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(URL1,8,Len(URL2))<>URL2 Then
ChkPost = False
Else
ChkPost = True
End If
End Function
'過濾HTML字符函數
Function HTMLEncode(fString)
If Not IsNull(fString) And fString <> "" Then
fString = Replace(fString, "&", "&")
fString = Replace(fString, ">", ">")
fString = Replace(fString, "<", "<")
fString = Replace(fString, Chr(32), " ")
fString = Replace(fString, Chr(9), " ")
fString = Replace(fString, Chr(34), """)
fString = Replace(fString, Chr(39), "'")
fString = Replace(fString, Chr(13), "")
fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")
fString = Replace(fString, Chr(10), "<BR>")
fString = Replace(fString, Chr(255), " ")
HTMLEncode = fString
End If
End Function
'清除HTML標記
Function stripHTML(strHTML)
Dim objRegExp,strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML,"")
strOutput = Replace(strOutput, "<","<")
strOutput = Replace(strOutput, ">",">")
stripHTML = strOutput
Set objRegExp = Nothing
End Function
===============================================================================
以下儲存為 editplus 之*.ctl檔
===============================================================================
#TITLE=ASP常用語法及函數
#INFO
ASP常用的一些語法及自定義函數
#SORT=n
#T= ===ASP常用語法===
#T=============================
#T=數據庫相關
#T= 連接ACCESS數據庫
<%
Dim DBName,Conn
DBName"^!" '定義數據庫路徑及名稱
SET Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DBName)
%>
#T= 連接MS SQL數據庫
<%
Dim Conn
SET Conn=Server.CreateObject("ADODB.connection")
Conn.Open "PROVIDER=SQLOLEDB;DATA SOURCE=SQL服務器名稱或IP地址;UID=數據庫登錄帳號;PWD=數據庫密碼;DATABASE=數據庫名稱"
%>
#T= 建立記錄集
SET ^!=Server.CreateObject("ADODB.recordset")
#T= 執行SQL命令
RS.Open SQL,conn,1,1
#T= 執行SQL命令
Conn.Execute("^!")
#T= RS直接執行SQL命令
SET RS = Conn.Execute("^!")
#T= 關閉記錄集
RS.CLOSE
SET RS=NOTHING
#T= 關閉數據庫
Conn.Close
SET Conn=Nothing
#T=============================
#T=ServerVariables相關
#T= 取上一頁地址
Request.ServerVariables("HTTP_REFERER")
#T= 取服務器的名稱1
Request.ServerVariables("SERVER_NAME")
#T= 取服務器的名稱2
Request.ServerVariables("HTTP_HOST")
#T= 取服務器IP
Request.ServerVariables("LOCAL_ADDR")
#T= 取用戶IP
Request.ServerVariables("Remote_Host")
#T= 取用戶真實IP1
Request.serverVariables("REMOTE_ADDR")
#T= 取用戶真實IP函數
Function GetRealIP()
GetRealIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
IF(GetRealIP = "")THEN GetRealIP = Request.ServerVariables("REMOTE_ADDR")
End Function
#T= 取服務器端口
Request.ServerVariables("SERVER_PORT")
#T= 取服務器操作系統
Request.ServerVariables("OS")
#T= 取服務器的絕對路徑
Request.ServerVariables("APPL_PHYSICAL_PATH")
#T= 取本文件的絕對路徑1
Requet.ServerVariables("PATH_TRANSLATED")
#T= 取本文件的絕對路徑2
Server.mappath(Request.ServerVariables("SCRIPT_NAME"))
#T= 取本文件的相對路徑1
Request.ServerVariables("URL")
#T= 取本文件的相對路徑2
Request.ServerVariables("SCRIPT_NAME")
#T= 取本文件的相對路徑3
Request.ServerVariables("PATH_INFO")
#T= 取地址欄後的參數
Request.ServerVariables("QUERY_STRING")
#T= 取服務器系統信息
Request.ServerVariables("HTTP_USER_AGENT")
#T= 服務器組件檢測
<%
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
SET xTestObj = Server.CreateObject(strClassString)
IF(0 = Err)THEN IsObjInstalled = True
SET xTestObj = Nothing
Err = 0
End Function
'IF(IsObjInstalled("Persits.Upload")=True)THEN
' Response.Write "支持AspUpload組件"
'ELSE
' Response.Write "不支持AspUpload組件"
'END IF
%>
#T= 取客戶端語言環境
^!Request.ServerVariables("HTTP_ACCEPT_LANGUAGE")
#T= 取客戶端信息:HTTP_USER_AGENT
^!Request.ServerVariables("HTTP_USER_AGENT")
#T= 取表單(Form)值元素值
Request.Form("^!")
#T= 取URL傳遞的值
Request.QueryString("^!")
#T= 取完整URL地址
Function GetUrl()
GetUrl="http://"&Request.ServerVariables("SERVER_N ... .ServerVariables("URL")
IF(Request.ServerVariables("QUERY_STRING")<>"")THEN GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function
#T=============================
#T=自定義函數
#T= 過濾HTML字符
<%
'過濾HTML字符函數
Function HTMLEncode(str)
IF(str <> "")THEN
str = Replace(str, "&", "&")
str = Replace(str, ">", ">")
str = Replace(str, "<", "<")
str = Replace(str, Chr(32), " ")
str = Replace(str, Chr(9), " ")
str = Replace(str, Chr(34), """)
str = Replace(str, Chr(39), "'")
str = Replace(str, Chr(13), "")
str = Replace(str, Chr(10) & Chr(10), "</P><P>")
str = Replace(str, Chr(10), "<BR>")
str = Replace(str, Chr(255), " ")
END IF
HTMLEncode = str
End Function
%>
#T= 檢測上頁是否從本站提交
<%
'檢測上頁是否從本站提交
'返回:True,False
'===============================================================
Function IsSelfRefer()
Dim sHttp_Referer, sServer_Name
sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
IF(Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name)THEN
IsSelfRefer = True
ELSE
IsSelfRefer = False
END IF
End Function
%>
#T= 清除所有HTML標記
<%
'清除HTML標記
Function stripHTML(htmlStr)
Dim regEx
SET regEx = New Regexp
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "<.+?>"
htmlStr = regEx.Replace(htmlStr,"")
htmlStr = Replace(htmlStr, "<","<")
htmlStr = Replace(htmlStr, ">",">")
htmlStr = Replace(htmlStr,chr(10),"")
htmlStr = Replace(htmlStr,chr(13),"")
stripHTML = htmlStr
SET regEx = Nothing
End Function
%>
#T= 取字符串長度
<%
'求字符串長度函數
Function GetLength(str)
Dim Length
For i=1 to Len(str)
IF(Asc(Mid(str,i,1))<0 or Asc(Mid(str,i,1))>256)THEN
Length=Length+2
ELSE
Length=Length+1
END IF
Next
GetLength=Length
End Function
%>
#T= 截取指定長度字符串
<%
'截取指定長度的字符串,多餘的用...代替
Function StrLeft(str,strlen)
IF(str = "")THEN
StrLeft = ""
Exit Function
END IF
Dim l,t,c,i
str = Replace(Replace(Replace(Replace(str," "," "),""",chr(34)),">",">"),"<","<")
l=len(str)
t=0
For i=1 to l
c=Abs(Asc(Mid(str,i,1)))
IF(c>255)THEN
t=t+2
ELSE
t=t+1
END IF
IF(t>strlen)THEN
StrLeft = left(str,i) & "..."
Exit For
ELSE
StrLeft = str
END IF
Next
StrLeft = Replace(Replace(Replace(Replace(StrLeft," "," "),chr(34),"""),">",">"),"<","<")
End Function
%>
#T= 獲取安全的提交參數
<%
'===============================================================
'SQL Injection Check
'函數功能:過濾字符參數中的單引號,對於數字參數進行判斷,如果不是數值類型,則賦值0
'參數意義:str ---- 要過濾的參數
'strType ---- 參數類型,分為字符型和數字型,字符型為"s",數字型為"i"
'===============================================================
Function CheckStr(str,strType)
Dim strTmp
strTmp = ""
IF(strType ="s")THEN
strTmp = Replace(Trim(str),"'","''")
ELSEIF(strType="i")THEN
IF(IsNumeric(str)=False)THEN str=False
strTmp = str
ELSE
strTmp = str
End IF
CheckStr= strTmp
End Function
%>
#T= 過濾不良字符(BadWord)
<%
'過濾不良字符(BadWords)
Function ChkBadWords(fString)
Dim BadWords,bwords,i
BadWords = "王八|洪志"
IF(Not(IsNull(BadWords) or IsNull(fString)))THEN
bwords = Split(BadWords, "|")
For i = 0 to UBound(bwords)
fString = Replace(fString, bwords(i), string(Len(bwords(i)),"*"))
Next
ChkBadWords = fString
END IF
End Function
%>
#T= 生成隨機自定義長度密碼
<%
'生成隨機自定義長度密碼
Function makePassword(maxLen)
Dim strNewPass
Dim whatsNext, upper, lower, intCounter
Randomize
For intCounter = 1 To maxLen
whatsNext = Int((1 - 0 + 1) * Rnd + 0)
IF(whatsNext = 0)THEN
'character
upper = 90
lower = 65
ELSE
upper = 57
lower = 48
END IF
strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
Next
makePassword = strNewPass
End Function
'Response.Write makepassword(8)
%>
#T= 填入Textarea時保持格式inHTML
<%
'===============================================================
'去除Html格式,用於從數據庫中取出值填入輸入框時
'注意:value="?"這邊一定要用雙引號
'===============================================================
Function inHTML(str)
Dim sTemp
sTemp = str
inHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<br>",chr(13))
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, """, Chr(34))
inHTML = sTemp
End Function
%>
#T= 正則表表達式驗證函數
<%
'正則表表達式驗證函數 patrn-正則表達式 strng-需要驗證的字符串
'===============================================================
Function RegExpTest(patrn, strng)
Dim regEx, retVal ' 建立變量。
SET regEx = New RegExp ' 建立正則表達式。
regEx.Pattern = patrn ' 設置模式。
regEx.IgnoreCase = False ' 設置是否區分大小寫。
retVal = regEx.Test(strng) ' 執行搜索測試。
RegExpTest = retVal '返回值,不符合就返回false,符合為true
SET regEx = NOTHING
End Function
%>
#T= 生成隨機字符串
<%
'生成隨機字符串
Function RndCode()
Dim CodeSet,AmountSet
CodeSet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
AmountSet = 62 ' 文字數量
Randomize
Dim vCode(10), vCodes,i
For i = 0 To 9
vCode(i) = Int(Rnd * AmountSet)
vCodes = vCodes & Mid(CodeSet, vCode(i) + 1, 1)
Next
RndCode=vCodes
End Function
%>
#T=============================
#T=FSO相關操作
#T= 判斷目錄是否存在
<%
Function IsFloderExist(strFolderName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FolderExists(strFolderName))THEN
IsFloderExist = True
ELSE
IsFloderExist = False
END IF
SET FSO=NOTHING
End Function
%>
#T= 創建目錄
<%
Function CreateFolder(strFolderName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FolderExists(strFolderName) = False)THEN
FSO.CreateFolder(strFolderName)
END IF
SET FSO=NOTHING
END Function
%>
#T= 刪除目錄
<%
Function DeleteFolder(strFolderName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FolderExists(strFolderName))THEN
FSO.DeleteFolder(strFolderName)
END IF
SET FSO=NOTHING
END Function
%>
#T= 判斷文件是否存在
<%
Function IsFileExist(strFileName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FileExists(strFileName))THEN
IsFileExist = True
ELSE
IsFileExist = False
END IF
SET FSO=NOTHING
End Function
%>
#T= 刪除文件
<%
Function DeleteFile(strFileName)
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
IF(FSO.FileExists(strFileName))THEN
FSO.DeleteFile(strFileName)
END IF
SET FSO=NOTHING
END Function
%>
#T=============================
#T= ASP小偷常用的幾個函數
<%
Function ByteToStr(vIn)
Dim strReturn,i,ThisCharCode,innerCode,Hight8,Low8,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
IF(ThisCharCode < &H80)THEN
strReturn = strReturn & Chr(ThisCharCode)
ELSE
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
END IF
Next
ByteToStr = strReturn
End Function
Function GetHttpPageContent(url,Method,SendStr)
Dim Retrieval
SET Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open Method, url, False ,"" ,""
.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
.Send(SendStr)
GetHttpPageContent = .ResponseBody
End With
SET Retrieval = Nothing
GetHttpPageContent=ByteToStr(GetHttpPageContent)
End Function
Function RegExpText(strng,regStr)
Dim regEx,Match,Matches,RetStr
SET regEx = New RegExp
regEx.Pattern = regStr
regEx.IgnoreCase = True
regEx.Global = True
SET Matches = regEx.Execute(strng)
For Each Match in Matches
RetStr = RetStr & regEx.Replace(Match.Value,"$1") & ","
Next
RegExpText = RetStr
set regEx=nothing
End Function
Function StreamBytesToBstr(strBody, CodeBase)
Dim objStream
SET objStream = Server.CreateObject("Adodb.Stream")
With objStream
.Type = 1
.Mode = 3
.Open
.Write strBody
.Position = 0
.Type = 2
.Charset = CodeBase
StreamBytesToBstr = .ReadText
.Close
End With
SET objStream = Nothing
End Function
%>
來源:http://www.ironman.tw/article.asp?id=64
全站熱搜
留言列表