我要评论'函数id：13
'函数作用：个性化加密
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-2-25 15:12
'修改时间：
'传人参数：
' strpassword：需加密的数据
'返回值：
' 加密后的数据
'============================================================================================================================
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
'============================================================================================================================
'函数id：14
'函数作用：禁止浏览器缓存本页
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-3-5 2:45
'修改时间：
'传人参数：
'返回值：
'============================================================================================================================
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
'============================================================================================================================
'函数id：15
'函数作用：网页格式化输入文本
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-3-5 2:50
'修改时间：
'传人参数：
' 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
'============================================================================================================================
'函数id：16
'函数作用：从头部截取字符串的指定长度(按字符数算)
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-3-5 3:04
'修改时间：
'传人参数：
' 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
'============================================================================================================================
'函数id：17
'函数作用：检测验证码
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-3-5 3:09
'修改时间：
'传人参数：
' 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
'============================================================================================================================
'函数id：18
'函数作用：生成验证码
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-3-5 3:16
'修改时间：
'传人参数：
'返回值：
'============================================================================================================================
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
'============================================================================================================================
'函数id：19
'函数作用：获取客户端操作系统版本
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-3-5 3:21
'修改时间：
'传人参数：
'返回值：操作系统版本名称
'============================================================================================================================
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
'============================================================================================================================
'函数id：20
'函数作用：数据库事务处理
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-3-5 3:25
'修改时间：
'传人参数：
'返回值：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
'============================================================================================================================
'函数id：21
'函数作用：快速排序（递归）
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-4-9 19:53
'修改时间：
'传人参数：
' arr:需排序的数组
' low:数组最小下标
' high:数组最大下标
'返回值：
'============================================================================================================================
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
'============================================================================================================================
'函数id：22
'函数作用：将数组的元素以特定字符串连起来
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-4-9 21:16
'修改时间：
'传人参数：
' arr:需串连的数组
' 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
'============================================================================================================================
'函数id：23
'函数作用：返回字符串以某分割符分割的数目
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-2-16 16:29
'修改时间：
'传人参数：
' 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
'============================================================================================================================
'函数id：24
'函数作用：截取含有分割符的字符串中指定数目的字符串
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-2-16 16:29
'修改时间：
'传人参数：
' 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
'============================================================================================================================
'函数id：25
'函数作用：利用stream下载文件
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-2-16 16:29
'修改时间：
'传人参数：
' 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
'============================================================================================================================
'函数id：26
'函数作用：返回信息
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-2-21 20：45
'修改时间：
'传人参数：
'返回值：
'============================================================================================================================
sub send_back(resultwords)
dim objresult
set objresult = server.createobject("msxml2.domdocument")
objresult.loadxml ("<返回结果></返回结果>")
objresult.selectsinglenode("返回结果").text = resultwords
response.contenttype = "text/xml"
objresult.save (response)
response.end
set objresult = nothing
end sub
'============================================================================================================================
'函数id：27
'函数作用：获取错误信息
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-4-22 13：13
'修改时间：
'传人参数：
'返回值：
'============================================================================================================================
function get_err()
if err.number > 0 then
get_err = err.description
else
get_err = "t"
end if
end function
'============================================================================================================================
'函数id：28
'函数作用：与saferequest相反
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
'建立时间：2006-2-16 15:32
'修改时间：
'传人参数：
' paraname:参数名称-字符型
' paratype:参数类型-数字型(1表示以上参数是数字，0表示以上参数为字符)
'返回值：
' 过滤后的字符串
'============================================================================================================================
function saferesponse(content)
dim paravalue
paravalue = content
paravalue = replace(paravalue,"[system:34]","'")
paravalue = replace(paravalue,"[system:61]","=")
saferesponse = paravalue
end function
'============================================================================================================================
'函数id：29
'函数作用：保存远程图片
'作者名称：http://news.dvbbs.net/infoview/article_2906.html
'建立时间：2006-2-16 15:32
'修改时间：
'传人参数：
' localfilename:本地文件名
' remotefileurl:远程文件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
%>
2
您可能感兴趣的文章:
如您对本文有疑问或者有任何想说的，请点击进行留言回复，万千网友为您解惑！
网友评论