Php文档 Php问答行业资讯 Php论坛 Php手册 Php博客

游戏榜单

软件榜单

关闭导航

热搜榜

热门下载

热门标签

关闭搜索

php爱好者> php文档>ASP之常用asp过程小函数

ASP之常用asp过程小函数

时间：2010-04-17 来源：mx11

ASP表格内如何强制它在第25个字就换行

str="12345678901234567890123456789012345678901234567890123456789"

lenth=len(str)

if lenth>25 then

for i = 1 to lenth step 25

StrPart=mid(str,i,25)

StrAll=StrAll+StrPart+"<br>"

else

fmtlen=str

end if

response.Write(StrAll)

网页对话框

<!--

function OpenNew(id) {

theUrl="list.asp?id="+id;

var winWidth=628;

var winHeight=610;

var top = (screen.availHeight/2)-(winHeight/2);

var left = (screen.availWidth/2)-(winWidth/2);

showModalDialog(theUrl,window,"toolbar:no;menubar:no;scroll:no;resizable:no;location:no;status:no;help:no;dialogWidth:"+winWidth+"px;dialogHeight:"+winHeight+"px;dialogTop:"+top+"px;dialogLeft:"+left+"px;");

}

//-->

</script>

一个分离中文英文的函数

Function SplitString(TheString)

Dim n,Chs,Eng

For n = 1 to Len(TheString)

If Asc(Mid(TheString,n,1))<0 then

Chs=Chs&Mid(TheString,n,1)

Else

Eng=Eng&Mid(TheString,n,1)

End if

SplitString="中文字符："&Chs&"<BR>英文字符："&Eng

End Function

ASP字数计算函数

’ASP字数计算函数

’by [email protected]

Function WordCount(strInput)

Dim strTemp

strTemp = Replace(strInput, vbTab, " ")

strTemp = Replace(strTemp, vbCr, " ")

strTemp = Replace(strTemp, vbLf, " ")

’ 删除字首字尾空格

strTemp = Trim(strTemp)

’ 替换为一个空格

Do While InStr(1, strTemp, " ", 1) <> 0

strTemp = Replace(strTemp, " ", " ")

Loop

WordCount = UBound(Split(strTemp, " ", -1, 1)) +1

End Function

分行模块

Function cuttextlen(intext, lens)

If Len(intext) <= lens Then

cuttextlen = intext

Else

tmptext = intext

GetTexts = ""

Do While Not Len(tmptext) <= lens

GetTexts = GetTexts + Left(tmptext, lens)

tmptext = Right(tmptext, Len(tmptext) - lens)

Do While (Asc(Left(tmptext, 1)) >= 65 And Asc(Left(tmptext, 1)) <= 90) Or (Asc(Left(tmptext, 1)) >= 97 And Asc(Left(tmptext, 1)) <= 122) Or (Asc(Left(tmptext, 1)) >= 45 And Asc(Left(tmptext, 1)) <= 57)

GetTexts = GetTexts + Left(tmptext, 1)

tmptext = Right(tmptext, Len(tmptext) - 1)

’If Len(tmptext) <= lens Then Exit Do

Loop

GetTexts = GetTexts & "<br>"

Loop

cuttextlen = GetTexts & tmptext

End If

End Function

日期减去天数等于第二个日期

function cc(dd,dadd)

{

//可以加上错误处理

var a = new Date(dd)

a = a.valueOf()

a = a - dadd * 24 * 60 * 60 * 1000

a = new Date(a)

alert(a.getFullYear() + "年" + (a.getMonth() + 1) + "月" + a.getDate() + "日")

}

cc("12/23/2002",2)

</script>

获得一个窗口的大小

document.body.clientWidth,document.body.clientHeight

网页不会被缓存

HTM网页

或者<META HTTP-EQUIV="expires" CONTENT="0">

ASP网页

Response.Expires = -1

Response.ExpiresAbsolute = Now() - 1

Response.cachecontrol = "no-cache"

