ASP的一些自定義函數(shù)整理第2/2頁
更新時間：2008年06月18日 21:35:52 作者：
書學(xué)asp，經(jīng)常會用到一些函數(shù)，對于代碼的重用性有所提高，執(zhí)行速度也提高，希望大家多多欣賞學(xué)習(xí)
'函數(shù)ID：13
'函數(shù)作用：個性化加密
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-2-25 15:12
'修改時間：
'傳人參數(shù)：
' StrPassword：需加密的數(shù)據(jù)
'返回值：
' 加密后的數(shù)據(jù)
'============================================================================================================================
Function MyEncrypt(StrPassword)
Dim StrLen,StrLeft,StrRight,n
n = 8
StrPassword = MD5(StrPassword)
StrLen = len(StrPassword)
StrLeft = left(StrPassword,n)
StrRight = right(StrPassword,StrLen-n)
MyEncrypt = StrRight&StrLeft
End function
'============================================================================================================================
'函數(shù)ID：14
'函數(shù)作用：禁止瀏覽器緩存本頁
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-3-5 2:45
'修改時間：
'傳人參數(shù)：
'返回值：
'============================================================================================================================
Sub NoBuffer()
Response.expires = 0
Response.expiresabsolute = Now() - 1
Response.addHeader "pragma","no-cache"
Response.addHeader "cache-control","private"
Response.CacheControl = "no-cache"
end sub
'============================================================================================================================
'函數(shù)ID：15
'函數(shù)作用：網(wǎng)頁格式化輸入文本
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-3-5 2:50
'修改時間：
'傳人參數(shù)：
' fString：源字符串
'返回值：格式化后的字符串
'============================================================================================================================
function HTMLEncode(fString)
if not isnull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32)&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>")
HTMLEncode = fString
end if
end function
'============================================================================================================================
'函數(shù)ID：16
'函數(shù)作用：從頭部截取字符串的指定長度(按字符數(shù)算)
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-3-5 3:04
'修改時間：
'傳人參數(shù)：
' Str：源字符串
' StrLen：長度
'返回值：截取得到的字符串
'============================================================================================================================
Function GotTopic(Str,StrLen)
Dim l,t,c, i,LableStr,regEx,Match,Matches,focus,last_str
if IsNull(Str) then
GotTopic = ""
Exit Function
end if
if Str = "" then
GotTopic=""
Exit Function
end if
Set regEx = New RegExp
regEx.Pattern = "\[[^\[\]]*\]"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(Str)
For Each Match in Matches
LableStr = LableStr & Match.Value
Next
Str = regEx.Replace(Str,"")
Str=Replace(Replace(Replace(Replace(Str," "," "),""",Chr(34)),">",">"),"<","<")
l=len(str)
t=0
strlen=Clng(strLen)
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-2 then
focus = i
last_str = ".."
end if
if t = strLen-1 then
focus = i
last_str = "."
end if
if t>=strlen then
GotTopic=left(str,focus)&last_str
exit for
else
GotTopic=str
end if
next
GotTopic = Replace(Replace(Replace(Replace(GotTopic," "," "),Chr(34),"""),">",">"),"<","<") & LableStr
end function
'============================================================================================================================
'函數(shù)ID：17
'函數(shù)作用：檢測驗證碼
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-3-5 3:09
'修改時間：
'傳人參數(shù)：
' RadomPass：輸入的驗證碼
'返回值：
'============================================================================================================================
Sub CheckRadomPass(RadomPass)
if radompass = "" then
call ShowErr(language_arr(14))
elseif Session("GetCode") = "9999" then
Session("GetCode")=""
elseif Session("GetCode") = "" then
call ShowErr(language_arr(15))
elseif cstr(Session("GetCode"))<>radompass then
call ShowErr(language_arr(16))
end if
Session("GetCode")=""
End sub
'============================================================================================================================
'函數(shù)ID：18
'函數(shù)作用：生成驗證碼
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-3-5 3:16
'修改時間：
'傳人參數(shù)：
'返回值：
'============================================================================================================================
Function GetCode()
Dim TestObj
On Error Resume Next
Set TestObj = Server.CreateObject("Adodb.Stream")
Set TestObj = Nothing
If Err Then
Dim TempNum
Randomize timer
TempNum = cint(8999*Rnd+1000)
Session("GetCode") = TempNum
GetCode = Session("GetCode")
Else
GetCode = "<img src="""&Site_Url&"inc/GetCode.asp"">"
End If
End Function
'============================================================================================================================
'函數(shù)ID：19
'函數(shù)作用：獲取客戶端操作系統(tǒng)版本
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-3-5 3:21
'修改時間：
'傳人參數(shù)：
'返回值：操作系統(tǒng)版本名稱
'============================================================================================================================
Function GetSystem()
dim System
System = Request.ServerVariables("HTTP_USER_AGENT")
if Instr(System,"Windows NT 5.2") then
System = "Win2003"
elseif Instr(System,"Windows NT 5.0") then
System="Win2000"
elseif Instr(System,"Windows NT 5.1") then
System = "WinXP"
elseif Instr(System,"Windows NT") then
System = "WinNT"
elseif Instr(System,"Windows 9") then
System = "Win9x"
elseif Instr(System,"unix") or instr(System,"linux") or instr(System,"SunOS") or instr(System,"BSD") then
System = "Unix"
elseif Instr(System,"Mac") then
System = "Mac"
else
System = "Other"
end if
GetSystem = System
End Function
'============================================================================================================================
'函數(shù)ID：20
'函數(shù)作用：數(shù)據(jù)庫事務(wù)處理
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-3-5 3:25
'修改時間：
'傳人參數(shù)：
'返回值：true or false
'============================================================================================================================
function ConnManage(Conn_object)
if Conn_object.Errors.count<>0 then
Conn_object.rollbacktrans
err.clear
ConnManage = false
else
Conn_object.committrans
ConnManage = true
end if
end function
'============================================================================================================================
'函數(shù)ID：21
'函數(shù)作用：快速排序（遞歸）
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-4-9 19:53
'修改時間：
'傳人參數(shù)：
' arr:需排序的數(shù)組
' Low:數(shù)組最小下標(biāo)
' High:數(shù)組最大下標(biāo)
'返回值：
'============================================================================================================================
Sub QuickSort(arr,Low,High)
Dim i,j,x,y,k
i=Low
j=High
x=arr(Cint((Low+High)/2))
Do
While (arr(i)-x<0 and i<High)
i=i+1
Wend
While (x-arr(j)<0 and j>Low)
j=j-1
Wend
If i<=j Then
y=arr(i)
arr(i)=arr(j)
arr(j)=y
i=i+1
j=j-1
End if
Loop while i<=j
If Low<j Then call QuickSort(arr,Low,j)
If i<High Then call QuickSort(arr,i,High)
End sub
'============================================================================================================================
'函數(shù)ID：22
'函數(shù)作用：將數(shù)組的元素以特定字符串連起來
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-4-9 21:16
'修改時間：
'傳人參數(shù)：
' arr:需串連的數(shù)組
' character:串連字符
'返回值：
' 串連后的字符串
'============================================================================================================================
function arr_join(arr,character)
dim i
for i = 0 to ubound(arr)
if i = 0 then
arr_join = arr(i)
else
arr_join = arr_join & character & arr(i)
end if
next
end function
'============================================================================================================================
'函數(shù)ID：23
'函數(shù)作用：返回字符串以某分割符分割的數(shù)目
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-2-16 16:29
'修改時間：
'傳人參數(shù)：
' errStr:錯誤提示-字符型
'返回值：返回提交頁面
'============================================================================================================================
function count_character(str,character)
dim i
i = 0
Do Until InStr(str,character) = 0
str = Mid(str, InStr(str,character) + 1)
i = i + 1
Loop
count_character = i
End function
'============================================================================================================================
'函數(shù)ID：24
'函數(shù)作用：截取含有分割符的字符串中指定數(shù)目的字符串
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-2-16 16:29
'修改時間：
'傳人參數(shù)：
' errStr:錯誤提示-字符型
'返回值：返回提交頁面
'============================================================================================================================
function inter_str_by_character_num(str,character,start,num)
dim i,str_temp,start_location,inter_length,str_length
i = 0
inter_length = 0
str_length = len(str)
str = right(left(str,str_length-1),str_length-2)
str_length = str_length - 2
str_temp = str
Do Until InStr(str_temp,character) = 0
i = i + 1
str_temp = Mid(str_temp,InStr(str_temp,character) + 1)
if i = start - 1 then start_location = str_length - len(str_temp)
if i = start + num - 1 then
inter_length = str_length - len(str_temp) - start_location
exit do
end if
Loop
if inter_length = 0 then
inter_str_by_character_num = mid(str,start_location+1)
else
inter_str_by_character_num = mid(str,start_location+1,inter_length-1)
end if
End function
'============================================================================================================================
'函數(shù)ID：25
'函數(shù)作用：利用Stream下載文件
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-2-16 16:29
'修改時間：
'傳人參數(shù)：
' errStr:錯誤提示-字符型
'返回值：返回提交頁面
'============================================================================================================================
function downloadFile(strFile)
dim strFilename,s,fso,f,intFilelength
Response.Buffer = True
Response.Clear
Set s = Server.CreateObject("ADODB.Stream")
s.Open
s.Type = 1
on error resume next
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(strFile) then
Response.Write("<h1>Error:</h1>該文件不存在<p>")
Response.End
end if
Set f = fso.GetFile(strFile)
intFilelength = f.size
s.LoadFromFile(strFile)
if err then
Response.Write("<h1>Error:</h1>文件下載錯誤<p>")
Response.End
end if
Response.AddHeader "Content-Disposition","attachment;filename=" & f.name
Response.AddHeader "Content-Length",intFilelength
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite s.Read
Response.Flush
s.Close
set f = nothing
set fso = nothing
Set s = Nothing
end function
'============================================================================================================================
'函數(shù)ID：26
'函數(shù)作用：返回信息
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-2-21 20：45
'修改時間：
'傳人參數(shù)：
'返回值：
'============================================================================================================================
sub send_back(ResultWords)
dim objResult
Set objResult = Server.CreateObject("MSXML2.DOMDocument")
objResult.loadXML ("<返回結(jié)果></返回結(jié)果>")
objResult.selectSingleNode("返回結(jié)果").text = ResultWords
Response.ContentType = "text/xml"
objResult.save (Response)
Response.End
Set objResult = Nothing
end sub
'============================================================================================================================
'函數(shù)ID：27
'函數(shù)作用：獲取錯誤信息
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-4-22 13：13
'修改時間：
'傳人參數(shù)：
'返回值：
'============================================================================================================================
function get_err()
if Err.Number > 0 then
get_err = Err.Description
else
get_err = "T"
end if
end function
'============================================================================================================================
'函數(shù)ID：28
'函數(shù)作用：與SafeRequest相反
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立時間：2006-2-16 15:32
'修改時間：
'傳人參數(shù)：
' paraName:參數(shù)名稱-字符型
' paraType:參數(shù)類型-數(shù)字型(1表示以上參數(shù)是數(shù)字，0表示以上參數(shù)為字符)
'返回值：
' 過濾后的字符串
'============================================================================================================================
function SafeResponse(content)
dim paraValue
paraValue = content
paraValue = replace(paraValue,"[system:34]","'")
paraValue = replace(paraValue,"[system:61]","=")
SafeResponse = paraValue
end function
'============================================================================================================================
'函數(shù)ID：29
'函數(shù)作用：保存遠(yuǎn)程圖片
'作者名稱：http://news.dvbbs.net/infoview/Article_2906.html
'建立時間：2006-2-16 15:32
'修改時間：
'傳人參數(shù)：
' LocalFileName:本地文件名
' RemoteFileUrl:遠(yuǎn)程文件URL
'返回值：
'============================================================================================================================
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
dim Ads,Retrieval,GetRemoteData
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", RemoteFileUrl, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set Ads = Server.CreateObject("Adodb.Stream")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile LocalFileName,2
.Cancel()
.Close()
End With
Set Ads=nothing
end sub
%>
相關(guān)文章
其實(shí)SQL注入漏洞并不可怕，知道原理 ＋ 耐心仔細(xì)，就可以徹底防范2011-11-11
ASP在ACCESS中模糊查詢"內(nèi)存溢出"的解決方法
這篇文章主要介紹了ASP在ACCESS中模糊查詢"內(nèi)存溢出"的解決方法,本文導(dǎo)致這個問題的原因是字符編碼問題,使用了一個轉(zhuǎn)碼函數(shù)解決,需要的朋友可以參考下2014-06-06
asp實(shí)現(xiàn)圖片右鍵滑輪控制大小的函數(shù)
asp實(shí)現(xiàn)圖片右鍵滑輪控制大小的函數(shù)...2007-08-08
ASP中過濾UBB和Html標(biāo)簽...2006-09-09
URL反編碼函數(shù),簡單易懂。 主要是原來的中文進(jìn)行了url編碼，具體使用的時候需要還原成中文，就需要這樣的函數(shù)。2010-05-05
經(jīng)常有些地方性的B2B或者B2C網(wǎng)站到處都被批量發(fā)布好多垃圾信息，把我的解決辦法分享給大家2011-12-12
asp中獲取當(dāng)前月份距離以前某個時間的月份數(shù)
獲取當(dāng)前月份距離以前某個時間的月份數(shù)，asp都是用DateDiff函數(shù)來實(shí)現(xiàn)2012-04-04
在ASP編程中使用數(shù)組...2006-10-10
這篇文章主要介紹了asp批量添加修改刪除操作示例，包括js客戶端數(shù)據(jù)有效性驗證，服務(wù)器端自己添加驗證,需要的朋友可以參考下2017-03-03
ASP使用FSO讀取模板的代碼...2007-03-03