ASP编程常用的函数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

’*************************************

’IP过滤

’*************************************

function MatchIP(IP)

on error resume next

MatchIP=false

Dim SIp,SplitIP

for each SIp in FilterIP

SIp=replace(SIp,"*","/d*")

SplitIP=split(SIp,".")

Dim re,strMatchs,strIP

Set re=new RegExp

re.IgnoreCase =True

re.Global=True

re.Pattern="("&SplitIP(0)"|).""("&SplitIP(1)"|).""("&SplitIP(2)"|).""("&SplitIP(3)"|)"

Set strMatchs=re.Execute(IP)

strIP=strMatchs(0).SubMatches(0) & "." & strMatchs(0).SubMatches(1)& "." & strMatchs(0).SubMatches(2)& "." & strMatchs(0).SubMatches(3)

if strIP=IP then MatchIP=true:exit function

Set strMatchs=nothing

Set re=nothing

end function

’*************************************

’获得注册码

’*************************************

Function getcode()

getcode= "<img src=""common/getcode.asp"" alt="""" margin-right:40px;""/>"

End Function

’*************************************

’限制上传文件类型

’*************************************

Function IsvalidFile(File_Type)

IsvalidFile = False

Dim GName

For Each GName in UP_FileType

If File_Type = GName Then

IsvalidFile = True

Exit For

End If

End Function

’*************************************

’检测是否只包含英文和数字

’*************************************

Function IsValidChars(str)

Dim re,chkstr

Set re=new RegExp

re.IgnoreCase =true

re.Global=True

re.Pattern="[^_/.a-zA-Z/d]"

IsValidChars=True

chkstr=re.Replace(str,"")

if chkstr<>str then IsValidChars=False

set re=nothing

End Function

’*************************************

’检测是否只包含英文和数字

’*************************************

Function IsvalidValue(ArrayN,Str)

IsvalidValue = false

Dim GName

For Each GName in ArrayN

If Str = GName Then

IsvalidValue = true

Exit For

End If

End Function

’*************************************

’检测是否有效的数字

’*************************************

Function IsInteger(Para)

IsInteger=False

If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then

IsInteger=True

End If

End Function

’*************************************

’用户名检测

’*************************************

Function IsValidUserName(byVal UserName)

on error resume next

Dim i,c

Dim VUserName

IsValidUserName = True

For i = 1 To Len(UserName)

c = Lcase(Mid(UserName,i,1))

If InStr("$!<>?#^%@~`&*();:+=’"" ",c) > 0 Then

IsValidUserName = False

Exit Function

End IF

For Each VUserName in Register_UserName

If UserName = VUserName Then

IsValidUserName = False

Exit For

End If

End Function

’*************************************

’检测是否有效的E-mail地址

’*************************************

Function IsValidEmail(Email)

Dim names,name,c

IsValidEmail = True

Names = Split(email,"@")

If UBound(names) <> 1 Then

IsValidEmail = False

Exit Function

End If

For Each name IN names

If Len(name) <= 0 Then

IsValidEmail = False

Exit Function

End If

For i = 1 to Len(name)

c = Lcase(Mid(name,1))

If InStr("abcdefghijklmnopqrstuvwxyz_-.",c) <= 0 And Not IsNumeric(c) Then

IsValidEmail = false

Exit Function

End If

If Left(name,1) = "." or Right(name,1) = "." Then

IsValidEmail = false

Exit Function

End If

If InStr(names(1),".") <= 0 Then

IsValidEmail = False

Exit Function

End If

i = Len(names(1)) - InStrRev(names(1),".")

If i <> 2 And i <> 3 Then

IsValidEmail = False

Exit Function

End If

If InStr(email,"..") > 0 Then

IsValidEmail = False

End If

End Function

’*************************************

’过滤超链接

’*************************************

Function checkURL(ByVal ChkStr)

Dim str:str=ChkStr

str=Trim(str)

If IsNull(str) Then

checkURL = ""

Exit Function

End If

Dim re

Set re=new RegExp

re.IgnoreCase =True

re.Global=True

re.Pattern="(d)(ocument/.cookie)"

Str = re.replace(Str,"$1ocument cookie")

re.Pattern="(d)(ocument/.write)"

Str = re.replace(Str,"$1ocument write")

re.Pattern="(s)(cript:)"

Str = re.replace(Str,"$1cript ")

re.Pattern="(s)(cript)"

Str = re.replace(Str,"$1cript")

re.Pattern="(o)(bject)"

Str = re.replace(Str,"$1bject")

re.Pattern="(a)(pplet)"

Str = re.replace(Str,"$1pplet")

re.Pattern="(e)(mbed)"

Str = re.replace(Str,"$1mbed")

Set re=nothing

Str = Replace(Str,">",">")

Str = Replace(Str,"<","<")

checkURL=Str

end function

’*************************************

’过滤文件名字

’*************************************

Function FixName(UpFileExt)

If IsEmpty(UpFileExt) Then Exit Function

FixName = Ucase(UpFileExt)

FixName = Replace(FixName,Chr(0),"")

FixName = Replace(FixName,".","ASP","ASA","ASPX","CER","CDX","HTR","")

End Function

’*************************************

’过滤特殊字符

’*************************************

Function CheckStr(byVal ChkStr)

Dim Str:Str=ChkStr

If IsNull(Str) Then

CheckStr = ""

Exit Function

End If

Str = Replace(Str,"&","&")

Str = Replace(Str,"’","’")

Str = Replace(Str,"""",""")