PHP网页

header("Expires: Mon, 26 Jul 1997 05:00:00 GMT");

header("Cache-Control: no-cache, must-revalidate");

header("Pragma: no-cache");

19. 检查一段字符串是否全由数字组成

function checkNum(str){return str.match(/\\D/)==null}

alert(checkNum("1232142141"))

alert(checkNum("123214214a1"))

// --></script>

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

’检查邮件

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

Function CheckEmail(strEmail)

Dim re

Set re = New RegExp

re.Pattern = "^[\\w-\\.]{1,}\\@([\\da-zA-Z-]{1,}\\.){1,}[\\da-zA-Z-]{2,3}?"

re.IgnoreCase = True

CheckEmail = re.Test(strEmail)

End Function

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

’检查无效字符

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

Function CheckStr(byVal ChkStr)

Dim Str:Str=ChkStr

Str=Trim(Str)

If IsNull(Str) Then

CheckStr = ""

Exit Function

End If

Dim re

Set re=new RegExp

re.IgnoreCase =True

re.Global=True

re.Pattern="(\\r\\n){3,}"

Str=re.Replace(Str,"?1?1?1")

Set re=Nothing

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

CheckStr=Str

End Function

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

’弹出对话框并返回到URL

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

Sub Messageback(message,url)

Response.write "<script>alert(’"&message&"’);location.href=’"&url&"’;</script>"

End Sub

Dim StartTime

StartTime = Timer() ’存储程序开始执行时间

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

’功能: 输出程序总消耗时间

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

Sub PrintExpendTime()

Response.Write("<div align=center>执行时间: " & (Timer() - StartTime) * 1000 & "毫秒 By Conan++</div>")

End Sub

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

’转换HTML代码

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

Function HTMLEncode(reString)

Dim Str:Str=reString

If Not IsNull(Str) Then

Str = UnCheckStr(Str)

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

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

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

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

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

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

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

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

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

HTMLEncode = Str

End If

End Function

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

’注销session内容,并转向到url

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

Sub Logout(url)

Session.Contents.Removeall()

Response.Redirect url

End Sub

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

’脏字过滤功能

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

Function DelDirty(str)

str=replace(str,"妈的","MD")

str=replace(str,"靠","KAO")

DelDirty=str

End Function

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

’取得IP地址

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

Function Userip()

Dim GetClientIP

’如果客户端用了代理服务器，则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法

GetClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")

If GetClientIP = "" or isnull(GetClientIP) or isempty(GetClientIP) Then

’如果客户端没用代理，应该用Request.ServerVariables("REMOTE_ADDR")方法

GetClientIP = Request.ServerVariables("REMOTE_ADDR")

end if

Userip = GetClientIP

End function

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

’ 判断数字是否整形

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

function isInteger(para)

on error resume next

dim str

dim l,i

if isNUll(para) then

isInteger=false

exit function

end if

str=cstr(para)

if trim(str)="" then

isInteger=false

exit function

end if

l=len(str)

for i=1 to l

if mid(str,i,1)>"9" or mid(str,i,1)<"0" then

isInteger=false

exit function

end if

isInteger=true

if err.number<>0 then err.clear

end function

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

’ 指定秒数重定向另外的连接

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

sub GoPage(url,s)

s=s*1000

Response.Write "<SCRIPT LANGUAGE=javascript>"

Response.Write "window.setTimeout("&chr(34)&"window.navigate(’"&url&"’)"&chr(34)&","&s&")"

Response.Write "</script>"

end sub

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

’分页显示

’LastNextPage(ipagecount,ipagecurrent,"","",)

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

’Sub LastNextPage(pagecount,page,table_style,font_style)

Sub LastNextPage(pagecount,page)

Dim query, a, x, temp

action = "http://"; & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")

query = Split(Request.ServerVariables("QUERY_STRING"), "&")

For Each x In query

a = Split(x, "=")

If StrComp(a(0), "page", vbTextCompare) <> 0 Then

