📄 function.asp
字号:
' AddRecipient ----收信人地址
' Subject ----主题
' Body ----信件内容
' Sender ----发信人地址
'****************************************************
function SendMail(MailServerAddress,AddRecipient,Subject,Body,Sender,MailFrom)
on error resume next
Dim JMail
Set JMail=Server.CreateObject("JMail.SMTPMail")
if err then
SendMail= "<br><li>没有安装JMail组件</li>"
err.clear
exit function
end if
JMail.Logging=True
JMail.Charset="gb2312"
JMail.ContentType = "text/html"
JMail.ServerAddress=MailServerAddress
JMail.AddRecipient=AddRecipient
JMail.Subject=Subject
JMail.Body=MailBody
JMail.Sender=Sender
JMail.From = MailFrom
JMail.Priority=1
JMail.Execute
Set JMail=nothing
if err then
SendMail=err.description
err.clear
else
SendMail="OK"
end if
end function
'****************************************************
'过程名：WriteErrMsg
'作 用：显示错误提示信息
'参 数：无
'****************************************************
sub WriteErrMsg()
dim strErr
strErr=strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
strErr=strErr & "<link href='style.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
strErr=strErr & "<table cellpadding=2 cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
strErr=strErr & " <tr align='center'><td height='20' class='title'><strong>错误信息</strong></td></tr>" & vbcrlf
strErr=strErr & " <tr><td height='100' class='tdbg' valign='top'><b>产生错误的可能原因：</b><br>" & errmsg &"</td></tr>" & vbcrlf
strErr=strErr & " <tr align='center'><td class='title'><a href='javascript:history.go(-1)'>【返回】</a></td></tr>" & vbcrlf
strErr=strErr & "</table>" & vbcrlf
strErr=strErr & "</body></html>" & vbcrlf
response.write strErr
end sub
'****************************************************
'过程名：WriteSuccessMsg
'作 用：显示成功提示信息
'参 数：无
'****************************************************
sub WriteSuccessMsg(SuccessMsg)
dim strSuccess
strSuccess=strSuccess & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
strSuccess=strSuccess & "<link href='style.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
strSuccess=strSuccess & "<table cellpadding=2 cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
strSuccess=strSuccess & " <tr align='center'><td height='20' class='title'><strong>恭喜你！</strong></td></tr>" & vbcrlf
strSuccess=strSuccess & " <tr><td height='100' class='tdbg' valign='top'><br>" & SuccessMsg &"</td></tr>" & vbcrlf
strSuccess=strSuccess & " <tr align='center'><td class='title'><a href='javascript:history.go(-1)'>【返回】</a></td></tr>" & vbcrlf
strSuccess=strSuccess & "</table>" & vbcrlf
strSuccess=strSuccess & "</body></html>" & vbcrlf
response.write strSuccess
end sub
function getFileExtName(fileName)
dim pos
pos=instrrev(filename,".")
if pos>0 then
getFileExtName=mid(fileName,pos+1)
else
getFileExtName=""
end if
end function
'==================================================
'过程名：MenuJS
'作 用：生成下拉菜单相关的JS代码
'参 数：无
'==================================================
sub MenuJS()
response.write "<script type='text/javascript' language='JavaScript1.2' src='Inc/Southidcmenu.js'></script>"
end sub
dim pNum,pNum2
pNum=1
pNum2=0
'=================================================
'过程名：ShowRootClass_Menu
'作 用：显示一级栏目（下拉菜单效果）
'参 数：Language -----语言 1-中文 2-英文
'=================================================
sub ShowRootClass_Menu(Language)
response.write "<script type='text/javascript' language='JavaScript1.2'>" & vbcrlf & "<!--" & vbcrlf
response.write "stm_bm(['uueoehr',400,'','images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
response.write "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
response.write "stm_ai('p0i0',[0,'','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt Tahoma','9pt Tahoma',0,0]);" & vbcrlf
if Language=1 then
response.write "stm_aix('p0i1','p0i0',[0,'首页','','',-1,-1,0,'index.asp ','_self','index.asp','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#333333','#cc0000','9pt Tahoma','9pt Tahoma']);" & vbcrlf
else
response.write "stm_aix('p0i1','p0i0',[0,'Home','','',-1,-1,0,'Enindex.asp ','_self','Enindex.asp','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt Tahoma','9pt Tahoma']);" & vbcrlf
end if
response.write "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ffffff','#333333','#ffffff','9pt Tahoma','9pt Tahoma',0,0]);" & vbcrlf
dim sqlRoot,rsRoot,j
if Language=1 then
sqlRoot="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From MenuClass"
else
sqlRoot="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From EnMenuClass"
end if
sqlRoot= sqlRoot & " where Depth=0 and ShowOnTop=True order by RootID"
Set rsRoot= Server.CreateObject("ADODB.Recordset")
rsRoot.open sqlRoot,conn,1,1
if not(rsRoot.bof and rsRoot.eof) then
j=3
do while not rsRoot.eof
if rsRoot(4)<>"" then
response.write "stm_aix('p0i"&j&"','p0i0',[0,'" & rsRoot(1) & "','','',-1,-1,0,'" & rsRoot(4) & "','_self','" & rsRoot(4) & "','" & rsRoot(6) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#333333','#cc0000','9pt Tahoma','9pt Tahoma']);" & vbcrlf
end if
if rsRoot(5)>0 then
if Language=1 then
call GetClassMenu(rsRoot(0),0,1)
else
call GetClassMenu(rsRoot(0),0,2)
end if
end if
j=j+1
response.write "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#333333','#000000','9pt Tahoma','9pt Tahoma',0,0]);" & vbcrlf
j=j+1
rsRoot.movenext
loop
end if
rsRoot.close
set rsRoot=nothing
response.write "stm_em();" & vbcrlf
response.write "//-->" & vbcrlf & "</script>" & vbcrlf
end sub
sub GetClassMenu(ID,ShowType,Language)
dim sqlClass,rsClass,k
'1,4,0,4,2,3,6,7,100前4个数字控制菜单位置和大小
if pNum=1 then
response.write "stm_bp('p" & pNum & "',[1,4,0,4,2,3,6,7,100,'progid:DXImageTransform.Microsoft.Fade(overlap=.5,enabled=0,Duration=0.43)',-2,'',-2,67,2,3,'#999999','#EBEBEB','',3,1,1,'#aca899']);" & vbcrlf
else
if ShowType=0 then
response.write "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,4,0,0,2,3,6]);" & vbcrlf
else
response.write "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,2,-2,-3,2,3,0]);" & vbcrlf
end if
end if
k=0
if Language=1 then
sqlClass="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From MenuClass"
else
sqlClass="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From EnMenuClass"
end if
sqlClass= sqlClass & " where ParentID=" & ID & " order by OrderID asc"
Set rsClass= Server.CreateObject("ADODB.Recordset")
rsClass.open sqlClass,conn,1,1
do while not rsClass.eof
if rsClass(4)<>"" then
if rsClass(5)>0 then
response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(4) & "','_self','" & rsClass(4) & "','" & rsClass(6) & "','','',6,0,0,'images/arrow_r.gif','images/arrow_w.gif',7,7,0,0,1,'#FFFFFF',0,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt Tahoma']);" & vbcrlf
pNum=pNum+1
pNum2=pNum2+1
if Language=1 then
call GetClassMenu(rsClass(0),1,1)
else
call GetClassMenu(rsClass(0),1,2)
end if
else
response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(4) & "','_self','" & rsClass(4) & "','" & rsClass(6) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#FFFFFF',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt Tahoma']);" & vbcrlf
end if
end if
k=k+1
rsClass.movenext
loop
rsClass.close
set rsClass=nothing
response.write "stm_ep();" & vbcrlf
end sub
'==================================================
'过程名：ShowAnnounce
'作 用：显示本站公告信息
' AnnounceNum ----最多显示多少条公告
'==================================================
sub ShowAnnounce(AnnounceNum)
dim sqlAnnounce,rsAnnounce,i
if AnnounceNum>0 and AnnounceNum<=10 then
sqlAnnounce="select top " & AnnounceNum
else
sqlAnnounce="select top 10"
end if
sqlAnnounce=sqlAnnounce & " * from affiche order by ID Desc"
Set rsAnnounce= Server.CreateObject("ADODB.Recordset")
rsAnnounce.open sqlAnnounce,conn,1,1
if rsAnnounce.bof and rsAnnounce.eof then
AnnounceCount=0
response.write "<p> 没有公告</p>"
else
AnnounceCount=rsAnnounce.recordcount
response.Write "本站公告："
do while not rsAnnounce.eof
response.Write " <a href='#' onclick=""javascript:window.open('Affiche.asp?ID=" & rsAnnounce("id") &"', 'newwindow', 'height=450, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='" & rsAnnounce("Content") & "'><font color='#FF0000'>" &rsAnnounce("title") & "</font></a>"
rsAnnounce.movenext
i=i+1
loop
end if
rsAnnounce.close
set rsAnnounce=nothing
end sub
'==================================================
'过程名：ShowFriendLinks
'作 用：显示友情链接站点
'参 数：LinkType ----链接方式，1为LOGO链接，2为文字链接
' SiteNum ----最多显示多少个站点
' Cols ----分几列显示
' ShowType ----显示方式。1为向上滚动，2为横向列表，3为下拉列表框
'==================================================
'==================================================
'过程名：RollFriendLinks
'作 用：滚动显示友情链接站点
'参 数：无
'==================================================
sub RollFriendLinks()
%>
<script>
var rollspeed=30
rolllink2.innerHTML=rolllink1.innerHTML //克隆rolllink1为rolllink2
function Marquee(){
if(rolllink2.offsetTop-rolllink.scrollTop<=0) //当滚动至rolllink1与rolllink2交界时
rolllink.scrollTop-=rolllink1.offsetHeight //rolllink跳到最顶端
else{
rolllink.scrollTop++
}
}
var MyMar=setInterval(Marquee,rollspeed) //设置定时器
rolllink.onmouseover=function() {clearInterval(MyMar)}//鼠标移上时清除定时器达到滚动停止的目的
rolllink.onmouseout=function() {MyMar=setInterval(Marquee,rollspeed)}//鼠标移开时重设定时器
</script>
<%
end sub
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -