'@转换日期为星期几函数 '@idate为标准日期格式 '@itype为0时表示英文星期几,否则为中文 function showweek(idate,itype) if itype <> 0 then itype = 1 '//防止误输出错 dim inum,nday inum = weekday(idate) if itype = 0 then select case inum case 1 nday = "Sunday" case 2 nday = "Monday" case 3 nday = "Tuesday" case 4 nday = "Wednesday" case 5 nday = "Thursday" case 6 nday = "Friday" case 7 nday = "Saturday" end select else select case inum case 1 nday = "星期天" case 2 nday = "星期一" case 3 nday = "星期二" case 4 nday = "星期三" case 5 nday = "星期四" case 6 nday = "星期五" case 7 nday = "星期六" end select end if '//OUTPUT showweek = nday end function '//*************************************************************
'@分页列表函数 '@参数说明:TotalReCount:记录总数 '@page:当前页码,pagesize:分页大小,url:页面地址 function PageList(TotalReCount,page,pagesize,url) dim startPage,endPage,ipage,totalPage '//判断链接文件后参数个数 if inStr(1,url,"?") = 0 then url = url & "?" else url = url & "&" end if '//得到总页数 totalPage = TotalReCount \ pagesize if TotalRecount mod pagesize <> 0 then totalPage = Cint(TotalRecount\pagesize+1) startPage = 1 endPage = totalPage if page > 10 then startPage = page - 4 if totalPage < 10 then endPage = totalPage else if page =< 10 then endPage = 10 else endPage = page + 4 if endPage > totalPage then endPage = totalPage end if end if%> 共有:<%=TotalReCount%> <%=pagesize%>页 <%if page>1 then%> <a href="<%=url%>page=1"><font face="webdings">9</font></a> <a href="<%=url%>page=<%=page-1%>"><font face="webdings">7</font></a> <%end if%> <%for ipage = startPage to endPage if ipage <> page then%> <a href=""><%=ipage%></a> <%else response.write i&" " end if next%> <%if (totalPage-page)>4 then%> <a href="<%=url%>page=<%=page+1%>"><font face="webdings">8</font></a> <a href="<%=url%>page=<%=totalPage%>"><font face="webdings">:</font></a> <%end if
end function '//*************************************************************
'//检测组件是否安装函数 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 '//*************************************************************
Function SafeRequest(ParaName,ParaType) '防止SQL注入攻击代码 '--- 传入参数 ---//例: SafeRequest("username",0)或SafeRequest("id",1) 'ParaName:参数名称-字符型 'ParaType:参数类型-数字型(1表示参数是数字,0表示参数为字符)
Dim ParaValue ParaValue=Request(ParaName) If ParaType=1 then If not isNumeric(ParaValue) then 'Response.write "<script language=javascript>alert('参数" & ParaName & "必须为数字型!');</script>" Response.write "<script language=javascript>window.history.back();</script>" Response.end elseif ParaValue < 1 then ParaValue = 1 End if Else ParaValue=replace(ParaValue,"'","''") End if SafeRequest=ParaValue End function '//*************************************************************
'//HTML解码函数 Function HTMLDecode(fString) If Not IsNull(fString) Then fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, " ", CHR(32)) ' fString = Replace(fString, " ", CHR(9)) ' fString = Replace(fString, """, CHR(34)) '双引号过滤 'fString = Replace(fString, CHR(39), "'") '单引号过滤 'fString = Replace(fString, ,"" CHR(13)) fString = Replace(fString, "</p><p>", CHR(10) & CHR(10)) fString = Replace(fString, "<br>", CHR(10)) HTMLDecode = fString End If End Function '//*************************************************************
'//HTML编码函数 Function HTMLEncode(fString) If Not IsNull(fString) Then fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, CHR(32), " ") ' fString = Replace(fString, CHR(9), " ") ' fString = Replace(fString, CHR(34), """) '双引号过滤 'fString = Replace(fString, CHR(39), "'") '单引号过滤 fString = Replace(fString, CHR(13), "") fString = Replace(fString, CHR(10) & CHR(10), "</p><p>") fString = Replace(fString, CHR(10), "<br>") HTMLEncode = fString End If End Function '//*************************************************************
'CFS Encode Function Function CfsEnCode(CodeStr) Dim CodeLen Dim CodeSpace Dim NewCode dim cecr,cecb,cec CodeLen = 30 CodeSpace = CodeLen - Len(CodeStr) If Not CodeSpace < 1 Then For cecr = 1 To CodeSpace CodeStr = CodeStr & Chr(21) Next End If NewCode = 1 Dim Been For cecb = 1 To CodeLen Been = CodeLen + Asc(Mid(CodeStr,cecb,1)) * cecb NewCode = NewCode * Been Next CodeStr = NewCode NewCode = Empty For cec = 1 To Len(CodeStr) NewCode = NewCode & CfsCode(Mid(CodeStr,cec,3)) Next For cec = 20 To Len(NewCode) - 18 Step 2 CfsEnCode = CfsEnCode & Mid(NewCode,cec,1) Next End Function
Function CfsCode(Word) dim cc For cc = 1 To Len(Word) CfsCode = CfsCode & Asc(Mid(Word,cc,1)) Next CfsCode = Hex(CfsCode) End Function '//*************************************************************
'//转换中文货币大小写 function CLMoney(thenumber) dim Money,i,String1,String2,length,checkp'定义变量 dim one(),onestr()'定义数组
String1 = "零壹贰叁肆伍陆柒捌玖" String2 = "万仟佰拾亿仟佰拾万仟佰拾元角分厘毫"
checkp=instr(thenumber,".")'判断是否含有小数位 if checkp<>0 then thenumber=replace(thenumber,".","")'去除小数位 end if
length=len(thenumber) '取得数据长度 redim one(length-1)'重新定义数组大小 redim onestr(length-1)'重新定义数组大小
for i=0 to length-1
one(i)=mid(thenumber,i+1,1) '循环取得每一位的数字 one(i)=mid(string1,one(i)+1,1)'循环取得数字对应的大写
if checkp=0 then '不含有小数的数据其数字对应的单位 onestr(i)=mid(string2,14-length+i,1) else '含有小数的数据其数字对应的单位 onestr(i)=mid(string2,15-length+i+len(thenumber)-checkp,1) end if
one(i)=one(i)&onestr(i)'将数字与单位组合 next
Money=replace(join(one)," ","") '取得数组中所有的元素,并连接起来 Money=replace(Money,"零元","元") Money=replace(Money,"零万","万") Money=replace(Money,"零亿","亿") Money=replace(Money,"零仟","零") Money=replace(Money,"零佰","零") Money=replace(Money,"零拾","零")
do while not instr(Money,"零零")=0 Money=replace(Money,"零零","零") loop CLmoney = Money end function '//***********************************************************
'//IP转换成数字,限制IP时用 '@使用示例 '// userIPnum = IP2Num(Request.ServerVariables("REMOTE_ADDR")) '// if userIPnum > IP2Num("192.168.0.0") and userIPnum < '// IP2Num("192.168.0.255") then '// response.write ("<center>您的IP被禁止</center>") '// response.end '// end if
function IP2Num(sip) dim str1,str2,str3,str4 dim num IP2Num=0 if isnumeric(left(sip,2)) then str1=left(sip,instr(sip,".")-1) sip=mid(sip,instr(sip,".")+1) str2=left(sip,instr(sip,".")-1) sip=mid(sip,instr(sip,".")+1) str3=left(sip,instr(sip,".")-1) str4=mid(sip,instr(sip,".")+1) num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1 IP2Num = num end if end function '//********************************************************