temp = temp & a(0) & "=" & a(1) & "&"

End If

Response.Write("<table " & Table_style & ">" & vbCrLf )

Response.Write("<form method=get onsubmit=""document.location = ’" & action & "?" & temp & "Page=’+ this.page.value;return false;""><TR>" & vbCrLf )

Response.Write("<TD align=right>" & vbCrLf )

Response.Write(font_style & vbCrLf )

if page<=1 then

Response.Write ("[第一页] " & vbCrLf)

Response.Write ("[上一页] " & vbCrLf)

else

Response.Write("[<A HREF=" & action & "?" & temp & "Page=1>第一页</A>] " & vbCrLf)

Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page-1) & ">上一页</A>] " & vbCrLf)

end if

if page>=pagecount then

Response.Write ("[下一页] " & vbCrLf)

Response.Write ("[最后一页]" & vbCrLf)

else

Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page+1) & ">下一页</A>] " & vbCrLf)

Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & pagecount & ">最后一页</A>]" & vbCrLf)

end if

Response.Write(" 第" & "<INPUT TYEP=TEXT NAME=page SIZE=2 Maxlength=5 value=" & page & ">" & "页" & vbCrLf & "<INPUT type=submit style=""font-size: 7pt"" value=GO>")

Response.Write(" 共 " & pageCount & " 页" & vbCrLf)

Response.Write("</TD>" & vbCrLf )

Response.Write("</TR></form>" & vbCrLf )

Response.Write("</table>" & vbCrLf )

End Sub

’FSO读取文件

Function ReadFile(LocalFilePath)

Dim ObjFile,FSO_Temlet,FSO_Stream,TruePath

TruePath = Server.MapPath(LocalFilePath)

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

If ObjFile.FileExists(TruePath) Then

Set FSO_Temlet = ObjFile.GetFile(TruePath)

Set FSO_Stream = FSO_Temlet.OpenAsTextStream(1)

ReadFile = FSO_Stream.ReadAll

Set FSO_Temlet = Nothing

Set FSO_Stream = Nothing

Else

ReadFile = "FileNotFound"&TruePath

End If

Set ObjFile = Nothing

End Function

’FSO保存文件

Sub WriteFile(Content,LocalFilePath)

Dim ObjFile,FilePionter

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

Set FilePionter = ObjFile.CreateTextFile(Server.MapPath(LocalFilePath),True) ’创建文件

FilePionter.Write Content

FilePionter.close ’释放对象

Set FilePionter = Nothing

Set ObjFile = Nothing

End Sub

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

’得到浏览器目前的URL

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

Function GetCurURL()

If Request.ServerVariables("HTTPS") = "on" Then

GetCurrentURL = "https://";

Else

GetCurrentURL = "http://";

End If

GetCurURL = GetCurURL & Request.ServerVariables("SERVER_NAME")

If (Request.ServerVariables("SERVER_PORT") <> 80) Then GetCurURL = GetCurURL & ":" & Request.ServerVariables("SERVER_PORT")

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

If (Request.QueryString <> "") Then GetCurURL = GetCurURL & "?" & Request.QueryString

End Function

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

’函数名：SendMail

’作用：用Jmail组件发送邮件

’参数：MailtoAddress ----收信人地址

’ MailtoName -----收信人姓名

’ Subject -----主题

’ MailBody -----信件内容

’ FromName -----发信人姓名

’ MailFrom -----发信人地址

’ Priority -----信件优先级

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

function SendMail(MailtoAddress,MailtoName,Subject,MailBody,FromName,MailFrom,Priority)

on error resume next

Dim JMail

Set JMail=Server.CreateObject("JMail.Message")

if err then

SendMail= "<br><li>没有安装JMail组件</li>"

err.clear

exit function

end if

JMail.Charset="gb2312" ’邮件编码

JMail.silent=true

JMail.ContentType = "text/html" ’邮件正文格式

’JMail.ServerAddress=MailServer ’用来发送邮件的SMTP服务器

