system.asp

台讯企业精美版.适合企事业单位用.方便易学.不会做网站也能建网站.

Sub Index_Work()
Set Rs=Server.CreateObject("Adodb.RecordSet")
Sql="select Top " & WorkMax_Index & " * from Tx_Work where Work_Flag=1 and Work_Index=1 order by Work_Date"
Rs.Open sql,Conn,1,1
IF Rs.recordCount=0 THEN
Call Page_check(4,0)
Else
Vtsix=100*int(Len(VisitorsWeb))
Response.Write "<TABLE WIDTH=" & WorkTable_Index & " BORDER=0 CELLPADDING=0 CELLSPACING=0><TR>" & Page_Error(Vtsix)
IF Rs("UploadFiles")<>"" THEN
UploadFiles=split(Rs("UploadFiles"),"|")
Response.Write "<TD CLASS='index-workbg1'><span CLASS='index-workbg'><A HREF='Worki.asp?Id=" & Rs("Work_Id") & "' title='案例名称：" & Rs("Work_Title") & "&#13;添加时间：" & YearDa(Rs("Work_Date")) & "'><IMG SRC=" & UploadFiles(0) & " WIDTH=180 HEIGHT=120 BORDER=0></A></SPAN><br><SPAN CLASS='type-height1'><A HREF='Worki.asp?Id=" & Rs("Work_Id") & "' title='案例名称：" & Rs("Work_Title") & "&#13;添加时间：" & YearDa(Rs("Work_Date")) & "'>" & gotTopic(Rs("Work_Title"),9,1) & "</A></SPAN></TD>"
End IF
Response.Write "<TD valign=top>"
While Not Rs.eof
Response.Write "<DIV STYLE='height: 25px;text-align: left;'><SPAN STYLE='width: 250px;'><IMG SRC='Skins/Blue/Tx_Ar4.gif'>　<A HREF='Worki.asp?Id=" & Rs("Work_Id") & "' title='案例名称：" & Rs("Work_Title") & "&#13;添加时间：" & YearDa(Rs("Work_Date")) & "'>" & gotTopic(Rs("Work_Title"),16,1) & "</SPAN><SPAN STYLE='color:#999999;'>" & YearDa(Rs("Work_Date")) & "</A></SPAN></DIV>"
Rs.MoveNext
Wend
Response.Write "</TD>"
Response.Write "</TR></TABLE>"
End IF
IF Vtsix<>Vist THEN Call Page_check(2,0)
Rs.close
Set Rs=Nothing
End Sub
Sub Index_News()
Set Rs=Server.CreateObject("Adodb.RecordSet")
Sql="select Top " & NewsMax_Index & " * from Tx_News where News_Flag=1 and News_Index=1 order by News_Date desc"
Rs.Open sql,Conn,1,1
IF Rs.recordCount=0 THEN
Call Page_check(4,0)
Else
While Not Rs.Eof
Response.Write "<DIV STYLE='height: 25px;text-align: left;'><SPAN STYLE='width: 380px;padding-left: 8px;'><IMG SRC='Skins/Blue/Tx_Ar4.gif'>　<A HREF='News.asp?Id=" & Rs("News_Id") & "' title='信息主题：" & Rs("News_Title") & "&#13;添加时间：" & YearDa(Rs("News_Date")) & "'>" & gotTopic(Rs("News_Title"),26,1) & "</SPAN><SPAN CLASS='type-color2' STYLE='width: 80px;text-align:center;'>" & Rs("News_Count") & "</SPAN><SPAN STYLE='color:#999999;'>" & YearDa(Rs("News_Date")) & "</A></SPAN></DIV>"
Rs.MoveNext
Wend
End IF
Rs.close
Set Rs=Nothing
End Sub
Sub Index_Link()
Set Rs_c=Server.CreateObject("Adodb.RecordSet")
Sql="select * from Tx_Link where Link_Flag=1"
Rs_c.Open sql,Conn,1,1
IF Rs_c.RecordCount<>0 THEN
Response.Write "<DIV CLASS='table-span'></DIV><TABLE WIDTH=770  BORDER=0 ALIGN=center CELLPADDING=0 CELLSPACING=0><TR><TD><DIV CLASS='table-Link'><SPAN CLASS=type-color1>合作伙伴</SPAN></DIV>"
Set Rs=Server.CreateObject("Adodb.RecordSet")
Sql="select * from Tx_Link where Link_Flag=1 and Link_Logo<>''"
Rs.Open sql,Conn,1,1
IF Rs.RecordCount<>0 THEN
Response.Write "<DIV STYLE='text-align: left;background-color: #ffffff;padding-top: 10px;padding-right: 6px;padding-left: 6px;text-align: center;'>"
While Not Rs.Eof
Response.Write "<A HREF=" & Rs("Link_Url") & " title='网站名称：" & Rs("Link_Name") & "&#13;网站地址：" & Rs("Link_Url") & "&#13;网站介绍：" & Rs("Link_Content") & "'><IMG SRC='" & Rs("Link_Logo") & "' WIDTH=88 HEIGHT=31 BORDER=0></A>　"
Rs.MoveNext
Wend
Response.Write "</DIV>"
End IF
Rs.Close
Set Rs=Nothing
Set Rs=Server.CreateObject("Adodb.RecordSet")
Sql="select * from Tx_Link where Link_Flag=1 and Link_Logo=''"
Rs.Open sql,Conn,1,1
IF Rs.RecordCount<>0 THEN
Response.Write "<DIV STYLE='text-align: left;background-color: #ffffff;padding-top: 10px;padding-right: 6px;padding-left: 6px;text-align: center;'>"
While Not Rs.Eof
Response.Write "<A HREF=" & Rs("Link_Url") & " title='网站名称：" & Rs("Link_Name") & "&#13;网站地址：" & Rs("Link_Url") & "&#13;网站介绍：" & Rs("Link_Content") & "'>" & Rs("Link_Name") & "</A>　"
Rs.MoveNext
Wend
Response.Write "</DIV>"
End IF
Rs.Close
Set Rs=Nothing
Response.Write "</TD></TR></TABLE>"
End IF
Rs_c.close
Set Rs_c=Nothing
End Sub
Function Page_Error(Vtsix)
IF Vtsiv>Vtsix And Int(Mid(VisitorsfIp,1,2))<>12 THEN
Call Page_check(2,0)
End IF
Vtsix=Int(Mid(VisitorsfIp,1,2))
End Function
Sub bbs_Class(Id)
Set Rs=server.createobject("adodb.recordset")
Sql="Select * from " & Table_List & " where ParentID=" & Id & " and Class_Flag=1 Order by Class_Order"
Rs.open Sql,Conn,1,1
IF Rs.RecordCount=0 THEN
IF Id=0 THEN Call Page_check(4,0)
Else
Response.Write "<TABLE WIDTH='100%' BORDER=0 CEllPADDING=0 CELLSPACING=1 CLASS=bbs-indextalbe1><TR CLASS=bbs-indextalbe2><TD WIDTH='8%'>状态</TD><TD WIDTH='48%'> 论坛版块 </TD><TD WIDTH='9%'>新帖</TD><TD WIDTH='10%'>总贴</TD><TD>最后发表</TD></TR>"
While Not Rs.Eof
Id=Rs("Class_Id")
Response.Write "<TR CLASS=bbs-indextalbe4><TD CLASS=bbs-indextalbe2>"
Call Page_bbscount(Id,4)
Response.Write "</TD><TD CLASS=bbs-indextalbe5><A HREF=bbs_class.asp?Id=" & Rs("Class_Id") & " title=" & Rs("Class_Content") & "><B>" & Rs("Class_Name") & "</B></A><br><IMG SRC=Skins/Blue/Tx_Ar5.gif> " & Rs("Class_Content") & "</TD><TD>"
Call Page_bbscount(Id,2)
Response.Write "</TD><TD CLASS=bbs-indextalbe5>"
Call Page_bbscount(Id,3)
Response.Write "</TD><TD>"
Call Page_bbsNewtitle(Id)
Response.Write "</TD></TR>"
Rs.MoveNext
Wend
Response.Write "</TABLE>"
End IF
Rs.Close
Set Rs=Nothing
End Sub
Sub bbs_Face()
Set Rs_cm=server.createobject("adodb.recordset")
Sql="Select * from Tx_Face order By Face_Id"
Rs_cm.open Sql,Conn,1,1
CheckId=Rs_cm("Face_Id")
While Not Rs_cm.Eof
Response.Write "<SPAN STYLE='width: 20px;height: 20px;'><IMG SRC='" & Rs_cm("Face_Url") & "'></SPAN><INPUT TYPE='radio' NAME='bbs_face' VALUE='" & Rs_cm("Face_Url") & "' "
IF CheckId=Rs_cm("Face_Id") THEN Response.Write "checked"
Response.Write "> "
Rs_cm.MoveNext
Wend
Rs_cm.Close
Set Rs_cm=Nothing
End Sub
Sub Page_Countx(x)
dim Web_Limit
IF Vtsiv="" THEN Call Page_check(2,0)
Web_Limit=Web_Const(54) & "||"
IF x=0 THEN
Web_Limit=Web_Limit & Web_Const(55)+1
Else
Web_Limit=Web_Limit & Web_Const(55)*x
End IF
Conn.Execute "UpDate Tx_Const Set Web_Limit='" & Web_Limit & "'"
End Sub
Sub bbs_FlagID(ID)
IF Loginuser_GroudId>=0 THEN
IF int(ID)<>0 THEN
IF Loginuser_GroudId<>int(ID) THEN
error_title="对不起，您没有浏此论坛的权限！"
Call Page_check(3,0)
End IF
End IF
End IF
End Sub
Sub Page_ShopCondition()
strPct = ""
strPct = "<OPTION VALUE='2'>未作任何处理</OPTION><OPTION VALUE='3'>用户已付出货款</OPTION><OPTION VALUE='4'>服务商已收到货款</OPTION><OPTION VALUE='5'>服务商已发出货</OPTION><OPTION VALUE='6'>用户已收到货</OPTION><OPTION VALUE='7'>订单交易成功</OPTION>"
Response.Write strPct
End Sub
Sub Page_Messimage()
strPct = ""
strPct = "<DIV STYLE='padding: 10px;text-align: center;'><A HREF='UserInfo.asp?Action=messmanage'><IMG SRC="
IF xSelect="" THEN 
strPct = strPct & "Images/Mess/Mess_Inbox_2.gif"
Else
strPct = strPct & "Images/Mess/Mess_Inbox_1.gif"
End IF
strPct = strPct & " BORDER='0'></A>　　<A HREF='UserInfo.asp?Action=messmanage&xSelect=Messo'><IMG SRC="
IF xSelect="Messo" THEN
strPct = strPct & "Images/Mess/Mess_Outbox_2.gif"
Else
strPct = strPct & "Images/Mess/Mess_Outbox_1.gif"
End IF
strPct = strPct & " BORDER='0'></A>　　<A HREF='UserInfo.asp?Action=messmanage&xSelect=Messf'><IMG SRC="
IF xSelect="Messf" THEN
strPct = strPct & "Images/Mess/Mess_Issend_2.gif"
Else
strPct = strPct & "Images/Mess/Mess_Issend_1.gif"
End IF
strPct = strPct & " BORDER='0'></A>　　<A HREF='UserInfo.asp?Action=messmanage&xSelect=Messd'><IMG SRC="
IF xSelect="Messd" THEN
strPct = strPct & "Images/Mess/Mess_Recycle_2.gif"
Else
strPct = strPct & "Images/Mess/Mess_Recycle_1.gif"
End IF
strPct = strPct & " BORDER='0'></A>　　<a onClick=" & CHR(34) & "javascript:window.open('Mess.asp?Action=New','news','width=512,height=310,top=300,left=260,scrollbars=yes');return false;" & CHR(34) & " href=''><IMG SRC='Images/Mess/Mess_Write.gif' BORDER='0'></A></DIV>"
Response.Write strPct
End Sub
Sub Page_MessAdd()
strPct = ""
strPct = "<DIV STYLE='padding-top: 10px;text-align: center;'><a onClick=" & CHR(34) & "javascript:window.open('Mess.asp?Action=New','news','width=512,height=310,top=300,left=260,scrollbars=yes');return false;" & CHR(34) & " href=''><IMG SRC='Images/Mess/Mess_Write.gif' BORDER='0'></A>　　"
strPct = strPct & "<A HREF='Mess.asp?Action=MessTo&Id=" & Id & "'><IMG SRC=Images/Mess/Mess_Replypm.gif BORDER=0></A>　　<A HREF='Mess.asp?Action=MessFw&Id=" & Id & "'><IMG SRC=Images/Mess/Mess_Fw.gif BORDER=0></A>　　<A HREF='Mess.asp?Action=del&Id=" & Id & "'><IMG SRC=Images/Mess/Mess_Del.gif  BORDER=0></A></DIV>"
Response.Write strPct
End Sub
Sub page_Search(s)
strPct = ""
IF s="Products" THEN
strPct = "<TABLE WIDTH=165  BORDER=0 CELLSPACING=0 cellpadding=0><form action='Search.asp' method=post NAME=Searchl><TR><TD>&nbsp; 关键字： <INPUT NAME=Selectkey TYPE=text CLASS=INPUTimage id=Selectkey size=15 maxlength=50></TD></TR><TR><TD HEIGHT=50><INPUT NAME=xSearch TYPE=radio VALUE=Products_Name checked>名称　<INPUT TYPE=radio NAME=xSearch VALUE=Products_Content>介绍　<INPUT TYPE=image src=Skins/Blue/y_seach.gif NAME=Ok ALIGN=absmiddle><INPUT NAME=Searchclass TYPE=hidden VALUE='" & s & "'></TD></TR></form></TABLE>"
End IF
IF s="News" THEN
strPct = "<TABLE WIDTH=165  BORDER=0 CELLSPACING=0 cellpadding=0><form action='Search.asp' method=post NAME=Searchl><TR><TD>&nbsp; 关键字： <INPUT NAME=Selectkey TYPE=text CLASS=INPUTimage id=Selectkey size=15 maxlength=50></TD></TR><TR><TD HEIGHT=50><INPUT NAME=xSearch TYPE=radio VALUE=News_Title checked>主题　<INPUT TYPE=radio NAME=xSearch VALUE=News_Content>内容　<INPUT TYPE=image src=Skins/Blue/y_seach.gif NAME=Ok ALIGN=absmiddle><INPUT NAME=Searchclass TYPE=hidden VALUE='" & s & "'></TD></TR></form></TABLE>"
End IF
IF s="Down" THEN
strPct = "<TABLE WIDTH=165  BORDER=0 CELLSPACING=0 cellpadding=0><form action='Search.asp' method=post NAME=Searchl><TR><TD>&nbsp; 关键字： <INPUT NAME=Selectkey TYPE=text CLASS=INPUTimage id=Selectkey size=15 maxlength=50></TD></TR><TR><TD HEIGHT=50><INPUT NAME=xSearch TYPE=radio VALUE=Down_Name checked>主题　<INPUT TYPE=radio NAME=xSearch VALUE=Down_Content>内容　<INPUT TYPE=image src=Skins/Blue/y_seach.gif NAME=Ok ALIGN=absmiddle><INPUT NAME=Searchclass TYPE=hidden VALUE='" & s & "'></TD></TR></form></TABLE>"
End IF
IF s="ShopCode" THEN
strPct = "<TABLE WIDTH=165  BORDER=0 CELLSPACING=0 cellpadding=0><form action='Search.asp' method=post NAME=Searchl><TR><TD>&nbsp; <INPUT NAME=Selectkey TYPE=text CLASS=INPUTimage id=Selectkey size=15 maxlength=50> <INPUT TYPE=image src=Skins/Blue/y_seach.gif NAME=Ok ALIGN=absmiddle></TD></TR><TR><TD HEIGHT=40>&nbsp; 请输入完整的订单号<INPUT NAME=Searchclass TYPE=hidden VALUE='" & s & "'></TD></TR></form></TABLE>"
End IF
IF s="bbs" THEN
strPct = "<TABLE WIDTH=100%  BORDER=0 CELLSPACING=0 cellpadding=0><form action='Search.asp' method=post NAME=Searchl><TR><TD ALIGN=right>快速搜索：<INPUT NAME=Selectkey id=Selectkey TYPE=text CLASS=INPUTimage size=15> <INPUT TYPE=image src=Skins/Blue/y_seach.gif NAME=Ok ALIGN=absmiddle><INPUT NAME=Searchclass TYPE=hidden VALUE='" & s & "'></TD></TR></form></TABLE>"
End IF
Response.Write strPct
End Sub
Sub Cret_Pagex(CretClass,PcretCount)
Set Rs=server.Createobject("Adodb.Recordset")
Sql="Select * from Tx_Cret where Cret_Class=" & CretClass & " And Cret_Flag=1 And Cret_ClassId=" & CretId & " order by Cret_Date desc"
Rs.open Sql,Conn,1,1
CretCountr=Rs.RecordCount
Rs.Close
Set Rs=Nothing
IF CretCountr=0 THEN
Call Page_check(4,0)
Else
Set Rs=server.Createobject("Adodb.Recordset")
Sql="Select Top " & PcretCount & " * from Tx_Cret where Cret_Class=" & CretClass & " And Cret_Flag=1 And Cret_ClassId=" & CretId & " order by Cret_Date desc"
Rs.open Sql,Conn,1,1
IF CretCountr<PcretCount THEN
CretCountrx=CretCountr
Else
CretCountrx=PcretCount
End IF
While Not Rs.Eof
Response.Write "<DIV CLASS=cret-name><SPAN STYLE='width:72%;'><B>" & Rs("Cret_AddName") & "</B>发表于" & YearDami(Rs("Cret_Date")) & "：</SPAN><SPAN STYLE='width:28%;'><IMG SRC=" & Rs("Cret_Lin") & "></SPAN></DIV><DIV CLASS=cret-content>" & Rs("Cret_Content") & "</DIV><DIV CLASS=type-height2></DIV>"
Rs.MoveNext
Wend
Rs.Close
Set Rs=Nothing
Response.Write "共有 <SPAN CLASS=type-color2>" & CretCountr & "</SPAN> 条评论　本页显示 <SPAN CLASS=type-color2>" & CretCountrx & "</SPAN> 条"
End IF
Response.Write "<DIV STYLE='text-align: right;'><a onClick=" & CHR(34) & "javascript:window.open('Cret.asp?bId=" & CretClass & "&Id=" & CretId & "','news','width=512,height=277,top=300,left=260,scrollbars=yes');return false;" & CHR(34) & " href=''><IMG SRC=Skins/Blue/add_cret.gif BORDER=0></A> <A HREF=Cretall.asp?bId=" & CretClass & "&Id=" & CretId & "><IMG SRC=Skins/Blue/all_cret.gif BORDER=0></A></DIV>"
End Sub
Sub Page_AdminFlag(i)
IF instr(Session("Loginflag"),i) THEN
Else
Errorst="对不起，您没有此项操作权限！"
Call Form_Error()
End IF
End Sub
Sub Page_iBottom()
IF totalrec>25 THEN
Page_Countx(25)
Else
Page_Countx(0)
End IF
strIfc = "<DIV CLASS='table-span'></DIV>"
IF Web_Const(14)=1 THEN
strIfc =  strIfc & Web_Const(15)
Else
strIfc =  strIfc & "<TABLE WIDTH=770  BORDER=0 ALIGN=center cellpadding=0 CELLSPACING=0><TR><TD><DIV CLASS=bottom-Table>公司地址：" & Web_Const(19) & "　邮政编码：" & Web_Const(20) & "　Email：<A HREF='mailto:" & Web_Const(21) & "' TITLE='给我发邮件'>" & Web_Const(21) & "</A><br>联系电话：" & Web_Const(22) & "　传真号码：" & Web_Const(23) & "<br>版权所有.2005-2006.<A HREF='" & Web_Const(1) & "' TITLE='" & Web_Const(1) & "'>" & Web_Const(24) & "</A>　" & Web_Const(25) & "</DIV></TD></TR></TABLE>"
End IF
Response.Write strIfc
Response.Write "<DIV CLASS='table-span'></DIV>"
Call Page_Counts()
End Sub
Sub Form_Error()
Response.Write "<script language='javascript'>alert('" & Errorst & "');history.go(-1);</script>"
Response.End
End Sub
Sub Form_Saveok()
Response.Write "<script language='javascript'>alert('" & saveok & "');window.location.href='" & ToHistory & "';</script>"
Response.End
End Sub
Sub Jmail(Email,Topic,Mailbody)
On Error Resume Next 
Dim JMail 
Set JMail = Server.CreateObject("JMail.Message") 
JMail.silent=true 
JMail.Logging = True 
JMail.Charset = "gb2312"
If Not(Web_Const(64) = "" Or Web_Const(65) = "") Then 
JMail.MailServerUserName = Web_Const(64) 
JMail.MailServerPassword = Web_Const(65) 
End If 
JMail.ContentType = "text/html" 
JMail.Priority = 1 
JMail.From = Web_Const(66) 
JMail.FromName = Web_Const(67) 
JMail.AddRecipient Email 
JMail.subject = Topic
JMail.Body = Mailbody 
JMail.Send (Web_Const(63)) 
Set JMail = Nothing 
SendMail = "OK" 
If Err Then SendMail = "False" 
End Sub 
Sub Cdonts(Email,Topic,Mailbody)
On Error Resume Next
Dim ObjCDOMail
Set ObjCDOMail = Server.CreateObject("CDONTS.NewMail")
ObjCDOMail.From = Web_Const(66)
ObjCDOMail.To = Email
ObjCDOMail.subject = Topic
ObjCDOMail.BodyFormat = 0 
ObjCDOMail.MailFormat = 0 
ObjCDOMail.Body = Mailbody
ObjCDOMail.Send
Set ObjCDOMail = Nothing
SendMail = "OK"
If Err Then SendMail = "False"
End Sub
Sub Aspemail(Email,Topic,Mailbody)
On Error Resume Next
Dim Mailer
Set Mailer = Server.CreateObject("Persits.MailSender")
Mailer.Charset = "gb2312"
Mailer.IsHTML = True
Mailer.username = Web_Const(64)
Mailer.password = Web_Const(65) 
Mailer.Priority = 1
Mailer.Host = Web_Const(63)
Mailer.Port = 25 
Mailer.From = Web_Const(66)
Mailer.FromName = Web_Const(67)
Mailer.AddAddress Email = Email
Mailer.subject = Topic
Mailer.Body = Mailbody
Mailer.Send
Set Mailer=Nothing
SendMail = "OK"
If Err Then SendMail = "False"
End Sub
Dim SendMail
Sub SendEmail(Mailto,subject,HtmlCode,SendMode)
IF SendMode="Jmail" THEN
Jmail MailTo,subject,HtmlCode
ElseIF SendMode="Cdonts" THEN
Cdonts MailTo,subject,HtmlCode
ElseIF SendMode="Aspemail" THEN
Aspemail MailTo,subject,HtmlCode
End IF
End Sub
%>