ASP 3.0 常用自定义函数选编

最新推荐文章于 2021-01-17 17:45:09 发布

原创最新推荐文章于 2021-01-17 17:45:09 发布 · 1.2k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#asp #function #server #stream #url #class

'**************************************************

'ASP 3.0 常用函数库

'WDFrog选编

'2006-04-6

'<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

'**************************************************

Class cls_FunLib

Public ErrMsg,ErrId

Public ReURL '来路地址

Private Sub Class_Initialize()

ReURL=Request.ServerVariables("HTTP_REFERER")

Call ClearErr()

End Sub

Private Sub Class_Terminate()

'//析构函数

End Sub

Public Function ClearErr()

ErrMsg=""

ErrId=0

End Function

'**************************************

'返回页面提交数据,并过滤[']["]

'keyName 值对名

'defValue 默认值

'**************************************

Public Function GetQ(keyName,defValue)

Dim temp

temp=Safe(Request(keyName))

if temp=vbNullString Then

temp=defValue

End If

GetQ=temp

End Function

'*******************************************

'获取页面提交的整型数据

'******************************************

Public Function GetInt(keyName,defValue)

Dim temp

if NOT IsNumeric(defValue) Then

Call Err.Raise(7474,"util","默认值应为数字!")

Exit Function

End If

temp=Safe(Request(keyName))

if temp=vbNullString Then

temp=defValue

End If

If IsNumeric(temp) Then

GetInt=CInt(temp)

End If

End Function

'****************************************

'过滤[']["]

'****************************************

Public Function Safe(str)

str=Replace(str,"'","")

str=Replace(str,"""","")

Safe=str

End Function

'***************************************

'比较两个字符串是否相等

'***************************************

Public Function Cmp(strA,strB)

if Trim(UCase(Cstr(strA)))=Trim(UCase(Cstr(strB))) Then

Cmp=True

Else

Cmp=False

End If

End Function

'****************************************

'获取访问者IP

'****************************************

Public Function GetIP()

Dim strIPAddr

If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then

strIPAddr = Request.ServerVariables("REMOTE_ADDR")

ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then

strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)

ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then

strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)

Else

strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")

End If

GetIP = Safe(Trim(Mid(strIPAddr, 1, 30)))

End Function

'***************************************

'关闭本窗口

'***************************************

Public Function WinClose()

Response.Write "<Script language=""JScript"">" & vbcrlf

Response.Write(" window.close();") & vbcrlf

Response.Write "</Script>" & vbcrlf

End Function

'**************************************

'刷新窗口

'winType : 0,父窗口 1,本窗口

'**************************************

Public Function ReLoad(winType)

Response.Write "<Script language=""JScript"">" & vbcrlf

if winType=0 Then

Response.Write("window.opener.location.reload();") & vbcrlf

Else

Response.Write("window.location.reload();") & vbcrlf

End If

Response.Write "</Script>" & vbcrlf

End Function

'****************************************

'显示一条提示信息

'****************************************

Public Function MsgBox(msg)

msg=Replace(msg,"""","""")

Response.Write "<Script language=""JScript"">"

Response.Write "alert(""" & msg & """);"

Response.Write "</Script>"

End Function

'**************************************************

'客户端重定向

'***************************************************

Public Function Go(URL)

Response.Write "<Script language=""JScript"">"

Response.Write "window.location.href='" & URL & "';"

Response.Write "</Script>"

End Function

'********************************************

'显示文本域提交上来的数据

'保证回车正常显示

'********************************************

Public Function Deal(str)

Dim iStr

iStr=Replace(str,"<","<")

iStr=Replace(iStr,">",">")

iStr=Replace(iStr,"'","""")

iStr=Replace(iStr,Chr(13),"<BR>")

iStr=Replace(iStr," "," ")

iStr=Replace(iStr,vbTab,"  &nbsp")

Deal=iStr

End Function

'**************************************

'过滤HTML标签

'**************************************

Public Function NoHtml(str)

dim re

Set re=new RegExp

re.IgnoreCase =true

re.Global=True

re.Pattern="(<.[^<]*>)"

str=re.replace(str," ")

re.Pattern="(</[^<]*>)"

str=re.replace(str," ")

NoHtml=str

set re=nothing

end function

'**************************************

'检测是否为站外提交

'*************************************

Public 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 = True

End If

End Function

'**************************************************

'函数名：gotTopic

'作用：截字符串，汉字一个算两个字符，英文算一个字符

'参数：str ----原字符串

' strlen ----截取长度

'返回值：截取后的字符串

'**************************************************

Function gotTopic(str,strlen)

if str="" then

gotTopic=""

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

gotTopic=left(str,i) & "…"

exit for

else

gotTopic=str

end if

gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<")

End Function

'**************************************************

'函数名：strLength

'作用：求字符串长度。汉字算两个字符，英文算一个字符。

'参数：str ----要求长度的字符串

'返回值：字符串长度

'**************************************************

Public Function strLen(str)

ON ERROR RESUME NEXT

dim WINNT_CHINESE

WINNT_CHINESE = (len("中国")=2)

if WINNT_CHINESE then

dim l,t,c

dim i

l=len(str)

t=l

for i=1 to l

c=asc(mid(str,i,1))

if c<0 then c=c+65536

if c>255 then

t=t+1

end if

strLen=t

else

strLen=len(str)

end if

if err.number<>0 then err.clear

end function

'**************************************************

'函数名：IsObjInstalled

'作用：检查组件是否已经安装

'参数：strClassString ----组件名

'返回值：True ----已经安装

' False ----没有安装

'**************************************************

Public 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

'******************************************************

'作用: 删除一个文件

'参数: FileName ----完整的文件名

'返回值: True成功,False失败

'******************************************************

Public Function DelFile(FileName)

Dim fso,whichfile,thisfile

If not IsObjInstalled("Scripting.FileSystemObject") Then

DelFile=False

Else

Set fso=CreateObject("Scripting.FileSystemObject")

If fso.FileExists(FileName) Then

whichfile=fileName

Set thisfile = fso.GetFile(whichfile)

thisfile.Delete True

DelFile=True

Else

DelFile=False

End If

End if

End Function

'-------------根据指定名称生成目录---------

Public Function CreateDir(foldername)

On Error Resume Next

err.Clear()

Dim fso,f

Set fso = Server.CreateObject("Scripting.FileSystemObject")

Set f = fso.CreateFolder(foldername)

Set fso = nothing

If Err Then

CreateDir = False

Else

CreateDir = True

End If

End Function

'------------------检查某一目录是否存在-------------------

Public Function CheckDir(FolderPath)

dim fso

Set fso = Server.CreateObject("Scripting.FileSystemObject")

If fso.FolderExists(FolderPath) then

CheckDir = True

Else

CheckDir = False

End if

Set fso = nothing

End Function

'*********************************************

'生成当前页地址,不包括所带参数

'*********************************************

Public Function GetCurURL()

Dim URL

URL="http://" & Request.ServerVariables("SERVER_NAME")

URL=URL & Request.ServerVariables("SCRIPT_NAME")

GetCurURL=URL &"?"

End Function

'****************************************

'完成编码转换

'将字节串转换为GB2312 的字符串

'**************************************

Public Function Bytes2bStr(Byval inv)

Dim stream

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

With stream

.Type=2

.Open()

.WriteText inv

.Position=0

.CharSet="GB2312"

.Position=2

Bytes2bStr=.ReadText

.Close()

End With

Set stream=Nothing

End Function

'************************************

'生成一段随机数

'*************************************

Public Function GetRandNum()

Dim ranNum

randomize()

ranNum=int(9999*rnd)+100

GetRandNum=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum

End Function

'*********************************

'返回短时间

'********************************

Public Function ShortDate(dValue)

ShortDate=DatePart("yyyy",dValue) & "-" & DatePart("m",dValue) & "-" & DatePart("d",dValue)

End Function

'*************************************

'检测给定值是否在字符中，字符串以flag([,][|]..)分割

'Values: 数据集合

'chkValue:检测值

'flag:分割符号

'************************************

Public Function InCollection(Byval Values, byVal chkValue,ByVal flag)

Dim arr,iValue

InCollection=False

arr=split(Values,flag)

For Each iValue In arr

If Trim(UCase(Cstr(iValue)))=Trim(UCase(Cstr(chkValue))) Then

InCollection=True

Exit For

End If

End Function

End Class

Dim util

Set util=New cls_FunLib