pw_function.asp

网站代码

<%
Rem Pw_Sys 判断发言是否来自外部
function post_chk()
  dim server_v1,server_v2
  post_chk="no"
  server_v1=Request.ServerVariables("HTTP_REFERER")
  server_v2=Request.ServerVariables("SERVER_NAME")
  if mid(server_v1,8,len(server_v2))=server_v2 then post_chk="yes":exit function
end function

Rem Pw_Sys 把空格换成&nbsp和把换行换成<br>
function Pw_changstr(str)
str=Replace(str, Chr(32), "&nbsp;")'
str=Replace(str, vbCrLf, "<br>") '把换行换成<br>
response.Write(""&str&"")
end function

Rem Pw_Sys 日期格式转换函数
function DateTimeFormat(DateTime,Format) 
select case Format
case "1"
 DateTimeFormat=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日"
case "2"
 DateTimeFormat=""&month(DateTime)&"月"&day(DateTime)&"日"
case "3" 
 DateTimeFormat=""&year(DateTime)&"-"&month(DateTime)&"-"&day(DateTime)&""
case "4" 
 DateTimeFormat=""&year(DateTime)&"/"&month(DateTime)&"/"&day(DateTime)&""
case "5"
 DateTimeFormat=""&month(DateTime)&"/"&day(DateTime)&""
case "6"
 DateTimeFormat=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日<font color=red> "&FormatDateTime(DateTime,4)&"</font>"
case "7"
   temp="星期日,星期一,星期二,星期三,星期四,星期五,星期六"
   temp=split(temp,",") 
   DateTimeFormat=temp(Weekday(DateTime)-1)
case else
 DateTimeFormat=DateTime
end select
end function