Dim re

Set re=new RegExp

re.IgnoreCase =True

re.Global=True

re.Pattern="(w)(here)"

Str = re.replace(Str,"$1here")

re.Pattern="(s)(elect)"

Str = re.replace(Str,"$1elect")

re.Pattern="(i)(nsert)"

Str = re.replace(Str,"$1nsert")

re.Pattern="(c)(reate)"

Str = re.replace(Str,"$1reate")

re.Pattern="(d)(rop)"

Str = re.replace(Str,"$1rop")

re.Pattern="(a)(lter)"

Str = re.replace(Str,"$1lter")

re.Pattern="(d)(elete)"

Str = re.replace(Str,"$1elete")

re.Pattern="(u)(pdate)"

Str = re.replace(Str,"$1pdate")

re.Pattern="(/s)(or)"

Str = re.replace(Str,"$1or")

Set re=nothing

CheckStr=Str

End Function

’*************************************

’恢复特殊字符

’*************************************

Function UnCheckStr(ByVal Str)

If IsNull(Str) Then

UnCheckStr = ""

Exit Function

End If

Str = Replace(Str,"’")

Str = Replace(Str,""","""")

Dim re

Set re=new RegExp

re.IgnoreCase =True

re.Global=True

re.Pattern="(w)(here)"

str = re.replace(str,"$1here")

re.Pattern="(s)(elect)"

str = re.replace(str,"$1elect")

re.Pattern="(i)(nsert)"

str = re.replace(str,"$1nsert")

re.Pattern="(c)(reate)"

str = re.replace(str,"$1reate")

re.Pattern="(d)(rop)"

str = re.replace(str,"$1rop")

re.Pattern="(a)(lter)"

str = re.replace(str,"$1lter")

re.Pattern="(d)(elete)"

str = re.replace(str,"$1elete")

re.Pattern="(u)(pdate)"

str = re.replace(str,"$1pdate")

re.Pattern="(/s)(or)"

Str = re.replace(Str,"$1or")

Set re=nothing

Str = Replace(Str,"&")

UnCheckStr=Str

End Function

’*************************************

’转换HTML代码

’*************************************

Function HTMLEncode(ByVal reString)

Dim Str:Str=reString

If Not IsNull(Str) Then

Str = Replace(Str,">")

Str = Replace(Str,"<")

Str = Replace(Str,CHR(9)," ")

Str = Replace(Str,CHR(32)," ")

Str = Replace(Str,CHR(39),CHR(34),""")

Str = Replace(Str,CHR(13),"")

Str = Replace(Str,CHR(10),"<br/>")

HTMLEncode = Str

End If

End Function

’*************************************

’反转换HTML代码

’*************************************

Function HTMLDecode(ByVal reString)

Dim Str:Str=reString

If Not IsNull(Str) Then

Str = Replace(Str," ",CHR(9))

Str = Replace(Str," ",CHR(32))

Str = Replace(Str,CHR(39))

Str = Replace(Str,CHR(34))

Str = Replace(Str,"",CHR(13))

Str = Replace(Str,"<br/>",CHR(10))

HTMLDecode = Str

End If

End Function

’*************************************

’恢复&字符

’*************************************

function ClearHTML(ByVal reString)

Dim Str:Str=reString

If Not IsNull(Str) Then

Str = Replace(Str,"&")

ClearHTML = Str

End If

End Function

’*************************************

’过滤textarea

’*************************************

Function UBBFilter(ByVal reString)

Dim Str:Str=reString

If Not IsNull(Str) Then

Str = Replace(Str,"</textarea>","</textarea>")

UBBFilter = Str

End If

End Function

’*************************************

’过滤HTML代码

’*************************************

Function EditDeHTML(byVal Content)

EditDeHTML=Content

IF Not IsNull(EditDeHTML) Then

EditDeHTML=UnCheckStr(EditDeHTML)

EditDeHTML=Replace(EditDeHTML,"&")

EditDeHTML=Replace(EditDeHTML,"<")

EditDeHTML=Replace(EditDeHTML,">")

EditDeHTML=Replace(EditDeHTML,chr(34),""")

EditDeHTML=Replace(EditDeHTML,chr(39),"’")

End IF

End Function 分页函数

’*************************************

dim FirstShortCut,ShortCut

FirstShortCut=false

Function MultiPage(Numbers,Perpage,Curpage,Url_Add,aname,Style)

CurPage=Int(Curpage)

Numbers=Int(Numbers)

Dim URL

URL=Request.ServerVariables("Script_Name")&Url_Add

MultiPage=""

Dim Page,Offset,PageI

’ If Int(Numbers)>Int(PerPage) Then

Page=9

Offset=4

Dim Pages,FromPage,ToPage

If Numbers Mod Cint(Perpage)=0 Then

Pages=Int(Numbers/Perpage)

Else

Pages=Int(Numbers/Perpage)+1

End If

FromPage=Curpage-Offset

ToPage=Curpage+Page-Offset-1

If Page>Pages Then

FromPage=1

ToPage=Pages

Else

If FromPage<1 Then

Topage=Curpage+1-FromPage

FromPage=1

If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then ToPage=Page

ElseIF Topage>Pages Then

FromPage =Curpage-Pages +ToPage

ToPage=Pages

If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then FromPage=Pages-Page+1

End If

MultiPage="<div class=""page"" &Style"""><ul>"

’if Curpage<>1 then MultiPage=MultiPage&"<li class=""PageL""><a href="""&Url&"page=1"" class=""PageLbutton"" title=""第一页""></a></li>"

MultiPage=MultiPage"<li class=""pageNumber"">"

if Curpage<>1 then MultiPage=MultiPage"<a href="""&Url"page=1"" title=""第一页"" text-decoration:none""><</a> | "

if not FirstShortCut then ShortCut=" accesskey="",""" else ShortCut=""

if Curpage<>1 then MultiPage=MultiPage"<a href="""&Url"page="&CurPage-1""" title=""上一页"" text-decoration:none;"""&ShortCut"></a>"

For PageI=FromPage TO ToPage

If PageI<>CurPage Then

MultiPage=MultiPage"<a href="""&Url"page="&PageI&aname""">"&PageI"</a> | "

Else

MultiPage=MultiPage"<strong>"&PageI"</strong>"

if PageI<>Pages then MultiPage=MultiPage" | "

End If

if not FirstShortCut then ShortCut=" accesskey="".""" else ShortCut=""

if Curpage<>pages then MultiPage=MultiPage"<a href="""&Url"page="&CurPage+1""" title=""下一页"" text-decoration:none"""&ShortCut"></a>"

if Curpage<>pages then MultiPage=MultiPage"<a href="""&Url"page="&Pages&aname""" title=""最后一页"" text-decoration:none"">></a>"

MultiPage=MultiPage"</li>"

’If Int(Pages)>Int(Page) Then

’ MultiPage=MultiPage&"<li>...</li><li><a href="""&Url&"page="&Pages&aname&""">"&pages&"</a></li>"

’End If

’if Curpage<>pages then MultiPage=MultiPage&"<li class=""PageR""><a href="""&Url&"page="&Pages&aname&""" class=""PageRbutton"" title=""最后一页""></a></li>"

MultiPage=MultiPage"</ul></div>"

’ End If

FirstShortCut=true

End Function

’*************************************

’切割内容 - 按行分割

’*************************************

Function SplitLines(byVal Content,byVal ContentNums)

Dim ts,l

ContentNums=int(ContentNums)

If IsNull(Content) Then Exit Function

i=1

ts = 0

For i=1 to Len(Content)

l=Lcase(Mid(Content,5))

If l="<br/>" Then

ts=ts+1

End If

l=Lcase(Mid(Content,4))

If l="<br>" Then

ts=ts+1

End If

l=Lcase(Mid(Content,3))

If l="<p>" Then

ts=ts+1

End If

If ts>ContentNums Then Exit For

If ts>ContentNums Then

Content=Left(Content,i-1)

End If

SplitLines=Content

End Function

’*************************************

’切割内容 - 按字符分割

’*************************************

Function CutStr(byVal Str,byVal StrLen)

Dim l,t,c,i

If IsNull(Str) Then CutStr="":Exit Function

l=Len(str)

StrLen=int(StrLen)

t=0

For i=1 To l

c=Asc(Mid(str,1))

If c<0 Or c>255 Then t=t+2 Else t=t+1

IF t>=StrLen Then

CutStr=left(Str,i)"..."

Exit For

Else

CutStr=Str

End If

End Function

’*************************************

’删除引用标签

’*************************************

Function DelQuote(strContent)

If IsNull(strContent) Then Exit Function

Dim re

Set re=new RegExp

re.IgnoreCase =True

re.Global=True

re.Pattern="/[quote/](.[^/]]*?)/[//quote/]"

strContent= re.Replace(strContent,"")

re.Pattern="/[quote=(.[^/]]*)/](.[^/]]*?)/[//quote/]"

strContent= re.Replace(strContent,"")

Set re=nothing

DelQuote=strContent

End Function

’*************************************

’获取客户端IP

’*************************************

function getIP()

dim strIP,IP_Ary,strIP_list

strIP_list=Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"")

If InStr(strIP_list,",")<>0 Then

IP_Ary = Split(strIP_list,")

strIP = IP_Ary(0)

Else

strIP = strIP_list

End IF

If strIP=Empty Then strIP=Replace(Request.ServerVariables("REMOTE_ADDR"),"")

getIP=strIP

End Function

’*************************************

’获取客户端浏览器信息

’*************************************

function getbrowser(strUA)

dim arrInfo,strType,temp1,temp2

strType=""

strUA=LCase(strUA)

arrInfo=Array("Unkown","Unkown")

’浏览器判断

if Instr(strUA,"mozilla")>0 then arrInfo(0)="Mozilla"

if Instr(strUA,"icab")>0 then arrInfo(0)="iCab"

if Instr(strUA,"lynx")>0 then arrInfo(0)="Lynx"

if Instr(strUA,"links")>0 then arrInfo(0)="Links"

if Instr(strUA,"elinks")>0 then arrInfo(0)="ELinks"

if Instr(strUA,"jbrowser")>0 then arrInfo(0)="Jbrowser"

if Instr(strUA,"konqueror")>0 then arrInfo(0)="konqueror"

if Instr(strUA,"wget")>0 then arrInfo(0)="wget"

if Instr(strUA,"ask jeeves")>0 or Instr(strUA,"teoma")>0 then arrInfo(0)="Ask Jeeves/Teoma"

if Instr(strUA,"opera")>0 then arrInfo(0)="opera"

if Instr(strUA,"gecko")>0 then

strType="[Gecko]"

arrInfo(0)="Mozilla"

if Instr(strUA,"aol")>0 then arrInfo(0)="AOL"

if Instr(strUA,"netscape")>0 then arrInfo(0)="netscape"

if Instr(strUA,"firefox")>0 then arrInfo(0)="FireFox"

if Instr(strUA,"chimera")>0 then arrInfo(0)="Chimera"

if Instr(strUA,"camino")>0 then arrInfo(0)="Camino"

if Instr(strUA,"galeon")>0 then arrInfo(0)="galeon"

if Instr(strUA,"k-meleon")>0 then arrInfo(0)="K-Meleon"

arrInfo(0)=arrInfo(0)+strType

end if

if Instr(strUA,"bot")>0 or Instr(strUA,"crawl")>0 then

strType="[Bot/Crawler]"

arrInfo(0)=""

if Instr(strUA,"grub")>0 then arrInfo(0)="Grub"

if Instr(strUA,"googlebot")>0 then arrInfo(0)="GoogleBot"

if Instr(strUA,"msnbot")>0 then arrInfo(0)="MSN Bot"

if Instr(strUA,"slurp")>0 then arrInfo(0)="Yahoo! Slurp"

arrInfo(0)=arrInfo(0)+strType

end if

if Instr(strUA,"applewebkit")>0 then

strType="[AppleWebKit]"

arrInfo(0)=""

if Instr(strUA,"omniweb")>0 then arrInfo(0)="OmniWeb"

if Instr(strUA,"safari")>0 then arrInfo(0)="Safari"

arrInfo(0)=arrInfo(0)+strType

end if

if Instr(strUA,"msie")>0 then

strType="[MSIE"

temp1=mid(strUA,(Instr(strUA,"msie")+4),6)

temp2=Instr(temp1,";")

temp1=left(temp1,temp2-1)

strType=strType & temp1 "]"

arrInfo(0)="Internet Explorer"

if Instr(strUA,"msn")>0 then arrInfo(0)="MSN"

if Instr(strUA,"webtv")>0 then arrInfo(0)="WebTV"

if Instr(strUA,"myie2")>0 then arrInfo(0)="MyIE2"

if Instr(strUA,"maxthon")>0 then arrInfo(0)="Maxthon"

if Instr(strUA,"gosurf")>0 then arrInfo(0)="GoSurf"

if Instr(strUA,"netcaptor")>0 then arrInfo(0)="NetCaptor"

if Instr(strUA,"sleipnir")>0 then arrInfo(0)="Sleipnir"

if Instr(strUA,"avant browser")>0 then arrInfo(0)="Avantbrowser"

if Instr(strUA,"greenbrowser")>0 then arrInfo(0)="Greenbrowser"

if Instr(strUA,"slimbrowser")>0 then arrInfo(0)="Slimbrowser"

arrInfo(0)=arrInfo(0)+strType

end if

’操作系统判断

if Instr(strUA,"windows")>0 then arrInfo(1)="Windows"

if Instr(strUA,"windows ce")>0 then arrInfo(1)="Windows CE"

if Instr(strUA,"windows 95")>0 then arrInfo(1)="Windows 95"

if Instr(strUA,"win98")>0 then arrInfo(1)="Windows 98"

if Instr(strUA,"windows 98")>0 then arrInfo(1)="Windows 98"

if Instr(strUA,"windows 2000")>0 then arrInfo(1)="Windows 2000"

if Instr(strUA,"windows xp")>0 then arrInfo(1)="Windows XP"

if Instr(strUA,"windows nt")>0 then

arrInfo(1)="Windows NT"

if Instr(strUA,"windows nt 5.0")>0 then arrInfo(1)="Windows 2000"

if Instr(strUA,"windows nt 5.1")>0 then arrInfo(1)="Windows XP"

if Instr(strUA,"windows nt 5.2")>0 then arrInfo(1)="Windows 2003"

end if

if Instr(strUA,"x11")>0 or Instr(strUA,"unix")>0 then arrInfo(1)="Unix"

if Instr(strUA,"sunos")>0 or Instr(strUA,"sun os")>0 then arrInfo(1)="SUN OS"

if Instr(strUA,"powerpc")>0 or Instr(strUA,"ppc")>0 then arrInfo(1)="PowerPC"

if Instr(strUA,"macintosh")>0 then arrInfo(1)="Mac"

if Instr(strUA,"mac osx")>0 then arrInfo(1)="MacOSX"

if Instr(strUA,"freebsd")>0 then arrInfo(1)="FreeBSD"

if Instr(strUA,"linux")>0 then arrInfo(1)="Linux"

if Instr(strUA,"palmsource")>0 or Instr(strUA,"palmos")>0 then arrInfo(1)="PalmOS"

if Instr(strUA,"wap ")>0 then arrInfo(1)="WAP"

’arrInfo(0)=strUA

getbrowser=arrInfo

end function

’*************************************

’计算随机数

’*************************************

function randomStr(intLength)

dim strSeed,seedLength,pos,str,i

strSeed = "abcdefghijklmnopqrstuvwxyz1234567890"

seedLength=len(strSeed)

str=""

Randomize

for i=1 to intLength

str=str+mid(strSeed,int(seedLength*rnd)+1,1)

randomStr=str

end function

’*************************************

’自动闭合UBB

’*************************************

function closeUBB(strContent)

dim arrTags,OpenPos,ClosePos,re,j,Match

Set re=new RegExp

re.IgnoreCase =True

re.Global=True

arrTags=array("code","quote","list","color","align","font","size","b","i","u","html")

for i=0 to ubound(arrTags)

OpenPos=0

ClosePos=0

re.Pattern="/["+arrTags(i)+"(=[^/[/]]+|)/]"

Set strMatchs=re.Execute(strContent)

For Each Match in strMatchs

OpenPos=OpenPos+1

re.Pattern="/[/"+arrTags(i)+"/]"

Set strMatchs=re.Execute(strContent)

For Each Match in strMatchs

ClosePos=ClosePos+1

for j=1 to OpenPos-ClosePos

strContent=strContent+"[/"+arrTags(i)+"]"

closeUBB=strContent

end function

’*************************************

’自动闭合HTML

’*************************************

function closeHTML(strContent)

dim arrTags,Match

Set re=new RegExp

re.IgnoreCase =True

re.Global=True

arrTags=array("p","div","span","table","ul","h1","h2","h3","h4","h5","h6")

for i=0 to ubound(arrTags)

OpenPos=0

ClosePos=0

re.Pattern="/<"+arrTags(i)+"( [^/</>]+|)/>"

Set strMatchs=re.Execute(strContent)

For Each Match in strMatchs

OpenPos=OpenPos+1

re.Pattern="/</"+arrTags(i)+"/>"

Set strMatchs=re.Execute(strContent)

For Each Match in strMatchs

ClosePos=ClosePos+1

for j=1 to OpenPos-ClosePos

strContent=strContent+"</"+arrTags(i)+">"

closeHTML=strContent

end function

’*************************************

’读取文件

’*************************************

Function LoadFromFile(ByVal File)

Dim objStream

Dim RText

RText=array(0,"")

On Error Resume Next

Set objStream = Server.CreateObject("ADODB.Stream")

If Err Then

RText=array(Err.Number,Err.Description)

LoadFromFile=RText

Err.Clear

exit function

End If

With objStream

.Type = 2

.Mode = 3

.Open

.Charset = "utf-8"

.Position = objStream.Size

.LoadFromFile Server.MapPath(File)

If Err.Number<>0 Then

RText=array(Err.Number,Err.Description)

LoadFromFile=RText

Err.Clear

exit function

End If

RText=array(0,.ReadText)

.Close

End With

LoadFromFile=RText

Set objStream = nothing

End Function

’*************************************

’保存文件

’*************************************

Function SavetoFile(ByVal strBody,ByVal File)

Dim objStream

Dim RText

RText=array(0,Err.Description)

Err.Clear

exit function

End If

With objStream

.Type = 2

.Open

.Charset = "utf-8"

.Position = objStream.Size

.WriteText = strBody

.SavetoFile Server.MapPath(File),2

.Close

End With

RText=array(0,"保存文件成功!")

SavetoFile=RText

Set objStream = nothing

End Function

’*************************************

’数据库添加修改操作

’*************************************

function DBQuest(table,DBArray,Action)

dim AddCount,TempDB,v

if Action<>"insert" or Action<>"update" then Action="insert"

if Action="insert" then v=2 else v=3

if not IsArray(DBArray) then

DBQuest=-1

exit function

else

Set TempDB=Server.CreateObject("ADODB.RecordSet")

On Error Resume Next

TempDB.Open table,Conn,1,v

if err then

DBQuest=-2

exit function

end if

if Action="insert" then TempDB.addNew

AddCount=UBound(DBArray,1)

for i=0 to AddCount

TempDB(DBArray(i)(0))=DBArray(i)(1)

TempDB.update

TempDB.close

set TempDB=nothing

DBQuest=0

end if

end Function

%>检测系统组件是否安装

’*************************************

Function CheckObjInstalled(strClassstring)

On Error Resume Next

Dim Temp

Err = 0

Dim TmpObj

Set TmpObj = Server.CreateObject(strClassstring)

Temp = Err

IF Temp = 0 OR Temp = -2147221477 Then

CheckObjInstalled=true

ElseIF Temp = 1 OR Temp = -2147221005 Then

CheckObjInstalled=false

End IF

Err.Clear

Set TmpObj = nothing

Err = 0

End Function

’*************************************

’判断服务器Microsoft.XMLDOM

’*************************************

Function getXMLDOM

On Error Resume Next

Dim Temp

getXMLDOM="Microsoft.XMLDOM"

Err = 0

Dim TmpObj

Set TmpObj = Server.CreateObject(getXMLDOM)

Temp = Err

IF Temp = 1 OR Temp = -2147221005 Then

getXMLDOM="Msxml2.DOMDocument.5.0"

End IF

Err.Clear

Set TmpObj = nothing

Err = 0

end function

’*************************************

’判断服务器MSXML2.ServerXMLHTTP

’*************************************

Function getXMLHTTP

On Error Resume Next

Dim Temp

getXMLHTTP="MSXML2.ServerXMLHTTP"

Err = 0

Dim TmpObj

Set TmpObj = Server.CreateObject(getXMLHTTP)

Temp = Err

IF Temp = 1 OR Temp = -2147221005 Then

getXMLHTTP="Msxml2.ServerXMLHTTP.5.0"

End IF

Err.Clear

Set TmpObj = nothing

Err = 0

end function

’*********************************************************

’ 目的：检查正则式

’ 输入： id

’ 返回：成功为True

’*********************************************************

Function CheckRegExp(source,para)

If para="[username]" Then

para="^[.A-Za-z0-9/u4e00-/u9fa5]+$"

End If

If para="[password]" Then

para="^[a-z0-9]+$"

End If

If para="[email]" Then

para="^([0-9a-zA-Z]([-./w]*[0-9a-zA-Z])*@([0-9a-zA-Z][-/w]*/.)+[a-zA-Z]*)$"

End If

If para="[homepage]" Then

para="^[a-zA-Z]+://[a-zA-z0-9/-/./]+?/*$"

End If

If para="[nojapan]" Then

para="[/u3040-/u30ff]+"

End If

If para="[guid]" Then

para="^/w{8}/-/w{4}/-/w{4}/-/w{4}/-/w{12}$"

End If

Dim re

Set re = New RegExp

re.Global = True

re.Pattern = para

re.IgnoreCase = False

CheckRegExp = re.Test(source)

End Function

’**********************************************

’获取在线人数

’**********************************************

function getonline

getonline=1

if len(Application(space_CookieName"_onlineCount"))>0 then

if DateDiff("s",Application(space_CookieName"_userOnlineCountTime"),Now())>60 then

Application.Lock()

Application(space_CookieName"_online")=Application(space_CookieName"_onlineCount")

Application(space_CookieName"_onlineCount")=1

Application(space_CookieName"_onlineCountKey")=randStr(2)

Application(space_CookieName"_userOnlineCountTime")=Now()

Application.Unlock()

else

if Session(space_CookieName"userOnlineKey")<>Application(space_CookieName"_onlineCountKey") then

Application.Lock()

Application(space_CookieName"_onlineCount")=Application(space_CookieName"_onlineCount")+1

Application.Unlock()

Session(space_CookieName"userOnlineKey")=Application(space_CookieName"_onlineCountKey")

end if

else

Application.Lock

Application(space_CookieName"_online")=1

Application(space_CookieName"_onlineCount")=1

Application(space_CookieName"_onlineCountKey")=randStr(2)

Application(space_CookieName"_userOnlineCountTime")=Now()

Application.Unlock

end if

getonline=Application(space_CookieName"_online")

end Function

ASP编程常用的函数function集合

相关推荐