7.经常有可能对某个事物进行当前状态的判断，一般即做一字段（数值类型，默认值为0）通过对该字段值的修改达到状态切换的效果。那么，我又做了个函数，让自己轻松轻松。 [转自：711网络工作室 http://www.tc711.com]
<%
Function pvouch(tablename,fildname,autoidname,indexid)
dim fildvalue
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from "&tablename&" where "&autoidname&"="&indexid
rs.Open sql,conn,2,3
fildvalue=rs(""&fildname&"")
if fildvalue=0 then
fildvalue=1
else
fildvalue=0
end if
rs(""&fildname&"")=fildvalue
rs.update
rs.close
Set rs = Nothing
End Function
%>
参数说明：
pvouch(tablename,fildname,autoidname,indexid)
tablename 该事物所在数据库中的表名
fildname 该事物用以表明状态的字段名（字段类型是数值型）
autoidname 在该表中的自动编号名
indexid 用以修改状态的对应自动编号的值 [转自：711网络工作室 http://www.tc711.com]
引用示例如下：
<%
dowhat=request.QueryString("dowhat")
p_id=cint(request.QueryString("p_id"))
if dowhat="tj" and p_id<>"" then
call pvouch("cn_products","p_vouch","p_id",p_id)
end if
%>
<%if rs("p_vouch")=0 then%>
<a href=showpro.asp?dowhat=tj&p_id=<%=rs("p_id")%>>推荐</a>
<%else%>
<a href=showpro.asp?dowhat=tj&p_id=<%=rs("p_id")%>>取消推荐</a>
<%end if%>
调试地址：http://www.cnbruce.com/test/function/showpro.asp
8.为很多中小企业写站点，一般产品展示是个大项目，那么做成的页面也就不同。
要不就是横排来几个，要不就是竖排来几个，甚至全站要翻来覆去的搞个好几次，麻烦也很累。索性写个函数能缓解一下，于是就成了下面
<% function showpros(tablename,topnum,fildname,loopnum,typenum) Set rs = Server.CreateObject ("ADODB.Recordset") sql = "Select top "&topnum&" * from "&tablename rs.Open sql,conn,1,1 if rs.eof and rs.bof then response.Write("暂时无该记录") else response.Write("<table width='100%'>") for i=1 to rs.recordcount if (i mod loopnum=1) then response.write"<tr>" end if select case typenum case "1" response.Write("<td><table width='100%'><tr><td bgcolor=red width='50%'>") response.Write(rs(""&fildname&"")) response.Write("</td><td bgcolor=black>") response.Write("方式1之"&i&"记录")'此处的“方式1”可以替换显示为其余字段的值 response.Write("</td></tr>")'如果字段比较多，继续添加新个表格行来显示 response.Write("</table></td>") case "2" response.Write("<td><table width='100%'><tr><td bgcolor=red>") response.Write(rs(""&fildname&"")) response.Write("</td></tr>") response.Write("<tr><td bgcolor=black>") response.Write("方式2之"&i&"记录") response.Write("</td></tr>") response.Write("</table></td>") end select if (i mod loopnum=0) then response.write"</tr>" end if rs.movenext next response.Write("</table>") end if rs.close Set rs = Nothing end function %> 参数说明：showpros(tablename,topnum,fildname,loopnum,typenum)
whichpro为选择何类型的产品种类
topnum表示提取多少条记录
fildname表示调试显示的字段，具体应用的时候可以省去该参数，在函数内部直接使用
loopnum表示显示的循环每行的记录条数
typenum表示循环显示的方法：目前分了两类，横向并列、纵向并列显示同一数据记录行的不同记录
引用示例如下：
<%
if request.form("submit")<>"" then
topnum=request.form("topnum")
loopnum=request.form("loopnum")
typenum=request.form("typenum")
else
topnum=8
loopnum=2
typenum=1
end if
%>
<%call showpros("cn_products",topnum,"p_name",loopnum,typenum)%>
<form action=index.asp method=post>
显示的记录总数：<input name=topnum value=<%=topnum%>>
显示的行循环数：<input name=loopnum value=<%=loopnum%>>
显示的方式类型：<select name=typenum>
<option value="1">方式1</option>
<option value="2">方式2</option>
</select>
<input type=submit name=submit value=Sure>
</form>
调试地址：http://www.cnbruce.com/test/function/index.asp
可以选择文件下载查看： [down=attachments/month_0411/vskz_function.rar]Download file[/down]
9.IP转换成数字，限制IP时用
'//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
10.ASP安全检测与过滤函数SafeCheck
<%
'作用:安全字符串检测函数
'名字:SafeCheck
'参数:CheckString,CheckType,CheckLength
'说明:
'Checkstring待检测字符串:任意字符.
'CheckType检测类型0正常短字符1数字2日期3金钱4编码HTML5解码HTML6登录字符串7防攻击检测
'CheckLength检测类型长度:类型为int,当为金钱时为小数点的位置
'返回值:如果通过检测,返回正确字符串,
'如果未通过则返回错误代码SYSTEM_ERROR|ERROR_CODE
'Script Writen by :SnowDu(杜雪.NET)
'Web:http://www.snsites.com/
'Web:http://www.knowsky.com/
'-------------------------------------------
function SafeCheck(CheckString,CheckType,CheckLength)
On Error Resume Next
ErrorRoot="SYSTEM_ERROR|"
if checkString="" then
SafeCheck=ErrorRoot&"00001"
exit function
end if
CheckString=Replace(CheckString,"'","'")
select case CheckType
case 0
CheckString=trim(CheckString)
SafeCheck=Left(CheckString,CheckLength)
case 1
if not isnumberic(CheckString) then
SafeCheck=ErrorRoot&"00002"
exit function
else
SafeCheck=Left(CheckString,CheckLength)
end if
case 2
tempVar=IsDate(CheckString)
if Not TempVar then
SafeCheck=ErrorRoot&"00003"
exit function
else
select case CheckLength
case 0
SafeCheck=FormatDateTime(CheckString,vbShortDate)
case 1
SafeCheck=FormatDateTime(CheckString,vbLongDate)
case 2
SafeCheck=CheckString
end select
end if
case 3
tempVar=FormatCurrency(CheckString,0)
if Err then
SafeCheck=ErrorRoot&"00004"
exit function
else
SafeCheck=FormatCurrency(CheckString,CheckLength)
end if
case 4
sTemp = CheckString
If IsNull(sTemp) = True Then
SafeCheck=ErrorRoot&"00005"
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
sTemp = Replace(sTemp, Chr(10), "<br>")
SafeCheck = Left(sTemp,CheckLength)
case 5
sTemp = CheckString
If IsNull(sTemp) = True Then
SafeCheck=ErrorRoot&"00006"
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, """, Chr(34))
sTemp = Replace(sTemp, "<br>",Chr(10))
SafeCheck = Left(sTemp,CheckLength)
case 6
s_BadStr = "' &<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
n = Len(s_BadStr)
IsSafeStr = True
For i = 1 To n
If Instr(CheckString, Mid(s_BadStr, i, 1)) > 0 Then
IsSafeStr = False
End If
Next
if IsSafeStr then
SafeCheck=left(CheckString,CheckLength)
else
SafeCheck=ErrorRoot&"00007"
Exit Function
end if
case 7
s_Filter="net user|xp_cmdshell|/add|select|count|asc|char|mid|'|""|"
S_Filter=S_Filter&"insert|delete|drop|truncate|from|%|declare|-"
S_Filters=split(S_Filter,"|")
isFound=false
for i=0 to ubound(S_Filters)-1
if Instr(lcase(CheckString),lcase(S_Filters(i)))<>0 then
isFound=true
exit for
end if
next
if isFound then
SafeCheck=ErrorRoot&"00008"
Exit Function
else
SafeCheck=left(CheckString,CheckLength)
end if
end select
end function
%>
11.控制输出字符串的长度，可以区别中英文
函数在下面，是方法是：
strvalue("复请Email通知如果不填写则取注册Email",26)
这里26是指26个英文字母，也就是13个汉字
function strlen(str)
dim p_len
p_len=0
strlen=0
if trim(str)<>"" then
p_len=len(trim(str))
for xx=1 to p_len
if asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
else
strlen=int(strlen) + 1
end if
next
end if
end function
function strvalue(str,lennum)
dim p_num
dim i
if strlen(str)<=lennum then
strvalue=str
else
p_num=0
x=0
do while not p_num > lennum-2
x=x+1
if asc(mid(str,x,1))<0 then
p_num=int(p_num) + 2
else
p_num=int(p_num) + 1
end if
strvalue=left(trim(str),x)&"…"
loop
end if
end function
12.一个把数字转英文的实用程序
原数字格式：2000
格式化后：TWO THOUSAND ONLY
引用：<%=make("2000")%>
自定义函数：
<%
function zr4(y)'准备数据
dim z(10)
z(1)="ONE"
z(2)="TWO"
z(3)="THREE"
z(4)="FOUR"
z(5)="FIVE"
z(6)="SIX"
z(7)="SEVEN"
z(8)="EIGHT"
z(9)="NINE"
zr4=z(MID(y,1,1))
end function
function zr3(y)'准备数据
dim z(10)
z(1)="ONE"
z(2)="TWO"
z(3)="THREE"
z(4)="FOUR"
z(5)="FIVE"
z(6)="SIX"
z(7)="SEVEN"
z(8)="EIGHT"
z(9)="NINE"
zr3=z(MID(y,3,1))
end function
function zr2(y)'准备数据
dim z(20)
z(10)="TEN"
z(11)="ELEVEN"
z(12)="TWELVE"
z(13)="THIRTEEN"
z(14)="FOURTEEN"
z(15)="FIFTEEN"
z(16)="SIXTEEN"
z(17)="SEVENTEEN"
z(18)="EIGHTEEN"
z(19)="NINETEEN"
zr2=z(MID(y,2,2))
end function
function zr1(y)'准备数据
dim z(10)
z(1)="TEN"
z(2)="TWENTY"
z(3)="THIRTY"
z(4)="FORTY"
z(5)="FIFTY"
z(6)="SIXTY"
z(7)="SEVENTY"
z(8)="EIGHTY"
z(9)="NINETY"
zr1=z(MID(y,2,1))
end function
function dw(y)'准备数据
dim z(5)
z(0)=""
z(1)="THOUSAND"
z(2)="MILLION"
z(3)="BILLION"
dw=z(y)
end function
function w2(y)'用来制作2位数字转英文
if MID(y,2,1)="0" then'判断是否小于十
value=zr3(y)
elseif MID(y,2,1)="1" then'判断是否在十到二十之间
value=zr2(y)
elseif MID(y,3,1)="0" then'判断是否为大于二十小于一百的能被十整除的数（为了去掉尾空格）
value=zr1(y)
else
value=zr1(y)+" "+zr3(y)'加上十位到个位的空格
end if
w2=value
end function
function w3(y)'用来制作3位数字转英文
if MID(y,1,1)="0" then'判断是否小于一百
value=w2(y)
elseif MID(y,2,2)="00" then '判断是否能被一百整除
value=zr4(y)+" "+"HUNDRED"
else
value=zr4(y)+" "+"HUNDRED"+" "+"AND"+" "+w2(y)'不苷囊竺婕印癆ND”
end if
w3=value
end function
function make(x)
z=instr(1,x,".",1)'取小数点位置
if z<>0 then'判断有没有小数
lstr=mid(x,1,z-1)'取小数点左边的字串
rstr=mid(x,z+1,2)'取小数点右边的字串
else
lstr=x'没有小数的情况
end if
lstrev=StrReverse(lstr)'对左边的字串取反字串
dim a(5)'定义5个字串变量用来存放解析出的三位一组的字串
select case len(lstrev) mod 3'字串长度不能被整除，需补齐
case "1"
lstrev=lstrev+"00"
case "2"
lstrev=lstrev+"0"
end select
lm=""'用来存放转换后的整数部分
for i=0 to len(lstrev)/3-1'计算有多少个三位
a(i)=StrReverse(mid(lstrev,3*i+1,3))'截取第1个三位
if a(i)<>"000" then '用来避免这种情况“1000000=ONE MILLION THOUSAND ONLY”
if i<>0 then
lm=w3(a(i))+" "+dw(i)+" "+lm'用来加上“THOUSAND OR MILLION OR BILLION”
else
lm=w3(a(i))'防止i=0时“lm=w3(a(i))+" "+dw(i)+" "+lm”多加两个尾空格
end if
else
lm=w3(a(i))+lm
end if
NEXT
xs=""'用来存放转换后的小数部分
if z<>0 then
xs="AND CENTS"+" "+w2("$"+rstr)+" "'小数部分存在时转换小数部分
end if
make=lm+" "+xs+"ONLY"'最后结果，加上ONLY
end function
%>
13.把长的数字用逗号隔开显示
文字格式：12345678
格式化数字：12,345,678
自定义函数：
<%
Function Comma(str)
If Not(IsNumeric(str)) Or str = 0 Then
Result = 0
ElseIf Len(Fix(str)) < 4 Then
Result = str
Else
Pos = Instr(1,str,".")
If Pos > 0 Then
Dec = Mid(str,Pos)
End if
Res = StrReverse(Fix(str))
LoopCount = 1
While LoopCount <= Len(Res)
TempResult = TempResult + Mid(Res,LoopCount,3)
LoopCount = LoopCount + 3
If LoopCount <= Len(Res) Then
TempResult = TempResult + ","
End If
Wend
Result = StrReverse(TempResult) + Dec
End If
Comma = Result
End Function
%>
引用：
<%
aLongNumber = "12345678"
response.wirte Comma(aLongNumber)
%>
14.随机生成文件名的函数
<%
Function Generator(Length)
dim i, tempS, v
dim c(39)
tempS = ""
c(1) = "a": c(2) = "b": c(3) = "c": c(4) = "d": c(5) = "e": c(6) = "f": c(7) = "g"
c(8) = "h": c(9) = "i": c(10) = "j": c(11) = "k": c(12) = "l": c(13) = "m": c(14) = "n"
c(15) = "o": c(16) = "p": c(17) = "q": c(18) = "r": c(19) = "s": c(20) = "t": c(21) = "u"
c(22) = "v": c(23) = "w": c(24) = "x": c(25) = "y": c(26) = "z": c(27) = "1": c(28) = "2"
c(29) = "3": c(30) = "4": c(31) = "5": c(32) = "6": c(33) = "7": c(34) = "8": c(35) = "9"
c(36) = "-": c(37) = "_": c(38) = "@": c(39) = "!"
If isNumeric(Length) = False Then
Response.Write "A numeric datatype was not submitted to this function."
Exit Function
End If
For i = 1 to Length
Randomize
v = Int((39 * Rnd) + 1)
tempS = tempS & c(v)
Next
Generator = tempS
End Function
For i = 1 to 20
Randomize
x = Int((20 * Rnd) + 1) + 10
Response.Write Generator(x) & "<br>" & vbnewline
Next
%>
15.每行显示n个字母，自动换行
Function rowscode(str,n)
If len(str)<=n/2 Then
rowscode=str
Else
Dim TStr
Dim l,t,c
Dim i
l=len(str)
TStr=""
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
TStr=TStr&(mid(str,i,1))
If t>n Then
TStr=TStr&"<br>"
t=0
End if
next
rowscode= TStr
End If
End Function |
