分类： 系统运维
2010-04-17 22:44:11
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+"
"
next
else
fmtlen=str
end if
response.Write(StrAll)
%>
网页对话框
一个分离中文英文的函数
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
Next
SplitString="中文字符："&Chs&"
英文字符："&Eng
End Function
ASP字数计算函数
<%
’ASP字数计算函数
’by
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 & "
"
Loop
cuttextlen = GetTexts & tmptext
End If
End Function
日期减去天数等于第二个日期
获得一个窗口的大小
document.body.clientWidth,document.body.clientHeight
网页不会被缓存
HTM网页
或者
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 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="(,}"
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 ""
End Sub
Dim StartTime
StartTime = Timer() ’存储程序开始执行时间
’*******************************************************************
’功能: 输出程序总消耗时间
’*******************************************************************
Sub PrintExpendTime()
Response.Write("
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(9), " ")
Str = Replace(Str, CHR(34),""")
Str = Replace(Str, CHR(39),"'")
Str = Replace(Str, CHR(13), "")
Str = Replace(Str, CHR(10), "
")
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
next
isInteger=true
if err.number<>0 then err.clear
end function
’*******************************************************************
’ 指定秒数重定向另外的连接
’*******************************************************************
sub GoPage(url,s)
s=s*1000
Response.Write ""
end sub
’*******************************************************************
’分页显示
’LastNextPage(ipagecount,ipagecurrent,"","",)
’*******************************************************************
’Sub LastNextPage(pagecount,page,table_style,font_style)
’生成上一页下一页链接
Sub LastNextPage(pagecount,page)
Dim query, a, x, temp
act
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
Next
Response.Write("
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= "
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 ’域名（如果用”这样的用户名登录时，请指明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)
Next
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
