ddtaobao_syscode.asp
来自「设计考虑校园电子商务模式」· ASP 代码 · 共 659 行 · 第 1/2 页
ASP
659 行
<%
'****************************************************
' 多多校园 Power by ddtaobao.com
' Email:ddmaster@126.com OICQ:136465584
' Web: http://www.ddtaobao.com 作者:多多
' 校园、企业、医院、公司程序定做，系统开发，网站制作!
' Copyright (C) 2007 ddtaobao.com All Rights Reserved
'****************************************************
%><%
dim badip,rsbadip
badip=Request.ServerVariables("REMOTE_ADDR")
set rsbadip=conn.execute("select * from dd_ip where ip='"&badip&"'")
if not rsbadip.eof then
response.Write "<br><br><br><br><br><table cellpadding=0 cellspacing=0 border='1' bordercolor='"&table&"' align='center' style='border-collapse:collapse; font-size:12px; width:400px'>"
response.Write " <tr >"
response.Write " <td width='100%' height='25' >"
response.Write " <p align='center'><font color='#FF0000'>系统信息提示</font></td>"
response.Write " </tr>"
response.Write " <tr >"
response.Write " <td width='100%' height='25' ><p align='center'>您是不受欢迎用户</td>"
response.Write " </tr>"
response.Write "</table>"
response.end
end if
%><%
Function toususelect()
Dim Strsqtousu,Rstousu
SET Rstousu=Server.CreateObject("Adodb.Recordset")
Strsqtousu="SELECT tousuName FROM [dd_tstyp] ORDER BY id ASC"
Rstousu.Open Strsqtousu,conn,1,1
IF NOT Rstousu.EOF AND NOT Rstousu.BOF THEN
toususelect=empty
DO WHILE NOT Rstousu.EOF
toususelect=toususelect&"<option value='"& Rstousu("tousuName") &"'>"& Rstousu("tousuName") &"</option>"
Rstousu.MoveNext
Loop
Rstousu.Close
SET Rstousu=Nothing
END IF
toususelect=toususelect
END Function
%>
<%
'=================================================
'过程名：ShowUserLogin
'作 用：显示用户登录表单
'参 数：无
'=================================================
sub ShowUserLogin()
dim strLogin
if session("user_id")="" then
strLogin="<table align='center' width='100%' border='0' cellspacing='0' cellpadding='0'>" & vbcrlf
strLogin=strLogin & "<form action='chkuser_login.asp' method='post' name='input' id='input' onsubmit=return(CheckInput())>" & vbcrlf
strLogin=strLogin & "<tr><td height='25' align='right'>用户名：</td><td height='25'><input name='username' type='text' id='username' size='14' maxlength='20'></td></tr>" & vbcrlf
strLogin=strLogin & "<tr><td height='25' align='right'>密 码：</td><td height='25'><input name='password' type='password' id='password' size='14' maxlength='20'></td></tr>" & vbcrlf
strLogin=strLogin & "<tr><td height='25' align='right'>验证码：</td><td height='25'><input name='getcode' type='text' id='getcode' size='4'> </a><img src='inc/Code.asp' alt='验证码,看不清楚?请点击刷新验证码' border='0' id='getcode' style='cursor : pointer;' onclick=this.src='inc/code.asp'></td></tr>" & vbcrlf
strLogin=strLogin & "<tr align='center'><td height='30' colspan='2'><input type='submit' name='Submit' value=' 登陆 '> <input name='Reset' type='reset' id='Reset' value=' 清除 '>" & vbcrlf
strLogin=strLogin & "<br><br><a href='UserReg.asp'>新用户注册</a> <a href='Getpws.asp'>忘记密码？</a><br></td>" & vbcrlf
strLogin=strLogin & "</tr></form></table>" & vbcrlf
response.write strLogin
Else
response.write "<div align='center'><br>欢迎您！" & session("User_Name") & "<br>"
response.write "<script src='myMessage.asp'></script><br>" & vbcrlf
response.write "<a href='user.asp'>进入控制面板</a><br><br>" & vbcrlf
response.write "<a href='UserLogout.asp'>【注销登录】</a></div>" & vbcrlf
end if
end sub%>
<%
'==================================================
'过程名：showtopbook
'作 用：显示最新留言
'参 数：m:显示的条数n:标题的最大长度
'==================================================
sub showtopbook(m,n)
set rs=conn.execute("select top "&m&" id,userid,title,date from dd_book where userid=0 and bookfont=1 order by id desc")
Response.Write"<table width='96%' border='0' align='center' cellspacing='0' cellpadding='0'>"
if rs.eof then
response.write"<tr> <td height='20' colspan='2' >暂时没有留言</td></tr>"
end if
do while not rs.eof
response.write"<tr> <td height='20' >·<a href=book.asp>"&left(rs("title"),n)&"</a></td><td height='20' width='78' ><p align='right'><font color='#FF0000'>[</font>"&rs("date")&"<font color='#FF0000'>]</font></td></tr>"
response.write"<tr> <td height='2' background='img/white_line.gif' colspan='2'></td></tr>"
rs.movenext
loop
rs.close
response.write"</table>"
end sub
%>
<%
'=================================================
'过程名：ShowFriendSite
'作 用：显示友情链接站点
'参 数：LinkType ----链接方式，1为LOGO链接，2为文字链接
' SiteNum ----最多显示多少个站点
' Cols ----分几列显示
' ShowType ----显示方式。1为向上滚动，2为横向列表，3为下拉列表框
'=================================================
sub ShowFriendSite(LinkType,SiteNum,Cols,ShowType)
dim sqlLink,rsLink,SiteCount,i,strLink
if LinkType<>1 and LinkType<>2 then
LinkType=1
else
LinkType=Cint(LinkType)
end if
if SiteNum<=0 or SiteNum>100 then
SiteNum=10
end if
if Cols<=0 or Cols>20 then
Cols=10
end if
if ShowType=1 then
strLink=strLink & "<marquee id='LinkScrollArea' direction='up' scrolldelay='50' scrollamount='1' width='100' height='100' onmouseover='this.stop();' onmouseout='this.start();'>"
elseif ShowType=3 then
strLink=strLink & "<select name='FriendSite' onchange=""if(this.options[this.selectedIndex].value!=''){window.open(this.options[this.selectedIndex].value,'_blank');}""><option value=''>友情文字链接站点</option>"
end if
if ShowType=1 or ShowType=2 then
strLink=strLink & "<table width='100%' cellSpacing='5'><tr align='center' class='tdbg'>"
end if
sqlLink="select top " & SiteNum & " * from dd_FriendSite where IsOK=True and LinkType=" & LinkType & " order by IsGood,id desc"
set rsLink=server.createobject("adodb.recordset")
rsLink.open sqlLink,conn,1,1
if rsLink.bof and rsLink.eof then
if ShowType=1 or ShowType=2 then
for i=1 to SiteNum
strLink=strLink & "<td><a href='FriendSiteReg.asp' target='_blank'>"
if LinkType=1 then
strLink=strLink & "<img src='images/logo.gif' width='88' height='31' border='0' alt='点击申请'>"
else
strLink=strLink & "点击申请"
end if
strLink=strLink & "</a></td>"
if i mod Cols=0 and i<SiteNum then
strLink=strLink & "</tr><tr align='center' class='tdbg'>"
end if
next
end if
else
SiteCount=rsLink.recordcount
for i=1 to SiteCount
if ShowType=1 or ShowType=2 then
if LinkType=1 then
strLink=strLink & "<td width='88'><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>"
if rsLink("LogoUrl")="" or rsLink("LogoUrl")="http://" then
strLink=strLink & "<img src='images/logo.gif' width='88' height='31' border='0'>"
else
strLink=strLink & "<img src='" & rsLink("LogoUrl") & "' width='88' height='31' border='0'>"
end if
strLink=strLink & "</a></td>"
else
strLink=strLink & "<td width='88'><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>" & rsLink("SiteName") & "</a></td>"
end if
if i mod Cols=0 and i<SiteNum then
strLink=strLink & "</tr><tr align='center' class='tdbg'>"
end if
else
strLink=strLink & "<option value='" & rsLink("SiteUrl") & "'>" & rsLink("SiteName") & "</option>"
end if
rsLink.moveNext
next
if SiteCount<SiteNum and (ShowType=1 or ShowType=2) then
for i=SiteCount+1 to SiteNum
if LinkType=1 then
strLink=strLink & "<td width='88'><a href='FriendSiteReg.asp' target='_blank'><img src='images/logo.gif' width='88' height='31' border='0' alt='点击申请'></a></td>"
else
strLink=strLink & "<td width='88'><a href='FriendSiteReg.asp' target='_blank'>点击申请</a></td>"
end if
if i mod Cols=0 and i<SiteNum then
strLink=strLink & "</tr><tr align='center' class='tdbg'>"
end if
next
end if
end if
if ShowType=1 or ShowType=2 then
strLink=strLink & "</tr></table>"
end if
if ShowType=1 then
strLink=strLink & "</marquee>"
elseif ShowType=3 then
strLink=strLink & "</select>"
end if
response.write strLink
rsLink.close
set rsLink=nothing
end sub
'=================================================
'过程名：ShowVote
'作 用：显示网站调查
'参 数：无
'=================================================
sub ShowVote()
dim sqlVote,rsVote,i
sqlVote="select top 1 * from dd_Vote where IsSelected=True"
Set rsVote= Server.CreateObject("ADODB.Recordset")
rsVote.open sqlVote,conn,1,1
if rsVote.bof and rsVote.eof then
response.Write " 没有任何调查"
else
response.write "<form name='VoteForm' method='post' action='vote.asp' target='_blank'>"
response.write " " & rsVote("Title") & "<br>"
if rsVote("VoteType")="Single" then
for i=1 to 8
if trim(rsVote("Select" & i) & "")="" then exit for
response.Write "<input type='radio' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
next
else
for i=1 to 8
if trim(rsVote("Select" & i) & "")="" then exit for
response.Write "<input type='checkbox' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
next
end if
response.write "<br><input name='VoteType' type='hidden'value='" & rsVote("VoteType") & "'>"
response.write "<input name='Action' type='hidden' value='Vote'>"
response.write "<input name='ID' type='hidden' value='" & rsVote("ID") & "'>"
response.write "<div align='center'>"
response.write "<a href='javascript:VoteForm.submit();'><img src='images/voteSubmit.gif' width='52' height='18' border='0'></a> "
response.write "<a href='Vote.asp?ID=" & rsVote("ID") & "&Action=Show' target='_blank'><img src='images/voteView.gif' width='52' height='18' border='0'></a>"
response.write "</div></form>"
end if
rsVote.close
set rsVote=nothing
end sub
%>
<%
Function GetShopZu(str)
Dim strsqGetShopZu,rsGetShopZu
strsqGetShopZu="Select Name From [dd_typ] where ID="&str
Set RsGetShopZu=conn.execute(strsqGetShopZu)
GetShopZu=RsGetShopZu("Name")
RsGetShopZu.Close
Set RsGetShopZu=Nothing
End Function
%>
<%
Function ShopSelect()
Dim StrsqShopSelect,RsShopSelect
SET RsShopSelect=Server.CreateObject("Adodb.Recordset")
StrsqShopSelect="SELECT ID,Name FROM [dd_typ] ORDER BY id ASC"
RsShopSelect.Open StrsqShopSelect,conn,1,1
IF NOT RsShopSelect.EOF AND NOT RsShopSelect.BOF THEN
ShopSelect=empty
DO WHILE NOT RsShopSelect.EOF
ShopSelect=ShopSelect&"<option value='"& RsShopSelect("id") &"'>"& RsShopSelect("Name") &"</option>"
RsShopSelect.MoveNext
Loop
RsShopSelect.Close
SET RsShopSelect=Nothing
END IF
ShopSelect=ShopSelect
END Function
%>
<%
Function top1(str)
IF str="0" Then
top1="<font color=#cccccc>店铺等级评定中...</font>"
ElseIF str="1" Then
top1="<img src=images/level/level1.gif width=16 height=16 border=0 alt=一星级店铺>"
ElseIF str="2" Then
top1="<img src=images/level/level2.gif width=34 height=16 border=0 alt=二星级店铺>"
ElseIF str="3" Then
top1="<img src=images/level/level3.gif width=51 height=16 border=0 alt=三星级店铺>"
ElseIF str="4" Then
top1="<img src=images/level/level4.gif width=67 height=16 border=0 alt=四星级店铺>"
ElseIF str="5" Then
top1="<img src=images/level/level5.gif width=84 height=16 border=0 alt=五星级店铺>"
End IF
top1=top1
End Function
sub MenuJS()
%>
<script language="JavaScript" type="text/JavaScript">
//下拉菜单相关代码
var h;
var w;
var l;
var t;
var topMar = 1;
var leftMar = -2;
var space = 1;
var isvisible;
var MENU_SHADOW_COLOR='#f1f1f1';//定义下拉菜单阴影色
var global = window.document
global.fo_currentMenu = null
global.fo_shadows = new Array
function HideMenu()
{
var mX;
var mY;
var vDiv;
var mDiv;
if (isvisible == true)
{
vDiv = document.all("menuDiv");
mX = window.event.clientX + document.body.scrollLeft;
mY = window.event.clientY + document.body.scrollTop;
if ((mX < parseInt(vDiv.style.left)) || (mX > parseInt(vDiv.style.left)+vDiv.offsetWidth) || (mY < parseInt(vDiv.style.top)-h) || (mY > parseInt(vDiv.style.top)+vDiv.offsetHeight)){
vDiv.style.visibility = "hidden";
isvisible = false;
}
}
}
function ShowMenu(vMnuCode,tWidth) {
vSrc = window.event.srcElement;
vMnuCode = "<table id='submenu' cellspacing=1 cellpadding=3 style='width:"+tWidth+"' class=menu onmouseout='HideMenu()'><tr height=23><td nowrap align=left class=MenuBody>" + vMnuCode + "</td></tr></table>";
h = vSrc.offsetHeight;
w = vSrc.offsetWidth;
l = vSrc.offsetLeft + leftMar+4;
t = vSrc.offsetTop + topMar + h + space-2;
vParent = vSrc.offsetParent;
while (vParent.tagName.toUpperCase() != "BODY")
{
l += vParent.offsetLeft;
t += vParent.offsetTop;
vParent = vParent.offsetParent;
}
menuDiv.innerHTML = vMnuCode;
menuDiv.style.top = t;
menuDiv.style.left = l;
menuDiv.style.visibility = "visible";
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?