’如果服务器需要SMTP身份验证则还需指定以下参数

JMail.MailServerUserName = MailServerUserName ’登录用户名

JMail.MailServerPassWord = MailServerPassword ’登录密码

JMail.MailDomain = MailDomain ’域名（如果用“[email protected]”这样的用户名登录时，请指明domain.com

JMail.AddRecipient MailtoAddress,MailtoName ’收信人

JMail.Subject=Subject ’主题

JMail.HMTLBody=MailBody ’邮件正文（HTML格式）

JMail.Body=MailBody ’邮件正文（纯文本格式）

JMail.FromName=FromName ’发信人姓名

JMail.From = MailFrom ’发信人Email

JMail.Priority=Priority ’邮件等级，1为加急，3为普通，5为低级

JMail.Send(MailServer)

SendMail =JMail.ErrorMessage

JMail.Close

Set JMail=nothing

end function

’=================================================

’过程名：savestaticpage

’作用：保存为静态页面

’参数：from——地址，tofile——文件名

’=================================================

sub savestaticpage(from,tofile)

set fso=Server.CreateObject("Scripting.FileSystemObject"

PostUrl="http://";& host & "/" & from

Rvalue=SendToSp(PostUrl)

Rvalue=Bytes2bStr(Rvalue)

if Rvalue="" then

if err then

WriteErrMsg(err.description)

end if

response.End()

end if

Set hf = fso.CreateTextFile(tofile, True)

hf.Write Rvalue

hf.Close

set hf=nothing

set fso=nothing

end sub

’读取URL接口

Function SendToSp(PostUrl)

IsSuccess=""

Set xml = Server.CreateObject("Microsoft.XMLHTTP"

xml.Open "GET",PostUrl,False

xml.Send

’if xml.readystate<>4 then

’ WriteErrMsg("更新页面失败，可能是服务器故障，请稍后在试！！！"

’ SendToSp=""

’ exit function

’end if

IsSuccess= xml.Responsebody

Set xml = Nothing

SendToSp = IsSuccess

End Function

Const adTypeBinary = 1

Const adTypeText = 2

’转换接口值为字符串

Function Bytes2bStr(vin)

Dim BytesStream,StringReturn

Set BytesStream = Server.CreateObject("ADODB.Stream"

With BytesStream

.Type=adTypeText

.Open

.WriteText vin

.Position = 0

.Charset = "GB2312"

.Position = 2

StringReturn = .ReadText

.close

End With

Set BytesStream = Nothing

Bytes2bStr = StringReturn

End Function

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

’函数名：ReplaceBadChar

’作用：过滤非法的SQL字符

’参数：strChar-----要过滤的字符

’返回值：过滤后的字符

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

function ReplaceBadChar(strChar)

if strChar="" then

ReplaceBadChar=""

else

ReplaceBadChar=replace(replace(replace(replace(replace(replace(replace(strChar,"’","’’"),"*",""),"?",""),"(",""),")",""),"<",""),".","")

end if

end function

经常在ASP里面碰到要求用户输入日期,比如生日,那么如何知道他输入的值是否有效呢?比如输入2月,则肯定没有30,31号;又如她要是输入4月,那么肯定没有31号,等等.....

　　下面是我碰到时的解决方案，在ASP中实现：

Tyear=parseInt(<%=year(date)%>);

Tmonth=parseInt(<%=month(date)%>);

Tday=parseInt(<%=day(date)%>);

Tdate= Tyear*10000+Tmonth*100+Tday;

Fyear=parseInt(document.register.birthyear.value);

Fmonth=parseInt(document.register.birthmonth.value);

Fday=parseInt(document.register.birthday.value);

Fdate=(Fyear+18)*10000+Fmonth*100+Fday;

if(Fyear==0 || Fmonth==0 || Fday==0){

alert("請選擇您的出生日期。");

document.register.birthyear.focus();

return false;

}

else if(Fdate>Tdate){

alert("對不起，您未滿十八歲。");

document.register.birthyear.focus();

return false;

}

else

{

　 theDate = new Date(Fyear,Fmonth,0);

　 if (Fday > theDate.getDate ())

　 {

　　 window.alert ("出生日期輸入錯誤！");

　　 return false;

　 }

Function DateToStr(DateTime,ShowType) ’日期转换函数

Dim DateMonth,DateDay,DateHour,DateMinute

DateMonth=Month(DateTime)

DateDay=Day(DateTime)

DateHour=Hour(DateTime)

DateMinute=Minute(DateTime)

IF Len(DateMonth)<2 Then DateMonth="0"&DateMonth

IF Len(DateDay)<2 Then DateDay="0"&DateDay

IF Len(DateMinute)<2 Then DateMinute="0"&DateMinute

Select Case ShowType

Case "Y-m-d"

DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay

Case "Y-m-d H:I A"

Dim DateAMPM

IF DateHour>12 Then

DateHour=DateHour-12

DateAMPM="PM"

Else

DateHour=DateHour

DateAMPM="AM"

End IF

IF Len(DateHour)<2 Then DateHour="0"&DateHour

DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&"

"&DateAMPM

Case "Y-m-d H:I:S"

Dim DateSecond

DateSecond=Second(DateTime)

IF Len(DateHour)<2 Then DateHour="0"&DateHour

IF Len(DateSecond)<2 Then DateSecond="0"&DateSecond

DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&"

"&DateHour&":"&DateMinute&":"&DateSecond

Case "YmdHIS"

DateSecond=Second(DateTime)

IF Len(DateHour)<2 Then DateHour="0"&DateHour

IF Len(DateSecond)<2 Then DateSecond="0"&DateSecond

DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond

Case "ym"

DateToStr=Right(Year(DateTime),2)&DateMonth

Case "d"

DateToStr=DateDay

Case Else

IF Len(DateHour)<2 Then DateHour="0"&DateHour

DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute

End Select

End Function

Function CheckCardId(e)’身份证验证代码函数

arrVerifyCode = Split("1,0,x,9,8,7,6,5,4,3,2", ",")

Wi = Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2", ",")

Checker = Split("1,9,8,7,6,5,4,3,2,1,1", ",")

If Len(e) < 15 Or Len(e) = 16 Or Len(e) = 17 Or Len(e) > 18 Then

CheckCardId= "身份证号共有 15 码或18位"

CheckCardId = False

Exit Function

End If

Dim Ai

If Len(e) = 18 Then

Ai = Mid(e, 1, 17)

ElseIf Len(e) = 15 Then

Ai = e

Ai = Left(Ai, 6) & "19" & Mid(Ai, 7, 9)

End If

If Not IsNumeric(Ai) Then

CheckCardId= "身份证除最后一位外，必须为数字！"

Exit Function

End If

Dim strYear, strMonth, strDay

strYear = CInt(Mid(Ai, 7, 4))

strMonth = CInt(Mid(Ai, 11, 2))

strDay = CInt(Mid(Ai, 13, 2))

BirthDay = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay)

If IsDate(BirthDay) Then

If DateDiff("yyyy",Now,BirthDay)<-140 or cdate(BirthDay)>date() Then

CheckCardId= "身份证输入错误！"

Exit Function

End If

If strMonth > 12 Or strDay > 31 Then

CheckCardId= "身份证输入错误！"

Exit Function

End If

Else

CheckCardId= "身份证输入错误！"

Exit Function

End If

Dim i, TotalmulAiWi

For i = 0 To 16

TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)

Dim modvalue

modvalue = TotalmulAiWi Mod 11

Dim strVerifyCode

strVerifyCode = arrVerifyCode(modvalue)

Ai = Ai & strVerifyCode

CheckCardId = Ai

If Len(e) = 18 And e <> Ai Then

CheckCardId= "身份证号码输入错误！"

Exit Function

End If

End Function