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,"'")<>0 or InStr(1,",")<>0 or InStr(str,"+")<>0 or InStr(1,"-")<>0 or InStr(1,"&")<>0 or InStr(1,"%")<>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) 

Else 

strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 

End If 

getIP = Trim(Mid(strIPAddr,30)) 

End Function

%>

使用方法:

str="Insert Into ip_login(loginip,loginname)values('"& getip & "','"& user & "')"