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
猜你喜欢
- 这几年来,我们这个行业一直都在谈用户体验,以用户为中心的设计。“用户体验”是指用户访问网站的界面、功能、相关信息的可读性、操作的方便性,交互
- 6、遮罩滤镜作用:该滤镜可以为对象建立一个覆盖于表面的膜,其效果就象戴着有色眼镜看物体一样。语法: {filter:mask(color=c
- <script language="JScript" Runat="Server&q
- ajax编程获取Google的PageRank3(PR值)及所在目录,想给你的站增加Google PR查询的功能吗?如果你不会就看看本文吧,
- 最近常有厦门的客户通过网站上的联系方式加我QQ,询问网站改版的情况。几乎每日都要针对客户网站存在的问题做一番分析,然后客户以价格等其他因素结
- MySQL采用了基于开销的优化器,以确定处理查询的最解方式。在很多情况下,MySQL能够计算最佳的可能查询计划,但在某些情况下,MySQL没
- 如何做一个随机密码产生器?<%genPassword = ""RandomizeFor&nbs
- 打开VB6,新建ActiveX DLL 2、在工程引用中加入Microsoft Active Server Pages Object Lib
- 人们对于产品设计这类事情,往往容易眼高手低,在宇宙层面上夸夸其谈,却落不了地,只能飘着。真正到了自己动手的时候,才会发现问题很多,实践和理论
- 俺觉得自 己试着写写sql,调试调试还是有帮助的,读人家sql例子好像读懂了,自己写就未 必思路正确,调试得通,写得简洁。 这篇文字在网上被
- JavaScript 读取、删除 Cookie 的函数* * WebFXCookie class */ fun
- asp使用WScript.Shell获取电脑的网络配置信息Option Explicit Dim WSHShe
- 在blueidea上看到movoin转的一个动态加载include文件代码,接着dnawo又修改了下,我用了dnawo修改后的版本,感觉挺好
- 段时间作项目中,遇到使用视图的问题,以前的工作中很少遇到视图,认为直接用表就ok了,何须视图呢?下面我来讲述一下它的功用:以往当我们查询数据
- 给网页添加打印按钮,除了打印之外,还有页面设置、打印预览、复制本文链接到剪贴板等网页基本应用。正象我在图中标注的,大部分按钮只能适用于IE浏
- 同质化的网站越来越多,往往你还没发展起来,就已有许多站点抄袭走了你的成果,如何留下用户?——让用户有更好的使用体验。一些网页上的小技巧,可以
- 时间格式化函数,代码简单但较实用代码很简单,谁都能看懂Function fmstr(str, str1, Lens) Dim str2For
- IE8主页http://www.microsoft.com/windows/products/winfamily/ie/ie8/defaul
- 在绝大多数查询中,MySQL使用哪种校对规则进行比较是很显然的。例如,在下列情况中,校对规则明显的是“列x的列校对规则”:SELECT&nb
- div+css实现圆角边框,在网络上查看了一下,很多都是实现圆角的矩形的方法,我在这里介绍的是实现圆角矩形边框的方法。用代码说明问题:<