ASP经常用到的函数
时间:2009-07-06 13:00:00
'****
'函数名称: strReplace(Str)
'函数功能: 过滤单引号
'参数说明: Str
'****
Function strReplace(Str)
dim tempcheckstr
tempcheckstr=Str
If Isnull(tempcheckstr) Then
strReplace = ""
Exit Function
End If
strReplace = Replace(tempcheckstr,"'","''")
End Function
'****
'函数名称: Alert(showType,str,url)
'函数功能: 弹出对话框
'参数说明: showType 显示类别 1 返回上一页面 2 转到另一页面 3 关闭窗口
' str 错误信息
' url 转向地址
'****
sub Alert(showType,str,url)
response.Write("<script language=""javascript"">"& vbcrlf)
response.Write("<!--"& vbcrlf)
response.Write("window.alert("""& str &""");"& vbcrlf)
if showType=1 then
response.Write("window.history.go(-1); "& vbcrlf)
elseif showType=2 then
response.Write("window.location.href ="""& url &"""; "& vbcrlf)
elseif showType=3 then
response.Write("window.opener=null; "& vbcrlf)
response.Write("window.close(); "& vbcrlf)
elseif showType=4 then
response.Write("top.location.href ="""& url &"""; "& vbcrlf)
end if
response.Write("//-->"& vbcrlf)
response.Write("</script>")
end sub
'****
'函数名称: ZeroFill(Num,Num_Length)
'函数功能: 前面补0
'参数说明: Num 要操作的数字
' Num_Length 显示的位数
'返回值 : 格式化的字符串
'****
Function ZeroFill(Num,Num_Length)
Dim ZeroFill_i,ZeroFill_ReturnNum
For ZeroFill_i=len(Num) To Num_Length-1
ZeroFill_ReturnNum=ZeroFill_ReturnNum&"0"
Next
ZeroFill_ReturnNum=ZeroFill_ReturnNum&Num
ZeroFill=ZeroFill_ReturnNum
End Function
'****
'函数名:IsValidEmail
'作 用:检查Email地址合法性
'参 数:email ----要检查的Email地址
'返回值:True ----Email地址合法
' False ----Email地址不合法
'****
function IsValidEmail(email)
dim names, name, i, 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, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
IsValidEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
IsValidEmail = false
exit function
end if
next
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
'*****
'函数名:strLength
'作 用:求字符串长度。汉字算两个字符,英文算一个字符。
'参 数:str ----要求长度的字符串
'返回值:字符串长度
'*****
Function strLength(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
t = 0
For i = 1 To l
c = Asc(Mid(Str, i, 1))
'If c < 0 Then c = c + 65536
If c > 255 Then
t = t + 2
else
t = t + 1
End If
Next
strLength = t
Else
strLength = Len(Str)
End If
If Err.Number <> 0 Then Err.Clear
End Function
function show(str,i)
if strLength(str) > i then
show = left(str,i)&"..."
else
show = str
end if
end function
' ============================================
'函数名:RemoveHTML
'作 用:去除HTML标签
'参 数:strHTML ----文章内容
'返回值:替换后的内容
' ============================================
Function RemoveHTML(strHTML)
Dim objRegExp, Match, Matches
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
'取闭合的<>
objRegExp.Pattern = "<.+?>"
'进行匹配
Set Matches = objRegExp.Execute(strHTML)
' 遍历匹配集合,并替换掉匹配的项目
For Each Match in Matches
strHtml=Replace(strHTML,Match.Value,"")
Next
RemoveHTML=strHTML
Set objRegExp = Nothing
End Function
'-----------------------本函数为远程获取内容的函数,URL即为网页地址,asp页面也行-----
Function GetBody(url)
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False, "", ""
.Send
GetBody = .ResponseBody
End With
End Function
'--------------------------内码处理的函数,否则发送的邮件可能是乱码
Function BytesToBstr(strBody,CodeBase)
dim objStream
set objStream = Server.CreateObject("Adodb.Stream")
objStream.Type = 1
objStream.Mode =3
objStream.Open
objStream.Write strBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = CodeBase
BytesToBstr = objStream.ReadText
objStream.Close
set objStream = nothing
End Function
'**
'函数名:getPicUrl
'作 用:获得信息里的图片地址
'参 数:str ----信息
'**
function getPicUrl(str)
dim content,regstr,url
content=str&""
regstr="src=.+?.(gif|jpg)"
url=Replace(Replace(Replace(RegExp_Execute(regstr,content),"'",""),"""",""),"src=","")
getPicUrl=url
end function
Function RegExp_Execute(patrn, strng)
Dim regEx, Match, Matches,values '建立变量。
Set regEx = New RegExp '建立正则表达式。
regEx.Pattern = patrn '设置模式。
regEx.IgnoreCase = true '设置是否区分字符大小写。
regEx.Global = True '设置全局可用性。
Set Matches = regEx.Execute(strng) '执行搜索。
For Each Match in Matches '遍历匹配集合。
values=values&Match.Value&","
Next
RegExp_Execute = values
End Function
''发送电子邮件函数
'siteEmail 发送方邮箱
'smtp 邮箱主机地址
'emailUserName 邮箱用户名
'emailUserPWD 邮箱密码
'inceptEmail 接受邮件的邮箱地址
'sendName 发送人的名称
'sendTitle 邮件标题
'sendContent 邮件正文
sub EmailSend(siteEmail,smtp,emailUserName,emailUserPWD,inceptEmail,sendName,sendTitle,sendContent)
dim jmail
set jmail = CreateObject ("jmail.message") ''创建对象
jmail.Silent = true ''一般不用改
jmail.Charset = "gb2312" ''信件的语言编码
jmail.ContentType = "text/html" ''信件的格式html或纯文本
jmail.From = siteEmail ''发信人邮箱
jmail.FromName = sendName ''发信人姓名
jmail.Subject = sendTitle ''信件主题
jmail.AddRecipient inceptEmail ''收信人地址
jmail.Body = sendContent ''信件正文
jmail.MailServerUserName = emailUserName ''服务器登陆用户名(您的邮件地址)
jmail.MailServerPassWord = emailUserPWD ''服务器登陆密码(您的邮件密码)
jmail.Send(smtp) ''服务器地址
jmail.Close
set jmail = nothing
end sub
'=========================================================
'利用AspJpeg将图片上传后按比例缩放。同时改变文件大小
'http://www.jinhuo.cn/club/archiver/t_7167.html
'http://space.flash8.net/space/html/33/337333_itemid_280395.html
'=========================================================
Function PicEdit(PicName,PicModeWidth,PicModeHeight)
dim PP,W,H,scale,firstW,firstH,ModeScale,EndH,EndW
Set PP=New ImgWHInfo
W = PP.imgW(Server.Mappath(PicName)) ''原图片宽度
H = PP.imgH(Server.Mappath(PicName)) ''原图片高度
Dim n_OriginalWidth, n_OriginalHeight '原图片宽度、高度
Dim n_BuildWidth, n_BuildHeight '缩略图宽度、高度
Dim div1, div2
Dim n1, n2
n_OriginalWidth = PP.imgW(Server.Mappath(PicName))
n_OriginalHeight = PP.imgH(Server.Mappath(PicName))
div1 = n_OriginalWidth / n_OriginalHeight
div2 = n_OriginalHeight / n_OriginalWidth
n1 = 0
n2 = 0
If n_OriginalWidth > PicModeWidth Then
n1 = n_OriginalWidth / PicModeWidth
Else
n_BuildWidth = n_OriginalWidth
End If
If n_OriginalHeight > PicModeHeight Then
n2 = n_OriginalHeight / PicModeHeight
Else
n_BuildHeight = n_OriginalHeight
End If
If n1 <> 0 or n2 <> 0 Then
If n1 > n2 Then
n_BuildWidth = PicModeWidth
n_BuildHeight = PicModeWidth * div2
Else
n_BuildWidth = PicModeHeight * div1
n_BuildHeight = PicModeHeight
End If
End If
Set PP = nothing
dim Jpeg,Path
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Path = Server.MapPath(PicName)
Jpeg.open Path
'Jpeg.Width = EndW
'Jpeg.Height = EndH
Jpeg.Width = n_BuildWidth
Jpeg.Height = n_BuildHeight
Jpeg.Save Server.MapPath(PicName)
Jpeg.Close:Set Jpeg = Nothing
End Function
'判断ip是否合法
function chk_ip(strIP)
dim boolIsIP
dim arrIP boolIsIP = True '函数初始值为true
arrIP = split(strIP, ".") '将输入的IP用"."分割为数组,数组下标从0开始,所以有效IP分割后的数组上界必须为3
if ubound(arrIP)<>3 then
boolIsIP = False
else
for intLoop = 0 to ubound(arrIP)
if not isnumeric(arrIP(intLoop)) then '检查数组元素中各项是否为数字,如果不是则不是有效IP
boolIsIP = False
else
if arrIP(intLoop)>255 or arrIP(intLoop)<0 then '检查IP数字是否满足IP的取值范围
boolIsIP = False
end if
end if
next
end if
chk_ip = boolIsIp
end function