ASP通用函数源码集

<%
'判断文件名是否合法
Function isFilename(aFilename)
Dim sErrorStr,iNameLength,i
isFilename=TRUE
sErrorStr=Array("/","/",":","*","?","""","<",">","|")
iNameLength=Len(aFilename)
If iNameLength<1 Or iNameLength=null Then
isFilename=FALSE
Else
For i=0 To 8
If instr(aFilename,sErrorStr(i)) Then
isFilename=FALSE
End If
Next
End If
End Function

'去掉字符串头尾的连续的回车和空格
function trimVBcrlf(str)
trimVBcrlf=rtrimVBcrlf(ltrimVBcrlf(str))
end function

'去掉字符串开头的连续的回车和空格
function ltrimVBcrlf(str)
dim pos,isBlankChar
pos=1
isBlankChar=true
while isBlankChar
if mid(str,pos,1)=" " then
pos=pos+1
elseif mid(str,pos,2)=VBcrlf then
pos=pos+2
else
isBlankChar=false
end if
wend
ltrimVBcrlf=right(str,len(str)-pos+1)
end function

'去掉字符串末尾的连续的回车和空格
function rtrimVBcrlf(str)
dim pos,isBlankChar
pos=len(str)
isBlankChar=true
while isBlankChar and pos>=2
if mid(str,pos,1)=" " then
pos=pos-1
elseif mid(str,pos-1,2)=VBcrlf then
pos=pos-2
else
isBlankChar=false
end if
wend
rtrimVBcrlf=rtrim(left(str,pos))
end function

'判断Email是否有效,返回1表示正确
Function isEmail(aEmail)
Dim iLocat,v,iLength,i,checkletter
If instr(aEmail,"@") = 0 Or instr(aEmail,".") = 0 Then
isEmail=0
EXIT FUNCTION
End If
iLocat=instr(aEmail,"@")
If instr(iLocat,aEmail,".")=0 Or instr(iLocat+1,aEmail,"@")>0 Then
isEmail=0
EXIT FUNCTION
End If
If left(aEmail,1)="." Or right(aEmail,1)="." Or left(aEmail,1)="@" Or right(aEmail,1)="@" Then
isEmail=0
EXIT FUNCTION
End If
v="1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_-.@"
iLength=len(aEmail)
For i=1 To iLength
checkletter=mid(aEmail,i,1)
If instr(v,checkletter)=0 Then
isEmail=0
EXIT FUNCTION
End If
Next
isEmail=1
End Function

'测试用:显示服务器信息
Sub showServer
Dim name
Response.write "<Table border=1 bordercolor=lightblue CELLSPACING=0>"
for each name in request.servervariables
Response.write "<tr>"
Response.write "<td>"&name&"</td>"
Response.write "<td>"&request.servervariables(name)&"<br></td>"
Response.write "</tr>"
next
Response.write "</table>"
End Sub

'测试用:显示Rs结果集以及字段名称
Sub showRs(rs)
Dim strTable,whatever
Response.write "<center><table><tr>"
for each whatever in rs.fields
response.write "<td><b>" & whatever.name & "</B></TD>"
next
strTable = "</tr><tr><td>"&rs.GetString(,,"</td><td>","</tr><tr><td>"," ") &"</td></tr></table></center>"
Response.Write(strTable)
End Sub

'用HTML格式显示文本
Function txt2Html(str)
if isnull(str) then
txt2Html=""
exit Function
end if
str=Replace(str,chr(34),""")
str=Replace(str,"<","<")
str=Replace(str,">",">")
str=Replace(str,chr(13)+chr(10),"<br>")
str=Replace(str,chr(9),"    ")
str=Replace(str," "," ")
txt2Html=str
End Function

'测试用:显示调试错误信息
Sub showError
Dim sErrMsg
sErrMsg=Err.Source&" "&Err.Description
Response.write "<center>"&sErrMsg&"</center>"
Err.clear
End Sub

'显示文字计数器
Sub showCounter
Dim fs,outfile,filename,count
filename=server.mappath("count.txt")
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.fileExists(filename) Then
Set outfile=fs.openTextFile(filename,1)
count=outfile.readline
count=count+1
Response.write "<center>浏览人次："&count&"<center>"
outfile.close
Set outfile=fs.CreateTextFile(filename)
outfile.writeline(count)
Else
Set outfile=fs.openTextFile(filename,8,TRUE)
count=0
outfile.writeline(count)
END IF
outfile.close
set fs=nothing
End Sub
%>
////////////////////////////
<%
'***************************
'將搜索關鍵字用紅色顯示
'***************************
Public Function ChkBadWord(old_string,key_word)
if old_string<>"" or old_string<>null then
key_word = Replace(key_word,"+","/+")
key_word = Replace(key_word,"*","/*")
key_word = Replace(key_word,".","/.")
Dim regEx, Match, Matches,new_string
Set regEx = New RegExp   '建立正則表達式。
regEx.Pattern = key_word   ' 設置模式。
regEx.IgnoreCase = True   ' 設置是否區分字符大小寫。
regEx.Global = True   ' 設置全局可用性。
On Error Resume Next
Set Matches = regEx.Execute(old_string) ' 執行搜索。
if matches.count <>0 then
new_string = old_string
For Each Match in Matches  ' 遍歷匹配集合。
  new_string=replace(new_string,match.value,"<font color=red>" & match.value & "</font>" )
 Next