%>
<%
Rem Pw_Sys 用户登陆调用
sub UserLogin() 
if Session("Pw_UserID")="" then 
response.write "<TABLE cellSpacing=0 cellPadding=4 width=160  align=center border=0>"& vbCrLf
response.write "  <FORM name=Loginform action=""Login.asp?Action=ChkLogin"" method=post>"& vbCrLf
response.write "  <TBODY>"& vbCrLf
response.write " <TR> "& vbCrLf
response.write "   <TD height=30>用户名：</TD>"& vbCrLf
response.write "   <TD height=30><input name=""Username"" type=""text"" class=""insert"" value="""" size=""12"" maxlength=""20""> "& vbCrLf
response.write "   </TD>"& vbCrLf
response.write " </TR>"& vbCrLf
response.write " <TR> "& vbCrLf
response.write "   <TD height=30>密　码：</TD>"& vbCrLf
response.write "   <TD height=30><INPUT name=""UserPass"" type=""password"" class=""insert"" id=""UserPass"" size=""12"" maxlength=""20""> "& vbCrLf
response.write "   </TD>"& vbCrLf
response.write " </TR>"& vbCrLf
response.write " <TR align=middle> "& vbCrLf
response.write "   <TD colSpan=2 height=30><div align=""center""> "& vbCrLf
response.write "<input type=""submit"" name=""Submit"" value=""登 陆"">&nbsp;"& vbCrLf
response.write "<input type=""button"" name=""Submit2"" value=""注 册"" onClick=""location.href='User_Reg.asp'"">"& vbCrLf
response.write " </div></TD>"& vbCrLf
response.write " </TR>"& vbCrLf
response.write "</FORM>"& vbCrLf
response.write "  </TABLE>"& vbCrLf

else 
  
response.write "<table width=""160"" border=""0"" align=""center"" cellpadding=""3"" cellspacing=""0"">"& vbCrLf
response.write "<tr><td width=""37%"" height=""21"" align=""right"">用户名：</td>"& vbCrLf
response.write "<td width=""63%"" height=""21"">"& vbCrLf
response.Write(Ucase(Session("Pw_Sys_User")))
response.write "</td></tr><tr> "& vbCrLf
response.write "<td height=""18""align=""right"">身&nbsp; 份：</td>"& vbCrLf
response.write "<td height=""18"">"& vbCrLf

select case Session("Grade")
case 0
response.write "普通会员"
case 1
response.write "VIP会员"
case 2
response.write "管理员"
end select

response.write "</td>"& vbCrLf
response.write "</tr>"& vbCrLf
response.write "<tr> "& vbCrLf
response.write "<td height=""18"" colspan=""2"" align=""center""> "& vbCrLf
response.write "<a href=Login.asp?Action=LoginOut>退出登陆</a> "& vbCrLf
response.write "&nbsp; <a href=User_Modify.asp>修改资料</a></td>"& vbCrLf
response.write "</tr>"& vbCrLf
response.write "</table> "& vbCrLf

end if
end sub

Rem Pw_Sys 定义滚动公告
Sub Marquee() 
response.write"<MARQUEE id=scrollarea onmouseover=this.stop(); onmouseout=this.start(); scrollAmount=1 scrollDelay=10 width=600 height=20>"
set rs=server.createobject("adodb.recordset")
sql="select top 1 * from announce where marquee=1 ORDER BY id DESC"
rs.open sql,conn,1,1
if Rs.eof or Rs.bof then
response.write "还没有任何滚动公告..."
else
response.write rs("Content")
end if
response.write "</MARQUEE>"
Rs.close
set Rs=nothing
End sub
%>
<SCRIPT language=JavaScript> 
//双击滚屏
var currentpos,timer; 

function initialize() 
{ 
timer=setInterval("scrollwindow()",30); 
} 
function sc(){ 
clearInterval(timer); 
} 
function scrollwindow() 
{ 
currentpos=document.body.scrollTop; 
window.scroll(0,++currentpos); 
if (currentpos != document.body.scrollTop) 
sc(); 
} 
document.onmousedown=sc 
document.ondblclick=initialize 
</script><NOSCRIPT><IFRAME SRC=*.html></IFRAME></NOSCRIPT>
<%
Rem Pw_Sys 网站统计
sub SiteCount()
	set rscount=server.createobject("adodb.recordset")
	
	sqlCount="select Count(ID) from Info"
	rsCount.open sqlCount,conn,1,1
	response.write "信息总数：" & rsCount(0) & "条<br>"
	rsCount.close

	sqlCount="select sum(Hits) from Info"
	rsCount.open sqlCount,conn,1,1
	response.write "信息浏览：" & rsCount(0) & "次<br>"
	rsCount.close
	
	sqlCount="select Count(ID) from sort"
	rsCount.open sqlCount,conn,1,1
	response.write "栏目分类：" & rsCount(0) & "个<br>"	
	rsCount.close
		
	sqlCount="select sum(Hit) from sort"
	rsCount.open sqlCount,conn,1,1
	response.write "栏目浏览：" & rsCount(0) & "次<br>"	
	rsCount.close
	
	sqlCount="select count(ID) from words"
	rsCount.open sqlCount,conn,1,1
	response.write "留言条数：" & rsCount(0) & "条<br>"	
	rsCount.close
			
	set rsCount=nothing
end sub

Rem Pw_Sys 网站调查
sub Ew_FlashVote()
response.write "<IFRAME ID=""vote"" SRC=""Vote/index.htm"" FRAMEBORDER=""0"" SCROLLING=""no"" WIDTH=""190"" HEIGHT=""180""></IFRAME> "& vbCrLf
end sub

Rem Pw_Sys 网站搜索
Sub Ew_ShowSearch()
response.write "<table width=""100%"" border=""0"" cellspacing=""3"" cellpadding=""2"">"& vbCrLf
response.write "<form name=""form1"" method=""post"" action=""search.asp""><tr> "& vbCrLf
response.write "<td height=""32"" colspan=""2"" align=""right"">本站搜索： "& vbCrLf
response.write "<input name=""txtitle"" type=""text"" class=""insert"" id=""txtitle"" size=""13"">&nbsp;&nbsp; </td>"& vbCrLf
response.write "</tr><tr> "& vbCrLf
response.write "<td width=""49%""align=""right"">"& vbCrLf
response.write "<input type=""submit"" value=""查 询"" name=""title2"" class=""buttonface""></td>"& vbCrLf
response.write "<td width=""51%"" align=""center"">"& vbCrLf
response.write "<input type=""reset"" name=""Submit3"" value=""清 除""></td>"& vbCrLf
response.write "</tr></form></table>"& vbCrLf
End sub

Call WriteCopyRight()
Rem Ew_Sys 版式权
function WriteCopyRight()
response.write "<!--"& vbCrLf
response.write "* 个人版：300元 商业版：500元 "& vbCrLf
response.write "* 演 示：http://Demo.wenday.com"& vbCrLf
response.write "* 版本：网站信息引擎_Engine_WenDay Ver 2.0 正式版FOR_FREE"& vbCrLf
response.write "* 版权 所有: 一奔网 络工作室(Wenday.Com)"& vbCrLf
response.write "* 联 系QQ: 42367091"& vbCrLf
response.write "* Email:[e-mail]"& vbCrLf
response.write "* 程序开发: Wenday"& vbCrLf
response.write "-->"& vbCrLf
End Function

Rem Pw_Sys 栏目的显示
Sub Ew_ShowSort()
response.write "<table width=""90%"" border=""0"" align=""center"" cellpadding=""1"" cellspacing=""1"">"& vbCrLf
Set Rs=conn.execute("select * from Sort where B_id=0 and setting order by S_order")
if Rs.eof and Rs.bof then
response.write "还没有任何栏目"
else
do while not Rs.eof
set names=rs("names")
set id=rs("id")
response.write "<tr><td colspan=""2""><img src=""Img/02_1.gif"" width=""12"" height=""9"">"& vbCrLf
response.write "<a href=Sort.asp?SortID="&ID&">"&names&"</a>"
response.write "</td></tr><tr> "& vbCrLf
if Rs("Setting")<5  and Rs("Setting")<>3 then
Set RsClass=Conn.Execute("Select * from Sort where B_ID="& Rs("ID") &" order by S_Order")
do while not RsClass.eof
response.write "<tr><td width=""36%"" align=""right""><img src=""Img/icon.gif"" width=""12"" height=""11"" align=""absmiddle""></td>"& vbCrLf
response.write "<td width=""64%"">"& vbCrLf
response.write "<a href='Class.asp?ClassID="&trim(RsClass("ID"))&"'>"&trim(RsClass("Names"))&"</a>"
response.write "</td></tr><tr> "& vbCrLf
RsClass.movenext
loop
RsClass.close
set RsClass=nothing
end if 
Rs.movenext
loop  
end if  
Rs.close  
set Rs=nothing
response.write "</table>"& vbCrLf
End sub

Rem Pw_Sys 信息条的显示
Function Ew_ShowInfo(s_num,nums,Linenum,S_info,Show_date)
response.write "<table width=""100%"" height=""21"" border=""0"" align=""center"" cellpadding=""1"" cellspacing=""2"">"& vbCrLf
Select case s_num
	case 1 '热门
InfoSql="select top "&nums&" * from Info order by hits desc,ID desc"
	case 2 '新信息
InfoSql="select top "&nums&" * from Info order by order by AddDate desc,ID desc"
	case 3 '大类热门
InfoSql="select top "&nums&" * from Info where Sort1="&S_info&" order by hits desc,ID desc"
	case 4 '小类热门
InfoSql="select top "&nums&" * from Info where Sort2="&S_info&" order by hits desc,ID desc"
	case 5 '大类
InfoSql="select top "&nums&" * from Info where Sort1="&S_info&" order by AddDate desc,ID desc"
	case 6 '小类
InfoSql="select top "&nums&" * from Info where Sort2="&S_info&" order by AddDate desc,ID desc"
	Case else   '其它
InfoSql="select top "&nums&" * from Info order by hits desc"
End Select

Set InfoRs=Conn.Execute(InfoSql)
if InfoRs.eof or InfoRs.bof then
response.write"<tr><td align='center'>没有信息...</td></tr>"
end if 
while not Infors.eof 
set title=Infors("title")
set id=Infors("id")
response.write "<tr><td width=""8%""align=""right""><img src=""Img/icon.gif"" width=""12"" height=""11"" align=""absmiddle""></td><td width=""92%"">"& vbCrLf
response.write "<a href='ViewInfo.asp?id="&id&"'title='"&title&"'>"
if len(title)>Linenum then
response.write ""&Left(title,Linenum-2)&""
response.write "..."
else
response.write ""&title&""
end if
if Show_date=1 then 
response.write "&nbsp;&nbsp;"
response.write DateTimeFormat(Infors("AddDate"),3)
End if
response.write "</a></td></tr>"
Infors.movenext  
wend
Infors.close
set Infors=nothing
response.write "</table>"
End Function

Function NoPic(Ew_DisInfo)
response.write "<table width=""100"" border=""0"" align=""center"" cellpadding=""3"" cellspacing=""3""><tr> "& vbCrLf
response.write "<td><img src=""Img/nopic.gif"" border=""0""></td>"& vbCrLf
response.write "</tr><tr><td height=""18"">"& vbCrLf
response.write "<div align=""center"">"&Ew_DisInfo&"</div></td>"& vbCrLf
response.write "</tr></table>"& vbCrLf
End Function

Function Ew_ShowPic(Ew_Pic,Ew_InfoID,Ew_Title,Ew_With,Ew_Height,Ew_long)
response.write "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0""><tr><td>"& vbCrLf

response.write "<TABLE width=""136"" border=0 align=center cellPadding=0 cellSpacing=0>"& vbCrLf
response.write "<TR><TD height=8><IMG height=8 src=""Images/table/bg_0ltop.gif"" width=8></TD>"& vbCrLf
response.write "<TD background=Images/table/bg_01.gif height=8></TD>"& vbCrLf
response.write "<TD height=8><IMG height=8 src=""Images/table/bg_0rtop.gif"" width=8></TD></TR>"& vbCrLf
response.write "<TR><TD width=8 background=Images/table/bg_03.gif></TD>"& vbCrLf
response.write "<TD width=""120"" height=""90"" align=""center"" bgColor=#ffffff><a href=ViewInfo.asp?id="&Ew_InfoID&" Title='"&Ew_Title&"'><img src="&Ew_Pic&" border=0 width="&Ew_With&" height="&Ew_Height&" ></a></TD>"& vbCrLf
response.write "<TD width=8 background=Images/table/bg_04.gif></TD>"& vbCrLf
response.write "</TR><TR><TD height=8><IMG height=8 src=""Images/table/bg_0lbottom.gif"" width=8></TD>"& vbCrLf
response.write "<TD background=Images/table/bg_02.gif height=8></TD>"& vbCrLf
response.write "<TD height=8><IMG height=8 src=""Images/table/bg_0rbottom.gif"" width=8></TD>"& vbCrLf
response.write "</TR></TABLE>"& vbCrLf

response.write "</td></tr><tr><td align=center height=18>"& vbCrLf

response.write "<a href=ViewInfo.asp?id="&Ew_InfoID&" title='"&Ew_Title&"'>"
if len(Ew_Title)>Ew_long then
response.write Left(Ew_Title,Ew_long-2)
response.write "..."
else
response.write Ew_Title
end if
response.write "</a>"

response.write "</td></tr></table>"& vbCrLf
End Function

Function Ew_ShowTopPic(Top_num)
response.write "<TABLE cellSpacing=5 cellPadding=0 width=""100%"" align=center border=0><TBODY><TR vAlign=top>"& vbCrLf
sql="select  top "&Top_num&" * from Info where Ispic=1 and Pw_Good=True ORDER BY AddDate DESC,ID desc"
Set Rstop=conn.execute(Sql)
if Rstop.eof or Rstop.bof then
Call NoPic("无推荐图文信息")
end if
do while not Rstop.eof 
response.write "<TD height=82 align=middle>"
 Call Ew_ShowPic(Rstop("Pic"),Rstop(0),Rstop("Title"),121,98,18) 
response.write "</TD>"
Rstop.movenext  
loop
response.write "</TR></TBODY></TABLE>"
Rstop.close
set Rstop=nothing
End Function

Rem 单页信息 'BSetting=5 CSetting=3
Function Ew_OnlyPage(Page_T,Page_C)
response.write "<TABLE cellSpacing=0 cellPadding=0 width=""100%"" align=center border=0><TR>"& vbCrLf
response.write "<TD align=middle width=55 background=Img/homedhbg.gif height=34><img src=""Img/tp.gif"" width=""55"" height=""34""></TD>"& vbCrLf
response.write "<TD width=""459"" background=Img/homedhbg.gif align=""center"">"& vbCrLf
response.write "<strong>"&Page_T&"</strong>"
response.write "</TD><TD width=""78"" background=Img/homedhbg.gif>&nbsp;</TD>"& vbCrLf
response.write "</TR><TR><TD height=34 colspan=""3"" align=middle>"& vbCrLf
response.write "<table width=""100%"" border=""0"" cellspacing=""4"" cellpadding=""8""><tr><td height=""185"" valign=""top"">"& vbCrLf
response.write Page_C
response.write "</td></tr></table>"& vbCrLf
response.write "</TD></TR></TABLE>"& vbCrLf
End Function

%>