asp自定义函数，带案例使用方法

1、截断标题的函数
<%Function CutTitle(Title,TLen)
If len(Title)>TLen Then
CutTitle=Left(Title,TLen)&".."
Else
CutTitle=Title
End If
End Function
%>
使用方法
<%=CutTitle(rs("Title"),25)%>

2、添加，修改，删除函数
<%
Sub add()
AD_Name=request.form("AD_Name")
AD_Key=request.form("AD_Key")
if AD_Name="" or AD_Key="" then
response.write"所有的项目都必须填写！<a href=javascript:history.go(-1)>返回</a>"
response.end
end if
Conn.execute("insert into AD_Click(AD_Name,AD_Key)values('"&AD_Name&"','"&AD_Key&"')")
response.redirect "admin_ad.asp?Temp=添加成功！"&address
End Sub

Sub edit()
AD_Name=request.form("AD_Name")
AD_Key=request.form("AD_Key")
if AD_Name="" or AD_Key="" then
response.write"所有的项目都必须填写！<a href=javascript:history.go(-1)>返回</a>"
response.end
end if
id=int(request("ID"))
Conn.execute("update AD_Click set AD_Name='"&AD_Name&"',AD_Key='"&AD_Key&"' where ID="&ID)
response.redirect "admin_ad.asp?Temp=修改成功！"
End sub

sub del()
id=int(request("ID"))
Conn.execute("delete AD_Click where ID="&ID)
response.redirect "admin_ad.asp?Temp=删除成功！ID号为"&ID
end sub
%>

3、弹出错误提示
<%Sub AlertError (str)
Response.Write "<script language=""JavaScript"">" & chr(13)
Response.Write "<!--" & chr(13)
Response.Write "//" & chr(13)
Response.Write "alert (""" & str & """);" & chr(13)
Response.Write "window.history.back();" & chr(13)
Response.Write "//-->" & chr(13)
Response.Write "</script>" & chr(13)
Response.End
End Sub%>
运用方法:
<%if question1="" then
AlertError("请输入第一题答案，谢谢！")
response.end
end if%>


4、表格颜色交替变化
<%do while not(rs.EOF)%>
<%if i=0 then%>
<tr bgcolor=f3f3dd>
<%i=1%>
<%else%>
<tr bgcolor=e1e1ff>
<%i=0%>
<%end if%>

5、判断时间函数
Function Shijian(str)
nian = year(str)
yue = month(str)
ri = day(str)
select case yue
case "1" yue="Jan"
case "2" yue="Feb"
case "3" yue="Mar"
case "4" yue="Apr"
case "5" yue="May"
case "6" yue="Jun"
case "7" yue="Jul"
case "8" yue="Aug"
case "9" yue="Sep"
case "10" yue="Oct"
case "11" yue="Nov"
case "12" yue="Dec"
end select
Shijian=ri&", "&yue&", "&nian
End Function
使用方法:
<%=Shijian(rs("Shijian"))%>

6、判断是否是数字
Function checknum(str)
dim isnu
if (not isnumeric(str)) or InStr(1,str,".")<>0 or InStr(1,str,"'")<>0 or InStr(1,str,",")<>0 or InStr(str,"+")<>0 or InStr(1,str,"-")<>0 or InStr(1,str,"&")<>0 or InStr(1,str,"%")<>0 or InStr(str,"#")<>0 then
isnu="1"
else
isnu="0"
end if
checknum=isnu
end Function
使用方法:
<%if checknum(currentpage)="1" and currentpage<>"" then 
currentpage=1
end if %>

7、背景变换,图片切换,样式切换代码
<%
sub bg(pid,pida)
if pid=int(pida) then
response.write "background=""images/product/left_nav_3.gif"""
else
response.write "background=""images/product/left_nav_1.gif"" onmouseover='this.style.background=""url(images/product/left_nav_2.gif)""' onmouseout='this.style.background=""url(images/product/left_nav_1.gif)""' "
end if
end sub
使用方法:
<tr><td height="23" <% call bg(rs("id"),rs("ClassID"))%> > test </td></tr>


sub img(pid,pida)
if pid=int(pida) then
response.write "images/product/left_nav_a3.gif"
else 
response.write "images/product/left_nav_a1.gif"
end if
end sub
使用方法:
<td width="12" valign="middle" ><img src="<% call img(cid,rsclass("ClassID"))%>" width="8" height="8"></td>

sub calss(pid,pida)
if pid=int(pida) then
response.write "left_nav2"
else 
response.write "left_nav1"
end if
end sub
%>
使用方法:
<td><a href="Product_list.asp?pid=<%=rsclass("ClassID")%>" class="<% call calss(cid,rsclass("ClassID"))%>"><%=rsclass("ClassName")%></a></td>

8、父节点
<%
function parent(cid)
set crsclass=conn.execute("select * from [P_class] where ClassID="&cid&"")
parent=crsclass("RootID")
end function
%>
使用方法:
<% if cid<>"" then
if rsclass("Depth")=0 and parent(cid)=rsclass("ClassID") then
%>

9、权限函数
<%
Sub CheckPower(cid)
Dim CheckErr,Uparray
CheckErr=true
Uparray=Split(UserPower,",")
If Isarray(Uparray) then
For i=0 to Ubound(Uparray)
If cint(cid)=Cint(Uparray(i)) then CheckErr=false
Next
Else
CheckErr=true
End if
if CheckErr=true then
Response.write"您没有管理当前版块的权限！"
Response.end
End if
End Sub
%>
使用方法:
CheckPower(9)'权限检查

10、获得当前IP
<%
Private Function getIP() 
Dim strIPAddr 
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then 
strIPAddr = Request.ServerVariables("REMOTE_ADDR") 
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then 
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1) 
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then 
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1) 
Else 
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
End If 
getIP = Trim(Mid(strIPAddr, 1, 30)) 
End Function
%>
使用方法:
str="Insert Into ip_login(loginip,loginname)values('"& getip & "','"& user & "')"