else
new_string = old_string
end if
ChkBadWord = new_string
else
ChkBadWord=""
end if
End Function
'***************************
'替換html字符
'***************************
Public function HTMLEncodes(fString)
if not isnull(fString) then
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), "<BR> ")
 'fString = Replace(fString, "#", "#")
HTMLEncodes = fString
end if
end function
'***************************
'調用outlook時替換字符
'***************************
function MailEncodes(fString)
if not isnull(fString) then
fString = Replace(fString, "%", "%25")
fString = replace(fString, ">", "%3E")
fString = replace(fString, "<", "%3C")
fString = Replace(fString, "&", "%26")
fString = Replace(fString, CHR(34), "%22")
fString = Replace(fString, CHR(13), "%0a")
MailEncodes= fString
end if
end function
'***************************
'替換SQL語名的單引號符號
'***************************
function checkSQL(str)
 if isnull(str) then
  checkSQL = ""
  exit function
 end if
 checkSQL=replace(str,"'","''")
end function
'***************************
'判斷發言是否來自外部
'***************************
function chkpost()
 dim server_v1,server_v2
 chkpost=false
 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
  chkpost=false
 else
  chkpost=true
 end if
end function
'***************************
'過濾字符
'***************************
function ChkBadWords(fString)
dim bwords,ii,BadWords
 BadWords="媽的|奶的|媽的|傻B|傻B|傻b|傻B|傻B|fuck|bitch|傻B|傻B|性愛|法輪|媽的|裸體|明慧|洪志|大法|叼|叼|shit"
if not(isnull(BadWords) or isnull(fString)) then
bwords = split(BadWords, "|")
for ii = 0 to ubound(bwords)
fString = Replace(fString, bwords(ii), string(len(bwords(ii)),"*"))
next
ChkBadWords = fString
end if
end function
%>
'***************************
'ip范围限制函数
'***************************
'Function CheckIp(cInput_Ip,cBound_Ip)
'Created by qqdao, [e-mail] 2001/11/28
'说明：首先需要根据;号循环，然后判断是否含有"-"，如果有则进行拆分处理，最后判断是否在范围内
'参数： cInput_Ip,代检查的ip
' cBound_Ip,给定的范围格式为,单个ip,和范围ip，范围ip最后使用”-“分割，如果是“*”则必须放到最后一位
' 每个范围后添加":ALLOW"表示允许登陆，添加":REFUSE"表示拒绝登陆。多个范围用”;“隔开
' 例如192.168.1*.*:ALLOW;192.168.1.1:ALLOW;192.168.1.1-10:REFUSE"
'返回值: true/false
'更新：2001/12/05 支持ALLOW,REFUSE支持’*‘,不想对？支持，因为和*差不多
'******************************
function CheckIp(cInput_Ip,cBound_Ip)
dim cSingle_Ip,cTemp_IP,cStart_IP,cEnd_Ip
CheckIp = false
cSingle_Ip=split(cBound_Ip,";")

for i=0 to ubound(cSingle_Ip)
if Instr(cSingle_Ip(i),"REFUSE") <> 0 then '就是拒绝了
cTemp_IP = left(cSingle_Ip(i),instr(cSingle_Ip(i),":")-1)

if Instr(cTemp_IP,"*") <> 0 then '是宽范围
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"*")-1)
if left(cInput_Ip,len(cStart_IP))=cStart_IP then
CheckIp = false
exit function
end if
end if

if Instr(cTemp_IP,"-") = 0 then
cStart_IP = cTemp_IP
cEnd_Ip = cTemp_IP
else
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"-")-1)
cEnd_Ip = left(cStart_IP,InStrRev(cStart_IP,".")-1)+"."+mid(cTemp_IP,instr(cTemp_IP,"-")+1)
end if

if Ip2Str(cInput_Ip)>=Ip2Str(cStart_IP) and Ip2Str(cInput_Ip)<=Ip2Str(cEnd_Ip) then
CheckIp = false
exit function
end if

elseif Instr(cSingle_Ip(i),"ALLOW") <> 0 then '允许

cTemp_IP = left(cSingle_Ip(i),instr(cSingle_Ip(i),":")-1)

if Instr(cTemp_IP,"*") <> 0 then '是宽范围
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"*")-1)
if left(cInput_Ip,len(cStart_IP))=cStart_IP then
CheckIp = true
end if
end if

if Instr(cTemp_IP,"-") = 0 then
cStart_IP = cTemp_IP
cEnd_Ip = cTemp_IP
else
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"-")-1)
cEnd_Ip = left(cStart_IP,InStrRev(cStart_IP,".")-1)+"."+mid(cTemp_IP,instr(cTemp_IP,"-")+1)
end if

if Ip2Str(cInput_Ip)>=Ip2Str(cStart_IP) and Ip2Str(cInput_Ip)<=Ip2Str(cEnd_Ip) then
CheckIp =true
else
CheckIp =false
end if
end if
next

end function

'******************************
'Function Ip2Str(cIp)
'Created by qqdao, [e-mail] 2001/11/28
'参考动网ip算法
'参数：cIp ip地址
'返回值: 转换后数值
'******************************
function Ip2Str(cIp)
Dim str1,str2,str3,str4
Dim cIp_Temp
if cIp="127.0.0.1" then cIp="192.168.0.1"
str1=left(cIp,instr(cIp,".")-1)
cIp_Temp=mid(cIp,instr(cIp,".")+1)
str2=left(cIp_Temp,instr(cIp_Temp,".")-1)
cIp_Temp=mid(cIp_Temp,instr(cIp_Temp,".")+1)
str3=left(cIp_Temp,instr(cIp_Temp,".")-1)
str4=mid(cIp_Temp,instr(cIp_Temp,".")+1)

if isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 then

else
Ip2Str=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
end if

end function
'**************************
'处理各种日期格式的函数
'**************************
function wf_DateToChar(datetime,l)
'---------说明------------
'datetime是你要转化的日期值
'l是你要转化到的层次，可设为"d"、"n"和"s"
'"d"是指转化为yyyy-mm-dd形式
'"n"是指转化为yyyy-mm-dd hh:mm形式
'"s"是指转化为yyyy-mm-dd hh:mm:ss形式
'"long"是指转化为yyyy年mm月dd日的形式
'"no"是指转化为yyyymmdd的形式
'"short"是指转化为yymmdd的形式
'"t"是指转化为yymmdd hh:mm的形式
'-------------------------
dim ls_date,ls_getstr
if isnull(l) or trim(l)="" then l="s"
if isdate(datetime) then
ls_date=cstr(datetime)
'writeln ls_date
ls_getstr=DatePart("yyyy",cdate(ls_date))
ls_getstr=ls_getstr & "-" & wf_ctonstr(DatePart("m",cdate(ls_date)),2)
ls_getstr=ls_getstr & "-" & wf_ctonstr(DatePart("d",cdate(ls_date)),2)
if l="d" then wf_DateToChar=ls_getstr
ls_getstr=ls_getstr & " " & wf_ctonstr(DatePart("h",cdate(ls_date)),2)
ls_getstr=ls_getstr & ":" & wf_ctonstr(DatePart("n",cdate(ls_date)),2)
if l="n" then wf_DateToChar=ls_getstr
ls_getstr=ls_getstr & ":" & wf_ctonstr(DatePart("s",cdate(ls_date)),2)
if l="s" then wf_DateToChar=ls_getstr
if l="long" then wf_DateToChar=DatePart("yyyy",cdate(ls_date))&"年"&wf_ctonstr(DatePart("m",cdate(ls_date)),2)&"月"&wf_ctonstr(DatePart("d",cdate(ls_date)),2)&"日"
if l="no" then wf_DateToChar=DatePart("yyyy",cdate(ls_date))&wf_ctonstr(DatePart("m",cdate(ls_date)),2)&wf_ctonstr(DatePart("d",cdate(ls_date)),2)
if l="short" then wf_DateToChar=right(DatePart("yyyy",cdate(ls_date)),2)&wf_ctonstr(DatePart("m",cdate(ls_date)),2)&wf_ctonstr(DatePart("d",cdate(ls_date)),2)
if l="t" then wf_DateToChar=wf_ctonstr(DatePart("m",cdate(ls_date)),2)&wf_ctonstr(DatePart("d",cdate(ls_date)),2)&" "& wf_ctonstr(DatePart("h",cdate(ls_date)),2)& ":" & wf_ctonstr(DatePart("n",cdate(ls_date)),2)

else
wf_DateToChar=Null
end if

end function
'----把一位整数转化为两位整数----"1" to "01"
function wf_ctonstr(num,n)
if not IsNumeric(num) then
wf_ctonstr=num
else
if len(cstr(cint(num)))>=n then
wf_ctonstr=cstr(cint(num))
else
wf_ctonstr="0"&cstr(cint(num))
while len(wf_ctonstr)<n
wf_ctonstr="0"&cstr(wf_ctonstr)
wend
end if
end if
end function