<% On Error Resume Next Response.Charset="GB2312" Dim sRights,iUA_Type,sUI_Path,LsObject,conn,rs,connstr,DBType,OType Sub NoCache() response.Expires = -1 response.AddHeader "Pragma","no-cache" response.AddHeader "cache-control","no-store" End Sub Sub NoOpenWin() Response.write "" End Sub Sub IsUser() If sRights = "" Then Response.Write "" Response.End() End If End Sub Function Permission(userrights) If instr(session("UA_Rights"),"|0|") > 0 Then Permission = True Else Permission = False Dim x,scwords scwords = split(userrights,",") For x = 0 to UBound(scwords) If instr(sRights,scwords(x)) > 0 Then Permission = True Exit For End If Next End If End Function Sub DBConnBegin() set conn = Server.CreateObject("Adodb.Connection") set rs = Server.CreateObject("Adodb.Recordset") If Application("DBType") = "1" Then DBType = 1 OType = "" Else DBType = 2 OType = " desc" End If End Sub Sub DBConnEnd() set rs = nothing set conn = nothing End Sub Sub OutScript(str) Response.Write "" Response.End() End Sub Sub OutScriptNoBack(str) Response.Write "" Response.End() End Sub Function GetSafeStr(str) ' str = Trim(str) ' str = Replace(str,"'","") ' str = Replace(str,";","") ' str = Replace(str,",","") ' str = Replace(str,"!!","") ' str = Replace(str,Chr(34),"") ' str = Replace(str,">",">") ' str = Replace(str,"<","<") ' GetSafeStr = str dim Sql_Kill,Sql_Kill_2,Sql_Kill_3 Sql_Kill = "\'|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare|set|;|from|=|where" Sql_Kill_2 = split(Sql_Kill,"|") for Each Sql_Kill_3 In Sql_Kill_2 str=Replace(str,Sql_Kill_3,"") Next str=str str = Trim(str) str = Replace(str,"'","") str = Replace(str,";","") str = Replace(str,",","") str = Replace(str,"!!","") str = Replace(str,Chr(34),"") str = Replace(str,">",">") str = Replace(str,"<","<") GetSafeStr = str End Function Function IsSafeStr(str) Dim s_BadStr, n, i s_BadStr = "'  &<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32) n = Len(s_BadStr) IsSafeStr = True For i = 1 To n If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then IsSafeStr = False Exit Function End If Next End Function '=====清除HTML标签函数 Function ClearHTML(strHTML) Dim objRegExp, Match, Matches Set objRegExp = New Regexp objRegExp.IgnoreCase = True objRegExp.Global = True objRegExp.Pattern = "<.+?>" Set Matches = objRegExp.Execute(strHTML) For Each Match in Matches strHtml=Replace(strHTML,Match.Value,"") Next LhyClearHTML=strHTML Set objRegExp = Nothing End Function Function strLen(Str) If Trim(Str)="" Or IsNull(str) Then strlen=0 Else Dim P_len,x P_len=0 StrLen=0 P_len=Len(Trim(Str)) For x=1 To P_len If Asc(Mid(Str,x,1))<0 Then StrLen=Int(StrLen) + 2 Else StrLen=Int(StrLen) + 1 End If Next End if End Function Function CutStr(Str,LenNum) Dim P_num Dim I,X If StrLen(Str)<=LenNum Then Cutstr=Str Else P_num=0 X=0 Do While Not P_num > LenNum-2 X=X+1 If Asc(Mid(Str,X,1))<0 Then P_num=Int(P_num) + 2 Else P_num=Int(P_num) + 1 End If Cutstr=Left(Trim(Str),X-1)&"..." Loop End If End Function Function IsObjInstalled(strClassString) IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function Function FsoStr() FsoStr = "Scripting."&FsoAddStr&"FileSystemObject" End Function Function FsoStat() If IsObjInstalled(FsoStr()) = False Then FsoStat = False Else FsoStat = True End If End Function '================================================ '读取站点ID '================================================ Function ReadSiteID(sid) sql = "select SS_SiteID from SiteStructure where SS_ID=" & sid Set trs = LsObject.CreateRs(sql,1,1) If not trs.eof Then ReadSiteID = trs("SS_SiteID") End If trs.close End Function '================================================ '检测并创建路径 '================================================ Sub CreatePutPath(PathStr) Fso = "Scripting."&FsoAddStr&"FileSystemObject" Set MyFileObject = Server.CreateObject(Fso) If MyFileObject.FolderExists(Server.Mappath(PathStr)) = False Then Dim thispath,sthispath ArPathStr = Split(PathStr,"/") For x = 0 to UBound(ArPathStr) If ArPathStr(x) <> "" Then thispath = thispath & "/" & ArPathStr(x) sthispath = Server.Mappath(thispath) If MyFileObject.FolderExists(sthispath) = False Then MyFileObject.CreateFolder sthispath End If Next End If Set MyFileObject = Nothing End Sub Function DocNum() sql = "select count(d_ID) as DocNum from DocContents where d_Type=2 and UA_ID=" & Session("UA_ID") Set rs = LsObject.CreateRs(sql,1,1) DocNum = rs("DocNum") rs.close End Function Function DocCheckNum() sql = "select count(d_ID) as DocNum from DocContents where d_CheckIn<>0 and d_Type=2 and UA_ID=" & Session("UA_ID") Set rs = LsObject.CreateRs(sql,1,1) DocCheckNum = rs("DocNum") rs.close End Function Function DocSharingNum() sql = "select count(d_ID) as DocNum from DocContents where d_Sharing<>0 and d_Type=2 and UA_ID=" & Session("UA_ID") Set rs = LsObject.CreateRs(sql,1,1) DocSharingNum = rs("DocNum") rs.close End Function Function TodayDocNum() If DBType = 1 Then sql = "select count(d_ID) as TodayDocNum from DocContents where d_Type=2 and d_Date=#"&Date()&"# and UA_ID=" & Session("UA_ID") Else sql = "select count(d_ID) as TodayDocNum from DocContents where d_Type=2 and d_Date='"&Date()&"' and UA_ID=" & Session("UA_ID") End If Set rs = LsObject.CreateRs(sql,1,1) TodayDocNum = rs("TodayDocNum") rs.close End Function Function MailOutNum() sql = "select count(MO_ID) as MailOutNum from MailOutBox where MO_Type=2 and MO_FromID=" & Session("UA_ID") Set rs = LsObject.CreateRs(sql,1,1) MailOutNum = rs("MailOutNum") rs.close End Function Function MailDarftNum() sql = "select count(MO_ID) as MailDarftNum from MailOutBox where MO_Type=1 and MO_FromID=" & Session("UA_ID") Set rs = LsObject.CreateRs(sql,1,1) MailDarftNum = rs("MailDarftNum") rs.close End Function Function MailRefuseNum() sql = "select count(MI_ID) as MailRefuseNum from MailInBox where MI_Delete<>0 and UA_ID=" & Session("UA_ID") Set rs = LsObject.CreateRs(sql,1,1) MailRefuseNum = rs("MailRefuseNum") rs.close End Function Function MailInNum() sql = "select count(MI_ID) as MailInNum from MailInBox where MI_Read=0 and UA_ID=" & Session("UA_ID") Set rs = LsObject.CreateRs(sql,1,1) MailInNum = rs("MailInNum") rs.close End Function Function OnLinePeople(SS_ID) If DBType = 1 Then sql = "select Count(SS_ID) as SS_ID from EventsIP where SS_ID="&SS_ID&" and DateDiff('s',EI_LastTime,NOW())<600" Else sql = "select Count(SS_ID) as SS_ID from EventsIP where SS_ID="&SS_ID&" and DateDiff(s,EI_LastTime,{ fn NOW() })<600" End If Set rs = LsObject.CreateRs(sql,1,1) OnLinePeople = rs("SS_ID") rs.close End Function Function InterActiveNum(SS_ID,IS_ID,RevertIS) sql = "select count(I_ID) as IDcount from InteractiveInfo where I_ShowIs<>1 " If SS_ID<>"" And IsNumeric(SS_ID) Then sql = sql &" and SS_ID=" &SS_ID& "" If IS_ID<>"" And IsNumeric(IS_ID) Then sql = sql &" and IS_ID=" &IS_ID& "" If RevertIS<>"" And IsNumeric(RevertIS) Then sql = sql &" and I_RevertIS=" &RevertIS& "" Set rs = LsObject.CreateRs(sql,1,1) InterActiveNum = rs("IDcount") rs.close End Function '================================================ 'GB2312L转换,用于解决AJAX 输出乱码问题 '================================================ Function escape(str) dim i,s,c,a s="" For i=1 to Len(str) c=Mid(str,i,1) a=ASCW(c) If (a>=48 and a<=57) or (a>=65 and a<=90) or (a>=97 and a<=122) Then s = s & c ElseIf InStr("@*_+-./",c)>0 Then s = s & c ElseIf a>0 and a<16 Then s = s & "%0" & Hex(a) ElseIf a>=16 and a<256 Then s = s & "%" & Hex(a) Else s = s & "%u" & Hex(a) End If Next escape = s End Function Function unescape(str) dim i,s,c s="" For i=1 to Len(str) c=Mid(str,i,1) If Mid(str,i,2)="%u" and i<=Len(str)-5 Then If IsNumeric("&H" & Mid(str,i+2,4)) Then s = s & CHRW(CInt("&H" & Mid(str,i+2,4))) i = i+5 Else s = s & c End If ElseIf c="%" and i<=Len(str)-2 Then If IsNumeric("&H" & Mid(str,i+1,2)) Then s = s & CHRW(CInt("&H" & Mid(str,i+1,2))) i = i+2 Else s = s & c End If Else s = s & c End If Next unescape = s End Function Public Function GetDateCode(ByVal sDate,ByVal sMode) Dim sReturn If Not IsDate(sDate) Or IsNull(sDate) Then sDate = Now() sReturn=Year(sDate) & Right("0" & Month(sDate),2) & Right("0" & Day(sDate),2) select Case sMode Case "1" sReturn=sReturn & Right("0" & Hour(sDate),2) Case "2" sReturn=sReturn & Right("0" & Hour(sDate),2) & Right("0" & Minute(sDate),2) Case "3" sReturn=sReturn & Right("0" & Hour(sDate),2) & Right("0" & Minute(sDate),2) & Right("0" & Second(sDate),2) Case "4" sReturn = Year(sDate) &"-"& Right("0" &"-"& Month(sDate),2) &"-"& Right("0" & Day(sDate),2) Case "5" sReturn = Year(sDate) &"/"& Right("0" &"/"& Month(sDate),2) &"/"& Right("0" & Day(sDate),2) Case "6" sReturn = Year(sDate) & Right("0" & Month(sDate),2) & Right("0" & Day(sDate),2) End select GetDateCode=sReturn End Function Sub EventsUser(EU_Description) If EU_Description = "" Then Exit Sub sql = "select * from EventsUser order by EU_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If rs.eof Then EU_ID = 1 Else EU_ID = rs("EU_ID") + 1 End If rs.addnew rs("EU_ID") = EU_ID rs("EU_Date") = Date() rs("EU_Time") = Time() rs("UA_ID") = Session("UA_ID") rs("UA_Name") = Session("UA_Name") rs("EU_RemoteIP") = Request.ServerVariables("REMOTE_ADDR") rs("EU_Description") = EU_Description rs.update rs.close End Sub Function Rightscheck(ritem) IF instr(session("UA_Rights"),"|0|")>0 THEN Rightscheck = True ELSE If Instr(session("UA_Rights"),"|"&ritem&"|") > 0 Then Rightscheck = True Else Rightscheck = False End If END IF End Function Public Function GetRandom() Randomize GetRandom = Round(Rnd * (99999999 - 10000000 + 1) - 0.5) + 10000000 End Function Function sNull(Str) If Str = "" Or IsNull(Str) Or Str = Empty Then sNull = "" Else sNull = Str End If End Function Function GetPublicModule() GetPublicModule="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107" End Function '初始化 '======================================================================================================================= sRights = Session("UA_Rights") '[String] iUA_Type = Session("UA_Type") '[Integer] sUI_Path = Session("UI_Path") '[String] Set LsObject = Server.CreateObject("Lonsun3_0.LonsunCode") If Err <> 0 Then Response.write "
Lonsun3_0.dll Unregistered!
" Response.End() End If Call DBConnBegin() If Session("DBOK") = "" Then Set Conn = LsObject.CreateConn() If Err <> 0 Then Response.write "
Database connect failed!
数据库连接失败!
" conn.close Response.End() End If conn.close Session("DBOK") = "True" End If '通过构造出的数据库连接字符串,得到数据库中的数据表名的函数 Function GetTable(StrConn) Dim dataconn Set dataconn = Server.CreateObject("ADODB.CONNECTION") dataconn.Open StrConn Dim rstSchema Set rstSchema = dataconn.OpenSchema(20) Dim tableList tableList = "" Do while not rstSchema.EOF If rstSchema("TABLE_TYPE") = "TABLE" Then If Left(rstSchema("TABLE_NAME"), 1) <> "~" Then tableList = tableList&"|"&rstSchema("TABLE_NAME") End If End If rstSchema.MoveNext Loop rstSchema.Close dataconn.Close GetTable = tableList End Function '通过构造出的数据库连接字符串和表名,得到表中所有字段的函数 Sub GetFields(StrConn,TableName) Dim dataconn,rstSchema Set dataconn = Server.CreateObject("ADODB.CONNECTION") Set rstSchema = Server.CreateObject("ADODB.RECORDSET") dataconn.Open StrConn sql = "select * from "&TableName&"" rstSchema.open sql,dataconn,1,1 j = rstSchema.Fields.count FieldLists="" FieldTypes="" For i = 0 to j-1 FieldLists = FieldLists&"|"&rstSchema.Fields(i).Name FieldTypes = FieldTypes&"|"&rstSchema.Fields(i).Type Next rstSchema.Close dataconn.Close End Sub Function GetStrConn(DB_Type,DB_FILE,DB_ADDR,DB_NAME,DB_USER,DB_PWD) If DB_TYPE = "Excel" Then GetStrConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";Data Source=" & Server.MapPath(DB_FILE) & ";" End If If DB_TYPE = "ACCESS" Then GetStrConn = "provider=microsoft.jet.oledb.4.0;data source="&Server.MapPath(DB_FILE)&";user id="&DB_USER&";password="&DB_PWD&";" End If If DB_TYPE="SQL Server" Then GetStrConn = "PROVIDER=SQLOLEDB;Data Source="&DB_ADDR&";Initial Catalog="&DB_NAME&";User ID="&DB_USER&";Password="&DB_PWD&";" END IF End Function '追加查询条件 Function TypeName(DB_Type,FName,FValue,num) If DB_Type = "ACCESS" or DB_Type = "Excel" Then Select Case num Case 3,6,11 If IsNumeric(FValue) = False Then Response.Write("查询类型不匹配!"):Response.End TypeName = " and "&FName&"="&FValue Case 7 TypeName = " and "&FName&"=#"&FValue&"#" Case 5,202,203,205 TypeName = " and "&FName&" like '%"&FValue&"%'" End Select End If If DB_Type = "SQL Server" Then Select Case num Case 2,3,4,5,11,12,17,20,72,131 If IsNumeric(FValue) = False Then Response.Write("查询类型不匹配!"):Response.End TypeName = " and "&FName&"="&FValue Case 6,128,129,130,135,200,201,202,203,204,205 TypeName = " and "&FName&" like '%"&FValue&"%'" End Select End If End Function function ajaxStr(value) ajaxStr=""""&Replace(value,"""","\""""")&"""" end function function GetClassName(value) select case value case 1 GetClassName="所在区域" case 2 GetClassName="行业名称" case 3 GetClassName = "文化程度" case 4 GetClassName = "婚姻状态" case 5 GetClassName = "工作经验" case 6 GetClassName = "公司性质" case 7 GetClassName = "员工人数" end select end function Function overHTML(str) Dim sTemp sTemp = str overHTML = "" If IsNull(sTemp) = True or sTemp="" Then Exit Function End If sTemp = Replace(sTemp, "
", "") ' sTemp = Replace(sTemp, """, Chr(34)) '有这一行的话,在文本框中不显示内容了. sTemp = Replace(sTemp, " ", " ") sTemp = Replace(sTemp, "'", "'") sTemp = Replace(sTemp, ">", ">") sTemp = Replace(sTemp, "<", "<") sTemp = Replace(sTemp, "1copy1;", "©") sTemp = Replace(sTemp, "&", "&") overHTML = sTemp End Function '================================================ '作 用:检查组件是否已经安装 '参 数:strClassString ----组件名 '返回值:True ----已经安装 ' False ----没有安装 '================================================ Function IsObjInstalled(strClassString) On Error Resume Next IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function '判断是否是图片 'filename:完整路径 '返回:True 是图片 function CheckFileType(filename) const adTypeBinary=1 dim jpg(1):jpg(0)=CByte(&HFF):jpg(1)=CByte(&HD8) dim bmp(1):bmp(0)=CByte(&H42):bmp(1)=CByte(&H4D) dim png(3):png(0)=CByte(&H89):png(1)=CByte(&H50):png(2)=CByte(&H4E):png(3)=CByte(&H47) dim gif(5):gif(0)=CByte(&H47):gif(1)=CByte(&H49):gif(2)=CByte(&H46):gif(3)=CByte(&H39):gif(4)=CByte(&H38):gif(5)=CByte(&H61) CheckFileType=false dim fstream,fileExt,stamp,i fileExt=mid(filename,InStrRev(filename,".")+1) set fstream=Server.createobject("ADODB.Stream") fstream.Open fstream.Type=adTypeBinary fstream.LoadFromFile filename fstream.position=0 On Error Resume Next select case LCase(fileExt) case "jpg","jpeg" stamp=fstream.read(2) for i=0 to 1 if ascB(MidB(stamp,i+1,1))=jpg(i) then CheckFileType=true else CheckFileType=false next case "gif" stamp=fstream.read(6) for i=0 to 5 if ascB(MidB(stamp,i+1,1))=gif(i) then CheckFileType=true else CheckFileType=false next case "png" stamp=fstream.read(4) for i=0 to 3 if ascB(MidB(stamp,i+1,1))=png(i) then CheckFileType=true else CheckFileType=false next case "bmp" stamp=fstream.read(2) for i=0 to 1 if ascB(MidB(stamp,i+1,1))=bmp(i) then CheckFileType=true else CheckFileType=false next end select fstream.Close set fseteam=nothing if err.number<>0 then CheckFileType=false end function %> <% '===判断是否为超管 Function ISadmin() ISadmin=false if instr(session("UA_Rights"),"|0|")>0 then ISadmin=true End Function '====='Sub 接收ID、标题、内容、链接、左侧菜单链接 ,支持多ID Sub LHYSendMessage(UID,MTitle,MContent,MLink,MTarget) UID=replace(UID,"|","") UIDS=Split(UID,",") isYes=false for i=0 to UBound(UIDS) if UIDS(i)="" or IsNumeric(UIDS(i))=false then response.Write(vbcrlf & "") exit sub end if if isNumeric(MTarget)=false then MTarget=0 sqlm="select top 1 SM_ID,SM_IsSign,SM_Time from MessageBox where SM_User="&UIDS(i)&" and SM_Title='"&MTitle&"' and SM_Link='"&MLink&"'" set rsm=LsObject.CreateRs(sqlm,1,3) if rsm.eof then isYes=true'没有一模一样的内容 else rsm("SM_IsSign")=0 rsm("SM_Time")=now() rsm.update end if rsm.close() set rsm=nothing if isYes=true then sqlm="select top 1 * from MessageBox order by SM_ID desc" set rsm=LsObject.CreateRs(sqlm,1,3) if rsm.eof then SM_ID=1 else SM_ID=rsm("SM_ID")+1 end if rsm.addnew() rsm("SM_ID")=SM_ID rsm("SM_User")=UIDS(i) rsm("SM_Title")=MTitle rsm("SM_Content")=MContent rsm("SM_Link")=MLink rsm("SM_Time")=now() rsm("SM_IsSign")=0 rsm("SM_Target")=MTarget rsm.update() rsm.close() set rsm=nothing end if next end sub '================================================ '执行JS '================================================ function LHYAlert(message,str) alertstr="alert('"&message&"');" if message="" then alertstr="" if str="0" then response.Write("") elseif instr(str,"(")>0 then response.Write("") elseif str="-1" then response.Write("") else response.Write("") end if response.End() end function '================================================ '读取用户名称 '================================================ function LhyBackUname(uids) sqlstr="select UA_Name from UserAccount where UA_ID in("&uids&")" set srs = LsObject.CreateRs(sqlstr,1,1) do while not srs.eof getnames=getnames&srs(0)&"," srs.movenext loop srs.close set srs=nothing if getnames<>"" then getnames=left(getnames,len(getnames)-1) LhyBackUname=getnames end function function ArtcleCheckType(SS_ID,UA_ID) ArtcleCheckType=0 Lhysql="select AS_ID from ArtcleSet where SS_ID like '%|"&SS_ID&"|%' and AS_AddUsers like '%|"&UA_ID&"|%'" set Lhyrs = LsObject.CreateRs(Lhysql,1,1) if not Lhyrs.eof then ArtcleCheckType=1 end if Lhyrs.close set Lhyrs=nothing end function '================================================ '读取模版页面路径 '================================================ Function LhyGetNavUrl(SS_ID) Lhysql = "select SS_Url from SiteStructure where SS_ID="&SS_ID Set Lhyrs = LsObject.CreateRs(Lhysql,1,1) if not Lhyrs.eof then LhyGetNavUrl=Lhyrs("SS_Url") else LhyGetNavUrl="#" end if Lhyrs.close set Lhyrs=nothing End Function 'Select Case SS_Type ' Case 1 '普通页面 ' arrowimg = "SysImage/arrow16.gif" ' folderimg = "SysImage/arrow16.gif" ' Case 2 '文字分类 ' arrowimg = "SysImage/arrow18.gif" ' folderimg = "SysImage/arrow22.gif" ' Case 3 '图片分类 ' arrowimg = "SysImage/arrow35.gif" ' folderimg = "SysImage/arrow36.gif" ' Case 4 '产品 ' arrowimg = "SysImage/arrow23.gif" ' folderimg = "SysImage/arrow23.gif" ' Case 5 '留言 ' arrowimg = "SysImage/arrow24.gif" ' folderimg = "SysImage/arrow24.gif" ' Case 6 '招聘 ' arrowimg = "SysImage/arrow26.gif" ' folderimg = "SysImage/arrow26.gif" ' Case 7 '论坛 ' arrowimg = "SysImage/arrow25.gif" ' folderimg = "SysImage/arrow25.gif" ' Case 8 '视频点播 ' arrowimg = "SysImage/arrow28.gif" ' folderimg = "SysImage/arrow28.gif" ' Case 9 '子站链接 ' arrowimg = "SysImage/arrow30.gif" ' folderimg = "SysImage/arrow30.gif" ' Case 10 '下载中心 ' arrowimg = "SysImage/arrow31.gif" ' folderimg = "SysImage/arrow31.gif" ' Case 11 '在线报名 ' arrowimg = "SysImage/arrow38.gif" ' folderimg = "SysImage/arrow38.gif" ' Case 12 '电子喜帖 ' arrowimg = "SysImage/arrow32.gif" ' folderimg = "SysImage/arrow32.gif" ' Case 13 '企业名片 ' arrowimg = "SysImage/arrow34.gif" ' folderimg = "SysImage/arrow34.gif" ' Case 14 '旅游线路 ' arrowimg = "SysImage/arrow37.gif" ' folderimg = "SysImage/arrow37.gif" ' Case 101 '会员 ' arrowimg = "SysImage/arrow19.gif" ' folderimg = "SysImage/arrow19.gif" ' Case 102 '通知 ' arrowimg = "SysImage/arrow19.gif" ' folderimg = "SysImage/arrow19.gif" ' Case 103 '公告 ' arrowimg = "SysImage/arrow19.gif" ' folderimg = "SysImage/arrow19.gif" ' Case 104 '投票 ' arrowimg = "SysImage/arrow19.gif" ' folderimg = "SysImage/arrow19.gif" ' Case 105 '广告 ' arrowimg = "SysImage/arrow19.gif" ' folderimg = "SysImage/arrow19.gif" ' Case 106 '评论 ' arrowimg = "SysImage/arrow19.gif" ' folderimg = "SysImage/arrow19.gif" ' Case 107 '107统计 ' arrowimg = "SysImage/arrow19.gif" ' folderimg = "SysImage/arrow19.gif" ' Case 109 ' arrowimg = "SysImage/arrow19.gif" ' folderimg = "SysImage/arrow19.gif" ' End Select '显示项目列表 Function Str_SS_Type(SS_Type) Select Case SS_Type Case 1 Str_SS_Type = "〖 普通页面 〗" Case 2 Str_SS_Type = "〖 文字列表 〗" Case 3 Str_SS_Type = "〖 图片列表 〗" Case 4 Str_SS_Type = "〖 产品展示 〗" Case 5 Str_SS_Type = "〖 留言反馈 〗" Case 6 Str_SS_Type = "〖 人才招聘 〗" Case 7 Str_SS_Type = "〖 社区论坛 〗" Case 8 Str_SS_Type = "〖 视频点播 〗" Case 9 Str_SS_Type = "〖 子站链接 〗" Case 10 Str_SS_Type = "〖 下载中心 〗" Case 11 Str_SS_Type = "〖 在线报名 〗" Case 12 Str_SS_Type = "〖 电子喜帖 〗" Case 13 Str_SS_Type = "〖 企业名片 〗" Case 14 Str_SS_Type = "〖 旅游线路 〗" Case 15 Str_SS_Type = "〖领导之窗模块〗" Case 93 Str_SS_Type = "【信息公开模块】" Case 94 Str_SS_Type = "【公开目录模块】" Case 95 Str_SS_Type = "【场景服务模块】" Case 96 Str_SS_Type = "【人力资源模块】" Case 97 Str_SS_Type = "【政民直通车模块】" Case 98 Str_SS_Type = "【在线访谈模块】" Case 99 Str_SS_Type = "【百姓话题模块】" Case 100 Str_SS_Type = "【自定义查询模块】" Case 101 Str_SS_Type = "【模块 - 会员管理】" Case 102 Str_SS_Type = "【模块 - 通知管理】" Case 103 Str_SS_Type = "【模块 - 公告管理】" Case 104 Str_SS_Type = "【模块 - 投票管理】" Case 105 Str_SS_Type = "【模块 - 广告管理】" Case 106 Str_SS_Type = "【模块 - 评论管理】" Case 107 Str_SS_Type = "【模块 - 访问统计】" Case 1000 Str_SS_Type = "【主站点】" Case 1001 Str_SS_Type = "【子站点】" End Select End Function Function ShowStructureSelect1(SType,SS_Type) if SType=0 then'可以添加站点 sql = "select count(SS_ID) as SS_SiteCount from SiteStructure where SS_Type>=1000" Set rs = LsObject.CreateRs(sql,1,1) SS_SiteCount = rs("SS_SiteCount")'统计站点数 rs.close If IsNull(SS_SiteCount) Then SS_SiteCount = 0 If SS_SiteCount = 0 Then Response.write "" Else Response.write "" End If else Lhysql="select PM_Name,PM_Type,PM_Default from PublicModule where PM_State=0" if SType=7 or SType=8 or SType=9 or SType=10 or SType=11 or SType=12 or SType=13 or SType=14 or SType=93 or SType=95 or SType=94 or SType=99 then Lhysql=Lhysql&"and PM_Type="&SType end if Lhysql=Lhysql&" order by PM_Order" Set Lhyrs = LsObject.CreateRs(Lhysql,1,1) Do While not Lhyrs.eof Response.write ""&chr(13)&chr(10) Lhyrs.movenext Loop Lhyrs.close set Lhyrs=nothing end if End function '添加栏目时出现的下拉列 Function ShowStructureSelect(SType) if SType=0 then'可以添加站点 sql = "select count(SS_ID) as SS_SiteCount from SiteStructure where SS_Type>=1000" Set rs = LsObject.CreateRs(sql,1,1) SS_SiteCount = rs("SS_SiteCount")'统计站点数 rs.close If IsNull(SS_SiteCount) Then SS_SiteCount = 0 If SS_SiteCount = 0 Then Response.write "" Else Response.write "" End If else Lhysql="select PM_Name,PM_Type,PM_Default from PublicModule where PM_State=0" if SType=7 or SType=8 or SType=9 or SType=10 or SType=11 or SType=12 or SType=13 or SType=14 or SType=93 or SType=95 or SType=94 or SType=99 then Lhysql=Lhysql&"and PM_Type="&SType end if Lhysql=Lhysql&" order by PM_Order" Set Lhyrs = LsObject.CreateRs(Lhysql,1,1) Do While not Lhyrs.eof Response.write ""&chr(13)&chr(10) Lhyrs.movenext Loop Lhyrs.close set Lhyrs=nothing end if End function '显示相关权限复选框 Function ShowRightCheck(fori,STypes,SSID,Rights,RightsTwo) ShowRightCheck="" Lhysql="select PM_LimitsID,PM_LimitsName,PM_LimitsVal from PublicModule where PM_Type="&STypes Set Lhyrs = LsObject.CreateRs(Lhysql,1,1) If not Lhyrs.eof then PM_LimitsID=Lhyrs(0) PM_LimitsName=Lhyrs(1) PM_LimitsVal=Lhyrs(2) End if Lhyrs.close set Lhyrs=nothing if PM_LimitsID<>"" and not isnull(PM_LimitsID) then PM_LimitsIDs=split(PM_LimitsID,",") PM_LimitsNames=split(PM_LimitsName,",") PM_LimitsVals=split(PM_LimitsVal,",") for Lhyi=0 to ubound(PM_LimitsIDs) checkstr="":disabledstr="" If Instr(Rights,"|"&PM_LimitsVals(Lhyi)&SSID&"|") > 0 Then checkstr = " checked " End If If Instr(RightsTwo,"|"&PM_LimitsVals(Lhyi)&SSID&"|") > 0 Then disabledstr = "disabled " End If ShowRightCheck=ShowRightCheck&" " ShowRightCheck=ShowRightCheck&"" next end if End function '用户管理里用到的权限复选框 Function ShowRightCheck1(fori,STypes,SSID,Rights,RightsTwo,SS_Path_,inputchecked) ShowRightCheck1="" Lhysql="select PM_LimitsID,PM_LimitsName,PM_LimitsVal from PublicModule where PM_Type="&STypes Set Lhyrs = LsObject.CreateRs(Lhysql,1,1) If not Lhyrs.eof then PM_LimitsID=Lhyrs(0) PM_LimitsName=Lhyrs(1) PM_LimitsVal=Lhyrs(2) End if Lhyrs.close set Lhyrs=nothing if PM_LimitsID<>"" and not isnull(PM_LimitsID) then PM_LimitsIDs=split(PM_LimitsID,",") PM_LimitsNames=split(PM_LimitsName,",") PM_LimitsVals=split(PM_LimitsVal,",") for Lhyi=0 to ubound(PM_LimitsIDs) checkstr="":disabledstr="" 'If Instr(Rights,"|"&PM_LimitsVals(Lhyi)&SSID&"|") > 0 Then ' checkstr = " checked " 'End If 'If Instr(RightsTwo,"|"&PM_LimitsVals(Lhyi)&SSID&"|") > 0 Then ' disabledstr = "disabled " 'End If If instr(session("UA_Rights"),"|0|") > 0 or Instr(session("UA_Rights"),"|"&PM_LimitsVals(Lhyi)&SSID&"|") > 0 Then ShowRightCheck1=ShowRightCheck1&" " ShowRightCheck1=ShowRightCheck1&"" end if next end if End function Function ShowRightCheckedit(fori,STypes,SSID,Rights,RightsTwo) ShowRightCheckedit="" Lhysql="select PM_LimitsID,PM_LimitsName,PM_LimitsVal from PublicModule where PM_Type="&STypes Set Lhyrs = LsObject.CreateRs(Lhysql,1,1) If not Lhyrs.eof then PM_LimitsID=Lhyrs(0) PM_LimitsName=Lhyrs(1) PM_LimitsVal=Lhyrs(2) End if Lhyrs.close set Lhyrs=nothing if PM_LimitsID<>"" and not isnull(PM_LimitsID) then PM_LimitsIDs=split(PM_LimitsID,",") PM_LimitsNames=split(PM_LimitsName,",") PM_LimitsVals=split(PM_LimitsVal,",") for Lhyi=0 to ubound(PM_LimitsIDs) 'checkstr="" ' ' If Instr(Rights,"|"&PM_LimitsVals(Lhyi)&SSID&"|") > 0 Then ' checkstr = " checked " ' End If 'If Instr(RightsTwo,"|"&PM_LimitsVals(Lhyi)&SSID&"|") > 0 Then 'disabledstr = "disabled " 'End If If instr(session("UA_Rights"),"|0|") > 0 or Instr(session("UA_Rights"),"|"&PM_LimitsVals(Lhyi)&SSID&"|") > 0 Then ShowRightCheckedit=ShowRightCheckedit&" "" and Instr(Rights,"|"&PM_LimitsVals(Lhyi)&SSID&"|") > 0 Then ShowRightCheckedit=ShowRightCheckedit&" checked " end if ShowRightCheckedit=ShowRightCheckedit&" id="&PM_LimitsVals(Lhyi)&"dv"&SSID&fori&">" ShowRightCheckedit=ShowRightCheckedit&"" end if next end if End function '显示相关属性复选框 Function ShowAutCheck(Rights,RightsTwo) ShowAutCheck="" ModuleStr=GetPublicModule() Modules=split(ModuleStr,",") for xix=0 to ubound(Modules) STypes=Modules(xix) Lhysql="select PM_AttributeID,PM_AttributeName,PM_AttributeVal from PublicModule where PM_Type="&STypes Set Lhyrs = LsObject.CreateRs(Lhysql,1,1) If not Lhyrs.eof then PM_AttributeID=Lhyrs(0) PM_AttributeName=Lhyrs(1) PM_AttributeVal=Lhyrs(2) End if Lhyrs.close set Lhyrs=nothing if PM_AttributeID<>"" and not isnull(PM_AttributeID) then ShowAutCheck=ShowAutCheck&"" ShowAutCheck=ShowAutCheck&"" ShowAutCheck=ShowAutCheck&" 网站管理 >"&Str_SS_Type(STypes)&"属性" ShowAutCheck=ShowAutCheck&"" ShowAutCheck=ShowAutCheck&"" ShowAutCheck=ShowAutCheck&"" AttributeIDs=split(PM_AttributeID,",") AttributeNames=split(PM_AttributeName,",") AttributeVals=split(PM_AttributeVal,",") for Lhyi=0 to ubound(AttributeIDs) checkstr="":disabledstr="" If Instr(Rights,"|"&AttributeVals(Lhyi)&"_"&STypes&"|") > 0 Then checkstr = " checked " End If If Instr(RightsTwo,"|"&AttributeVals(Lhyi)&"_"&STypes&"|") > 0 Then disabledstr = " disabled " End If ShowAutCheck=ShowAutCheck&"
" ShowAutCheck=ShowAutCheck&"" ShowAutCheck=ShowAutCheck&"" ShowAutCheck=ShowAutCheck&"
" next ShowAutCheck=ShowAutCheck&"" ShowAutCheck=ShowAutCheck&"" end if Next End function '判断栏目是否有该属性 Function AttributeCheck(Stype,Cord) AttributeCheck=false IF IsNumeric(Stype) and Cord<>"" Then Lhysql="select PM_AttributeVal from PublicModule where PM_Type="&Stype Set Lhyrs = LsObject.CreateRs(Lhysql,1,1) If not Lhyrs.eof then AttributeVal=Lhyrs(0) IF AttributeVal<>"" THEN if instr(","&AttributeVal&",",","&Cord&",")>0 then AttributeCheck=True End If End if Lhyrs.close Set Lhyrs=nothing End IF End Function %> <% SiteUserName = "lonsun" SitePassword = "81303c3b85ffb156074dbe915fd91af5" %> <% '================================================ '读取网站基本设置信息 '================================================ '文章标题颜色 IndexDocTitDate = Application("IndexDocTitDate") IndexDocTitCol = Application("IndexDocTitCol") '编辑器设置 IndexPicWidth = Application("IndexPicWidth") IndexPicHeight = Application("IndexPicHeight") IndexEditor = Application("IndexEditor") IndexImg = Application("IndexImg") IndexImgExt = Application("IndexImgExt") IndexFlash = Application("IndexFlash") IndexFlashExt = Application("IndexFlashExt") IndexVideo = Application("IndexVideo") IndexVideoExt = Application("IndexVideoExt") IndexFile = Application("IndexFile") IndexFileExt = Application("IndexFileExt") IndexHotWords = Application("IndexHotWords") Indexfilterwords = Application("Indexfilterwords") '去除HTML格式 Public Function RemoveHTML(strHTML) Dim objRegExp, Match, Matches Set objRegExp = New Regexp objRegExp.IgnoreCase = True objRegExp.Global = True objRegExp.Pattern = "<.+?>" Set Matches = objRegExp.Execute(Trim(strHTML)) For Each Match in Matches strHtml=Replace(strHTML,Match.value,"") Next RemoveHTML=strHTML Set objRegExp = Nothing End Function Function outHTML(str) Dim sTemp sTemp = str outHTML = "" If IsNull(sTemp) = True Then Exit Function End If sTemp = Replace(sTemp, "&", "&") sTemp = Replace(sTemp, "<", "<") sTemp = Replace(sTemp, ">", ">") sTemp = Replace(sTemp, Chr(34), """) sTemp = Replace(sTemp, Chr(10), "
") outHTML = sTemp End Function ' ============================================ ' 格式化时间(显示) 参数:n_Flag ' ============================================ Function Format_Time(s_Time, n_Flag) Dim y, m, d, h, mi, s Format_Time = "" If IsDate(s_Time) = False Then Exit Function y = cstr(year(s_Time)) m = cstr(month(s_Time)) If len(m) = 1 Then m = "0" & m d = cstr(day(s_Time)) If len(d) = 1 Then d = "0" & d h = cstr(hour(s_Time)) If len(h) = 1 Then h = "0" & h mi = cstr(minute(s_Time)) If len(mi) = 1 Then mi = "0" & mi s = cstr(second(s_Time)) If len(s) = 1 Then s = "0" & s Select Case n_Flag Case 1 ' yyyy-mm-dd hh:mm:ss Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s Case 2 ' yyyy-mm-dd Format_Time = y & "-" & m & "-" & d Case 3 ' hh:mm:ss Format_Time = h & ":" & mi & ":" & s Case 4 ' yyyy年mm月dd日 Format_Time = y & "年" & m & "月" & d & "日" Case 5 ' yyyymmdd Format_Time = y & m & d case 6 'yyyymmddhhmmss format_time= y & m & d & h & mi & s End Select End Function Function CheckTable(TableName) Set Conn = LsObject.CreateConn() Set rs = Conn.OpenSchema(4) Do Until rs.EOF If rs("Table_name") = TableName Then CheckTable = True Exit Do Else CheckTable = False End If rs.movenext Loop rs.close Conn.close Set Conn = Nothing End Function '================================================ '读取我的桌面是否显示更多 '================================================ Sub IsMore(Modlue) sql = "select * from DesktopModule where DM_ID= "& Modlue Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then If rs("DM_URL")<>"" then Response.Write "更多>>" end if End if Rs.close End Sub '================================================ '读取我的桌面标题 '================================================ Sub DesktopTitle(Modlue) sql = "select * from DesktopModule where DM_ID= "& Modlue Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then Response.Write rs("DM_TITLE") End if Rs.close End Sub '================================================ '读取我的桌面板块显示内容 '================================================ Sub DesktopContent(Modlue) sql = "select * from DesktopModule where DM_ID= "& Modlue Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then server.execute(rs("DM_CONTENT")) End if Rs.close End Sub '================================================ '生成编辑框工具栏对应的JS文件 '================================================ Sub WriteFile(s_FileName, s_Text) On Error Resume Next Dim fso, file Set fso = Server.CreateObject("Scripting."&FsoAddStr&"FileSystemObject") Set file = fso.CreateTextFile(Server.Mappath(s_FileName), True) file.Write(s_Text) file.Close Set file = Nothing Set fso = Nothing End Sub '================================================ '调用文章扩展属性 '================================================ Sub Doc_Extension(Content,ExtenName) Select Case ExtenName Case "|P002|" '推荐 response.Write "" Case "|P003|" '加新 if instr(Content,ExtenName) then response.Write "" end if Case "|P004|" '共享 if instr(Content,ExtenName) then response.Write "" Else response.Write "" End If Case "|P005|" '热点 if instr(Content,ExtenName) then response.Write "" end if Case "|P006|" '引用 if instr(Content,ExtenName) then response.Write "" end if Case "|P009|" '标题 if instr(Content,ExtenName) then response.Write "" Else response.Write "" End If Case "|P010|" '评论 response.Write "" Case "|P011|" '投稿 response.Write "" End Select End Sub ' ============================================================================================================================= ' 我的桌面新闻文字列表 ' ============================================================================================================================= Sub IndexDocList(NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis) NumTr = NumRow * NumCol If IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,SI_Domain," If DBType = 1 Then 'Access sql = sql & "d_Author,d_Extension,d_Hit from DocContents where d_Type=2 and instr(d_Extension,'|P004|')<>0 and d_CheckIn<>0" else sql = sql & "d_Author,d_Extension,d_Hit from DocContents where d_Type=2 and charindex(d_Extension,'|P004|')<>0 and d_CheckIn<>0" end if Select Case OrderType Case 0 sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc" Case 1 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P002|')<>0" else sql = sql & " and charindex(d_Extension,'|P002|')<>0" end if sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc" Case 2 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P005|')<>0" else sql = sql & " and charindex(d_Extension,'|P005|')<>0" end if sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,3) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") SI_Domain = rs("SI_Domain") d_HtmlUrl = rs("d_HtmlUrl") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If instr(d_Extension,"|P005|")<>0 Then tNumWords = tNumWords - 6 If instr(d_Extension,"|P003|")<>0 Then tNumWords = tNumWords - 4 If d_Redirect = True Then d_HtmlUrl = d_RedirectLink Else d_HtmlUrl = SI_Domain&d_HtmlUrl End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If Response.write "" If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" If WebStyle = 1 Then Response.write "" Else Response.write "" End If If NumWords > 0 Then d_Title = CutStr(d_Title,tNumWords) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close Response.write " " End If End Sub ' 群最新列表(OrderType值:0默认排序,1推荐文章,2热点文章、3点击排名) ' ============================================================================================================================= Sub IndexGroupDocList(NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis) NumTr = NumRow * NumCol sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,SI_Domain," sql = sql & "d_Author,d_Extension,d_Hit,SS_SiteID from DocContents where d_Type=2 and d_CheckIn<>0" Select Case OrderType Case 0 sql = sql & " order by d_Date desc,d_Time desc" Case 1 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P002|')<>0" else sql = sql & " and charindex('|P002|',d_Extension)<>0" end if sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 2 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P005|')<>0" else sql = sql & " and charindex('|P005|',d_Extension)<>0" end if sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,3) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") SS_SiteID = rs("SS_SiteID") sqlSite = "select SI_Name,SI_Domain from SiteInfo where SS_SiteID="&SS_SiteID Set rsSite = LsObject.CreateRs(sqlSite,1,1) if not rsSite.eof then SiteName = rsSite(0) SI_Domain = rsSite(1) end if rsSite.close Set rsSite = Nothing If d_Hot = True Then tNumWords = tNumWords - 6 If d_New = True Then tNumWords = tNumWords - 4 If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If Response.write "" Response.write "" If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" t_alt=d_Title&" "&"发布时间:"&d_Date&" "&d_Time Response.write "" If NumWords > 0 Then d_Title = CutStr(d_Title,tNumWords) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" Response.write d_Title&"" Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "" Response.Write "" Response.Write "" Response.Write "["&CutStr(SiteName,8)&"]" Response.Write "" Response.write "
" Else rs.close Response.write "暂时没有文章" End If End Sub Dim IsObj '检查组件是否被支持及组件版本的子程序 sub ObjTest(strObj) on error resume next IsObj=false VerObj="" set TestObj=server.CreateObject (strObj) If -2147221005 <> Err Then IsObj = True VerObj = TestObj.version if VerObj="" or isnull(VerObj) then VerObj=TestObj.about end if set TestObj=nothing End sub Select Case iUA_Type case 1 UA_TypeStr = "超级管理员" case 2 UA_TypeStr = "单位管理员" case 3 UA_TypeStr = "普通用户" End Select sUA_Name = Session("UA_Name") sUI_Name = Session("UI_Name") %> <% LicUserName = "系统调试" FsoAddStr = "" WebStyle = "2" RootPath = "/" IndexHtmlDir = "/UserData/IndexHtml/" DocHtmlDir = "/UserData/DocHtml/" SortHtmlDir = "/UserData/SortHtml/" IPDB = "1" %> <% Dim objXmlHttp,binFileData,objAdoStream Dim lresolveTimeout,lconnectTimeout,lsendTimeout,lreceiveTimeout lresolveTimeout = 10000 ' 解析DNS名字的超时时间,10秒 lconnectTimeout = 20000 ' 建立Winsock连接的超时时间,10秒 lsendTimeout = 12000 ' 发送数据的超时时间,12秒 lreceiveTimeout = 20000 ' 接收response的超时时间,20秒 Sub HtmlComm(strUrl,FilePath) 'If InStr(strUrl,".shtml") Then ' strUrl = Replace(strUrl,"shtml","asp") 'End If 'Response.Write strUrl&"<>"&FilePath&"
" objXmlHttp.setTimeouts lresolveTimeout,lconnectTimeout,lsendTimeout,lreceiveTimeout dim p1 p1=Instr(strUrl,"?") if p1>0 then strUrl = strUrl & "&tm=" & timer() else strUrl = strUrl & "?tm=" & timer() end if 'Response.Write strUrl&"<>"&FilePath&"
" objXmlHttp.open "GET",strUrl,false objXmlHttp.send() binFileData = objXmlHttp.responseBody if IsNull(binFileData) then exit sub objAdoStream.Open() objAdoStream.Write(binFileData) objAdoStream.SaveToFile FilePath,2 If Err <> 0 Then Response.write error.description objAdoStream.Close() End Sub Sub CreateDocHtml(d_ID) '生成指定ID的文章html sql = "Select SS_ID,SI_Domain,d_HtmlUrl,d_Contents,d_Redirect,DST_URL from DocContents where d_CheckIn<>0 and d_Redirect=0 and d_ID="& d_ID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If SS_ID = rs("SS_ID") SI_Domain = rs("SI_Domain") d_HtmlUrl = rs("d_HtmlUrl") DST_URL = rs("DST_URL") d_Contents = rs("d_Contents") d_Redirect = rs("d_Redirect") rs.close If d_Redirect = False Then Ar_Contents = split(d_Contents,"[page]") MaxPage = ubound(Ar_Contents) + 1 Set objXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") 'Set objXmlHttp = Server.CreateObject("Microsoft.XMLHTTP") Set objAdoStream = Server.CreateObject("ADODB.Stream") objAdoStream.Type = 1 For k = 1 to MaxPage If k = 1 Then strUrl = SI_Domain&DST_URL&"?SS_ID="&SS_ID&"&d_ID=" & d_ID FileName = d_HtmlUrl Else strUrl = SI_Domain&DST_URL&"?page="&k&"&SS_ID="&SS_ID&"&d_ID=" & d_ID FileName = Left(d_HtmlUrl,Len(d_HtmlUrl)-5)&"_"&k&".html" End If FilePath = Server.MapPath(FileName) Call HtmlComm(strUrl,FilePath) Next Set objXmlHttp = nothing Set objAdoStream = nothing End If End Sub Sub CreateDocHtml1(d_ID) '生成指定ID的文章html sql = "Select SS_ID,SI_Domain,d_HtmlUrl,d_Contents,d_Redirect,DST_URL from DocContents where d_Redirect=0 and d_ID="& d_ID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If SS_ID = rs("SS_ID") SI_Domain = rs("SI_Domain") d_HtmlUrl = rs("d_HtmlUrl") DST_URL = rs("DST_URL") d_Contents = rs("d_Contents") d_Redirect = rs("d_Redirect") rs.close If d_Redirect = False Then Ar_Contents = split(d_Contents,"[page]") MaxPage = ubound(Ar_Contents) + 1 Set objXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") 'Set objXmlHttp = Server.CreateObject("Microsoft.XMLHTTP") Set objAdoStream = Server.CreateObject("ADODB.Stream") objAdoStream.Type = 1 For k = 1 to MaxPage If k = 1 Then strUrl = SI_Domain&DST_URL&"?SS_ID="&SS_ID&"&d_ID=" & d_ID FileName = d_HtmlUrl Else strUrl = SI_Domain&DST_URL&"?page="&k&"&SS_ID="&SS_ID&"&d_ID=" & d_ID FileName = Left(d_HtmlUrl,Len(d_HtmlUrl)-5)&"_"&k&".html" End If FilePath = Server.MapPath(FileName) Call HtmlComm(strUrl,FilePath) Next Set objXmlHttp = nothing Set objAdoStream = nothing End If End Sub Sub CreateIndexHtml(SSSiteID) '生成主页html sql = "select * from SiteInfo where SS_SiteID=" & SSSiteID Set rs = LsObject.CreateRS(sql,1,1) If rs.eof Then rs.close Exit Sub End If SI_Domain = rs("SI_Domain") SI_IndexUrl = rs("SI_IndexUrl") SI_Dir = rs("SI_Dir") rs.close Filename = Server.Mappath("../../" & SI_Dir & "/" & SI_IndexUrl) ' Set MyFileObject = Server.CreateObject(FsoStr()) ' If MyFileObject.FileExists(Filename) = False Then ' Set MyFileObject = Nothing ' Exit Sub ' End If ' Set MyFileObject = Nothing Set objXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") 'Set objXmlHttp = Server.CreateObject("Microsoft.XMLHTTP") Set objAdoStream = Server.CreateObject("ADODB.Stream") objAdoStream.Type = 1 strUrl = SI_Domain & "/Tmp/" & SI_IndexUrl & "?x=1" FileName = "index.html" FilePath = Server.MapPath("../../" & SI_Dir) & "\" & FileName ' FilePath = Server.MapPath("../../" & SI_Dir) & IndexHtmlDir & SSSiteID & "\" & FileName Call HtmlComm(strUrl,FilePath) Set objXmlHttp = nothing Set objAdoStream = nothing End Sub Sub CreatePathSortHtml(SS_Path) '生成与指定路径相关的栏目html SSLen = Len(SS_Path) SortCount = (SSLen - 1)/4 Set objXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") 'Set objXmlHttp = Server.CreateObject("Microsoft.XMLHTTP") Set objAdoStream = Server.CreateObject("ADODB.Stream") objAdoStream.Type = 1 Set Conn = LsObject.CreateConn() '读取当前路径所属站点ID号 sql = "select SS_SiteID from SiteStructure where SS_Path='" & SS_Path & "'" set rs1 = conn.Execute(sql) If not rs1.eof Then SS_SiteID = rs1("SS_SiteID") End If For k = 0 to SortCount - 1 UpdateSS_Path = Left(SS_Path,SSLen-(k*4)) sql = "select SS_ID,SS_URL,SI_Domain,SS_HtmlUrl from SiteStructure where SS_Path='"&UpdateSS_Path&"' and (SS_Type<4 or SS_Type=95) and SS_CheckIn<>0" set rs1 = conn.Execute(sql) If not rs1.eof Then SS_HtmlUrl = rs1("SS_HtmlUrl") UpdateSS_URL = rs1("SS_URL") UpdateSS_ID = rs1("SS_ID") SI_Domain = rs1("SI_Domain") If UpdateSS_ID = SS_SiteID Then '当循环到站点ID时停止生成Html rs1.close() Exit for End If strUrl = SI_Domain&UpdateSS_URL&"?SS_ID=" & UpdateSS_ID FileName = SS_HtmlUrl FilePath = Server.MapPath(FileName) Call HtmlComm(strUrl,FilePath) End If rs1.close Next Conn.close Set objXmlHttp = nothing Set objAdoStream = nothing End Sub Sub CreateIDSortHtml(theid) '生成指定ID下一级的栏目html Set objXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") 'Set objXmlHttp = Server.CreateObject("Microsoft.XMLHTTP") Set objAdoStream = Server.CreateObject("ADODB.Stream") objAdoStream.Type = 1 sql = "select SS_ID,SS_URL,SI_Domain,SS_HtmlUrl from SiteStructure where PSS_ID="&theid&" and (SS_Type<4 or SS_Type=95) and SS_CheckIn<>0 order by SS_Path desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount For k = 1 to rscount SS_HtmlUrl = rs("SS_HtmlUrl") SS_URL = rs("SS_URL") tSS_ID = rs("SS_ID") SI_Domain = rs("SI_Domain") strUrl = SI_Domain&SS_URL&"?SS_ID=" & tSS_ID FileName = SS_HtmlUrl FilePath = Server.MapPath(FileName) Call HtmlComm(strUrl,FilePath) rs.movenext Next rs.close Set objXmlHttp = nothing Set objAdoStream = nothing End Sub Sub CreateFirstSortHtml(StrSS_ID) '生成指定ID的栏目html Set objXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") 'Set objXmlHttp = Server.CreateObject("Microsoft.XMLHTTP") Set objAdoStream = Server.CreateObject("ADODB.Stream") objAdoStream.Type = 1 sql = "select SS_ID,PSS_ID,SS_URL,SI_Domain,SS_HtmlUrl from SiteStructure where SS_ID=" & StrSS_ID & " and SS_CheckIn<>0" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount For k = 1 to rscount tPSS_ID = rs("PSS_ID") If tPSS_ID > 0 Then SS_HtmlUrl = rs("SS_HtmlUrl") SS_URL = rs("SS_URL") tSS_ID = rs("SS_ID") SI_Domain = rs("SI_Domain") strUrl = SI_Domain&SS_URL&"?SS_ID=" & tSS_ID FileName = SS_HtmlUrl FilePath = Server.MapPath(FileName) Call HtmlComm(strUrl,FilePath) End If rs.movenext Next rs.close Set objXmlHttp = nothing Set objAdoStream = nothing End Sub %> <% Public WebLanguage Public Txt1,Txt2,Txt3,Txt4,Txt5,Txt6,Txt7,Txt8,Txt9,Txt10,Txt11,Txt12,Txt13,Txt14,Txt15,Txt16,Txt17,Txt18,Txt19,Txt20 Public Txt21,Txt22,Txt23,Txt24,Txt25,Txt26,Txt27,Txt28,Txt29,Txt30,Txt31,Txt32,Txt33,Txt34,Txt35,Txt36,Txt37,Txt38,Txt39,Txt40 Public Txt41,Txt42,Txt43,Txt44,Txt45,Txt46,Txt47,Txt48,Txt49,Txt50,Txt51,Txt52,Txt53,Txt54,Txt55,Txt56,Txt57,Txt58,Txt59,Txt60 Public ErrTxt0,ErrTxt1,ErrTxt2,ErrTxt3,ErrTxt4,ErrTxt5,ErrTxt6,ErrTxt7,ErrTxt8,ErrTxt9,ErrTxt10,ErrTxt11,ErrTxt12,ErrTxt13,ErrTxt14,ErrTxt15,ErrTxt16,ErrTxt17,ErrTxt18,ErrTxt19,ErrTxt20 Sub LanguageInit(Lg) Select Case Lg Case 1 Txt1 = "首页" Txt2 = "第" Txt3 = "页" Txt4 = "共" Txt5 = "页" Txt6 = "条" Txt7 = "点击" Txt8 = "更多" Txt9 = "上一篇" Txt10 = "下一篇" Txt11 = "没有新闻了" Txt12 = "上一页" Txt13 = "下一页" Txt14 = "尾页" Txt15 = "加入日期" Txt16 = "点击观看" Txt17 = "请登录后观看!" Txt18 = "注 册" Txt19 = "登 录" Txt20 = "发表新贴" Txt21 = "回复贴子" Txt22 = "我的密码忘了怎么办?" Txt23 = "当前用户" Txt24 = "修改资料" Txt25 = "安全退出" Txt26 = "接受协议" Txt27 = "不接受协议" Txt28 = "用户名" Txt29 = "问题" Txt30 = "答案" Txt31 = "第一步" Txt32 = "第二步" Txt33 = "确 定" Txt34 = "取 消" Txt35 = "返 回" Txt36 = "密码" Txt37 = "请牢记您的密码" Txt38 = "注册成功!" Txt39 = "点击登录..." Txt40 = "资料修改成功!请重新登录。" Txt41 = "主题" Txt42 = "留言" Txt43 = "搜索" Txt44 = "邮件" Txt45 = "主页" Txt46 = "是" Txt47 = "发表的" Txt48 = "在" Txt49 = "回复" Txt50 = "时间" Txt51 = "感谢您的留言!我们会及时审核并回复。" ErrTxt0 = "出错提示:\n\n" ErrTxt1 = "
  正在更新中...
" ErrTxt2 = "
  请输入关键词后点击搜索!
" ErrTxt3 = "
  报歉!未找到符合条件的内容。
" ErrTxt4 = "根ID号有误,请联系系统管理员!" ErrTxt5 = "您无权使用该页或者您的连接已超时,请重新登录!" ErrTxt6 = "
  无相关链接
" ErrTxt7 = "不能为空" ErrTxt8 = "系统无此用户!" ErrTxt9 = "对不起!答案不正确,我们不能告诉您密码。" ErrTxt10 = "内容填写不规范!" ErrTxt11 = "当前表单不可重复提交!" ErrTxt12 = "用户验证失败!" ErrTxt13 = "用户已被锁定,请联系管理员!" ErrTxt14 = "登录失败,非本栏目会员!" ErrTxt15 = "此用户名已被他人注册,请更换!" ErrTxt16 = "仅限会员订购!" ErrTxt17 = "非法字符!" Case 2 Txt1 = "Home" Txt2 = "the" Txt3 = "page" Txt4 = "Total" Txt5 = "Pages" Txt6 = "Results" Txt7 = "Hits" Txt8 = "More" Txt9 = "Prev article" Txt10 = "Next article" Txt11 = "No articles" Txt12 = "Prev page" Txt13 = "Next page" Txt14 = "End page" Txt15 = "Add date" Txt16 = "Click to watch" Txt17 = "Please watch logging!" Txt18 = "Register" Txt19 = "Login" Txt20 = "Released new article" Txt21 = "Reply to the article" Txt22 = "How do I forget the password?" Txt23 = "Current users" Txt24 = "Edit information" Txt25 = "Safe logout" Txt26 = "Accept agreement" Txt27 = "Not accept agreement" Txt28 = "Username" Txt29 = "Question" Txt30 = "Answer" Txt31 = "First" Txt32 = "Second" Txt33 = "Submit" Txt34 = "Cancel" Txt35 = "Back" Txt36 = "Password" Txt37 = "Please remember your password" Txt38 = "Registration success!" Txt39 = "Click login..." Txt40 = "Information modify success! Please Re-login." Txt41 = "subject" Txt42 = "message" Txt43 = "search" Txt44 = "email" Txt45 = "web" Txt46 = "is" Txt47 = "Released" Txt48 = "in" Txt49 = "Reply" Txt50 = "time" Txt51 = "Thank you for the message! We will promptly review and reply to. " ErrTxt0 = "Error suggested:\n\n" ErrTxt1 = "
  Being updated. . .
" ErrTxt2 = "
  Please click search after importation Keywords!
" ErrTxt3 = "
  Sorry! Unable to find qualified content.
" ErrTxt4 = "Root ID Incorrect,Please contact the system administrator!" ErrTxt5 = "You have no right to use the link page or you have overtime, re-entered!" ErrTxt6 = "
  No Related Links
" ErrTxt7 = "Not empty" ErrTxt8 = "No such system users!" ErrTxt9 = "Sorry! The answer is not correct, we can not tell you password. " ErrTxt10 = "Fill not standardized!" ErrTxt11 = "Form not submitted to the current plots!" ErrTxt12 = "User Authentication failed! " ErrTxt13 = "Users have been locked, please contact managers !" ErrTxt14 = "Login failure, non-members of the columns!" ErrTxt15 = "Registered users who have been here, please replace!" ErrTxt16 = "Member limited order! " ErrTxt17 = "Illegal characters!" End Select WebLanguage = Lg End Sub 'Init Call LanguageInit(1) %> <%ThisSiteID = 539 %> <% sql = "select * from SiteInfo where SS_SiteID=" & ThisSiteID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Call OutScript("请设置当前站点ID!") End If Dim SiteInfo(8) SiteInfo(0) = ThisSiteID SiteInfo(1) = rs("SI_Name") SiteInfo(2) = rs("SI_Title") SiteInfo(3) = rs("SI_Domain") SiteInfo(4) = rs("SI_Logo") SiteInfo(5) = rs("SI_Copyright") SiteInfo(6) = rs("SI_Keywords") SiteInfo(7) = rs("SI_Description") SiteInfo(8) = rs("SI_BeiAnNo") rs.close %> <% If Application("ServerStat") = "" Then sql = "select * from SysStat where ID=1" Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then Application("ServerStat") = rs("ServerStat") Application("ServerTitle") = rs("ServerTitle") End If rs.close End If If Application("ServerStat") = 0 Then Response.write "
    "&Application("ServerTitle")&"
" Response.End() End If %> <% Sub Pagination() If NowSSURL = "" Then tNowSSURL = Request.ServerVariables("SCRIPT_NAME") Else tNowSSURL = NowSSURL End If If rscount > 0 Then Response.write "" If maxcount > 1 Then Response.Write "" End If Response.write "
" If mypage = 1 Then Response.Write "  " Else Response.Write "  " End If If mypage > 1 Then Response.Write "" Response.write "  " Else Response.Write "  " End If Response.Write Txt2&" " & mypage & " "&Txt3&"  " If mypage < maxcount Then Response.Write "" Response.Write "  " Response.Write "" Response.Write "  " Else Response.Write "  " End If Response.Write Txt4&" " & maxcount & " "&Txt5&" " & rscount & " "&Txt6&"  " Response.write "  
" End if End Sub %> <% Dim NowSSIS,NowSSID,NowPSID,NowPSIS,NowPSSubItem,NowSSSiteID,SubID(),SubName(),SubType(),SubURL(),SubPath(),SubItem(),SubNum Dim td_Title,td_SubTitle,td_KeyWords,td_Date,td_Time,td_Contents,td_Resource,td_Author,td_Hit,DocNowPlace,RelativeLink,CommentList Dim rscount,linkpar,mypagesize,mypage,maxcount,scriptname,counter,i,j Dim IsPicJS NowSSIS = False NowPSSubItem = True NowSSID = GetSafeStr(Request.QueryString("SS_ID")) NowPSID = GetSafeStr(Request.QueryString("PS_ID")) If NowPSID = "" or IsNull(NowPSID) = True or IsNumeric(NowPSID) = False Then NowPSID = 0 NowPSID = CInt(NowPSID) ' ====================================================================================================================== ' 防sql注入 ' ====================================================================================================================== 'Dim SQL_injdata 'SQL_injdata = "'|and|exec|cast|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare|drop|from|alert|script|or|where|;" 'SQL_inj = split(SQL_injdata,"|") 'If Request.QueryString <> "" Then ' For Each SQL_Get In Request.QueryString ' For SQL_Data = 0 To Ubound(SQL_inj) ' '提交内容长度不超过32个字符 ' If instr(Request.QueryString(SQL_Get),SQL_inj(SQL_Data)) > 0 or len(Request.QueryString(SQL_Get))<1 Then ' Response.Write "" Response.End End if Next Next End If If Request.Form <> "" Then For Each SQL_Post In Request.Form For SQL_Data = 0 To Ubound(SQL_inj) '提交内容长度不超过32个字符(除特长,个人简介,留言内容,评论内容,论坛内容) If instr(Request.Form(SQL_Post),Sql_inj(SQL_Data)) > 0 or (SQL_Post<>"JA_StrongSuit" and SQL_Post<>"JA_Intro" and SQL_Post<>"c_Contents" and SQL_Post<>"m_Contents" and SQL_Post<>"F_Contents" and len(Request.Form(SQL_Post))>32) Then Response.Write "" Response.End End If Next Next End If Dim Reg1,Reg2,Reg3 Reg1 = "'|(and|or)\b.+?(>|<|=|in|like)|/\*.+?\*/|<\s*script\b|\bEXEC\b|UNION.+?SELECT|UPDATE.+?SET|" Reg1 = Reg1 & "INSERT\s+INTO.+?VALUES|(SELECT|DELETE).+?FROM|(CREATE|" Reg1 = Reg1 & "ALTER|DROP|TRUNCATE)\s+(TABLE|DATABASE)" Reg2 = "\b(and|or)\b.{1,6}?(=|>|<|\bin\b|\blike\b)|/\*.+?\*/|<\s*script\b|" Reg2 = Reg2 & "\bEXEC\b|UNION.+?SELECT|UPDATE.+?SET|INSERT\s+INTO.+?VALUES|(SELECT|DELETE)" Reg2 = Reg2 & ".+?FROM|(CREATE|ALTER|DROP|TRUNCATE)\s+(TABLE|DATABASE)" Reg3 = "\b(and|or)\b.{1,6}?(=|>|<|\bin\b|\blike\b)|/\*.+?\*/|" Reg3 = Reg3 & "<\s*script\b|\bEXEC\b|UNION.+?SELECT|UPDATE.+?SET|INSERT\s+INTO.+?VALUES|(" Reg3 = Reg3 & "SELECT|DELETE).+?FROM|(CREATE|ALTER|DROP|TRUNCATE)\s+(TABLE|DATABASE)" If Request.QueryString<>"" Then Call StopHacker(Request.QueryString,Reg1) If Request.Form<>"" then call StopHacker(Request.Form,Reg2) If Request.Cookies<>"" then call StopHacker(Request.Cookies,Reg3) Public Function StopHacker(ByVal values,ByVal re) Dim l_get, l_get2,n_get,regex,IP For Each n_get in values For Each l_get in values l_get2 = values(l_get) set regex = new regexp regex.ignorecase = true regex.global = true regex.pattern = re If regex.test(l_get2) then IP=Request.ServerVariables("HTTP_X_FORWARDED_FOR") If IP = "" Then IP=Request.ServerVariables("REMOTE_ADDR") End If Response.Write "Illegal operation!" Response.End End If set regex = nothing Next Next End Function ' ====================================================================================================================== ' 导航初始化 ' ====================================================================================================================== If NowSSID <> "" and IsNumeric(NowSSID) = True Then sql = "select * from SiteStructure where SS_ID="&NowSSID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then NowSSIS = False Else NowSSName = rs("SS_Name") NowSSPath = rs("SS_Path") NowSSSubItem = rs("SS_SubItem") NowSSURL = rs("SS_URL") NowSSHtmlUrl = rs("SS_HtmlUrl") NowSSType = rs("SS_Type") NowSSPath = rs("SS_Path") NowSSPathNum = UBound(Split(NowSSPath,"-")) NowPSSID = rs("PSS_ID") NowSSIS = True End If rs.close End If NowSSSiteID = ThisSiteID If NowPSID > 0 Then sql = "select * from ProductSort where SS_ID=" & NowSSID & " and PS_ID=" & NowPSID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then NowPSName = rs("PS_Name") NowPSPath = rs("PS_Path") NowPSSubItem = rs("PS_SubItem") NowPPSID = rs("PPS_ID") NowPSPathNum = UBound(split(NowPSPath,"-")) End If rs.close End If ' ====================================================================================================================== ' 当前栏目上一级名称 ' ====================================================================================================================== Sub NowPSSName() If NowPSSID > 0 and NowSSSubItem = False Then sql = "select SS_Name from SiteStructure where SS_ID="&NowPSSID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then Response.write rs("SS_Name") End If rs.close Else Response.write NowSSName End If End Sub ' ====================================================================================================================== ' 水平主导航 ' ====================================================================================================================== Sub HorzMainNav(NowCor,IndexURL) If IndexURL = "" Then Exit Sub sql = "select * from SiteStructure where SS_CheckIn<>0 and SS_Type<101 and PSS_ID="&NowSSSiteID&" order by SS_Path" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If If NowSSIS = False Then Response.write ""&Txt1&" " Else Response.write ""&Txt1&" " End If For i = 1 to rscount SS_ID = rs("SS_ID") SS_Name = rs("SS_Name") SS_URL = rs("SS_URL") tSS_Path = rs("SS_Path") SS_Type = rs("SS_Type") SS_LinkURL = rs("SS_LinkURL") SS_HtmlUrl = rs("SS_HtmlUrl") If SS_LinkURL <> "" Then SS_URL = SS_LinkURL Else If SS_Type < 4 and WebStyle = 2 Then SS_URL = SS_HtmlUrl '静态 .html Else SS_URL = SS_URL & "?SS_ID=" &SS_ID '动态 .shtml End If End If If CStr(SS_ID) = NowSSID or Instr(NowSSPath,tSS_Path) > 0 Then Response.write " | "&SS_Name&"" Else Response.write " | "&SS_Name&"" End If rs.movenext Next rs.close End Sub ' ====================================================================================================================== ' 垂直主导航 ' ====================================================================================================================== Sub VertMainNav(NowCor,NowBgCor,NowBgGrd,TbWid,TdHig,TdBgCor,TdBgGrd,TdAlign,ItemIcon,IndexURL) If IndexURL = "" Then Exit Sub sql = "select * from SiteStructure where SS_CheckIn<>0 and SS_Type<101 and PSS_ID="&NowSSSiteID&" order by SS_Path" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If Response.write " "" Then Response.write " width="""&TbWid&"""" Response.write ">" If NowSSIS = False Then Response.write " "" Then Response.write " Height="""&TdHig&"""" If NowBgCor <> "" Then Response.write " bgcolor="""&NowBgCor&"""" If NowBgGrd <> "" Then Response.write " background="""&NowBgGrd&"""" If TdAlign <> "" Then Response.write " align="""&TdAlign&"""" If ItemIcon <> "" Then Response.write " " Response.write ">"&Txt1&"" Else Response.write " "" Then Response.write " Height="""&TdHig&"""" If TdBgCor <> "" Then Response.write " bgcolor="""&TdBgCor&"""" If TdBgGrd <> "" Then Response.write " background="""&TdBgGrd&"""" If TdAlign <> "" Then Response.write " align="""&TdAlign&"""" If ItemIcon <> "" Then Response.write " " Response.write ">"&Txt1&"" End If For i = 1 to rscount SS_ID = rs("SS_ID") SS_Name = rs("SS_Name") SS_URL = rs("SS_URL") tSS_Path = rs("SS_Path") SS_Type = rs("SS_Type") SS_LinkURL = rs("SS_LinkURL") SS_HtmlUrl = rs("SS_HtmlUrl") If SS_LinkURL <> "" Then SS_URL = SS_LinkURL Else If SS_Type < 4 and WebStyle = 2 Then SS_URL = SS_HtmlUrl '静态 .html Else SS_URL = SS_URL & "?SS_ID=" &SS_ID '动态 .shtml End If End If If CStr(SS_ID) = NowSSID or Instr(NowSSPath,tSS_Path) > 0 Then Response.write " "" Then Response.write " Height="""&TdHig&"""" If NowBgCor <> "" Then Response.write " bgcolor="""&NowBgCor&"""" If NowBgGrd <> "" Then Response.write " background="""&NowBgGrd&"""" If TdAlign <> "" Then Response.write " align="""&TdAlign&"""" Response.write ">" If ItemIcon <> "" Then Response.write " " Response.write ""&SS_Name&"" Else Response.write " "" Then Response.write " Height="""&TdHig&"""" If TdBgCor <> "" Then Response.write " bgcolor="""&TdBgCor&"""" If TdBgGrd <> "" Then Response.write " background="""&TdBgGrd&"""" If TdAlign <> "" Then Response.write " align="""&TdAlign&"""" Response.write ">" If ItemIcon <> "" Then Response.write " " Response.write ""&SS_Name&"" End If rs.movenext Next rs.close Response.write "
" End Sub ' ====================================================================================================================== ' 水平子导航 ' ====================================================================================================================== Sub HorzSubNav(NowCor,NavVis) If NowSSIS = False Then Exit Sub If NowSSType = 4 Then Call ProductHorzNav(NowCor,NavVis) Exit Sub End If If NowSSType < 101 Then If NowSSSubItem = True Then sql = "select * from SiteStructure where SS_CheckIn<>0 and SS_Type<101 and PSS_ID="&NowSSID&" order by SS_Path" Else If NowPSSID = 0 Then Exit Sub sql = "select * from SiteStructure where SS_CheckIn<>0 and SS_Type<101 and PSS_ID="&NowPSSID&" order by SS_Path" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount SubNum = rscount Redim Preserve SubID(rscount),SubName(rscount),SubType(rscount),SubURL(rscount),SubItem(rscount),SubPath(rscount) str = "" For i = 1 to rscount SubID(i) = rs("SS_ID") SubName(i) = rs("SS_Name") SubType(i) = rs("SS_Type") SubURL(i) = rs("SS_URL") SubItem(i) = rs("SS_SubItem") SubPath(i) = rs("SS_Path") SS_LinkURL = rs("SS_LinkURL") SS_HtmlUrl = rs("SS_HtmlUrl") If SubType(i) < 4 and WebStyle = 2 Then SubURL(i) = SS_HtmlUrl '静态 .html Else SubURL(i) = SubURL(i) & "?SS_ID=" &SubID(i) '动态 .shtml End If If SS_LinkURL <> "" Then SubURL(i) = SS_LinkURL str = str & ""&SubName(i)&"" Else If SS_SubItem = False and CStr(SubID(i)) = NowSSID Then str = str & ""&SubName(i)&"" Else str = str & ""&SubName(i)&"" End If End If If i < rscount Then str = str & " | " rs.movenext Next rs.close If NavVis = 1 Then Response.write str End If End Sub ' ====================================================================================================================== ' 垂直子导航(以文章标题) ' 新增左边距Padd_left参数 ' ====================================================================================================================== Sub DocVertSubNav(NowCor,NowBgCor,NowBgGrd,TbWid,TdHig,TdBgCor,TdBgGrd,TdAlign,Padd_left,ItemIcon,NavVis) If xd_ID = "" or IsNull(xd_ID) or IsNumeric(xd_ID) = False Then xd_ID = GetSafeStr(Request.QueryString("d_ID")) If NowSSIS = False Then Exit Sub If NowSSType < 101 Then If NowPSSID = 0 Then Exit Sub sql = "select d_ID,d_Title,DST_URL,d_HtmlUrl,SI_Domain,d_Redirect,d_RedirectLink from DocContents where d_CheckIn<>0 and d_Type=2 and SS_ID="&NowSSID sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount SubNum = rscount If rscount = 0 Then rs.close Exit Sub End If str = " "" Then str = str & " width="""&TbWid&"""" str = str & ">" For i = 1 to rscount d_ID = rs("d_ID") d_Title = rs("d_Title") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?SS_ID="&NowSSID&"&d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If CStr(d_ID) = xd_ID Then str = str & " "" Then str = str & " Height="""&TdHig&"""" If NowBgCor <> "" Then str = str & " bgcolor="""&NowBgCor&"""" If NowBgGrd <> "" Then str = str & " background="""&NowBgGrd&"""" If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&""&d_Title&"" str = str & "" Else str = str & " "" Then str = str & " Height="""&TdHig&"""" If TdBgCor <> "" Then str = str & " bgcolor="""&TdBgCor&"""" If TdBgGrd <> "" Then str = str & " background="""&TdBgGrd&""" onMouseOver=""this.background='"&NowBgGrd&"'""" str = str & " onMouseOut=""this.background='"&TdBgGrd&"'""" End If If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&d_Title&"" End If rs.movenext Next rs.close str = str & "
" If NavVis = 1 Then Response.write str End If End Sub '取得打开窗口类型 Public Function getTarget(ByVal OpenType) ' If OpenType = "" Or OpenType = 0 Then ' getTarget = "" ' ElseIf OpenType = 1 Then ' getTarget = " target=""_blank""" ' Else ' getTarget = " target=""" & OpenType & """" ' End If If NowSSSubItem=true then getTarget = " target=""_blank""" end if End Function ' ====================================================================================================================== ' 垂直子导航 ' 新增左边距Padd_left参数 ' ====================================================================================================================== Sub VertSubNav(NowCor,NowBgCor,NowBgGrd,TbWid,TdHig,TdBgCor,TdBgGrd,TdAlign,Padd_left,ItemIcon,NavVis,Target) If NowSSIS = False Then Exit Sub If NowSSType = 4 Then Call ProductVertNav(NowCor,NowBgCor,NowBgGrd,TbWid,TdHig,TdBgCor,TdBgGrd,TdAlign,Padd_left,ItemIcon,NavVis) ' Call ProductVertMenuNav(2,"/","pro.shtml",1) Exit Sub End If If NowSSType < 101 or NowSSType=104 Then If NowSSSubItem = True Then sql = "select * from SiteStructure where SS_CheckIn<>0 and (SS_Type<101 or SS_Type=104) and PSS_ID="&NowSSID&" order by SS_Path" Else If NowPSSID = 0 Then Exit Sub sql = "select * from SiteStructure where SS_CheckIn<>0 and (SS_Type<101 or SS_Type=104) and PSS_ID="&NowPSSID&" order by SS_Path" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount SubNum = rscount If rscount = 0 Then rs.close Exit Sub End If Redim Preserve SubID(rscount),SubName(rscount),SubType(rscount),SubURL(rscount),SubItem(rscount),SubPath(rscount) str = " "" Then str = str & " width="""&TbWid&"""" str = str & ">" For i = 1 to rscount SubID(i) = rs("SS_ID") SubName(i) = rs("SS_Name") SubType(i) = rs("SS_Type") SubURL(i) = rs("SS_URL") SubItem(i) = rs("SS_SubItem") SubPath(i) = rs("SS_Path") SS_LinkURL = rs("SS_LinkURL") SS_HtmlUrl = rs("SS_HtmlUrl") 'NowSSSubItem = rs("SS_SubItem") If SubType(i) < 4 and WebStyle = 2 Then SubURL(i) = SS_HtmlUrl '静态 .html Else SubURL(i) = SubURL(i) & "?SS_ID=" &SubID(i) '动态 .shtml End If If SS_LinkURL <> "" Then SubURL(i) = SS_LinkURL str = str & " "" Then str = str & " Height="""&TdHig&"""" If TdBgCor <> "" Then str = str & " bgcolor="""&TdBgCor&"""" If TdBgGrd <> "" Then str = str & " background="""&TdBgGrd&""" onMouseOver=""this.background='"&NowBgGrd&"'""" str = str & " onMouseOut=""this.background='"&TdBgGrd&"'""" End If If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&SubName(i)&"" Else If SS_SubItem = False and CStr(SubID(i)) = NowSSID Then str = str & " "" Then str = str & " Height="""&TdHig&"""" If NowBgCor <> "" Then str = str & " bgcolor="""&NowBgCor&"""" If NowBgGrd <> "" Then str = str & " background="""&NowBgGrd&"""" If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&""&SubName(i)&"" str = str & "" Else str = str & " "" Then str = str & " Height="""&TdHig&"""" If TdBgCor <> "" Then str = str & " bgcolor="""&TdBgCor&"""" If TdBgGrd <> "" Then str = str & " background="""&TdBgGrd&""" onMouseOver=""this.background='"&NowBgGrd&"'""" str = str & " onMouseOut=""this.background='"&TdBgGrd&"'""" End If If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&SubName(i)&"" End If End If rs.movenext Next rs.close str = str & "
" If NavVis = 1 Then Response.write str End If End Sub ' ====================================================================================================================== ' 垂直子导航(指定ID) ' ====================================================================================================================== Sub VertMenuSubNav(SS_ID,NowCor,NowBgCor,NowBgGrd,TbWid,TdHig,TdBgCor,TdBgGrd,TdAlign,ItemIcon,Padd_left,NavVis) If SS_ID = "" or IsNumeric(SS_ID) = False Then Exit Sub sql = "select * from SiteStructure where SS_CheckIn<>0 and SS_Type<101 and PSS_ID="&SS_ID&" order by SS_Path" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount SubNum = rscount If rscount = 0 Then rs.close Exit Sub End If str = " "" Then str = str & " width="""&TbWid&"""" str = str & ">" For i = 1 to rscount tSS_ID = rs("SS_ID") SS_Name = rs("SS_Name") SS_Type = rs("SS_Type") SS_URL = rs("SS_URL") SS_SubItem = rs("SS_SubItem") SS_Path = rs("SS_Path") SS_LinkURL = rs("SS_LinkURL") SS_HtmlUrl = rs("SS_HtmlUrl") If SS_Type < 4 and WebStyle = 2 Then SS_URL = SS_HtmlUrl '静态 .html Else SS_URL = SS_URL & "?SS_ID=" &tSS_ID '动态 .shtml End If If SS_LinkURL <> "" Then str = str & " "" Then str = str & " Height="""&TdHig&"""" If TdBgCor <> "" Then str = str & " bgcolor="""&TdBgCor&"""" If TdBgGrd <> "" Then str = str & " background="""&TdBgGrd&""" onMouseOver=""this.background='"&NowBgGrd&"'""" str = str & " onMouseOut=""this.background='"&TdBgGrd&"'""" End If If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&SS_Name&"" Else If SS_SubItem = False and CStr(tSS_ID) = NowSSID Then str = str & " "" Then str = str & " Height="""&TdHig&"""" If NowBgCor <> "" Then str = str & " bgcolor="""&NowBgCor&"""" If NowBgGrd <> "" Then str = str & " background="""&NowBgGrd&"""" If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&""&SS_Name&"" str = str & "" Else str = str & " "" Then str = str & " Height="""&TdHig&"""" If TdBgCor <> "" Then str = str & " bgcolor="""&TdBgCor&"""" If TdBgGrd <> "" Then str = str & " background="""&TdBgGrd&""" onMouseOver=""this.background='"&NowBgGrd&"'""" str = str & " onMouseOut=""this.background='"&TdBgGrd&"'""" End If If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&SS_Name&"" End If End If rs.movenext Next rs.close str = str & "
" If NavVis = 1 Then Response.write str End Sub '====================================================================================================================== ' 当前位置 '====================================================================================================================== Sub NowPlace(IndexURL) If NowSSIS = False Then Exit Sub If IndexURL = "" Then Exit Sub If NowSSSiteID > 0 Then sql = "select * from SiteStructure where SS_ID="&NowSSSiteID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Call OutScript(ErrTxt0&ErrTxt4) End If RootSSPath = rs("SS_Path") RootSSPathNum = UBound(Split(RootSSPath,"-")) rs.close Else RootSSPathNum = 0 End If If RootSSPathNum >= NowSSPathNum Then Exit Sub PSS_ID = NowPSSID Response.write ""&Txt1&" > " OutStr = "" For i = 2 to NowSSPathNum - RootSSPathNum sql = "select * from SiteStructure where SS_ID="&PSS_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then SS_ID = rs("SS_ID") SS_Name = rs("SS_Name") SS_URL = rs("SS_URL") PSS_ID = rs("PSS_ID") SS_LinkURL = rs("SS_LinkURL") SS_Type = rs("SS_Type") SS_HtmlUrl = rs("SS_HtmlUrl") If SS_Type < 4 and WebStyle = 2 Then SS_URL = SS_HtmlUrl '静态 .html Else SS_URL = SS_URL & "?SS_ID=" &SS_ID '动态 .shtml End If If SS_LinkURL <> "" Then If OutStr = "" Then 'OutStr = ""&SS_Name&" > " OutStr = ""&SS_Name&" > " Else 'OutStr = ""&SS_Name&" > " & OutStr OutStr = ""&SS_Name&" > " & OutStr End If Else If OutStr = "" Then 'OutStr = ""&SS_Name&" > " OutStr = ""&SS_Name&" > " Else 'OutStr = ""&SS_Name&" > " & OutStr OutStr = ""&SS_Name&" > " & OutStr End If End If End If rs.close Next Response.write OutStr & NowSSName OutStr = "" If NowSSType = 4 and NowPSID > 0 Then Call ProductNowPlace() End Sub ' ====================================================================================================================== ' 产品分类水平导航 ' ====================================================================================================================== Sub ProductHorzNav(NowCor) If NowPSSubItem = False Then sql = "select * from ProductSort where SS_ID=" & NowSSID & " and PPS_ID=" & NowPPSID & " order by PS_Path" Else sql = "select * from ProductSort where SS_ID=" & NowSSID & " and PPS_ID=" & NowPSID & " order by PS_Path" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount str = "" For i = 1 to rscount PS_ID = rs("PS_ID") PS_Name = rs("PS_Name") LinkStr = "SS_ID=" & NowSSID & "&PS_ID=" & PS_ID If PS_ID = NowPSID Then str = str & ""&PS_Name&"" Else str = str & ""&PS_Name&"" End If If i < rscount Then str = str & " | " rs.movenext Next rs.close If NavVis = 1 Then Response.write str End Sub ' ====================================================================================================================== ' 产品分类垂直导航 ' ====================================================================================================================== Sub ProductVertNav(NowCor,NowBgCor,NowBgGrd,TbWid,TdHig,TdBgCor,TdBgGrd,TdAlign,Padd_left,ItemIcon,NavVis) If NowPSSubItem = False Then sql = "select * from ProductSort where SS_ID=" & NowSSID & " and PPS_ID=" & NowPPSID & " order by PS_Path" Else sql = "select * from ProductSort where SS_ID=" & NowSSID & " and PPS_ID=" & NowPSID & " order by PS_Path" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If str = " "" Then str = str & " width=""" & TbWid &"""" str = str & ">" For i = 1 to rscount PS_ID = rs("PS_ID") PS_Name = rs("PS_Name") LinkStr = "SS_ID=" & NowSSID & "&PS_ID=" & PS_ID If PS_ID = NowPSID Then str = str & " "" Then str = str & " align=""" & TdAlign&"""" If TdHig <> "" Then str = str & " Height=""" & TdHig&"""" If NowBgCor <> "" Then str = str & " bgcolor=""" & NowBgCor&"""" If NowBgGrd <> "" Then str = str & " background=""" & NowBgGrd&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&PS_Name&"" Else str = str & " "" Then str = str & " align=""" & TdAlign&"""" If TdHig <> "" Then str = str & " Height=""" & TdHig&"""" If TdBgCor <> "" Then str = str & " bgcolor=""" & TdBgCor&"""" If TdBgGrd <> "" Then str = str & " background=""" & TdBgGrd&"""" str = str & " style=""padding-left:"&Padd_left&"px;"">" If ItemIcon <> "" Then str = str & " " str = str & ""&PS_Name&"" End If rs.movenext Next rs.close str = str & "
" If NavVis = 1 Then Response.write str End Sub ' ====================================================================================================================== ' 产品分类垂直固定菜单式导航 ' ====================================================================================================================== Sub ProductVertMenuNav(SS_ID,PS_Path,ViewUrl,NavVis) If SS_ID = "" or PS_Path = "" Then Exit Sub sql = "select * from ProductSort where SS_ID=" & SS_ID & " and PS_Path like '%" & PS_Path & "%' order by PS_Path" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If %> <% j = 1 m = 1 x = 1 PS_Str = " 0 Then arrowimg = "/System/SysImage/arrow2.gif" Else arrowimg = "/System/SysImage/arrow1.gif" End If Else arrowimg = "/System/SysImage/arrow2.gif" End If LinkStr = "?SS_ID=" & SS_ID & "&PS_ID=" & PS_ID '上一子项目表结束 If PathNum = 0 and i > 1 Then PS_Str = PS_Str & "
" &chr(13)&chr(10) PS_Str = PS_Str & "" &chr(13)&chr(10) End If '主分类 If PathNum = 0 Then PS_Str = PS_Str & "" &chr(13)&chr(10) '分类项目图标 If PS_SubItem = True Then PS_Str = PS_Str & "" Else PS_Str = PS_Str & "" End If '链接文字 If PS_SubItem = True Then PS_Str = PS_Str & ""&PS_Name&"" Else PS_Str = PS_Str & "" If CInt(NowPSID) = PS_ID Then PS_Str = PS_Str & "" & PS_Name & "" Else PS_Str = PS_Str & PS_Name End If PS_Str = PS_Str &"" End If PS_Str = PS_Str & "" &chr(13)&chr(10) x = x + 1 End If '下一子项目表开始 If PathNum = 0 and i < rscount Then PS_Str = PS_Str & "" &chr(13)&chr(10) If InStr(NowPSPath,PS_Path) > 0 Then PS_Str = PS_Str & "" &chr(13)&chr(10) Else PS_Str = PS_Str & "
" &chr(13)&chr(10) End If End If '子分类 If PathNum > 0 Then If i = rscount Then bg01 = "tdbg03" If PathNum = 1 Then bg02 = "tdbg05" Else bg02 = "tdbg04" End If Else bg01 = "tdbg01" bg02 = "tdbg02" End If '项目图标 PS_Str = PS_Str & "" &chr(13)&chr(10) End If '最后一子项目表结束 If PathNum > 0 and i = rscount Then PS_Str = PS_Str & "
" &chr(13)&chr(10) For k = 1 to PathNum - 1 PS_Str = PS_Str & "" &chr(13)&chr(10) Next PS_Str = PS_Str & "" &chr(13)&chr(10) '链接 If PS_SubItem = True Then PS_Str = PS_Str & "" Else PS_Str = PS_Str & "" End If PS_Str = PS_Str & "
  " PS_Str = PS_Str & ""&PS_Name&"" PS_Str = PS_Str & "" If CInt(NowPSID) = PS_ID Then PS_Str = PS_Str & "" & PS_Name & "" Else PS_Str = PS_Str & PS_Name End If PS_Str = PS_Str &"
" &chr(13)&chr(10) PS_Str = PS_Str & "" &chr(13)&chr(10) End If If PathNum = 0 Then j = j + 1 m = m + 1 rs.movenext Next rs.close PS_Str = PS_Str & "" If NavVis = 1 Then Response.write PS_Str %> <% End If End Sub '====================================================================================================================== ' 产品分类当前位置 '====================================================================================================================== Sub ProductNowPlace() PPS_ID = NowPPSID Response.write " > " OutStr = "" For i = 2 to NowPSPathNum sql = "select * from ProductSort where SS_ID=" & NowSSID & " and PS_ID=" & PPS_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then PS_ID = rs("PS_ID") PS_Name = rs("PS_Name") PPS_ID = rs("PPS_ID") If OutStr = "" Then OutStr = ""&PS_Name&" > " Else OutStr = ""&PS_Name&" > " & OutStr End If End If rs.close Next Response.write OutStr & ""&NowPSName&"" OutStr = "" End Sub %> <% ' ====================================================================================================================== ' 导航主菜单子栏目列表(SS_ID:栏目ID,NumCol:每行显示子栏目个数,PadLeft:左边距,PadRight:右边距) ' ====================================================================================================================== Sub SortMenuList(SS_ID,NumCol,PadLeft,PadRight) sql = "select * from SiteStructure where PSS_ID="&SS_ID&" and SS_CheckIn<>0 and SS_Type<101 order by SS_No" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount For i = 1 to rscount SS_Name = rs("SS_Name") SS_Type = rs("SS_Type") SS_URL = rs("SS_URL") SS_ID = rs("SS_ID") SS_HtmlUrl = rs("SS_HtmlUrl") SS_LinkURL = rs("SS_LinkURL") If (SS_Type < 4 or SS_Type = 95) and WebStyle = 2 Then SS_URL = SS_HtmlUrl Else SS_URL = SS_URL & "?SS_ID=" & SS_ID End If If SS_LinkURL <> "" Then Response.write ""&SS_Name&"" Else Response.write ""&SS_Name&"" End If If i mod NumCol > 0 and i < rscount Then Response.write "  " If i mod NumCol = 0 Then Response.write "
" rs.movenext Next rs.close End Sub ' ====================================================================================================================== ' 新导航主菜单子栏目列表:增加子栏目显示总数,栏目名称字数限制(SS_ID:栏目ID,Nums:显示栏目数,PadLeft:左边距,PadRight:右边距,WordNums:标题字数) ' ====================================================================================================================== Sub SortMenuList_New(SS_ID,Nums,PadLeft,PadRight,WordNums) sql = "select * from SiteStructure where PSS_ID="&SS_ID&" and SS_CheckIn<>0 and SS_Type<101 order by SS_No" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount if rscount > Nums then rscount = Nums end if For i = 1 to rscount SS_Name = rs("SS_Name") SS_Type = rs("SS_Type") SS_URL = rs("SS_URL") SS_ID = rs("SS_ID") SS_HtmlUrl = rs("SS_HtmlUrl") SS_LinkURL = rs("SS_LinkURL") If (SS_Type < 4 or SS_Type = 95) and WebStyle = 2 Then SS_URL = SS_HtmlUrl Else SS_URL = SS_URL & "?SS_ID=" & SS_ID End If If SS_LinkURL <> "" Then Response.write ""&CutStr(SS_Name,WordNums)&"" Else Response.write ""&CutStr(SS_Name,WordNums)&"" End If rs.movenext Next rs.close End Sub ' ====================================================================================================================== ' 子栏目列表 ' ====================================================================================================================== Sub SortList(SS_ID,NumCol) sql = "select * from SiteStructure where PSS_ID="&SS_ID&" and SS_CheckIn<>0 and SS_Type<101 order by SS_No" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount For i = 1 to rscount SS_Name = rs("SS_Name") SS_Type = rs("SS_Type") SS_URL = rs("SS_URL") SS_ID = rs("SS_ID") SI_Domain = rs("SI_Domain") SS_HtmlUrl = rs("SS_HtmlUrl") SS_LinkURL = rs("SS_LinkURL") If SS_LinkURL <> "" Then SS_URL = SS_LinkURL Else If (SS_Type < 4 or SS_Type = 95) and WebStyle = 2 Then SS_URL = SI_Domain & SS_HtmlUrl Else SS_URL = SI_Domain & SS_URL & "?SS_ID=" & SS_ID End If End If Response.write ""&SS_Name&"" If i mod NumCol > 0 and i < rscount Then Response.write "  " If i mod NumCol = 0 Then Response.write "
" rs.movenext Next rs.close End Sub ' ====================================================================================================================== ' 站内通知(SS_ID:栏目ID) ' ====================================================================================================================== Sub Notice(SS_ID) If SS_ID = "" or IsNumeric(SS_ID) = False Then Exit Sub sql = "select * from Notice where SS_ID=" & SS_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then n_Enable = rs("n_Enable") If n_Enable = False Then rs.close Exit Sub End If n_ID = rs("n_ID") n_Width = rs("n_Width") n_Height = rs("n_Height") n_Left = rs("n_Left") n_Top = rs("n_Top") n_Toolbar = rs("n_Toolbar") n_Location = rs("n_Location") n_Status = rs("n_Status") n_Menubar = rs("n_Menubar") n_Scrollbars = rs("n_Scrollbars") n_Resizable = rs("n_Resizable") winStr = "" & chr(13) &chr(10) Response.write winStr End If rs.close End Sub ' ====================================================================================================================== ' 站内公告(SS_ID:栏目ID) ' ====================================================================================================================== Sub CallBoard(SS_ID) If SS_ID = "" or IsNumeric(SS_ID) = False Then Exit Sub sql = "select * from CallBoard where SS_ID=" & SS_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then mspeed = rs("mspeed") mbehavior = rs("mbehavior") mdirection = rs("mdirection") mwidth = rs("mwidth") mheight = rs("mheight") contents_gg = rs("contents_gg") Response.write " "scrool" Then Response.write " behavior=""" & mbehavior & """" Response.write " onMouseOver=""this.stop()"" onMouseOut=""this.start()"">"&contents_gg&"" End If rs.close End Sub '====================================================================================================================== ' 首页显示投票调查选项(SS_ID:栏目ID,dVoteNameID:投票标题ID,WinWidth:显示宽度,WinHeight:显示高度,TxtVis:是否允许查看,IsSubmit_Val:是否显示提交文字,Submit_Css:提交按钮样式,IsView_Val:是否显示查看文字,View_Css:查看按钮样式,TrHig:行高) '====================================================================================================================== Sub Vote_Css(SS_ID,dVoteNameID,WinWidth,WinHeight,TxtVis,IsSubmit_Val,Submit_Css,IsView_Val,View_Css,TrHig) If SS_ID = "" or IsNumeric(SS_ID) = False or dVoteNameID = ""or IsNumeric(dVoteNameID) = False Then Exit Sub If TxtVis = "" or IsNumeric(TxtVis) = False Then Exit Sub str = "" sql = "select * from VoteName where SS_ID="&SS_ID&" and VoteID="&dVoteNameID&" Order by VoteTaxis desc,VoteID desc" Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then Votename = rs("Votename") rs.close Dim VoteID(),VoteType(),VoteTitle(),vote_id sql = "select * from VoteTitle where SS_ID="&SS_ID&" and VoteID="&dVoteNameID&" order by ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount ReDim Preserve VoteID(rscount),VoteType(rscount),VoteTitle(rscount) If rscount = 0 Then rs.close Exit Sub End If If rscount > 1 then str = str & "
"&Votename&"
" vote_id = "" For i = 1 to rscount VoteID(i) = rs("ID") '投票题目ID VoteTitle(i) = rs("VoteTitle") Select case rs("VoteType") case 0 VoteType(i) = "radio" case 1 VoteType(i) = "checkbox" case 2 VoteType(i) = "txt" End select vote_id = vote_id & VoteID(i) & "," '投票题目ID组 rs.movenext Next rs.close str = str & ""&chr(13)&chr(10) str = str & "
" str = str & "" For i = 1 to rscount sql = "select * from VoteStat where VoteID=" & VoteID(i) Set rs = LsObject.CreateRs(sql,1,1) trscount = rs.recordcount If trscount > 0 Then str = str & "" str = str & "" str = str & "
" If rscount > 1 Then str = str & i & "、" str = str & VoteTitle(i) & "
" If VoteType(i) = "txt" then str = str & "" Else str = str & "" For k = 1 to trscount VoteItemID = rs("ID") VoteTpID = rs("VoteID") VoteItem = rs("VoteItem") sql11 = "select * from VoteTitle where ID=" & VoteTpID Set rs11 = LsObject.CreateRs(sql11,1,1) If not rs11.eof Then VoteTp=rs11("VoteType") End If rs11.close str = str & "" str = str & "" rs.movenext Next str = str & "" End if str = str & "
" str = str & "  " str = str & "" str = str & "
" str = str & "" & VoteItem & "
" str = str & "
" End If rs.close Next str = str & "" str = str & "" str = str & "" IP = request.ServerVariables("REMOTE_ADDR") If Session(IP) = 1 Then str = str & " " Else str = str & " " End If str = str & "" str = str & "
" Response.write str End If End Sub '====================================================================================================================== ' 首页投票调查列表(SS_ID:栏目ID,PageName:链接地址,TrHeight:行高,TrNum:显示条数,ItemIco:前缀小图标,ItemWid:小图标显示宽度,NumWords:显示字数) '====================================================================================================================== Sub IndexVote(SS_ID,PageName,TrHeight,TrNum,ItemIco,ItemWid,NumWords) If PageName = "" Then Exit Sub If DBType = 1 Then 'Access sql = "Select Top "&TrNum&" * from VoteName Where SS_ID = "&SS_ID&" and (isNull(VoteDate)=True or (isNull(VoteDate)=false and datediff('d',VoteDate,date())<0)) Order by VoteTaxis desc,VoteID desc" else sql = "Select Top "&TrNum&" * from VoteName Where SS_ID = "&SS_ID&" and (IsNULL(VoteDate,'1900-1-1')='1900-1-1' or (IsNULL(VoteDate,'1900-1-1')=VoteDate and datediff(day,VoteDate,"&Date()&")<0)) Order by VoteTaxis desc,VoteID desc" end if Set rs = LsObject.CreateRs(sql,1,3) rscount = rs.recordcount If Not rs.eof Then Str = "" Str = Str & "" If TrNum < rscount Then rscount = TrNum For i=1 to rscount VoteID = rs("VoteID") VoteName = rs("VoteName") If Cint(Len(VoteName)) > Cint(NumWords) Then VoteName = Left(VoteName,NumWords)&"..." Str = Str & "" Str = Str & "" Str = Str & "" rs.MoveNext Next Str = Str & "
" Str = Str & "" Str = Str & "" & VoteName & "" Str = Str & "
" End If rs.Close Set rs = Nothing Response.Write(Str) End Sub Sub VoteList(PerNumRow,NumWords) '显示投票内容 VoteID = GetSafeStr(Request.QueryString("VoteID")) If VoteID <> "" Then If IsNumeric(VoteID) = True Then 'Call Vote_ghj(NowSSID,VoteID,500,500,1) Call Vote_ghj(NowSSID,VoteID,500,600,1,1,"",1,"") Exit Sub End If End If sql = "Select * from VoteName Where SS_ID = "&NowSSID&" Order by VoteID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If linkpar ="&SS_ID="&NowSSID mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "
" Call Pagination() Response.Write "
" Response.write "" If maxcount > 1 Then '下载多于1页 Response.write "
" Call Pagination() Response.Write "
" End If End Sub Sub Vote_ghj(SS_ID,dVoteNameID,WinWidth,WinHeight,TxtVis,IsSubmit_Val,Submit_Css,IsView_Val,View_Css) If SS_ID = "" or IsNumeric(SS_ID) = False Then Exit Sub If TxtVis = "" or IsNumeric(TxtVis) = False Then Exit Sub str = "" if dVoteNameID="" then sql = "select top 1 * from VoteName where SS_ID="&SS_ID&" Order by VoteTaxis desc,VoteID desc" else sql = "select * from VoteName where SS_ID="&SS_ID&" and VoteID="&dVoteNameID&" Order by VoteTaxis desc,VoteID desc" end if Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then Votename = rs("Votename") dVoteNameID = rs("VoteID") VoteDate = rs("VoteDate") VoteContents = Votename if VoteDate = "" or isnull(VoteDate) then VoteDate = "2090-01-01" rs.close Dim VoteID(),VoteType(),VoteTitle(),vote_id sql = "select * from VoteTitle where SS_ID="&SS_ID&" and VoteID="&dVoteNameID&" order by ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount ReDim Preserve VoteID(rscount),VoteType(rscount),VoteTitle(rscount) If rscount = 0 Then rs.close Exit Sub End If If rscount > 1 then str = str & "
"&Votename&"
" if VoteContents<>"" then str = str & "
"&VoteContents&"
" vote_id = "" For i = 1 to rscount VoteID(i) = rs("ID") '投票题目ID VoteTitle(i) = rs("VoteTitle") Select case rs("VoteType") case 0 VoteType(i) = "radio" case 1 VoteType(i) = "checkbox" case 2 VoteType(i) = "txt" End select vote_id = vote_id & VoteID(i) & "," '投票题目ID组 rs.movenext Next rs.close str = str & ""&chr(13)&chr(10) str = str & "
" str = str & "" For i = 1 to rscount sql = "select * from VoteStat where VoteID=" & VoteID(i) Set rs = LsObject.CreateRs(sql,1,1) trscount = rs.recordcount If trscount > 0 Then str = str & "" str = str & "" str = str & "
" If rscount > 1 Then str = str & i & "、" str = str & VoteTitle(i) & "
" If VoteType(i) = "txt" then str = str & "" Else str = str & "" For k = 1 to trscount VoteItemID = rs("ID") VoteTpID = rs("VoteID") VoteItem = rs("VoteItem") sql11 = "select * from VoteTitle where ID=" & VoteTpID Set rs11 = LsObject.CreateRs(sql11,1,1) If not rs11.eof Then VoteTp=rs11("VoteType") End If rs11.close str = str & "" str = str & "" rs.movenext Next str = str & "" End if str = str & "
" str = str & "  " str = str & "" str = str & "
" str = str & "" & VoteItem & "
" str = str & "
" End If rs.close Next str = str & "" str = str & "" str = str & "" IP = request.ServerVariables("REMOTE_ADDR") 'If Session(IP) = 1 Then ' str = str & " " ' Else '过期判断 if date() < VoteDate then str = str & " " end if 'End If str = str & "" str = str & "
" Response.write str End If End Sub '====================================================================================================================== ' 投票调查(SS_ID:栏目ID,dVoteNameID:投票主题ID ,TxtVis:文本型问题是否显示结果) '====================================================================================================================== Sub Vote(SS_ID,VoteNameID,WinWidth,WinHeight,TxtVis) If SS_ID = "" or IsNumeric(SS_ID) = False Then Exit Sub if VoteNameID="" then VoteNameID=request("VoteID") If VoteNameID = "" or IsNumeric(VoteNameID) = False Then Exit Sub end if If TxtVis = "" or IsNumeric(TxtVis) = False Then Exit Sub str = "" If DBType = 1 Then 'Access sql = "select * from VoteName where SS_ID="&SS_ID&" and VoteID="&VoteNameID&" and (isNull(VoteDate)=True or (isNull(VoteDate)=false and datediff('d',VoteDate,date())<0)) Order by VoteTaxis desc,VoteID desc" else sql = "select * from VoteName where SS_ID="&SS_ID&" and VoteID="&VoteNameID&" and (IsNULL(VoteDate,'1900-1-1')='1900-1-1' or (IsNULL(VoteDate,'1900-1-1')=VoteDate and datediff(day,VoteDate,"&Date()&")<0)) Order by VoteTaxis desc,VoteID desc" end if Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then dVoteNameID = rs("VoteID") else If DBType = 1 Then 'Access sqla = "select * from VoteName where SS_ID="&SS_ID&" and (isNull(VoteDate)=True or (isNull(VoteDate)=false and datediff('d',VoteDate,date())<0)) Order by VoteTaxis desc,VoteID desc" else sqla = "select * from VoteName where SS_ID="&SS_ID&" and (IsNULL(VoteDate,'1900-1-1')='1900-1-1' or (IsNULL(VoteDate,'1900-1-1')=VoteDate and datediff(day,VoteDate,"&Date()&")<0)) Order by VoteTaxis desc,VoteID desc" end if Set rsa = LsObject.CreateRs(sqla,1,3) If not rsa.eof Then dVoteNameID = rsa("VoteID") end if rsa.close end if rs.close sql = "select * from VoteName where SS_ID="&SS_ID&" and VoteID="&dVoteNameID&" Order by VoteTaxis desc,VoteID desc" Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then Votename = rs("Votename") VoteCol = rs("VoteCol") VoteView = rs("VoteView") rs.close Dim VoteID(),VoteType(),VoteTitle(),vote_id sql = "select * from VoteTitle where SS_ID="&SS_ID&" and VoteID="&dVoteNameID&" order by ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount ReDim Preserve VoteID(rscount),VoteType(rscount),VoteTitle(rscount) If rscount = 0 Then rs.close Exit Sub End If If rscount > 1 then str = str & "
"&Votename&"
" vote_id = "" For i = 1 to rscount VoteID(i) = rs("ID") '投票题目ID VoteTitle(i) = rs("VoteTitle") Select case rs("VoteType") case 0 VoteType(i) = "radio" case 1 VoteType(i) = "checkbox" case 2 VoteType(i) = "txt" case 3 VoteType(i) = "radio" case 4 VoteType(i) = "checkbox" End select vote_id = vote_id & VoteID(i) & "," '投票题目ID组 rs.movenext Next rs.close str = str & ""&chr(13)&chr(10) str = str & "
" str = str & "" For i = 1 to rscount sql = "select * from VoteStat where VoteID=" & VoteID(i) Set rs = LsObject.CreateRs(sql,1,1) trscount = rs.recordcount If trscount > 0 Then str = str & "" str = str & "" str = str & "
" If rscount > 1 Then str = str & i & "、" str = str & VoteTitle(i) & "
" If VoteType(i) = "txt" then str = str & "" Else str = str & "" VoteItemID = rs("ID") VoteTpID = rs("VoteID") VoteItem = rs("VoteItem") sql11 = "select * from VoteTitle where ID=" & VoteTpID Set rs11 = LsObject.CreateRs(sql11,1,1) If not rs11.eof Then VoteTp=rs11("VoteType") End If rs11.close if VoteTp<>3 and VoteTp<>4 then For k = 1 to trscount str = str & "" rs.movenext Next end if if VoteTp=3 or VoteTp=4 then str = str & "" For k = 1 to trscount str = str & "" if int(k/VoteCol)=k/VoteCol then str = str & "" end if rs.movenext Next str = str & "" end if str = str & "" End if str = str & "
" str = str & "  " str = str & "" str = str & "
" str = str & "
" str = str & "" & rs("VoteItem") & "
" str = str & "
" str = str & "" & rs("VoteItem") & "
" str = str & "
" End If rs.close Next str = str & "" str = str & "" str = str & "" IP = request.ServerVariables("REMOTE_ADDR") ' If Session(IP) = 1 Then ' str = str & " " ' Else str = str & " " ' End If if VoteView=0 then str = str & "" end if str = str & "
" Response.write str End If End Sub ' ============================================================================================================================= ' 读取路径 ' ============================================================================================================================= Function ReadSSPath(SSID) sql = "select SS_Path from SiteStructure where SS_ID=" & SSID Set rs = LsObject.CreateRs(sql,1,1) If Not rs.eof Then ReadSSPath = rs("SS_Path") End If rs.close End Function ' =============================================================================================== ' 首页单图片文字列表(SS_ID:栏目ID;SubIS:是否显示子栏目内容;SSIDS:多栏目ID;NumRow:行数;NumCol:列数;OrderType:排列顺序;TrHig:行高;ItemIcon:小图标;ItemWid:小图标宽度;TitleWid:文字标题显示宽度;NumWords:文字标题限定显示字数;DateVis:是否显示日期;TimeVis:是否显示时间;AuthorVis:是否显示作者;HitVis:是否显示点击数;TbBg:小图片单元格背景;TbWid:单元格宽度,TbHig:单元格高度;PicWid:图片宽度;PicHig:图片高度;IsPicTitle:是否显示图片新闻标题;IsPicCont:是否显示图片新闻摘要;NumPicTitle:图片新闻标题字数;NumPicCont:图片新闻摘要字数) ' 上面显示一条新闻的图片,标题,摘要;下面显示多条新闻列表,并不重复显示此图片新闻 '================================================================================================ Sub IndexPicDocList(SS_ID,SubIS,SSIDS,NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis,TbBg,TbWid,TbHig,PicWid,PicHig,IsPicTitle,IsPicCont,NumPicTitle,NumPicCont) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub response.Write "" sql = "select top 1 d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_linkimage,d_Contents,DST_URL,d_HtmlUrl,DocContents.SI_Domain,d_Author,d_Extension,d_Hit,UI_Name,SS_Name from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0 and d_linkimage<>''" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If Select Case OrderType Case 0 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 1 sql = sql & " and charindex('|P002|',d_Extension)<>0" '推荐新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 2 sql = sql & " and charindex('|P005|',d_Extension)<>0" '热点新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,3) if not rs.eof then NumPicTitle = NumPicTitle*2 NumPicCont = NumPicCont*2 top_ID = rs("d_ID") d_ID = rs("d_ID") d_Title = rs("d_Title") d_Contents = rs("d_Contents") d_Linkimage = rs("d_Linkimage") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If response.Write "" else top_ID = 0 end if rs.close response.Write "
" if IsPicTitle<>0 then'显示新闻标题 Response.write "" d_Title = CutStr(d_Title,NumPicTitle) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" response.Write d_Title&"
" end if if IsPicCont<>0 then'显示新闻摘要 response.Write CutStr(RemoveHTML(d_Contents),NumPicCont) end if response.Write "
" sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,DocContents.SI_Domain,d_Author,d_Extension,d_Hit,UI_Name,SS_Name from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0 and d_ID not in ("&top_ID&")" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If Select Case OrderType Case 0 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 1 sql = sql & " and charindex('|P002|',d_Extension)<>0" '推荐新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 2 sql = sql & " and charindex('|P005|',d_Extension)<>0" '热点新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") UI_Name = rs("UI_Name") SS_Name = rs("SS_Name") If Instr(UI_Name,">") Then UI_Name = Trim(Mid(UI_Name,InStrRev(UI_Name,">")+1,len(UI_Name))) If instr(d_Extension,"|P005|")<>0 Then tNumWords = tNumWords - 6 If instr(d_Extension,"|P003|")<>0 Then tNumWords = tNumWords - 4 If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" if instr(d_Extension,"|P003|")<>0 or instr(d_Extension,"|P005|")<>0 then '显示加新,加热图标标题长度再缩短四个字符 d_Title = CutStr(d_Title,tNumWords-4) else d_Title = CutStr(d_Title,tNumWords) end if If d_TitleColor <> "" Then d_Title = ""&d_Title&"" '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",d_Date,date())< int(IndexDocTitDate) then d_Title = "" & d_Title & "" end if end if Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If response.Write "
" End Sub ' =============================================================================================== ' 首页单图片多文字列表(SS_ID:栏目ID;SubIS:是否显示子栏目内容;SSIDS:多栏目ID;NumRow:行数;NumCol:列数;OrderType:排列顺序;TrHig:行高;ItemIcon:小图标;ItemWid:小图标宽度;TitleWid:文字标题显示宽度;NumWords:文字标题限定显示字数;DateVis:是否显示日期;TimeVis:是否显示时间;AuthorVis:是否显示作者;HitVis:是否显示点击数;TbBg:小图片单元格背景;TbWid:单元格宽度,TbHig:单元格高度;PicWid:图片宽度;PicHig:图片高度;TopNums:图片右侧显示新闻条数;TopTitleWid:图片右侧显示新闻宽度;TopNumWords:图片右侧显示新闻宽度字数) ' 上面显示一条新闻的图片,多条新闻标题;下面显示多条新闻列表,并不重复显示上面显示的新闻标题 '================================================================================================ Sub IndexPicDocLists(SS_ID,SubIS,SSIDS,NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis,TbBg,TbWid,TbHig,PicWid,PicHig,TopNums,TopTitleWid,TopNumWords) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub response.Write "" '显示图片新闻 sql = "select top 1 d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_linkimage,d_Contents,DST_URL,d_HtmlUrl,DocContents.SI_Domain,d_Author,d_Extension,d_Hit,UI_Name,SS_Name from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0 and d_linkimage<>''" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If Select Case OrderType Case 0 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 1 sql = sql & " and instr(d_Extension,'|P002|')<>0" '推荐新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 2 sql = sql & " and instr(d_Extension,'|P005|')<>0" '热点新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then NumPicTitle = NumPicTitle*2 NumPicCont = NumPicCont*2 top_ID = rs("d_ID") d_ID = rs("d_ID") d_Title = rs("d_Title") d_Contents = rs("d_Contents") d_Linkimage = rs("d_Linkimage") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If response.Write "" else top_ID = 0 end if rs.close response.Write "" response.Write "
" '显示上面新闻列表 sql = "select top "&TopNums&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,DocContents.SI_Domain,d_Author,d_Extension,d_Hit,UI_Name,SS_Name from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0 and d_ID not in ("&top_ID&")" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If Select Case OrderType Case 0 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 1 sql = sql & " and instr(d_Extension,'|P002|')<>0" '推荐新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 2 sql = sql & " and instr(d_Extension,'|P005|')<>0" '热点新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > TopNums Then rscount = TopNums If rscount > 0 Then Response.write "" For i = 1 to rscount TopNumWords = TopNumWords*2 d_ID = rs("d_ID") if top_IDs <> "" then top_IDs = top_IDs &","&d_ID else top_IDs = top_ID end if d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If instr(d_Extension,"|P005|")<>0 Then tNumWords = tNumWords - 6 If instr(d_Extension,"|P003|")<>0 Then tNumWords = tNumWords - 4 If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" if instr(d_Extension,"|P003|")<>0 or instr(d_Extension,"|P005|")<>0 then '显示加新,加热图标标题长度再缩短四个字符 d_Title = CutStr(d_Title,TopNumWords-4) else d_Title = CutStr(d_Title,TopNumWords) end if If d_TitleColor <> "" Then d_Title = ""&d_Title&"" '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",d_Date,date())< int(IndexDocTitDate) then d_Title = "" & d_Title & "" end if end if Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close top_IDs = top_ID Response.write ErrTxt1 End If response.Write "
" '显示下面新闻列表 sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,DocContents.SI_Domain,d_Author,d_Extension,d_Hit,UI_Name,SS_Name from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0 and d_ID not in ("&top_IDs&")" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If Select Case OrderType Case 0 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 1 sql = sql & " and instr(d_Extension,'|P002|')<>0" '推荐新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 2 sql = sql & " and instr(d_Extension,'|P005|')<>0" '热点新闻 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If instr(d_Extension,"|P005|")<>0 Then tNumWords = tNumWords - 6 If instr(d_Extension,"|P003|")<>0 Then tNumWords = tNumWords - 4 If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" if instr(d_Extension,"|P003|")<>0 or instr(d_Extension,"|P005|")<>0 then '显示加新,加热图标标题长度再缩短四个字符 d_Title = CutStr(d_Title,tNumWords-4) else d_Title = CutStr(d_Title,tNumWords) end if If d_TitleColor <> "" Then d_Title = ""&d_Title&"" '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",d_Date,date())< int(IndexDocTitDate) then d_Title = "" & d_Title & "" end if end if Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If response.Write "
" End Sub ' =============================================================================================== ' 首页文字列表(SSIDS:多个SS_ID用,号隔开;OrderType值:0默认排序,1推荐文章,2热点文章、3点击排名) ' 可根据单个SS_ID,也可多个,也可单个SS_ID下的所有栏目 '================================================================================================ Sub IndexDocList(SS_ID,SubIS,SSIDS,NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,DocContents.SI_Domain," sql = sql & "d_Author,d_Extension,d_Hit,UI_Name,SS_Name from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If Select Case OrderType Case 0 'sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Case 1 sql = sql & " and instr(d_Extension,'|P002|')<>0" 'sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Case 2 sql = sql & " and instr(d_Extension,'|P005|')<>0" 'sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") UI_Name = rs("UI_Name") SS_Name = rs("SS_Name") If Instr(UI_Name,">") Then UI_Name = Trim(Mid(UI_Name,InStrRev(UI_Name,">")+1,len(UI_Name))) If d_Hot = True Then tNumWords = tNumWords - 6 If d_New = True Then tNumWords = tNumWords - 4 If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" if instr(d_Extension,"|P003|")<>0 or instr(d_Extension,"|P005|")<>0 then '显示加新,加热图标标题长度再缩短四个字符 d_Title = CutStr(d_Title,tNumWords-4) else d_Title = CutStr(d_Title,tNumWords) end if If d_TitleColor <> "" Then d_Title = ""&d_Title&"" '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",d_Date,date())< int(IndexDocTitDate) then d_Title = "" & d_Title & "" end if end if Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' =============================================================================================== ' 首页文字列表(显示全部标题名称,一般用于滚动的公告公示之类的栏目调用。SSIDS:多个SS_ID用,号隔开;OrderType值:0默认排序,1推荐文章,2热点文章、3点击排名) ' 可根据单个SS_ID,也可多个,也可单个SS_ID下的所有栏目 '================================================================================================ Sub IndexDocListNotice(SS_ID,SubIS,SSIDS,NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,DocContents.SI_Domain," sql = sql & "d_Author,d_Extension,d_Hit,UI_Name,SS_Name from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If Select Case OrderType Case 0 'sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Case 1 sql = sql & " and instr(d_Extension,'|P002|')<>0" 'sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Case 2 sql = sql & " and instr(d_Extension,'|P005|')<>0" 'sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") UI_Name = rs("UI_Name") SS_Name = rs("SS_Name") If Instr(UI_Name,">") Then UI_Name = Trim(Mid(UI_Name,InStrRev(UI_Name,">")+1,len(UI_Name))) If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If len(d_Title)<16 then st="padding-top:8px;" Else st="padding-top:5px;" End if If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" Response.write "" Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If d_TitleColor <> "" Then d_Title = ""&d_Title&"" '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",d_Date,date())< int(IndexDocTitDate) then d_Title = "" & d_Title & "" end if end if Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' ============================================================================================================================= ' 首页文字列表(含分类名称,OrderType值:0默认排序,1推荐文章,2热点文章、3点击排名) ' ============================================================================================================================= Sub IndexSortDocList(SS_ID,SubIS,NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumTr&" *,SiteStructure.SS_Name As SS_Name,SiteStructure.SS_HtmlUrl as SS_HtmlUrl" sql = sql & " from DocContents inner join SiteStructure On DocContents.SS_ID=SiteStructure.SS_ID" sql = sql & " where DocContents.d_Type=2 and DocContents.d_CheckIn<>0" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If Select Case OrderType Case 0 sql = sql & " order by DocContents.d_TopLock"&OType&",DocContents.d_No desc,DocContents.d_Date desc,DocContents.d_Time desc" Case 1 sql = sql & " and DocContents.instr(d_Extension,'|P002|')<>0" sql = sql & " order by DocContents.d_TopLock"&OType&",DocContents.d_No desc,DocContents.d_Date desc,DocContents.d_Time desc" Case 2 sql = sql & " and DocContents.instr(d_Extension,'|P005|')<>0" sql = sql & " order by DocContents.d_TopLock"&OType&",DocContents.d_No desc,DocContents.d_Date desc,DocContents.d_Time desc" Case 3 sql = sql & " order by DocContents.d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") tSS_ID = rs("SS_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hot = instr(rs("d_Extension"),"|P005|") d_New = instr(rs("d_Extension"),"|P003|") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") SS_Name = rs("SS_Name") SS_HtmlUrl = rs("SS_HtmlUrl") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Hot = True Then tNumWords = tNumWords - 5 If d_New = True Then tNumWords = tNumWords - 4 If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date '显示列表 If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "["&SS_Name&"] " Response.write "" If NumWords > 0 Then d_Title = CutStr(d_Title,tNumWords) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页调用图片加概要(SS_ID:栏目ID,TitleNumWords:标题显示字数,ContentNumWords:摘要显示字数,ImgWid:图片宽度,ImgHig:图片高度) ' ====================================================================================================================== Sub IndexDocImgAndWords(SS_ID,TitleNumWords,ContentNumWords,ImgWid,ImgHig) sql = "select top 1 d_ID,d_Title,d_Hit,d_TitleColor,d_LinkImage,d_Contents,d_Date,d_Time,DST_URL,d_HtmlUrl" sql = sql & " from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn<>0 and SS_ID="&SS_ID sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then xd_ID = rs("d_ID") xd_Title = rs("d_Title") xd_TitleColor = rs("d_TitleColor") xd_LinkImage = rs("d_LinkImage") xd_Contents = rs("d_Contents") xd_Date = rs("d_Date") xd_Time = rs("d_Time") xd_Hit = rs("d_Hit") xDST_URL = rs("DST_URL") xd_HtmlUrl = rs("d_HtmlUrl") xd_Title = CutStr(xd_Title,TitleNumWords*2) If xd_TitleColor <> "" Then xd_Title = ""&xd_Title&"" Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write "
"&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write "
"&chr(13)&chr(10) If WebStyle = 1 Then Response.write "" Else Response.write "" End If Response.write ""&xd_Title&"
    "& CutStr(RemoveHTML(xd_Contents),ContentNumWords*2) & "..." If WebStyle = 1 Then Response.write "详细>>" Else Response.write "详细>>" End If Response.write "
"&chr(13)&chr(10) End If rs.close End Sub ' ====================================================================================================================== ' 首页图片列表(增加了背景参数。SS_ID:栏目ID,SubIS:是否显示子栏目内容,SSIDS:多栏目ID,NumRow:行数,NumCol:列数,TbBdCor:表格背景色,TdBgCor:单元格背景色,TDPad:单元格边距,TdPadLeft:左边距,TdPadTop:上边距,ImgWid:图片宽度,ImgHig:图片高度,ImgBdWid:图片边框宽度,ImgBdCor:图片边框颜色,TitleVis:是否显示标题,NumWords:标题限定字数,TbBg:单元格背景) ' ====================================================================================================================== Sub IndexImageList(SS_ID,SubIS,SSIDS,NumRow,NumCol,TbBdCor,TdBgCor,TDPad,TDPadLeft,TDPadTop,ImgWid,ImgHig,ImgBdWid,ImgBdCor,TitleVis,NumWords,TbBg) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_LinkImage,DST_URL,d_HtmlUrl" sql = sql&" from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn<>0" If SSIDS <> "" Then sql = sql & " and SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount If i mod NumCol = 1 or NumCol = 1 Then Response.write "" d_ID = rs("d_ID") d_Title = rs("d_Title") d_LinkImage = rs("d_LinkImage") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = DST_URL&"?d_ID="&d_ID Else DocURL = d_HtmlUrl End If End If Response.write "" If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" Response.write " "" Then Response.write " style=""border-color:"&ImgBdCor&";""" Response.write " border="""&ImgBdWid&""" alt="""&d_Title&""">" If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" If TitleVis = 1 Then Response.write "
"&d_Title&"
" Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页新闻图片1234切换展示(SS_ID:栏目ID,SubIS:是否显示子栏目内容 ,SSIDS:多栏目ID,NumRow:显示个数,SpaceTime:切换速度,ShowType:显示方式,ImgWid:图片宽度,ImgHig:图片高度,ImgBdWid:图片背景宽度,ImgBdCor:图片背景颜色,CellSpc:边距,CellPad:边距,TbBgCor:表格背景色,TdBgCor:单元格背景色,NumWords:显示字数,WordsVis:是否显示标题,NavVis:是否显示数字图标) ' ====================================================================================================================== Sub ImageShow(SS_ID,SubIS,SSIDS,NumRow,SpaceTime,ShowType,ImgWid,ImgHig,ImgBdWid,ImgBdCor,CellSpc,CellPad,TbBgCor,TdBgCor,NumWords,WordsVis,NavVis) If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumRow) = False Then Exit Sub sql = "select top "&NumRow&" d_ID,d_LinkImage,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,DST_URL,d_HtmlUrl,SI_Domain" sql = sql&" from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SSIDS <> "" Then sql = sql & " and SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If If rscount > 0 Then Response.write "
" For j = 1 to rscount d_ID = rs("d_ID") d_LinkImage = rs("d_LinkImage") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) If d_TitleColor <>"" Then d_Title = ""&d_Title&"" Response.write "" Response.write "" Response.write "" rs.movenext If rs.eof Then Exit For Next rs.close Response.write "
" Response.write "" &chr(13)&chr(10) Response.write " "" Then Response.write " bgcolor="""&TbBgCor&"""" Response.write ">" Response.write "" Response.write "" Response.write "" If NavVis = 1 Then Response.write "" Else Response.write "" End If Response.write "" &chr(13)&chr(10) If WordsVis = 1 Then Response.write "" Else Response.write "" End If Response.write "" Response.write "
"" Then Response.write " bgcolor="""&TdBgCor&"""" Response.write ">" Response.write " "" Then Response.write "border-color:"&ImgBdCor&";" Response.write """ width="""&ImgWid&""" height="""&ImgHig&"""" If ImgBdWid <> "" Then Response.write " border="""&ImgBdWid&"""" Response.write ">
" Response.write "" Response.write "
" Response.write "" &chr(13)&chr(10) Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页图片自动切换效果(可带标题显示。Stype:1、新闻2、产品,SS_ID:栏目ID,SubIS:是否显示子栏目内容,SSIDS:多栏目ID,NumRow:显示个数,ImgWid:图片宽度,ImgHig:图片高度,ImgBdWid:图片边框宽度,ImgBdCor:图片边框颜色,TbBgCor:表格背景色,TdBgCor:单元格背景色,NumWords:标题字数,NavVis:是否显示切换数字) ' ====================================================================================================================== Sub ImageSlide(Stype,SS_ID,SubIS,SSIDS,NumRow,ImgWid,ImgHig,ImgBdWid,ImgBdCor,TbBgCor,TdBgCor,NumWords,NavVis) If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumRow) = False Then Exit Sub If Stype=1 then '调用文章 sql = "select top "&NumRow&" d_ID,d_LinkImage,d_Redirect,d_RedirectLink,d_Title,d_TitleColor,DST_URL,d_HtmlUrl,SI_Domain" sql = sql&" from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SSIDS <> "" Then sql = sql & " and SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" ElseIf Stype=2 then '调用产品图片 sql = "select * from ProductInfo where 1=1" If SSIDS <> "" Then sql = sql & " and SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and PS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql & " order by PI_Vouch"&OType&",PI_Date desc,PI_Time desc" End if Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If For i =1 to rscount d_ID = rs("d_ID") d_LinkImage = rs("d_LinkImage") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) If d_TitleColor <>"" Then d_Title = ""&d_Title&"" If i = 1 Then Response.write "" Response.write "
" Response.write "
" Response.write "" Response.write "" If NavVis = 1 Then Response.write "" End If Response.write "
"&d_Title&"
" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
" Response.write "
"&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) End Sub ' ====================================================================================================================== ' 首页带1234Flash图片切换效果(Stype:1、新闻2、产品,SS_ID:栏目ID,SubIS:是否显示子栏目内容,SSIDS:多栏目ID,NumRow:显示个数,ImgWid:图片宽度,ImgHig:图片高度,TxtHig:标题显示行高,NumWords:标题字数) ' ====================================================================================================================== Sub ImageFlash(Stype,SS_ID,SubIS,SSIDS,NumRow,ImgWid,ImgHig,TxtHig,NumWords) If SS_ID = "" or IsNumeric(SS_ID) = False or IsNumeric(NumRow) = False Then Exit Sub If Stype=1 then '调用文章 sql = "select top "&NumRow&" d_ID,d_LinkImage,d_Redirect,d_RedirectLink,d_Title,DST_URL,d_HtmlUrl,SI_Domain from DocContents" sql = sql&" where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SSIDS <> "" Then sql = sql & " and SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Elseif Stype=2 then '调用产品图片 sql = "select * from ProductInfo where 1=1" If SSIDS <> "" Then sql = sql & " and SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and PS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql & " order by PI_Vouch"&OType&",PI_Date desc,PI_Time desc" End if Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write " "&chr(13)&chr(10) End Sub ' ====================================================================================================================== ' 首页调用普通页面内容(SS_ID:栏目ID,NumWords:显示字数) ' ====================================================================================================================== Sub IndexSortDoc(SS_ID,NumWords) If SS_ID = "" or IsNumeric(SS_ID) = False Then Exit Sub sql = "select * from DocContents where d_Type=1 and SS_ID=" & SS_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then text = totext(rs("d_Contents")) If NumWords <> "" and IsNumeric(NumWords) = True Then Response.write Left(text,NumWords) Else Response.write text End If End If rs.close End Sub '====================================================================================================================== '首页大标题(SS_ID:栏目ID,OrderType:1、显示标题新闻2、显示推荐新闻3、显示热点新闻4、按点击数排行5、显示固顶新闻,FontFamily:字体名称,FontSize:字体大小,FontColor:字体颜色,FontWeight:标题是否加粗,TitlePad:标题边距,TitleAlign:标题显示方向,NumWords:文章标题字数,ContentIs:是否显示概要,ContentLen:概要显示字数,CFontColor:摘要字体颜色,MoreIs:是否显示详细文字) '====================================================================================================================== Sub IndexDocBigTitle(SS_ID,OrderType,FontFamily,FontSize,FontColor,FontWeight,TitlePad,TitleAlign,NumWords,ContentIs,ContentLen,CFontColor,MoreIs) If SS_ID = "" or IsNumeric(SS_ID) = False Then Exit Sub sql = "select top 1 * from DocContents where d_CheckIn<>0 and d_Type=2 and SS_ID="&SS_ID&"" Select Case OrderType Case 0 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P009|')<>0 order by d_Date desc,d_Time desc" else sql = sql & " and charindex('|P009|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示标题新闻 end if Case 1 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P002|')<>0 order by d_Date desc,d_Time desc" else sql = sql & " and charindex('|P002|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示推荐新闻 end if Case 2 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P005|')<>0 order by d_Date desc,d_Time desc" else sql = sql & " and charindex('|P005|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示热点新闻 end if Case 3 sql = sql & " order by d_Hit desc" '按点击数排行 Case 4 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P003|')<>0 order by d_Date desc,d_Time desc" else sql = sql & " and charindex('|P003|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示加新新闻 end if Case 5 sql = sql & " and d_TopLock<>0 order by d_Date desc,d_Time desc" '显示固顶新闻 End Select Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then d_ID = rs("d_ID") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_TitleColor = rs("d_TitleColor") d_SubTitle = rs("d_SubTitle") d_Title = rs("d_Title") d_contents = rs("d_contents") If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If str = "" If ContentIs = 1 Then str = str & "" End If str = str & "
" str = str & "" If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) str = str & ""&d_Title&"" str = str & "
" str = str & ""&CutStr(overHTML(d_contents),ContentLen*2)&"" if MoreIs =1 Then str = str & "[查看详细]" end if str = str & "
" Response.write str Else Response.Write ErrTxt1 End If rs.close End Sub Sub IndexDocList_Except1(SS_ID,SubIS,SSIDS,NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub sql = "select top 1 d_ID from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If Select Case OrderType Case 0 sql = sql & " and charindex('|P009|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示标题新闻 Case 1 sql = sql & " and instr(d_Extension,'|P002|')<>0" sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 2 sql = sql & " and instr(d_Extension,'|P005|')<>0" sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) if rs.eof then xd_ID=0 else xd_ID=rs("d_ID") end if rs.close sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,DocContents.SI_Domain," sql = sql & "d_Author,d_Extension,d_Hit,UI_Name,SS_Name from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0 and d_ID not in ("&xd_ID&")" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") UI_Name = rs("UI_Name") SS_Name = rs("SS_Name") If Instr(UI_Name,">") Then UI_Name = Trim(Mid(UI_Name,InStrRev(UI_Name,">")+1,len(UI_Name))) If d_Hot = True Then tNumWords = tNumWords - 6 If d_New = True Then tNumWords = tNumWords - 4 If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" if instr(d_Extension,"|P003|")<>0 or instr(d_Extension,"|P005|")<>0 then '显示加新,加热图标标题长度再缩短四个字符 d_Title = CutStr(d_Title,tNumWords-4) else d_Title = CutStr(d_Title,tNumWords) end if If d_TitleColor <> "" Then d_Title = ""&d_Title&"" '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",d_Date,date())< int(IndexDocTitDate) then d_Title = "" & d_Title & "" end if end if Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date&" " If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub Sub IndexDocBigTitle1(SS_ID,OrderType,FontFamily,FontSize,FontColor,FontWeight,TitlePad,TitleAlign,NumWords,ContentIs,ContentLen,CFontColor,MoreIs) If SS_ID = "" or IsNumeric(SS_ID) = False Then Exit Sub sql = "select top 1 * from DocContents where d_CheckIn<>0 and d_Type=2 and SS_ID="&SS_ID&"" Select Case OrderType Case 0 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P009|')<>0 order by d_Date desc,d_Time desc" else sql = sql & " and charindex('|P009|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示标题新闻 end if Case 1 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P002|')<>0 order by d_Date desc,d_Time desc" else sql = sql & " and charindex('|P002|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示推荐新闻 end if Case 2 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P005|')<>0 order by d_Date desc,d_Time desc" else sql = sql & " and charindex('|P005|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示热点新闻 end if Case 3 sql = sql & " order by d_Hit desc" '按点击数排行 Case 4 If DBType = 1 Then 'Access sql = sql & " and instr(d_Extension,'|P003|')<>0 order by d_Date desc,d_Time desc" else sql = sql & " and charindex('|P003|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示加新新闻 end if Case 5 sql = sql & " and d_TopLock<>0 order by d_Date desc,d_Time desc" '显示固顶新闻 End Select Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then d_ID = rs("d_ID") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_TitleColor = rs("d_TitleColor") d_SubTitle = rs("d_SubTitle") d_Title = rs("d_Title") d_contents = rs("d_contents") If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If str = "" If ContentIs = 1 Then str = str & "" End If str = str & "
" str = str & "" If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) str = str & ""&d_Title&"" str = str & "
" str = str & ""&CutStr(overHTML(d_contents),ContentLen*2)&"" if MoreIs =1 Then str = str & "[查看详细]" end if str = str & "
" Response.write str Else Response.Write ErrTxt1 End If rs.close End Sub ' =============================================================================================== ' 首页文字列表(不包含大标题新闻。OrderType:大标题新闻的选择1、显示标题新闻2、显示推荐新闻3、显示热点新闻4、按点击数排行5、显示固顶新闻) '================================================================================================ Sub IndexDocList_Except(SS_ID,SubIS,SSIDS,NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub sql = "select top 1 d_ID from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If ' Select Case OrderType ' Case 0 ' 'sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" ' sql = sql & " order by d_TopLock"&OType&",d_Time desc,d_No desc,d_Date desc" ' Case 1 ' sql = sql & " and instr(d_Extension,'|P002|')<>0" ' 'sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" ' sql = sql & " order by d_TopLock"&OType&",d_Time desc,d_No desc,d_Date desc" ' Case 2 ' sql = sql & " and instr(d_Extension,'|P005|')<>0" ' 'sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" ' sql = sql & " order by d_TopLock"&OType&",d_Time desc,d_No desc,d_Date desc" ' Case 3 ' sql = sql & " order by d_Hit desc" ' End Select Select Case OrderType Case 0 sql = sql & " and charindex('|P009|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示标题新闻 Case 1 sql = sql & " and charindex('|P002|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示推荐新闻 Case 2 sql = sql & " and charindex('|P005|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示热点新闻 Case 3 sql = sql & " order by d_Hit desc" '按点击数排行 Case 4 sql = sql & " and charindex('|P003|',d_Extension)<>0 order by d_Date desc,d_Time desc" '显示加新新闻 Case 5 sql = sql & " and d_TopLock<>0 order by d_Date desc,d_Time desc" '显示固顶新闻 End Select sql="select top 1 * from DocContents where d_CheckIn<>0 and d_Type=2 and SS_ID="&SS_ID&" and d_TopLock<>0 order by d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if rs.eof then xd_ID=0 else xd_ID=rs("d_ID") end if rs.close sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,DocContents.SI_Domain," sql = sql & "d_Author,d_Extension,d_Hit,UI_Name,SS_Name from DocContents,SiteStructure where DocContents.SS_ID=SiteStructure.SS_ID and d_Type=2 and d_CheckIn<>0 and d_ID not in ("&xd_ID&")" If SSIDS <> "" Then sql = sql & " and DocContents.SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and DocContents.SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and DocContents.SS_ID="&SS_ID End If sql = sql & " order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") UI_Name = rs("UI_Name") SS_Name = rs("SS_Name") If Instr(UI_Name,">") Then UI_Name = Trim(Mid(UI_Name,InStrRev(UI_Name,">")+1,len(UI_Name))) If d_Hot = True Then tNumWords = tNumWords - 6 If d_New = True Then tNumWords = tNumWords - 4 If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" if instr(d_Extension,"|P003|")<>0 or instr(d_Extension,"|P005|")<>0 then '显示加新,加热图标标题长度再缩短四个字符 d_Title = CutStr(d_Title,tNumWords-4) else d_Title = CutStr(d_Title,tNumWords) end if If d_TitleColor <> "" Then d_Title = ""&d_Title&"" '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",d_Date,date())< int(IndexDocTitDate) then d_Title = "" & d_Title & "" end if end if Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页图片列表(IndexImage) ' ====================================================================================================================== Sub IndexImage(SS_ID,SubIS,SSIDS,NumRow,NumCol,TdWid,TbBdCor,TdBgGrd,TdPadLeft,TdPadTop,TdBgCor,ImgWid,ImgHig,ImgBdWid,ImgBdCor,TitleVis,NumWords,TitleFamily,TitleSize,TitleColor,TitleWeight,TitleAlign,ContentVis,ContentLen,Style) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Contents,d_Redirect,d_RedirectLink,d_LinkImage,DST_URL,d_HtmlUrl,SI_Domain" sql = sql&" from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn<>0" If SSIDS <> "" Then sql = sql & " and SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount If i mod NumCol = 1 or NumCol = 1 Then Response.write "" d_ID = rs("d_ID") d_Title = rs("d_Title") d_Contents = rs("d_Contents") d_LinkImage = rs("d_LinkImage") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If Response.write "" If i mod NumCol = 0 or i=rscount Then Response.write "" rs.movenext Next rs.close Response.write "
" If Style = 1 Then Response.write "" Response.write "" Response.write "" Response.write "" If ContentVis Then Response.write "" Response.write "" Response.write "" End If Response.write "
" Response.write "" Response.write " "" Then Response.write " style=""border-color:"&ImgBdCor&";""" Response.write " border="""&ImgBdWid&""" alt="""&d_Title&""">" If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) d_Title = ""&d_Title&"" If TitleVis Then Response.write "
"&d_Title&"
" Response.write "
" Response.Write "
" If ContentLen > 0 Then d_Contents = CutStr(overHTML(d_Contents),ContentLen*2) Response.Write d_Contents Response.Write "
" ElseIf Style = 2 Then If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) d_Title = ""&d_Title&"" If TitleVis Then Response.write "
"&d_Title&"
" Response.write "" Response.write "" Response.write "" If ContentVis Then Response.write "" End If Response.write "" Response.write "
" Response.write "" Response.write " "" Then Response.write " style=""border-color:"&ImgBdCor&";""" Response.write " border="""&ImgBdWid&""" alt="""&d_Title&""">" Response.write "" Response.Write "" If ContentLen > 0 Then d_Contents = CutStr(overHTML(d_Contents),ContentLen*2) Response.Write d_Contents Response.Write "
" End If Response.Write "
" Else rs.close Response.write ErrTxt1 End If End Sub '==================================================================================================== '首页普通页面图片调用,默认调用第一张图片(SS_ID:栏目ID,PicWidth:图片宽度,PicHeight:图片高度) '==================================================================================================== Sub ContentIndexPic(SS_ID,PicWidth,PicHeight) If SS_ID="" Or Not IsNumeric(SS_ID) Then Exit Sub sql = "Select SS_Path,SS_SiteID,SS_Type from SiteStructure Where SS_ID="&SS_ID&" and SS_Type=1" Set rs = LsObject.CreateRs(sql,1,1) If Not rs.eof Then SS_Path = rs("SS_Path") SS_SiteID = rs("SS_SiteID") SS_Type = rs("SS_Type") Sql1 = "Select * from DocContents where SS_Path='"&SS_Path&"' And SS_ID="&SS_ID&" And d_Type=1" Set rs1 = LsObject.CreateRs(sql1,1,1) If Not rs1.Eof Then d_SavePathFileName = rs1("d_SavePathFileName") d_SavePathFileName = Split(d_SavePathFileName,"|") Response.Write("") Else Response.Write ErrTxt1 End If End If End Sub '==================================================================================================== '站点地图(总共显示三级栏目。SiteID:站点ID) '==================================================================================================== Sub WebSite(SiteID) Response.Write "" Response.Write "
" sql = "select SS_ID,SS_Path,SS_Name,SS_Type,SS_SubItem,SS_LinkURL,SS_HtmlUrl,SS_URL from SiteStructure where SS_SiteID="&SiteID&" and SS_Type<101 and SS_CheckIn<>0 and len(SS_Path)=9 order by SS_Path" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > 0 Then For i = 1 to rscount '读取字段 SS_ID = rs("SS_ID") SS_Name = rs("SS_Name") SS_Type = rs("SS_Type") SS_Path = rs("SS_Path") SS_SubItem = rs("SS_SubItem") SS_LinkURL = rs("SS_LinkURL") SS_HtmlUrl = rs("SS_HtmlUrl") SS_URL = rs("SS_URL") Response.Write "" rs.movenext Next rs.close end if Response.Write "
 " if SS_LinkURL<>"" then response.Write ""&SS_Name&"" else If SS_Type < 4 Then response.Write ""&SS_Name&"" else response.Write ""&SS_Name&"" end if end if Response.Write "
" sqla = "select SS_ID,SS_Path,SS_Name,SS_Type,SS_SubItem,SS_LinkURL,SS_HtmlUrl,SS_URL from SiteStructure where SS_SiteID="&SiteID&" and SS_Type<101 and SS_CheckIn<>0 and PSS_ID="&SS_ID&" order by SS_Path" Set rsa = LsObject.CreateRs(sqla,1,1) rscounta = rsa.recordcount If rscounta > 0 Then For j = 1 to rscounta '读取字段 SS_IDa = rsa("SS_ID") SS_Namea = rsa("SS_Name") SS_Typea = rsa("SS_Type") SS_Patha = rsa("SS_Path") SS_SubItema = rsa("SS_SubItem") SS_LinkURLa = rsa("SS_LinkURL") SS_HtmlUrla = rsa("SS_HtmlUrl") SS_URLa = rsa("SS_URL") Response.Write "" rsa.movenext Next rsa.close end if Response.Write "
【" if SS_LinkURLa<>"" then response.Write ""&SS_Namea&"" else If SS_Typea < 4 Then response.Write ""&SS_Namea&"" else response.Write ""&SS_Namea&"" end if end if Response.Write "】" sqlb = "select SS_ID,SS_Path,SS_Name,SS_Type,SS_SubItem,SS_LinkURL,SS_HtmlUrl,SS_URL from SiteStructure where SS_SiteID="&SiteID&" and SS_Type<101 and SS_CheckIn<>0 and PSS_ID="&SS_IDa&" order by SS_Path" Set rsb = LsObject.CreateRs(sqlb,1,1) rscountb = rsb.recordcount If rscountb > 0 Then For k = 1 to rscountb '读取字段 SS_IDb = rsb("SS_ID") SS_Nameb = rsb("SS_Name") SS_Typeb = rsb("SS_Type") SS_Pathb = rsb("SS_Path") SS_SubItemb = rsb("SS_SubItem") SS_LinkURLb = rsb("SS_LinkURL") SS_HtmlUrlb = rsb("SS_HtmlUrl") SS_URLb = rsb("SS_URL") if SS_LinkURLb<>"" then response.Write ""&SS_Nameb&"  " else If SS_Typeb < 4 Then response.Write ""&SS_Nameb&"  " else response.Write ""&SS_Nameb&"  " end if end if rsb.movenext Next rsb.close end if Response.Write "
" end sub ' ====================================================================================================================== ' 首页图片无间隙滚动(IndexAutoMoveImage) ' SS_ID 栏目ID ' SSIDS 多个栏目ID集合,以 “,” 分隔 ' NumRecord 取多少条记录 ' ImgWid 图片宽度 ' ImgHig 图片高度 ' TableWid 表格宽度 ' TableHig 表格高度 ' OrderType值:0默认排序,1推荐文章,2热点文章、3点击排名 ' Directions值:1向上;2向右;3向下;4向左 ' marginleft 图片之间间隔,单位px ' bgCol 背景颜色 ' ====================================================================================================================== Sub IndexAutoMoveImage(SS_ID,SubIS,SSIDS,NumRecord,ImgWid,ImgHig,TableWid,TableHig,OrderType,Directions,marginleft,bgCol) If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumRecord) = False Then Exit Sub If marginleft="" Then marginleft = 0 If bgCol = "" Then bgCol = "#FFFFFF" sql = "select top "&NumRecord&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_LinkImage,DST_URL,d_HtmlUrl,SI_Domain,d_Extension" sql = sql&" from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn<>0" If SSIDS <> "" Then sql = sql & " and SS_ID in ("&SSIDS&")" ElseIf SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If Select Case OrderType Case 0 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 1 sql = sql & " and instr(d_Extension,'|P002|')<>0" '推荐 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 2 sql = sql & " and instr(d_Extension,'|P005|')<>0" '热点 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRecord Then rscount = NumRecord If rscount > 0 Then Call PicAutoPlay()'调用自动滚动JS ImgStr = "" For i = 1 to rscount d_ID = rs("d_ID") d_Title = rs("d_Title") d_LinkImage = rs("d_LinkImage") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If ImgStr = ImgStr & "" ImgStr = ImgStr & "" ImgStr = ImgStr ImgStr = ImgStr & "" rs.MoveNext Next If Directions = 3 Or Directions = 2 Or Directions = 1 Then Str = " "&chr(13) End If If Directions = 1 Then Str = Str & "
"&chr(13) Str = Str & "
"&ImgStr&"
" &chr(13) Str = Str & "
"&chr(13) Str = Str & "
"&chr(13) Str = Str & " "&chr(13) ElseIf Directions = 2 Then Str = Str & "
"&chr(13) Str = Str & "
"&ImgStr&"
"&chr(13) Str = Str & "
"&chr(13) Str = Str & "
"&chr(13) Str = Str & " "&chr(13) ElseIf Directions = 3 Then Str = Str & "
"&chr(13) Str = Str & "
"&ImgStr&"
"&chr(13) Str = Str & "
"&chr(13) Str = Str & "
"&chr(13) Str = Str & " "&chr(13) ElseIf Directions = 4 Then Str = Str & "
"&chr(13) Str = Str & " "&chr(13) Str = Str & " "&chr(13) Str = Str & " "&chr(13) Str = Str & " "&chr(13) Str = Str & " "&chr(13) Str = Str & "
"&ImgStr&"
"&chr(13) Str = Str & "
"&chr(13) Str = Str & " "&chr(13) End If Response.Write(Str) End If End Sub '====================================选项卡============================================= '调用方式:Call secBorad("td","tr",28,"left",5,0,"sec2","sec1",True,"选项1,选项2,选项3,选项4,选项5","secBoard") '参数说明: 'TdID:选项卡td的id名前缀,如:td0,td1,td2...tdn,只给td 'TrID:显示隐藏的内容,同上,不同的是这个在函数外设计, 'SecCount:选项卡数目 'CurShowTr:当前默认显示项 'CurClsName:当前显示样式名 'OriClsName:原始样式名 'IsFontTitle:是否使用文字 'TitleList:文字栏目列表,用逗号隔开 'JsFunName:js函数名,避免同一页面多个选项卡不同样式,调用js时名称冲突 Sub secBorad(TdID,TrID,TdHeight,TdAlign,SecCount,CurShowTr,CurClsName,OriClsName,IsFontTitle,TitleList,JsFunName) With Response .Write ""&vbcrlf .Write ""&vbcrlf .Write ""&vbcrlf If IsFontTitle Then TitleList = Split(TitleList,",") End If For i = 0 to SecCount-1 If i = CurShowTr Then .Write ""&vbcrlf Next .Write ""&vbcrlf .Write "
"&vbcrlf Else .Write ""&vbcrlf End If If IsArray(TitleList) Then .Write TitleList(i) .Write "
"&vbcrlf End With End Sub Sub Article(LocationURL,SSID,xd_ID) '验证新闻是否启用在线投稿 sql = "Select * from DocContents where d_id="&xd_ID&"" Set rs = LsObject.CreateRs(sql,1,1) If Not rs.Eof Then If DBType = 1 Then 'Access d_Article = instr(rs("d_Extension"),"|P011|") else d_Article = charindex("|P011|",rs("d_Extension")) end if End If rs.close If d_Article = "" Or IsNull(d_Article) Or Cint(Trim(d_Article)) = 0 Then Exit Sub Response.Write("我要投稿") End Sub '======================================================================================== '首页登录窗口调用(LoginType:1、网站后台登陆地址2、EOA登陆地址,TabWid:表格宽度,TabHig:表格高度,TdPadTop:头部边距,TabBg:表格背景,TxtStyle:文本框样式名,SubmitStyle:提交样式名,ResetStyle:重置样式名) '======================================================================================== Sub IndexLoginWin(LoginType,TabWid,TabHig,TdPadTop,TabBg,TxtStyle,SubmitStyle,ResetStyle) %> <% 'EOS登录界面 If LoginType=1 then Response.Write "
" Response.Write "" Response.Write "" Response.Write "" Response.Write "
用 户:
密 码:
 
" Response.Write "
" End if 'EOA登录界面 If LoginType=2 then Response.Write "
" Response.Write "" Response.Write "" Response.Write "" Response.Write "
用 户:
密 码:
 
" Response.Write "
" End if End Sub '======================================================================================== '图片幻灯片样式一(左边大图,右边小图切换Stype:1、新闻文章2、产品图片,SS_ID:栏目ID,SubIS:是否显示子栏目内容,SpaceTime:切换速度,ImgBigWid:大图宽度,ImgBigHig:大图高度,ImgSmallWid:小图宽度,ImgSmallHig:小图高度,TabBorderCor:表格边框颜色,TabBgCor:表格背景色,NumWords:标题显示字数) '======================================================================================== Sub ImgSlideStyle01(Stype,SS_ID,SubIS,SpaceTime,ImgBigWid,ImgBigHig,ImgSmallWid,ImgSmallHig,TabBorderCor,TabBgCor,NumWords) SrcHig=3*cint(ImgBigHig)+11 SrcHig0=2*cint(ImgBigHig)+10 Response.Write ""&chr(13)&chr(10) Response.Write ""&chr(13)&chr(10) If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) Then Exit Sub Response.Write "
    " If Stype=1 then '调用文章 sql = "select * from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then for i=1 to 4 if rs.eof then exit for else d_ID = rs("d_ID") d_LinkImage = rs("d_LinkImage") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If Response.Write "
  • &rs(
  • " end if rs.movenext next else response.Write "" end if end if If Stype=2 then '调用产品图片 sql = "select * from ProductInfo where 1=1" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and PS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql & " order by PI_Vouch"&OType&",PI_Date desc,PI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then for i=1 to 4 if rs.eof then exit for else sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("SS_ID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close DST_URL = SI_Domain&NowSSURL&"?PI_ID="&rs("PI_ID")&"&SS_ID="&rs("SS_ID")&"&PS_ID="&rs("PS_ID") Response.Write "
  • &rs(
  • " end if rs.movenext next end if end if Response.Write "
    " If Stype=1 then '调用文章 sql = "select * from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then for i=1 to 4 if rs.eof then exit for else if i=1 then Response.Write "
  • "&CutStr(rs("d_Title"),NumWords*2)&"
  • " else Response.Write "
  • "&CutStr(rs("d_Title"),NumWords*2)&"
  • " end if end if rs.movenext next end if end if If Stype=2 then '调用产品图片 sql = "select * from ProductInfo where 1=1" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and PS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql & " order by PI_Vouch"&OType&",PI_Date desc,PI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then for i=1 to 4 if rs.eof then exit for else if i=1 then Response.Write "
  • "&CutStr(rs("PI_Name"),NumWords*2)&"
  • " else Response.Write "
  • "&CutStr(rs("PI_Name"),NumWords*2)&"
  • " end if end if rs.movenext next end if end if Response.Write "
    " If Stype=1 then '调用文章 sql = "select * from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then for i=1 to 4 if rs.eof then exit for else if i=1 then Response.Write "
  • " else Response.Write "
  • " end if end if rs.movenext next end if end if If Stype=2 then '调用产品图片 sql = "select * from ProductInfo where 1=1" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and PS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql & " order by PI_Vouch"&OType&",PI_Date desc,PI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then for i=1 to 4 if rs.eof then exit for else if i=1 then Response.Write "
  • " else Response.Write "
  • " end if end if rs.movenext next end if end if Response.Write "
" End Sub '======================================================================================== '图片幻灯片样式二(上面大图,下面小图切换Stype:1、新闻文章2、产品图片,SS_ID:栏目ID,SubIS:是否显示子栏目内容,ImgBigWid:大图宽度,ImgBigHig:大图高度,ImgSmallWid:小图宽度,ImgSmallHig:小图高度,TabBorderCor:表格边框颜色,TabBgCor:表格背景色,NumWords:标题显示字数,Nums:显示个数) '======================================================================================== Sub ImgSlideStyle02(Stype,SS_ID,SubIS,ImgBigWid,ImgBigHig,ImgSmallWid,ImgSmallHig,TabBorder,TabBgCol,NumWords,Nums) Response.Write ""&chr(13)&chr(10) Response.Write ""&chr(13)&chr(10) Response.Write "
" If Stype=1 then '调用文章 sql = "select * from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then d_ID = rs("d_ID") d_LinkImage = rs("d_LinkImage") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If Response.Write "" Response.Write "" end if end if If Stype=2 then '调用产品图片 sql = "select * from ProductInfo where 1=1" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and PS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql & " order by PI_Vouch"&OType&",PI_Date desc,PI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("SS_ID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close DST_URL = SI_Domain&NowSSURL&"?PI_ID="&rs("PI_ID")&"&SS_ID="&rs("SS_ID")&"&PS_ID="&rs("PS_ID") Response.Write "" Response.Write "" end if end if Response.Write "
" If Stype=1 then '调用文章 sql = "select * from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then for i=1 to Nums if rs.eof then exit for else d_ID = rs("d_ID") d_LinkImage = rs("d_LinkImage") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If if i=1 then Response.Write "
" else Response.Write "
" end if end if rs.movenext next end if end if If Stype=2 then '调用产品图片 sql = "select * from ProductInfo where 1=1" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and PS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql & " order by PI_Vouch"&OType&",PI_Date desc,PI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then for i=1 to Nums if rs.eof then exit for else sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("SS_ID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close DST_URL = SI_Domain&NowSSURL&"?PI_ID="&rs("PI_ID")&"&SS_ID="&rs("SS_ID")&"&PS_ID="&rs("PS_ID") if i=1 then Response.Write "
" else Response.Write "
" end if end if rs.movenext next end if end if Response.Write "" End Sub '======================================================================================== '图片幻灯片样式三(Stype:1、新闻文章2、产品图片,SS_ID:栏目ID,SubIS:是否显示子栏目内容,ImgWid:图片宽度,ImgHig:图片高度,Nums:显示个数,NumWords:标题字数) '======================================================================================== Sub ImgSlideStyle03(Stype,SS_ID,SubIS,ImgWid,ImgHig,Nums,NumWords) Response.Write ""&chr(13)&chr(10) Response.Write "
"&chr(13)&chr(10) Response.Write "" End Sub '====================================================================================================================== ' 首页新闻排行调用(Site_ID:站点ID,Nums:显示条数,OrderType:0按每月排行 1按每年排行 2按总数排行) '====================================================================================================================== Sub IndexNewsPH(Site_ID,Nums,OrderType) Dim UnitID(),UnitName(),OpenDate(),CurrentMonthCount(),CurrentYearCount(),UnitTotalCount(),ArticleArr() sql = "select * from UnitsInfo where UI_ID > 1 order by UI_ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount k = rscount-1 If rscount >0 Then Redim Preserve UnitID(k),UnitName(k) for i = 0 to rscount-1 UnitID(i) = rs("UI_ID") UnitName(i) = rs("UI_Name") rs.movenext Next Else Response.Write("暂无注册单位") response.end() End If rs.close Redim Preserve CurrentMonthCount(k),CurrentYearCount(k),UnitTotalCount(k) for i = 0 to Ubound(UnitName) '各单位发布的新闻总数 sql = "select count(d_ID) as totalCount from DocContents where d_CheckIn <> 0 and SS_SiteID="&Site_ID&" and UI_Name like '%"&UnitName(i)&"%'" Set rs = LsObject.CreateRs(sql,1,1) totalCount = rs("totalCount") rs.close If totalCount = "" or IsNull(totalCount) Then totalCount = 0 End If UnitTotalCount(i) = totalCount '各单位本月发布的新闻总数 sql = "select count(d_ID) as MonthCount from DocContents where d_CheckIn <> 0 and SS_SiteID="&Site_ID&" and UI_Name like '%"&UnitName(i)&"%' and month(d_Date)="&month(date())&" and year(d_Date)="&year(date())&"" Set rs = LsObject.CreateRs(sql,1,1) MonthCount = rs("MonthCount") rs.close If MonthCount = "" or IsNull(MonthCount) Then MonthCount = 0 End If CurrentMonthCount(i) = MonthCount '各单位每本年发布的新闻总数 sql = "select count(d_ID) as YearCount from DocContents where d_CheckIn <> 0 and SS_SiteID="&Site_ID&" and UI_Name like '%"&UnitName(i)&"%' and year(d_Date)="&year(date())&"" Set rs = LsObject.CreateRs(sql,1,1) YearCount = rs("YearCount") rs.close If YearCount = "" or IsNull(YearCount) Then YearCount = 0 End If CurrentYearCount(i) = YearCount next Redim ArticleArr(k+1,5) For i = 0 to Ubound(UnitID) ArticleArr(i,0) = UnitID(i) ArticleArr(i,1) = UnitName(i) ArticleArr(i,2) = CurrentMonthCount(i) ArticleArr(i,3) = CurrentYearCount(i) ArticleArr(i,4) = UnitTotalCount(i) Next col=OrderType+2 For i = 0 to k For m = 0 to k-i If ArticleArr(m,col) < ArticleArr(m+1,col) Then For j = 0 to 4 temp = ArticleArr(m+1,j) ArticleArr(m+1,j) = ArticleArr(m,j) ArticleArr(m,j) = temp Next End If Next Next %> <% If k > Nums+1 Then k = Nums+1 End If for i = 0 to k Response.Write("") for j = 1 to 3 Response.Write "" next Response.Write("") next %>
" If j = 1 Then Response.write "" ElseIf j = 2 Then Response.Write ""&ArticleArr(i,1)&"" Else Response.Write " "&ArticleArr(i,2) End If Response.Write "
<% end Sub %> <% ' ====================================================================================================================== ' 通用广告(AS_ID:分类ID号; NumRow:行数;NumCol:列数;TdPadLeft:左边距;TdPadTop:上边距;TbBdCor:表格背景颜色;TdBgCor:单元格背景颜色;RandomIS:是否随机;RandomNum:随机数值;IsVouch:是否推荐;IsClose:是否显示关闭按钮;TagName:标签名称) ' ====================================================================================================================== Sub AD(AS_ID,NumRow,NumCol,TdPadLeft,TdPadTop,TbBdCor,TdBgCor,RandomIS,RandomNum,IsVouch,IsClose,TagName) If AS_ID = "" or IsNumeric(AS_ID) = False or RandomNum = "" Then Exit Sub With Response If IsClose = 1 Then .Write "" End If If RandomIS = 0 Then '不随机取 NumTr = NumRow * NumCol If NumTr = 0 Then Call OutScript("行数或列数不规范!") sql = "select top " & NumTr & " ADInfo.*,ADSort.AS_LogoIS as AS_LogoIS,ADSort.AS_LogoWidth as AS_LogoWidth," sql = sql&"ADSort.AS_LogoHeight as AS_LogoHeight from ADInfo inner join ADSort on ADInfo.AS_ID=ADSort.AS_ID where " sql = sql&"ADInfo.AS_ID="&AS_ID&" and ADInfo.AI_IsShow=1" If IsVouch = 1 Then sql = sql & " and ADInfo.AI_Vouch <> 0" sql = sql & " order by ADInfo.AI_Vouch"&OType&",ADInfo.AI_NO desc,ADInfo.AI_Date desc,ADInfo.AI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If If rscount > NumTr Then rscount = NumTr AS_LogoIS = rs("AS_LogoIS") AS_LogoWidth = rs("AS_LogoWidth") AS_LogoHeight = rs("AS_LogoHeight") .Write " "" Then .Write " bgcolor="""&TbBdCor&"""" .Write ">" If IsClose = 1 Then .Write "" .Write "" .Write "" End If If AS_LogoIS = True Then For i = 1 to rscount AI_ID = rs("AI_ID") AI_Name = rs("AI_Name") AI_LogoURL = rs("AI_LogoURL") AI_URL = rs("AI_URL") If i mod NumCol = 1 or NumCol = 1 Then .Write "" .Write "" If i mod NumCol = 0 Then .Write "" rs.movenext Next Else For i = 1 to rscount AI_ID = rs("AI_ID") AI_Name = rs("AI_Name") AI_LogoURL = rs("AI_LogoURL") If i mod NumCol = 1 or NumCol = 1 Then .Write "" .Write "" If i mod NumCol = 0 Then .Write "" rs.movenext Next End If rs.close .Write "
" .Write "" .Write "
" If UCase(right(AI_LogoURL,4)) = ".SWF" Then .Write "" .Write "" .Write "" .Write "" .Write ""#" Then .Write "?clickthru=/System/sys0_inc_link_hit.shtml?AI_ID="&AI_ID .Write """ quality=""high"" width="""&AS_LogoWidth&""" height="""&AS_LogoHeight&"""" .Write " type=""application/x-shockwave-flash"" wmode=""transparent"">" .Write "" Else If AI_URL<>"#" Then Response.write "" Response.write "" If AI_URL<>"#" Then Response.write "" End If .Write "
"&AI_Name&"
" Else '随机取值 Dim tAI_ID(),tAI_Name(),tAI_LogoURL(),tAI_URL() sql = "select top " & RandomNum & " ADInfo.*,ADSort.AS_LogoIS as AS_LogoIS,ADSort.AS_LogoWidth as AS_LogoWidth," sql = sql & "ADSort.AS_LogoHeight as AS_LogoHeight from ADInfo inner join ADSort on ADInfo.AS_ID=ADSort.AS_ID where " sql = sql & "ADInfo.AS_ID="&AS_ID&" and ADInfo.AI_IsShow=1" If IsVouch = 1 Then sql = sql & " and ADInfo.AI_Vouch <> 0" sql = sql & " order by ADInfo.AI_Vouch"&OType&",ADInfo.AI_NO desc,ADInfo.AI_Date desc,ADInfo.AI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If If rscount > RandomNum Then rscount = RandomNum Redim Preserve tAI_ID(rscount),tAI_Name(rscount),tAI_LogoURL(rscount),tAI_URL(rscount) AS_LogoIS = rs("AS_LogoIS") AS_LogoWidth = rs("AS_LogoWidth") AS_LogoHeight = rs("AS_LogoHeight") For i = 1 to rscount tAI_ID(i) = rs("AI_ID") tAI_Name(i) = rs("AI_Name") tAI_LogoURL(i) = rs("AI_LogoURL") tAI_URL(i) = rs("AI_URL") rs.movenext Next rs.close Randomize Max = rscount Min = 1 ri = Round(Rnd * (Max - Min + 1) - 0.5) + Min .Write " "" Then .Write " bgcolor="""&TbBdCor&"""" .Write ">" If IsClose = 1 Then .Write "" .Write "" .Write "" End If .Write "" .Write "" .Write "" .Write "
" .Write "" .Write "
" If AS_LogoIS = True Then If UCase(right(tAI_LogoURL(ri),4)) = ".SWF" Then .Write "" .Write "" .Write "" .Write "" .Write ""#" Then .Write "?clickthru=/System/sys0_inc_link_hit.shtml?AI_ID="&tAI_ID(ri) .Write """ quality=""high"" width="""&AS_LogoWidth&""" height="""&AS_LogoHeight&"""" .Write " type=""application/x-shockwave-flash"" wmode=""transparent"">" .Write "" Else If tAI_URL(ri)<>"#" Then .Write "" .Write "" If tAI_URL(ri)<>"#" Then .Write "" End If Else .Write ""&tAI_Name(ri)&"" End If .Write "
" End If End With End Sub ' ====================================================================================================================== ' 通用广告(增加背景图片,限定字数。AS_ID:分类ID号; NumRow:行数;NumCol:列数;TdPadLeft:左边距;TdPadTop:上边距;TbBdCor:表格背景颜色;TdBgCor:单元格背景颜色;RandomIS:是否随机;RandomNum:随机数值;IsVouch:是否推荐;IsClose:是否显示关闭按钮;TagName:标签名称,TDBg:背景图片,WordsNums:显示字数) ' ====================================================================================================================== Sub AD_New(AS_ID,NumRow,NumCol,TdPadLeft,TdPadTop,TbBdCor,TdBgCor,RandomIS,RandomNum,IsVouch,IsClose,TagName,TDBg,WordsNums) If AS_ID = "" or IsNumeric(AS_ID) = False or RandomNum = "" Then Exit Sub With Response If IsClose = 1 Then .Write "" End If If RandomIS = 0 Then '不随机取 NumTr = NumRow * NumCol If NumTr = 0 Then Call OutScript("行数或列数不规范!") sql = "select top " & NumTr & " ADInfo.*,ADSort.AS_LogoIS as AS_LogoIS,ADSort.AS_LogoWidth as AS_LogoWidth," sql = sql&"ADSort.AS_LogoHeight as AS_LogoHeight from ADInfo inner join ADSort on ADInfo.AS_ID=ADSort.AS_ID where " sql = sql&"ADInfo.AS_ID="&AS_ID&" and ADInfo.AI_IsShow=1" If IsVouch = 1 Then sql = sql & " and ADInfo.AI_Vouch <> 0" sql = sql & " order by ADInfo.AI_Vouch"&OType&",ADInfo.AI_NO desc,ADInfo.AI_Date desc,ADInfo.AI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If If rscount > NumTr Then rscount = NumTr AS_LogoIS = rs("AS_LogoIS") AS_LogoWidth = rs("AS_LogoWidth") AS_LogoHeight = rs("AS_LogoHeight") .Write " "" Then .Write " bgcolor="""&TbBdCor&"""" .Write ">" If IsClose = 1 Then .Write "" .Write "" .Write "" End If If AS_LogoIS = True Then For i = 1 to rscount AI_ID = rs("AI_ID") AI_Name = rs("AI_Name") AI_LogoURL = rs("AI_LogoURL") AI_URL = rs("AI_URL") If i mod NumCol = 1 or NumCol = 1 Then .Write "" .Write "" If i mod NumCol = 0 Then .Write "" rs.movenext Next Else For i = 1 to rscount AI_ID = rs("AI_ID") AI_Name = rs("AI_Name") AI_LogoURL = rs("AI_LogoURL") If i mod NumCol = 1 or NumCol = 1 Then .Write "" .Write "" If i mod NumCol = 0 Then .Write "" rs.movenext Next End If rs.close .Write "
" .Write "" .Write "
" If UCase(right(AI_LogoURL,4)) = ".SWF" Then .Write "" .Write "" .Write "" .Write "" .Write ""#" Then .Write "?clickthru=/System/sys0_inc_link_hit.shtml?AI_ID="&AI_ID .Write """ quality=""high"" width="""&AS_LogoWidth&""" height="""&AS_LogoHeight&"""" .Write " type=""application/x-shockwave-flash"" wmode=""transparent"">" .Write "" Else If AI_URL<>"#" Then Response.write "" Response.write "" If AI_URL<>"#" Then Response.write "" End If .Write "
"&CutStr(AI_Name,WordsNums*2)&"
" Else '随机取值 Dim tAI_ID(),tAI_Name(),tAI_LogoURL(),tAI_URL() sql = "select top " & RandomNum & " ADInfo.*,ADSort.AS_LogoIS as AS_LogoIS,ADSort.AS_LogoWidth as AS_LogoWidth," sql = sql & "ADSort.AS_LogoHeight as AS_LogoHeight from ADInfo inner join ADSort on ADInfo.AS_ID=ADSort.AS_ID where " sql = sql & "ADInfo.AS_ID="&AS_ID&" and ADInfo.AI_IsShow=1" If IsVouch = 1 Then sql = sql & " and ADInfo.AI_Vouch <> 0" sql = sql & " order by ADInfo.AI_Vouch"&OType&",ADInfo.AI_NO desc,ADInfo.AI_Date desc,ADInfo.AI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If If rscount > RandomNum Then rscount = RandomNum Redim Preserve tAI_ID(rscount),tAI_Name(rscount),tAI_LogoURL(rscount),tAI_URL(rscount) AS_LogoIS = rs("AS_LogoIS") AS_LogoWidth = rs("AS_LogoWidth") AS_LogoHeight = rs("AS_LogoHeight") For i = 1 to rscount tAI_ID(i) = rs("AI_ID") tAI_Name(i) = rs("AI_Name") tAI_LogoURL(i) = rs("AI_LogoURL") tAI_URL(i) = rs("AI_URL") rs.movenext Next rs.close Randomize Max = rscount Min = 1 ri = Round(Rnd * (Max - Min + 1) - 0.5) + Min .Write " "" Then .Write " bgcolor="""&TbBdCor&"""" .Write ">" If IsClose = 1 Then .Write "" .Write "" .Write "" End If .Write "" .Write "" .Write "" .Write "
" .Write "" .Write "
" If AS_LogoIS = True Then If UCase(right(tAI_LogoURL(ri),4)) = ".SWF" Then .Write "" .Write "" .Write "" .Write "" .Write ""#" Then .Write "?clickthru=/System/sys0_inc_link_hit.shtml?AI_ID="&tAI_ID(ri) .Write """ quality=""high"" width="""&AS_LogoWidth&""" height="""&AS_LogoHeight&"""" .Write " type=""application/x-shockwave-flash"" wmode=""transparent"">" .Write "" Else If tAI_URL(ri)<>"#" Then .Write "" .Write "" If tAI_URL(ri)<>"#" Then .Write "" End If Else .Write ""&CutStr(tAI_Name(ri),WordsNums*2)&"" End If .Write "
" End If End With End Sub ' ====================================================================================================================== ' 下拉列表式友情链接(AS_ID:广告分类,NumRow:显示个数,BgCor:背景颜色,FontCor:字体颜色,MenuName:菜单名称) ' ====================================================================================================================== Sub ADMenu(AS_ID,NumRow,BgCor,FontCor,MenuName) If AS_ID = "" or IsNumeric(AS_ID) = False or NumRow = "" or IsNumeric(NumRow) = False or MenuName = "" Then Exit Sub If NumRow = 0 Then Call OutScript("行数不规范!") sql = "select top "&NumRow&" * from ADInfo where AS_ID="&AS_ID&" and AI_IsShow=1" sql = sql & " order by AI_Vouch"&OType&",AI_NO desc,AI_Date desc,AI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If If rscount > NumRow Then rscount = NumRow Randomize Random = Round(Rnd * (100 - 1 + 1) - 0.5) + 1 Response.write ""&chr(13)&chr(10) rs.close End Sub '====================================================================================================================== '对联浮动广告(AS_ID:广告分类,TbSpc:表格间距,TbPad:表格填充,TbBdCor:表格背景色,TdBgCor:单元格背景色,MarginStyle:左对齐或右对齐"left"/"right",MarginWid:左或右边距,MagrinHig:顶边距,ObjName:对象名) ' ====================================================================================================================== Sub FloatAD(AS_ID,TbSpc,TbPad,TbBdCor,TdBgCor,MarginStyle,MarginWid,MagrinHig,ObjName) If AS_ID = "" or IsNumeric(AS_ID) = False Then Exit Sub sql = "select top 1 ADInfo.*,ADSort.AS_LogoIS as AS_LogoIS,ADSort.AS_LogoWidth as AS_LogoWidth," sql = sql&"ADSort.AS_LogoHeight as AS_LogoHeight from ADInfo inner join ADSort on ADInfo.AS_ID=ADSort.AS_ID where " sql = sql&"ADInfo.AI_Vouch<>0 and ADInfo.AS_ID="&AS_ID&" and ADInfo.AI_IsShow=1 order by ADInfo.AI_NO desc,ADInfo.AI_Date desc,ADInfo.AI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rs.eof Then rs.close Exit Sub End If If rscount > NumTr Then rscount = NumTr AS_LogoIS = rs("AS_LogoIS") AS_LogoWidth = rs("AS_LogoWidth") AS_LogoHeight = rs("AS_LogoHeight") If AS_LogoIS = True Then AI_ID = rs("AI_ID") AI_Name = rs("AI_Name") AI_LogoURL = rs("AI_LogoURL") Response.write "
" Response.write " "" Then Response.write " bgcolor="""&TbBdCor&"""" Response.write ">" Response.write "" Response.write "
" If UCase(right(AI_LogoURL,4)) = ".SWF" Then Response.write ""#" Then Response.write "?clickthru=/system/sys0_inc_link_hit.shtml?AI_ID="&AI_ID Response.write """ quality=""high"" width="""&AS_LogoWidth&""" height="""&AS_LogoHeight&"""" Response.write " type=""application/x-shockwave-flash"" wmode=""transparent"">" Else If AI_LogoURL<>"#" Then Response.write "" Response.write "" If AI_LogoURL<>"#" Then Response.write "" End If Response.write "
" Response.write "关闭
" Response.write "" & chr(13) End If rs.close End Sub '====================================================================================================================== '支持多个广告同时漂浮(AS_ID:广告分类号,Speed:漂浮速度) ' ====================================================================================================================== Sub MoveFloatAD(AS_ID,Speed) If AS_ID = "" Then Exit Sub sql = "select ADInfo.*,ADSort.AS_LogoIS as AS_LogoIS,ADSort.AS_LogoWidth as AS_LogoWidth," sql = sql&"ADSort.AS_LogoHeight as AS_LogoHeight from ADInfo inner join ADSort on ADInfo.AS_ID=ADSort.AS_ID where " sql = sql&"ADInfo.AS_ID ="&AS_ID&" and ADInfo.AI_IsShow=1 order by ADInfo.AI_NO desc,ADInfo.AI_Date desc,ADInfo.AI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rs.eof Then rs.close Exit Sub End If for mi=1 to rscount AS_LogoIS = rs("AS_LogoIS") AS_LogoWidth = rs("AS_LogoWidth") AS_LogoHeight = rs("AS_LogoHeight") AI_ID = rs("AI_ID") AI_Name = rs("AI_Name") AI_LogoURL = rs("AI_LogoURL") AI_URL= rs("AI_URL") If AS_LogoIS = True Then '漂浮轨迹不一样 randomize Timer Xval=Round(Rnd*(0-1000+1)-0.5)+1000*mi Yval=Round(Rnd*(0-700+1)-0.5)+700*mi Response.write"
"& chr(13) if AI_URL<>"#" then Response.write"" Response.write"" if AI_URL<>"#" then Response.write"" Response.write"
"& chr(13) Response.write"关闭"& chr(13) Response.write"
"& chr(13) Response.write"
"& chr(13) Response.write"" & chr(13) end if rs.movenext next rs.close set rs=nothing End Sub '====================================================================================================================== '头部大广告图片渐隐(AS_ID:广告分类,AD_Height:显示高度,StopTime:停顿时间,ObjectName:对象名称) ' ====================================================================================================================== Sub ADChangeHidden(AS_ID,AD_Height,StopTime,ObjectName) If AS_ID = "" Then Exit Sub sql = "select ADInfo.*,ADSort.AS_LogoIS as AS_LogoIS,ADSort.AS_LogoWidth as AS_LogoWidth," sql = sql&"ADSort.AS_LogoHeight as AS_LogoHeight from ADInfo left join ADSort on ADInfo.AS_ID=ADSort.AS_ID where " sql = sql&"ADInfo.AS_ID ="&AS_ID&" and ADInfo.AI_IsShow=1 order by ADInfo.AI_NO desc,ADInfo.AI_Date desc,ADInfo.AI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then AS_LogoIS = rs("AS_LogoIS") AS_LogoWidth = rs("AS_LogoWidth") AS_LogoHeight = rs("AS_LogoHeight") AI_ID = rs("AI_ID") AI_Name = rs("AI_Name") AI_LogoURL = rs("AI_LogoURL") AI_URL= rs("AI_URL") If AS_LogoIS = True Then With Response .Write "" & chr(13) .Write "
" If UCase(right(AI_LogoURL,4)) = ".SWF" Then .Write "" .Write "" .Write "" .Write "" .Write ""#" Then .Write "?clickthru=/System/sys0_inc_link_hit.shtml?AI_ID="&AI_ID .Write """ quality=""high"" width="""&AS_LogoWidth&""" height="""&AS_LogoHeight&"""" .Write " type=""application/x-shockwave-flash"" wmode=""transparent"">" .Write "" Else If AI_URL<>"#" Then .Write "" .Write "" If AI_URL<>"#" Then .Write "" End If .Write "
" End With End If End if rs.close set rs=nothing End Sub %> <% '====================================================================================================================== ' 普通文章栏目页面(指定ID的栏目页内容) '====================================================================================================================== Sub SortIDDoc(SS_ID) sql = "select * from DocContents where d_Type=1 and SS_ID=" & SS_ID Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then d_Hit = rs("d_Hit") rs("d_Hit") = d_Hit + 1 d_Contents = rs("d_Contents") rs.update If d_Contents = "" or IsNull(d_Contents) = True Then Response.write ErrTxt1 Else Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
" & d_Contents & "
" End If End If rs.close End Sub '====================================================================================================================== ' 栏目页普通文章栏目页面 '====================================================================================================================== Sub SortDoc() sql = "select * from DocContents where d_Type=1 and SS_ID=" & NowSSID Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then d_Hit = rs("d_Hit") rs("d_Hit") = d_Hit + 1 d_Contents = rs("d_Contents") rs.update If d_Contents = "" or IsNull(d_Contents) = True Then Response.write ErrTxt1 Else Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
" & d_Contents & "
" End If End If rs.close End Sub '====================================================================================================================== ' 栏目页场景文章列表(NumWords,标题字数,OutBack,鼠标移出背景,OverBack,鼠标移上背景,TbWid表格宽度,TitleIfWid,标题框架宽度,TitleIfHig,框架高度,TitleHig,内页表格高度,WzIfWid,文章框架宽度,TitleStyle,标题框架的样式,WzStyle文章框架的宽度 '====================================================================================================================== Sub SceneDocList(NumWords,OutBack,OverBack,TbWid,TitleIfWid,TitleIfHig,TitleHig,WzIfWid,TitleStyle,WzStyle) If NowSSSubItem = True Then sql = "select * from SiteStructure where SS_CheckIn<>0 and SS_Type<107 and PSS_ID="&NowSSID&" order by SS_Path" Else If NowPSSID = 0 Then Exit Sub sql = "select * from SiteStructure where SS_CheckIn<>0 and SS_Type<107 and PSS_ID="&NowPSSID&" order by SS_Path" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount SubNum = rscount Redim Preserve SubID(rscount),SubName(rscount),SubType(rscount),SubURL(rscount),SubItem(rscount),SubPath(rscount) For i = 1 to rscount SubID(i) = rs("SS_ID") SubName(i) = rs("SS_Name") SubType(i) = rs("SS_Type") SubURL(i) = rs("SS_URL") SubItem(i) = rs("SS_SubItem") SubPath(i) = rs("SS_Path") SS_LinkURL = rs("SS_LinkURL") SS_HtmlUrl = rs("SS_HtmlUrl") If (SubType(i) < 4 or SubType(i) =95) and WebStyle = 2 Then SubURL(i) = SS_HtmlUrl '静态 .html Else SubURL(i) = SubURL(i) & "?SS_ID=" &SubID(i) '动态 .shtml End If rs.movenext Next rs.close Response.write "
" Response.write "
" If NowSSIS = False Then Exit Sub If NowSSType = 1 Then '当前项目为页面 Call SortDoc() Exit Sub End If If NowSSSubItem = True Then If SubType(1) = 1 Then Response.Redirect "?SS_ID=" & SubID(1) '第一个子项目为页面,转向第一个项目 Exit Sub End If End If If NowSSSubItem = True and (NowSSType = 2 or NowSSType = 3 or NowSSType = 95) Then '当前项目有子项目,且为文字或图片分类,显示分类名称 Response.write "
" Response.write "" Response.write "" For i = 1 to SubNum If SubType(i) = 2 or SubType(i) = 3 or SubType(i) = 95 Then '列出项目名称 Response.write "" End If Next Response.write "
" Response.write ""&SubName(i)&"" Response.write "
" End If If NowSSSubItem = False and (NowSSType = 2 or NowSSType = 3 or NowSSType = 95) Then '当前项目下无子项目,且当前项目为图片或文字分类,显示文字列表 sqls = "select d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,d_Author,d_Vouch,d_Hit,d_Hot,d_New,DST_URl,d_HtmlUrl,SI_Domain" sqls = sqls&" from DocContents where SS_ID="&NowSSID&" and d_Type=2 and d_CheckIn<>0" sqls = sqls&" order by d_No asc" Set rss = LsObject.CreateRs(sqls,1,3) rscounta = rss.recordcount If rscounta = 0 Then rss.close End If For i = 1 to rscounta d_ID = rss("d_ID") rss.movenext Next Response.write "
" Response.write "" Response.write "
" End If End Sub '====================================================================================================================== ' 栏目页场景文章列表新样式(frameWid:框架宽度,frameHig:框架高度) '====================================================================================================================== Sub SceneDocList_New(frameWid,frameHig) response.Write "" End Sub '====================================================================================================================== ' 栏目页文字文章列表 (PerNumRow:每页显示条数,NumRow:当有子栏目时,调用子栏目条数,TrHig:行高,LineImage:单元格下划线图片,TdBgGrd:单元格背景图片,ItemIcon:标题前小图标,ItemWid:小图标所在单元格宽度,TitleWid:新闻标题所在单元格宽度,NumWords:新闻标题显示字数,DateVis:是否在文章标题后显示日期,取值:0;1,TimeVis:是否在文章标题后显示时间,取值:0;1,AuthorVis:是否在文章标题后显示发稿人,取值:0;1,HitVis:是否在文章标题后显示点击数,取值:0;1,SubDocVis:是否调用子栏目内新闻,取值:0;1) '====================================================================================================================== Sub DocList(PerNumRow,NumRow,TrHig,LineImage,TdBgGrd,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis,SubDocVis) If NowSSIS = False Then Exit Sub If NowSSType = 1 Then '当前项目为页面 Call SortDoc() Exit Sub End If If NowSSSubItem = True Then If SubType(1) = 1 Then Response.Redirect "?SS_ID=" & SubID(1) '第一个子项目为页面,转向第一个项目 Exit Sub End If End If If NowSSSubItem = True and (NowSSType = 2 or NowSSType = 3) Then '当前项目有子项目,且为文字或图片分类,显示分类名称 Response.write "" Response.write "" For i = 1 to SubNum If SubType(i) = 2 or SubType(i) = 3 Then '列出项目名称 Response.write "" If SubItem(i) = True and SubDocVis = 0 Then '分类包含子项目,列出子项目名称 sql = "select * from SiteStructure where PSS_ID=" & SubID(i) Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount For k = 1 to rscount SS_HtmlUrl = rs("SS_HtmlUrl") SS_ID = rs("SS_ID") SS_URL = rs("SS_URL") If WebStyle = 1 Then SS_HtmlUrl = SS_URL & "?SS_ID=" & SS_ID If k mod 8 = 1 Then Response.write "" rs.movenext Next rs.close Else '子项目中不再包含子项目,则列出指定篇数的最近更新文章列表 sql = "select top "&NumRow&" d_ID,d_Title,d_TitleColor,d_TitleFont,d_Redirect,d_RedirectLink," sql = sql & "d_Date,d_Time,d_Author,d_Vouch,d_Hit,d_Hot,d_New,DST_URl,d_HtmlUrl,SI_Domain,d_Extension from DocContents" If SubDocVis = 1 Then sql = sql & " where SS_Path like '%"&SubPath(i)&"%'" Else sql = sql & " where SS_ID="&SubID(i)&"" End If sql = sql&" and d_Type=2 and d_CheckIn<>0" 'sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql&" order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount For k = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_TitleFont = rs("d_TitleFont") If d_TitleFont <> "" And Not IsNull(d_TitleFont) Then d_TitleFont_Array = Split(d_TitleFont,"|") d_TitleFont = "" For Font_i=0 to Ubound(d_TitleFont_Array) Select Case d_TitleFont_Array(Font_i) Case "bold" d_TitleFont = d_TitleFont & "font-weight:bold;" Case "italic" d_TitleFont = d_TitleFont & "font-style:italic" Case Else End Select Next End If d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") 'd_Vouch = rs("d_Vouch") d_Hit = rs("d_Hit") d_Hot = instr(rs("d_Extension"),"|P005|") d_New = instr(rs("d_Extension"),"|P003|") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") d_Extension=rs("d_Extension") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If d_Hot = True Then tNumWords = tNumWords - 5 If d_New = True Then tNumWords = tNumWords - 4 Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.movenext Next rs.close End If End If Next Response.write "" Response.write "
" Response.write " "&SubName(i)&"" Response.write "    "&Txt8&" >>" Response.write "
" Response.write "  "&rs("SS_Name")&"" If k mod 8 = 0 or k = rscount Then Response.write "
" Response.write "" Response.write "" If NumWords > 0 Then d_Title = CutStr(d_Title,tNumWords) If d_TitleColor <> "" Then If d_TitleFont <> "" Then d_Title = "" & d_Title & "" Else d_Title = "" & d_Title & "" End If End If '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",d_Date,date())< int(IndexDocTitDate) then d_Title = "" & d_Title & "" end if end if Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&d_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " ["&Txt7&":"&d_Hit&"]" Response.write "
" End If If NowSSSubItem = False and (NowSSType = 2 or NowSSType = 3) Then '当前项目下无子项目,且当前项目为图片或文字分类,显示文字列表 sql = "select d_ID,d_Title,d_TitleColor,d_TitleFont,d_Redirect,d_RedirectLink,d_Date,d_Time,d_Author,d_Vouch,d_Hit,d_Hot,d_New,DST_URl,d_HtmlUrl,SI_Domain,d_Extension" sql = sql&" from DocContents where SS_ID="&NowSSID&" and d_Type=2 and d_CheckIn<>0" 'sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql&" order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If linkpar ="&SS_ID="&NowSSID mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "" Response.write "" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_TitleFont = rs("d_TitleFont") If d_TitleFont <> "" And Not IsNull(d_TitleFont) Then d_TitleFont_Array = Split(d_TitleFont,"|") d_TitleFont = "" For Font_i=0 to Ubound(d_TitleFont_Array) Select Case d_TitleFont_Array(Font_i) Case "bold" d_TitleFont = d_TitleFont & "font-weight:bold;" Case "italic" d_TitleFont = d_TitleFont & "font-style:italic" Case Else End Select Next End If d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") 'd_Vouch = rs("d_Vouch") d_Hot = instr(rs("d_Extension"),"|P005|") d_New = instr(rs("d_Extension"),"|P003|") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If d_Hot = True Then tNumWords = tNumWords - 5 If d_New = True Then tNumWords = tNumWords - 4 Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.movenext Next rs.close If maxcount > 1 Then '文章列表多于1页 Response.write "" End If Response.write "" Response.write "
" Call Pagination() Response.write "
" Response.write "" If NumWords > 0 Then d_Title = CutStr(d_Title,tNumWords) If d_TitleColor <> "" Then If d_TitleFont <> "" Then d_Title = "" & d_Title & "" Else d_Title = "" & d_Title & "" End If End If '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",d_Date,date())< int(IndexDocTitDate) then d_Title = "" & d_Title & "" end if end if Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&d_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " ["&Txt7&":"&d_Hit&"]" Response.write "

" Call Pagination() Response.write "
" End If End Sub '====================================================================================================================== '栏目页图片文章列表 (NumRow:列数,NumCol:行数,LineImage:单元格下划线图片,TbBdCor:表格背景色,TdBgCor:单元格背景色,TbPad:表格填充,ImgWid:图片宽度,ImgHig:图片高度,ImgBdWid:图片边框宽度,ImgBdCor:图片边框颜色,TitleVis:是否显示标题,NumWords:标题字数) '====================================================================================================================== Sub ImageList(NumRow,NumCol,LineImage,TbBdCor,TdBgCor,TbPad,ImgWid,ImgHig,ImgBdWid,ImgBdCor,TitleVis,NumWords) If NowSSIS = False Then Exit Sub If NowSSType = 1 Then '当前项目为页面 Call SortDoc() Exit Sub End If If NowSSSubItem = True Then '第一个子项目为页面,转向第一个项目 If SubType(1) = 1 Then Response.Redirect "?SS_ID=" & SubID(1) Exit Sub End If End If NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If NowSSSubItem = True and (NowSSType = 2 or NowSSType = 3) Then '当前项目有子项目,且为文字或图片分类,逐行显示子项图片列表 Response.write "" Response.write "" For i = 1 to SubNum If SubType(i) = 2 or SubType(i) = 3 Then '列出项目名称 Response.write "" Response.write "" Response.write "" End If Next Response.write "" Response.write "
" Response.write " "&SubName(i)&"" Response.write "    "&Txt8&" >>
" sql = "select top "&NumCol&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_LinkImage,DST_URl,d_HtmlUrl,SI_Domain" sql = sql&" from DocContents where d_ShowImageLink<>0 and d_CheckIn<>0" sql = sql& " and SS_Path like '%"&SubPath(i)&"%'" 'sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql&" order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumCol Then rscount = NumCol If rscount > 0 Then Response.write "" Response.write "" For k = 1 to rscount d_ID = rs("d_ID") d_Title = rs("d_Title") d_Title1 = rs("d_Title") d_LinkImage = rs("d_LinkImage") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" '-------------- 不使用AspJpeg组件 ----------------- Response.write " "" Then Response.write " style=""border-color:"&ImgBdCor&";""" Response.write " border="""&ImgBdWid&""">" If TitleVis = 1 Then Response.write "
"&d_Title&"
" End If Response.write "
" Else rs.close Response.write ErrTxt1 End If Response.write "
" End If If NowSSSubItem = False and (NowSSType = 2 or NowSSType = 3) Then '当前项目有子项目,且为文字或图片分类,显示分类名称 sql = "select d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_LinkImage,DST_URl,d_HtmlUrl,SI_Domain from DocContents" sql = sql&" where d_ShowImageLink<>0 and d_CheckIn<>0 and SS_ID="&NowSSID 'sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql&" order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If linkpar ="&SS_ID="&NowSSID mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(NumTr) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "
" Call Pagination() Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j If i mod NumCol = 1 or NumCol = 1 Then Response.write "" d_ID = rs("d_ID") d_Title = rs("d_Title") d_Title1 = rs("d_Title") d_LinkImage = rs("d_LinkImage") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" Response.write "" If i = j and j > NumCol and i mod NumCol <> 0 Then y = NumCol - (i mod NumCol) For x = 1 to y Response.write "" Next End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" '-------------- 不使用AspJpeg组件 ----------------- Response.write " "" Then Response.write " style=""border-color:"&ImgBdCor&";""" Response.write " border="""&ImgBdWid&""">" If TitleVis = 1 Then Response.write "
"&d_Title&"
" End If Response.write "
" If maxcount > 1 Then Call Pagination() Response.write "
" End If End Sub '====================================================================================================================== ' 新闻高级搜索 (SS_SiteID:站点ID) '====================================================================================================================== Sub SearchMoreDoc(SS_SiteID) %> <% response.Write "
关键字:
搜索栏目:
搜索范围:
排列方式:
起始日期:
截止日期:
     
" End Sub '====================================================================================================================== ' 产品高级搜索 (SS_SiteID:站点ID) '====================================================================================================================== Sub SearchMorePro(SS_SiteID) response.Write "
关键字:
产品系列:
型号:
价格:
排列方式:
     
" End Sub '====================================================================================================================== ' 高级搜索文章列表 (PerNumRow:每页显示条数,TrHig:行高,ItemIcon:前缀小图标,ItemWid:前缀小图标宽度,DateVis:是否显示日期,TimeVis:是否显示时间,AuthorVis:是否显示作者,HitVis:是否显示点击数) '====================================================================================================================== Sub SearchMoreDocList(PerNumRow,TrHig,ItemIcon,ItemWid,DateVis,TimeVis,AuthorVis,HitVis) SearchWords = GetSafeStr(Trim(Request("SearchWords"))) SearchSiteid = GetSafeStr(Trim(Request("SearchSiteid"))) SearchAction = GetSafeStr(Trim(Request("action"))) SearchType = Trim(Request("SearchType")) SearchFrom = GetSafeStr(Trim(Request("SearchFrom"))) SearchBegin = Trim(Request("a")) SearchEnd = Trim(Request("b")) SearchOrder = Trim(Request("SearchOrder")) if SearchAction="search" then sql = "select d_ID,SI_Domain,d_Title,d_Redirect,d_RedirectLink,d_LinkWords,d_Date,d_Time,d_Author,d_Vouch,d_Hit,DST_URl,d_HtmlUrl,d_Extension" sql = sql&" from DocContents where d_Type in(1,2,3) and d_CheckIn<>0 and SS_SiteID="&SearchSiteid if SearchType<>"" then sql = sql&" and SS_Path like '%"&SearchType&"%'" end if if SearchFrom=1 and SearchWords<>"" then sql = sql&" and (d_Title like '%"&SearchWords&"%' or d_Contents like '%"&SearchWords&"%' or d_KeyWords like '%"&SearchWords&"%' or d_Author like '%"&SearchWords&"%')" end if if SearchFrom=2 and SearchWords<>"" then sql = sql&" and d_Title like '%"&SearchWords&"%'" end if if SearchFrom=3 and SearchWords<>"" then sql = sql&" and d_Contents like '%"&SearchWords&"%'" end if if SearchFrom=4 and SearchWords<>"" then sql = sql&" and d_KeyWords like '%"&SearchWords&"%'" end if if SearchFrom=5 and SearchWords<>"" then sql = sql&" and d_Author like '%"&SearchWords&"%'" end if IF SearchBegin<>"" then sql = sql&" and d_Date>=#"&SearchBegin&"#" end if IF SearchEnd<>"" then sql = sql&" and d_Date<=#"&SearchEnd&"#" end if sql = sql&" order by" IF SearchOrder=1 then sql = sql&" d_DATE desc," end if IF SearchOrder=2 then sql = sql&" d_Hit desc," end if sql = sql&" d_ID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt3 Exit Sub End If linkpar ="&SearchWords="&SearchWords&"&SearchSiteid="&SearchSiteid&"&action="&SearchAction&"&SearchType="&SearchType&"&SearchFrom="&SearchFrom&"&a="&SearchBegin&"&b="&SearchEnd&"&SearchOrder="&SearchOrder mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "" Response.write "" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j d_ID = rs("d_ID") SI_Domain = rs("SI_Domain") d_Title = rs("d_Title") d_LinkWords = rs("d_LinkWords") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") d_Vouch = instr(rs("d_Extension"),"|P002|") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If IsNull(d_LinkWords) = True Then d_LinkWords = "" d_Title = Replace(d_Title,SearchWords,""&SearchWords&"",1,-1,1) If d_LinkWords <> "" Then d_LinkWords = Replace(d_LinkWords,SearchWords,""&SearchWords&"",1,-1,1) End If Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.movenext Next rs.close If maxcount > 1 Then '文章列表多于1页 Response.write "" End If Response.write "" Response.write "
" Call Pagination() Response.write "
" Response.write "" Response.write ""&d_Title&" " Response.write "" If d_Vouch = True Then Response.write " " If DateVis = 1 Then Response.write " "&d_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " ["&Txt7&":"&d_Hit&"]" Response.write "" Response.write "
"&d_LinkWords&"
" Response.write "
"&DocURL&"  "&d_Date&"
" Response.write "

" Call Pagination() Response.write "
" end if End Sub '====================================================================================================================== ' 高级搜索产品列表 (PerNumRow:每页显示条数,TrHig:行高,ItemIcon:前缀小图标,ItemWid:前缀小图标宽度,DateVis:是否显示日期,TimeVis:是否显示时间,AuthorVis:是否显示作者,HitVis:是否显示点击数) '====================================================================================================================== Sub SearchMoreProList(PerNumRow,TrHig,ItemIcon,ItemWid,DateVis,TimeVis,AuthorVis,HitVis) SearchWords = GetSafeStr(Trim(Request.form("SearchWords"))) SearchSiteid = GetSafeStr(Trim(Request.form("SearchSiteid"))) SearchAction = GetSafeStr(Trim(Request("action"))) SearchType = Trim(Request.form("SearchType")) SearchXh = GetSafeStr(Trim(Request.form("SearchXh"))) SearchBegin = Trim(Request.form("SearchBegin")) SearchEnd = Trim(Request.form("SearchEnd")) SearchOrder = Trim(Request.form("SearchOrder")) if SearchAction="search" then sql = "select * from ProductInfo where PS_Path<>''" if instr(SearchType,"/")<>0 then sql = sql&" and PS_Path like '%"&SearchType&"%'" else sql = sql&" and SS_ID="&SearchType end if if SearchWords<>"" then sql = sql&" and (PI_Name like '%"&SearchWords&"%' or PI_Intro like '%"&SearchWords&"%')" end if if SearchXh<>"" then sql = sql&" and PI_Type like '%"&SearchXh&"%'" end if IF SearchBegin<>"" then sql = sql&" and PI_Price>="&SearchBegin end if IF SearchEnd<>"" then sql = sql&" and PI_Price<="&SearchEnd end if sql = sql&" order by" IF SearchOrder=1 then sql = sql&" PI_Date desc," end if IF SearchOrder=2 then sql = sql&" PI_Hit desc," end if sql = sql&" PI_ID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt3 Exit Sub End If sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("SS_ID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close linkpar ="&SearchWords="&SearchWords&"&SearchSiteid="&SearchSiteid&"&action="&SearchAction&"&SearchType="&SearchType&"&SearchXh="&SearchXh&"&SearchBegin="&SearchBegin&"&SearchEnd="&SearchEnd&"&SearchOrder="&SearchOrder mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "" Response.write "" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j d_ID = rs("PI_ID") d_Title = rs("PI_Name") d_LinkWords = rs("PI_Type")'产品型号 d_Date = rs("PI_Date") d_Time = rs("PI_Time") d_Author = "¥"&rs("PI_Price") '价格 d_Vouch = rs("PI_Vouch") d_Hit = rs("PI_Hit") DST_URL = NowSSURL&"?PI_ID="&d_ID&"&SS_ID="&rs("SS_ID")&"&PS_ID="&rs("PS_ID") d_HtmlUrl = NowSSURL&"?PI_ID="&d_ID&"&SS_ID="&rs("SS_ID")&"&PS_ID="&rs("PS_ID") d_Redirect = "" d_RedirectLink = "" If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If IsNull(d_LinkWords) = True Then d_LinkWords = "" d_Title = Replace(d_Title,SearchWords,""&SearchWords&"",1,-1,1) If d_LinkWords <> "" Then d_LinkWords = Replace(d_LinkWords,SearchWords,""&SearchWords&"",1,-1,1) End If Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.movenext Next rs.close If maxcount > 1 Then '文章列表多于1页 Response.write "" End If Response.write "" Response.write "
" Call Pagination() Response.write "
" Response.write "" Response.write ""&d_Title&" " Response.write "" If d_Vouch = True Then Response.write " " If DateVis = 1 Then Response.write " "&d_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " ["&Txt7&":"&d_Hit&"]" Response.write "" Response.write "
"&d_LinkWords&"
" Response.write "
"&DocURL&"  "&d_Date&"
" Response.write "

" Call Pagination() Response.write "
" end if End Sub '====================================================================================================================== ' 搜索文章列表 (SS_SiteID:站点ID,PerNumRow:每页显示条数,TrHig:行高,ItemIcon:前缀小图标,ItemWid:前缀小图标宽度,DateVis:是否显示日期,TimeVis:是否显示时间,AuthorVis:是否显示作者,HitVis:是否显示点击数) '====================================================================================================================== Sub SearchDocList(SS_SiteID,PerNumRow,TrHig,ItemIcon,ItemWid,DateVis,TimeVis,AuthorVis,HitVis) SearchWords = GetSafeStr(Trim(Request.QueryString("SearchWords"))) If SearchWords = "" Then Response.write ErrTxt2 Exit Sub End If sql = "select * from PublicTitle where PT_CHECKIN=1 and PT_SSSiteID="&SS_SiteID&"" If SearchWords <> "" Then sql = sql&" and PT_TITLE like '%"&SearchWords&"%'" end if sql = sql&" order by PT_DTYPE asc,PT_ID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt3 Exit Sub End If linkpar ="&SearchWords="&SearchWords mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "" Response.write "" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j '判断具体模块,指向具体表 Select Case rs("PT_DTYPE") case 1,2,3,95'新闻模块 sqls = "select * from DocContents where d_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("d_ID") SI_Domain = rsa("SI_Domain") d_Title = rsa("d_Title") d_LinkWords = rsa("d_LinkWords") d_Date = rsa("d_Date") d_Time = rsa("d_Time") d_Author = rsa("d_Author") d_Vouch = rsa("d_Vouch") d_Hit = rsa("d_Hit") DST_URL = rsa("DST_URL") d_HtmlUrl = rsa("d_HtmlUrl") d_Redirect = rsa("d_Redirect") d_RedirectLink = rsa("d_RedirectLink") end if rsa.close case 4 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from ProductInfo where PI_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("PI_ID") d_Title = rsa("PI_Name") d_LinkWords = rsa("PI_Type")'产品型号 d_Date = rsa("PI_Date") d_Time = rsa("PI_Time") d_Author = "¥"&rsa("PI_Price") '价格 d_Vouch = rsa("PI_Vouch") d_Hit = rsa("PI_Hit") DST_URL = NowSSURL&"?PI_ID="&d_ID&"&SS_ID="&rsa("SS_ID")&"&PS_ID="&rsa("PS_ID") d_HtmlUrl = NowSSURL&"?PI_ID="&d_ID&"&SS_ID="&rsa("SS_ID")&"&PS_ID="&rsa("PS_ID") d_Redirect = "" d_RedirectLink = "" end if rsa.close case 5 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from MessageBoard where m_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("m_ID") d_Title = rsa("m_Subject") d_LinkWords = CutStr(rsa("m_Contents"),200)'具体内容 d_Date = rsa("m_Date") d_Time = rsa("m_Time") d_Author = rsa("m_Name") HitVis=0 DST_URL = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&SearchStr="&SearchWords&"&action=search" d_HtmlUrl = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&SearchStr="&SearchWords&"&action=search" d_Redirect = "" d_RedirectLink = "" end if rsa.close case 6 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from JobInfo where JI_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("JI_ID") d_Title = rsa("JI_Place") d_LinkWords = CutStr(rsa("JI_Request"),200)'具体内容 d_Date = rsa("JI_StartDate") d_Time = "至 "&rsa("JI_StopDate") d_Author = rsa("JI_Pay") '待遇 HitVis=0 DST_URL = NowSSURL&"?SS_ID="&rsa("SS_ID") d_HtmlUrl = NowSSURL&"?SS_ID="&rsa("SS_ID") d_Redirect = "" d_RedirectLink = "" end if rsa.close case 7 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from Forum where F_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("F_ID") d_Title = rsa("F_Title") d_LinkWords = rsa("F_Title") d_Date = rsa("F_Date") d_Time = rsa("F_Time") d_Author = rsa("F_Name") d_Vouch = "" d_Hit = rsa("F_Hit") DST_URL = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&F_ID="&rsa("F_ID") d_HtmlUrl = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&F_ID="&rsa("F_ID") d_Redirect = "" d_RedirectLink = "" end if rsa.close case 8 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from VodInfo where VI_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("VI_ID") d_Title = rsa("VI_Name") d_LinkWords = rsa("VI_Intro") d_Date = rsa("VI_Date") d_Time = rsa("VI_Time") d_Author = "" d_Vouch = "" d_Hit = rsa("VI_Hit") DST_URL = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&VI_ID="&rsa("VI_ID")&"&action=View" d_HtmlUrl = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&VI_ID="&rsa("VI_ID")&"&action=View" d_Redirect = "" d_RedirectLink = "" end if rsa.close case 10 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from DownLoad where DL_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("DL_ID") d_Title = rsa("DL_Name") d_LinkWords = rsa("DL_Intro") d_Date = rsa("DL_Date") d_Time = rsa("DL_Time") d_Author = "" d_Vouch = "" d_Hit = rsa("DL_Hit") DST_URL = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&DL_ID="&rsa("DL_ID") d_HtmlUrl = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&DL_ID="&rsa("DL_ID") d_Redirect = rsa("DL_URL") d_RedirectLink = rsa("DL_URL") end if rsa.close case 15'领导之窗 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from LeaderWindow where LW_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("LW_ID") d_Title = rsa("LW_TITLE") d_LinkWords = rsa("LW_Contents1") d_Date = rsa("LW_Date") d_Time = rsa("LW_Time") d_Author = "" d_Vouch = "" d_Hit = "" DST_URL = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&DL_ID="&rsa("LW_ID") d_HtmlUrl = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&DL_ID="&rsa("LW_ID") d_Redirect = "" d_RedirectLink = "" end if rsa.close case 94'公开目录 sqls = "select * from Doc_GKML where d_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("d_ID") d_Title = rsa("d_nrms") d_LinkWords = "" d_Date = rsa("d_Date") d_Time = rsa("d_Time") tp = rsa("d_Type") tp=tp-1 if tp=0 then tp="" s_str = "/News_gk"&tp&".shtml" d_Author = "" d_Vouch = "" d_Hit = "" DST_URL =s_str&"?d_ID="&d_ID&"&SS_ID="&rsa("SS_ID") d_HtmlUrl = s_str&"?d_ID="&d_ID&"&SS_ID="&rsa("SS_ID") d_Redirect = "" d_RedirectLink = "" end if rsa.close case 97'政民直通车 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from InterActiveInfo where I_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("I_ID") d_Title = rsa("I_Subject") d_LinkWords = "" d_Date = rsa("I_Date") d_Time = rsa("I_Time") d_Author = "" d_Vouch = "" d_Hit = rsa("I_Hit") DST_URL = NowSSURL&"?IS_ID="&rsa("IS_ID")&"&action=defind&SS_ID="&rsa("SS_ID")&"&I_ID="&rsa("I_ID") d_HtmlUrl = NowSSURL&"?IS_ID="&rsa("IS_ID")&"&action=defind&SS_ID="&rsa("SS_ID")&"&I_ID="&rsa("I_ID") d_Redirect = "" d_RedirectLink = "" end if rsa.close case 98'在线访谈 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from InterViewSort where IVS_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("IVS_ID") d_Title = rsa("IVS_Title") d_LinkWords = rsa("IVS_Synopsis") d_Date = rsa("IVS_Date") d_Time = "" d_Author = "" d_Vouch = "" d_Hit = "" DST_URL = NowSSURL&"?SS_ID="&rsa("IVS_SS_ID")&"&IVS_ID="&rsa("IVS_ID")&"&action=docshow" d_HtmlUrl = NowSSURL&"?SS_ID="&rsa("IVS_SS_ID")&"&IVS_ID="&rsa("IVS_ID")&"&action=docshow" d_Redirect = "" d_RedirectLink = "" end if rsa.close case 99'百姓话题 sqls = "select SS_ID,SS_URL,SI_Domain from SiteStructure where SS_ID="&rs("PT_SSID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then NowSSURL=rsa("SS_URL") SI_Domain=rsa("SI_Domain") end if rsa.close sqls = "select * from Forum2 where F_ID="&rs("PT_DID") Set rsa = LsObject.CreateRs(sqls,1,3) if not rsa.eof then d_ID = rsa("F_ID") d_Title = rsa("F_Title") d_LinkWords = "" d_Date = rsa("F_Date") d_Time = rsa("F_Time") d_Author = "" d_Vouch = "" d_Hit = rsa("F_Hit") DST_URL = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&F_ID="&rsa("F_ID") d_HtmlUrl = NowSSURL&"?SS_ID="&rsa("SS_ID")&"&F_ID="&rsa("F_ID") d_Redirect = "" d_RedirectLink = "" end if rsa.close End Select If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If IsNull(d_LinkWords) = True Then d_LinkWords = "" d_Title = Replace(d_Title,SearchWords,""&SearchWords&"",1,-1,1) If d_LinkWords <> "" Then d_LinkWords = Replace(d_LinkWords,SearchWords,""&SearchWords&"",1,-1,1) End If Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.movenext Next rs.close If maxcount > 1 Then '文章列表多于1页 Response.write "" End If Response.write "" Response.write "
" Call Pagination() Response.write "
" Response.write "" Response.write ""&d_Title&" " Response.write "" If d_Vouch = True Then Response.write " " If DateVis = 1 Then Response.write " "&d_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " ["&Txt7&":"&d_Hit&"]" Response.write "" Response.write "
"&d_LinkWords&"
" Response.write "
"&DocURL&"  "&d_Date&"
" Response.write "

" Call Pagination() Response.write "
" End Sub '====================================================================================================================== ' 文字文章列表 (当后台有转向其他栏目ID时可调用此函数PerNumRow:显示条数,NumRow:行数,TrHig:行高,LineImage:背景图片,TdBgGrd:单元格背景图片,ItemIcon:前缀小图标,ItemWid:小图标宽度,TitleWid:标题宽度,NumWords:标题文字字数,DateVis:是否显示日期,TimeVis:是否显示时间,AuthorVis:是否显示作者,HitVis:是否显示点击数,SubDocVis:是否调用子栏目内新闻,取值:0;1) '====================================================================================================================== Sub DocListFrom(PerNumRow,NumRow,TrHig,LineImage,TdBgGrd,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis,SubDocVis) Request_SSID = Request.QueryString("SS_ID") If Request_SSID <> "" Then sql = "select * from SiteStructure where SS_ID=" & Request_SSID & " And SS_IDFrom not in (0)" Set rs = LsObject.CreateRs(sql,1,1) If Not rs.Eof Then NewSSID = rs("SS_IDFrom") End If End If If NewSSID = "" Then NewSSID = NowSSID If NowSSIS = False Then Exit Sub If NowSSType = 1 Then '当前项目为页面 Call SortDocLMJ() Exit Sub End If If NowSSSubItem = True Then If SubType(1) = 1 Then Response.Redirect "?bb=bb&SS_ID=" & SubID(1) '第一个子项目为页面,转向第一个项目 Exit Sub End If End If If NowSSSubItem = True and (NowSSType = 2 or NowSSType = 3) Then '当前项目有子项目,且为文字或图片分类,显示分类名称 Response.write "" Response.write "" For i = 1 to SubNum If SubType(i) = 2 or SubType(i) = 3 Then '列出项目名称 Response.write "" If SubItem(i) = True and SubDocVis = 0 Then '分类包含子项目,列出子项目名称 sql = "select * from SiteStructure where PSS_ID=" & SubID(i) Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount For k = 1 to rscount SS_HtmlUrl = rs("SS_HtmlUrl") SS_ID = rs("SS_ID") SS_URL = rs("SS_URL") SS_IDFrom = rs("SS_IDFrom") If WebStyle = 1 Then SS_HtmlUrl = SS_URL & "?SS_ID=" & SS_ID If k mod 8 = 1 Then Response.write "" rs.movenext Next rs.close Else '子项目中不再包含子项目,则列出指定篇数的最近更新文章列表 If false Then sql = "select top "&NumRow&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink," sql = sql & "d_Date,d_Time,d_Author,d_Vouch,d_Hit,d_Hot,d_New,DST_URl,d_HtmlUrl,SI_Domain,d_TopLock ,d_Extension from DocContents" sql = sql & " where SS_ID=399 or (SS_ID=44)" Else sql = "select top "&NumRow&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink," sql = sql & "d_Date,d_Time,d_Author,d_Vouch,d_Hit,d_Hot,d_New,DST_URl,d_HtmlUrl,SI_Domain,d_TopLock,d_Extension from DocContents" If SubDocVis = 1 Then sql = sql & " where SS_Path like '%"&SubPath(i)&"%'" Else sql = sql & " where SS_ID="&NewSSID&"" End If End If sql = sql&" and d_Type=2 and d_CheckIn<>0" 'sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql&" order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount For k = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") 'd_Vouch = rs("d_Vouch") d_Hit = rs("d_Hit") d_Hot = instr(rs("d_Extension"),"|P005|") d_New = instr(rs("d_Extension"),"|P003|") d_TopLock = rs("d_TopLock") d_Extension=rs("d_Extension") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If d_Hot = True Then tNumWords = tNumWords - 5 If d_New = True Then tNumWords = tNumWords - 4 If d_TopLock=True Then tNumWords = tNumWords - 4 Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.movenext Next rs.close End If End If Next Response.write "" Response.write "
" Response.write " "&SubName(i)&"" Response.write "    "&Txt8&" >>" Response.write "
" Response.write "  "&rs("SS_Name")&"" If k mod 8 = 0 or k = rscount Then Response.write "
" Response.write "" Response.write "" If NumWords > 0 Then d_Title = CutStr(d_Title,tNumWords) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" Response.write d_Title&"" If d_TopLock=true Then Response.Write("[置顶]") Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&d_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " ["&Txt7&":"&d_Hit&"]" Response.write "
" End If If NowSSSubItem = False and (NowSSType = 2 or NowSSType = 3) Then '当前项目下无子项目,且当前项目为图片或文字分类,显示文字列表 If false Then sql = "select top "&NumRow&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink," sql = sql & "d_Date,d_Time,d_Author,d_Vouch,d_Hit,d_Hot,d_New,DST_URl,d_HtmlUrl,SI_Domain, d_TopLock,d_Extension from DocContents" sql = sql & " where SS_ID=399 or (SS_ID=44)" Else sql = "select d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,d_Author,d_Vouch,d_Hit,d_Hot,d_New,DST_URl,d_HtmlUrl,SI_Domain,d_TopLock,d_Extension" sql = sql&" from DocContents where SS_ID="&NewSSID&" and d_Type=2 and d_CheckIn<>0" End If 'sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" sql = sql&" order by d_TopLock"&OType&",d_Date desc,d_Time desc,d_No desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If linkpar ="&SS_ID="&NowSSID mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "" Response.write "" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") 'd_Vouch = rs("d_Vouch") d_Hot = instr(rs("d_Extension"),"|P005|") d_New = instr(rs("d_Extension"),"|P003|") d_Extension=rs("d_Extension") d_TopLock= rs("d_TopLock") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If d_Hot = True Then tNumWords = tNumWords - 5 If d_New = True Then tNumWords = tNumWords - 4 Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.movenext Next rs.close If maxcount > 1 Then '文章列表多于1页 Response.write "" End If Response.write "" Response.write "
" Call Pagination() Response.write "
" Response.write "" If NumWords > 0 Then d_Title = CutStr(d_Title,tNumWords) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" Response.write d_Title&"" If d_TopLock=true Then Response.Write("[置顶]") Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&d_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " ["&Txt7&":"&d_Hit&"]" Response.write "

" Call Pagination() Response.write "
" End If End Sub '====================================================================================================================== ' 普通栏目页面(当后台有转向其他栏目ID时可调用此函数) '====================================================================================================================== Sub SortDocFrom() Request_SSID = Request.QueryString("SS_ID") If Request_SSID <> "" Then sql = "select * from SiteStructure where SS_ID=" & Request_SSID & " And SS_IDFrom not in (0)" Set rs = LsObject.CreateRs(sql,1,1) If Not rs.Eof Then NewSSID = rs("SS_IDFrom") End If End If If NewSSID = "" Then NewSSID = NowSSID sql = "select * from DocContents where d_Type=1 and SS_ID=" & NewSSID Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then d_Hit = rs("d_Hit") rs("d_Hit") = d_Hit + 1 d_Contents = rs("d_Contents") rs.update If d_Contents = "" or IsNull(d_Contents) = True Then Response.write ErrTxt1 Else Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
" & d_Contents & "
" End If End If rs.close End Sub %> <% ' ====================================================================================================================== ' 首页产品展示列表(SS_ID:栏目ID,PS_Path:栏目路径,NumRow:行数,NumCol:列数,TbBdCor:单元格颜色,TdBgCor:单元格背景颜色,TbPad:单元格边距,ViewUrl:链接地址,PIwid:图片宽度,PIhig:图片高度,Trhig:图片与文字间距) ' ====================================================================================================================== Sub IndexProductList(SS_ID,PS_Path,NumRow,NumCol,TbBdCor,TdBgCor,TbPad,ViewUrl,PIwid,PIhig,Trhig) NumTr = NumRow * NumCol If NumTr = "" or IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" Then Exit Sub sql = "select * from ProductInfo where SS_ID="&SS_ID If PS_Path <> "" Then sql = sql & " and PS_Path like '%"&PS_Path&"%'" End If sql = sql & " order by PI_Vouch"&OType&",PI_Date desc,PI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If %><% Response.write "" & chr(13) &chr(10) Response.write "" & chr(13) &chr(10) For i = 1 to CInt(NumRow) Response.write "" For m = 1 to CInt(NumCol) PI_ID = rs("PI_ID") tPS_ID = rs("PS_ID") PI_Name = rs("PI_Name") PI_Type = rs("PI_Type") PI_Photo = rs("PI_Photo") PI_BigPhoto = rs("PI_BigPhoto") PI_Price = rs("PI_Price") If PI_Photo = "" or IsNull(PI_Photo) = True Then PI_Photo = "/System/SysImage/nophoto.gif" If PI_BigPhoto = "" or IsNull(PI_BigPhoto) = True Then PI_BigPhoto = PI_Photo Response.write "" rs.movenext If rs.eof Then Exit For Next Response.write "" If rs.eof Then Exit For Next Response.write "
" %>
" alt="<%= PI_Name%>" border="0" width="<%=PIwid%>" height="<%=PIhig%>" style="margin-bottom:<%=Trhig%>px;">
<%= PI_Name%>
<% Response.write "
" rs.close %> <% End Sub ' ====================================================================================================================== ' 栏目页产品展示列表(NumRow:行数,NumCol:列数,TbBdCor:表格背景色,TdBgCor:单元格背景色,TbPad:单元格填充,MemberIS:是否绑定会员,MemberSSID:会员栏目ID,PIwid:图片宽度,PIhig:图片高度) ' ====================================================================================================================== Sub ProductList(NumRow,NumCol,TbBdCor,TdBgCor,TbPad,MemberIS,MemberSSID,PIwid,PIhig) If NowSSIS = False Then Exit Sub Application("ProductMemIS") = MemberIS ' ------------------系统启用会员------------------------- If MemberIS = 1 Then Response.write "
" If Session("m_ID") = "" Then Response.write "" Response.write "  " Response.write "" 'Response.write "  "&Txt22&"" Else Response.write "【"&Txt23&":"&Session("m_Name")&"】" Response.write " "&Txt25&"" Response.write " "&Txt24&"" End If Response.write "
" End If ' ------------------验证Post------------------------- action = Request.Form("action") If action = "logincheck" Then '验证会员登录 Call MemberLoginCheck(MemberSSID) Exit Sub End If If action = "registercheck" Then '验证会员注册 Call MemberRegisterCheck(MemberSSID) Exit Sub End If If action = "editcheck" Then '验证会员修改资料 Call MemberEditCheck(MemberSSID) Exit Sub End If If action = "findpasscheckuser" Then '验证密码查询 Call MemberFindPassCheckUser() Exit Sub End If If action = "findpasscheckanswer" Then '验证密码查询 Call MemberFindPassCheckAnswer() Exit Sub End If ' ------------------验证Get------------------------- action = Request.QueryString("action") If action = "login" Then '用户登录表单 %>
会员登陆
<%= Txt28%>   
<%= Txt36%>   
 
忘记密码? 立刻注册
<% Exit Sub End If If action = "register" Then '用户注册表单 %> <%If WebLanguage = 1 Then%> <%If GetSafeStr(Request.QueryString("read")) <> "1" Then%>

继续注册前请先阅读本协议 >>

    欢迎您加入本网站参加交流和讨论,本网站为公共网站,为维护网上公共秩序和社会稳定,请您自觉遵守以下条款:

一、不得利用本站危害国家安全、泄露国家秘密,不得侵犯国家社会集体的和公民的合法权益,不得利用本站制作、复制和传播下列信息:

(一)煽动抗拒、破坏宪法和法律、行政法规实施的;
(二)煽动颠覆国家政权,推翻社会主义制度的;
(三)煽动分裂国家、破坏国家统一的;
(四)煽动民族仇恨、民族歧视,破坏民族团结的;
(五)捏造或者歪曲事实,散布谣言,扰乱社会秩序的;
(六)宣扬封建迷信、淫秽、色情、赌博、暴力、凶杀、恐怖、教唆犯罪的;
(七)公然侮辱他人或者捏造事实诽谤他人的,或者进行其他恶意攻击的;
(八)损害国家机关信誉的;
(九)其他违反宪法和法律行政法规的;
(十)进行商业广告行为的。

二、互相尊重,对自己的言论和行为负责。

    
<%Else%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
注:您输入的资料将作为使用本系统其他功能的数据,请准确地填写,谢谢!
用户名: *
密码: *
确认密码: *
姓名: *
性别:
年龄: *
省份:
城市: *
地址: *
邮编: *
电话: *
传真:
OICQ:
MSN:
Email: *
密码查询问题: *
密码查询答案: *
 
<%End If%> <%End If%> <%If WebLanguage = 2 Then%> <%If GetSafeStr(Request.QueryString("read")) <> "1" Then%>

Please read the agreement before registration continue >>
  You are welcome to participate in the exchange of ideas and discussion added to the website, the website for public website for online maintenance of public order and social stability, you have to consciously abide by the following provisions :
  First, should not be used to judge endangering national security, leaking state secrets, or violate the legitimate national rights and civil society collectively and shall not make use of this website production, reproduction and dissemination of the following information :
    (1) to incite resistance and undermining the Constitution and other laws and administrative regulations;
    (2) inciting subversion of state power to overthrow the socialist system;
    (3) inciting people to split the country and undermining national unity;
    (4) to incite ethnic hatred and discrimination that undermines national unity;
    (5) fabrication or distortion of facts, spread rumors, disturbs social order;
    (6) spread feudal superstition, obscenity, pornography, gambling, violence, murder, terrorism and abetting a crime;
    (7) humiliated others or making up stories to slander others, or other malicious attacks.
    (8) damage to the reputation of state organs;
    (9) violation of the Constitution and other administrative laws and regulations;
    (10) the commercial advertising.
   Second, mutual respect and on his own words and actions.

    
<%Else%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
Note : The information you input will use the system as a function of other data, and accurately completing Thank you!
login: *
password: *
confirmation assword: *
name: *
sex:
age: *
provinces:
city: *
address: *
postcode: *
tel: *
fax:
OICQ:
MSN:
Email: *
question for passwords: *
answer for passwords: *
 
<%End If%> <%End If%> <% Exit Sub End If If action = "edit" Then '用户修改资料表单 Call MemberEdit() Exit Sub End If If action = "findpass" Then '用户查询密码表单 Call MemberFindPass() Exit Sub End If If action = "logout" Then '用户安全退出 Session("m_ID") = "" Session("m_Name") = "" Session("m_ForumRights") = "" Session("m_Level") = "" Session("m_LoginNow") = "" rUrl = NowSSURL&"?SS_ID="&NowSSID If NowPSID > 0 Then rUrl = rUrl & "&PS_ID=" & NowPSID Response.Redirect rUrl End If ' ------------------显示产品详细资料------------------------- PI_ID = Request.QueryString("PI_ID") If PI_ID <> "" Then If IsNumeric(PI_ID) = False Then Exit Sub sql = "select * from ProductInfo where PI_ID=" & PI_ID Set rs = LsObject.CreateRs(sql,1,3) rscount = rs.recordcount If rs.eof Then rs.close Exit Sub End If PI_Name = rs("PI_Name") PI_Type = rs("PI_Type") PI_Photo = rs("PI_Photo") PI_BigPhoto = rs("PI_BigPhoto") PI_Hit = rs("PI_Hit") PI_Intro = rs("PI_Intro") PI_Model = rs("PI_Model") PI_Weight = rs("PI_Weight") PI_MarketPrice = rs("PI_MarketPrice") PI_PreferentialPrice = rs("PI_PreferentialPrice") If PI_Photo = "" or IsNull(PI_Photo) = True Then PI_Photo = "/System/SysImage/nophoto.gif" If PI_BigPhoto = "" or IsNull(PI_BigPhoto) = True Then PI_BigPhoto = PI_Photo rs("PI_Hit") = PI_Hit + 1 rs.update rs.close If WebLanguage = 1 Then %><%Response.write "" & chr(13) &chr(10) %>
" jqimg="<%=split(PI_Photo,"|")(0)%>" width=350>
    <% for i =0 to Ubound(split(PI_Photo,"|"))-1 UID = split(PI_Photo,"|")(i) response.Write"
  • " next %>
style="display:none"<%end if%>> style="display:none"<%end if%>> style="display:none"<%end if%>> style="display:none"<%end if%>> style="display:none"<%end if%>>
编 号  <%= PI_ID%>
名 称  <%= PI_Name%>
型 号  <%= PI_Type%>
价 格  ¥ <%= PI_Price%>
等级型号  <%= PI_Model%>
净 含 量  <%= PI_Weight%>
市 场 价  <%= PI_MarketPrice%>
优 惠 价  <%= PI_PreferentialPrice%>
<%= PI_Intro%>
>    
<% End If If WebLanguage = 2 Then %><%Response.write "" & chr(13) &chr(10) %>
" jqimg="<%=split(PI_Photo,"|")(0)%>" width=350>
    <% for i =0 to Ubound(split(PI_Photo,"|"))-1 UID = split(PI_Photo,"|")(i) response.Write"
  • " next %>
style="display:none"<%end if%>> style="display:none"<%end if%>> style="display:none"<%end if%>> style="display:none"<%end if%>> style="display:none"<%end if%>>
Number  <%= PI_ID%>
Name  <%= PI_Name%>
Model  <%= PI_Type%>
Price  ¥ <%= PI_Price%>
Level Type  <%= PI_Model%>
Weight  <%= PI_Weight%>
Marketprice  <%= PI_MarketPrice%>
PreferentialPrice  <%= PI_PreferentialPrice%>
<%= PI_Intro%>
>    
<% End If Exit Sub End If ' ------------------显示产品列表------------------------- '如果当前分类有子分类,显示子分类图标 If NowPSSubItem = True Then sql = "select * from ProductSort where SS_ID = "&NowSSID&" and PPS_ID=" & NowPSID Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount %>
<% iNumCol = 4 '列数 If rscount > 0 Then Response.write "" For i = 1 to rscount PS_ID = rs("PS_ID") PS_Name = rs("PS_Name") PS_Image = rs("PS_Image") If PS_Image = "" or IsNull(PS_Image) Then PS_Image = "/System/SysImage/nophoto.gif" If i mod iNumCol = 1 Then Response.write "" Response.write "" If i mod iNumCol = 0 Then Response.write "" rs.movenext Next Response.write "
" %>
<%= PS_Name%>
<%= PS_Name%>
<% Response.write "
" End If rs.close %>
<% Exit Sub End If '显示产品列表 NumTr = NumRow * NumCol If NumTr = "" or IsNumeric(NumTr) = False Then Exit Sub tPI_Name = Request.QueryString("PI_Name") sql = "select * from ProductInfo where SS_ID=" & NowSSID If tPI_Name <> "" Then sql = sql & " and PI_Name like '%" & tPI_Name & "%'" Else If NowPSID > 0 Then sql = sql & " and PS_ID=" & NowPSID End If sql = sql & " order by PI_Vouch"&OType&",PI_Date desc,PI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If linkpar = "&SS_ID=" & NowSSID & "&PS_ID=" & NowPSID & "&PI_Name=" & tPI_Name mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(NumTr) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage If WebLanguage = 1 Then %><% Response.write "" & chr(13) &chr(10) %>
<%If maxcount > 1 Then%> <%End If%>
<%Call Pagination()%>
<%If rscount > 0 Then Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j PI_ID = rs("PI_ID") PS_ID = rs("PS_ID") PI_Photo = rs("PI_Photo") PI_BigPhoto = rs("PI_BigPhoto") PI_Name = rs("PI_Name") PI_Type = rs("PI_Type") PI_Price = rs("PI_Price") If PI_Price = 0 Then PI_Price = "" If PI_Photo = "" or IsNull(PI_Photo) = True Then PI_Photo = "/System/SysImage/nophoto.gif" If PI_BigPhoto = "" or IsNull(PI_BigPhoto) = True Then PI_BigPhoto = PI_Photo If i mod NumCol = 1 Then Response.write "" Response.write "" If i mod NumCol = 0 Then Response.write "" rs.movenext Next Response.write "
" %>
" alt="<%= PI_Name%>" border="0" height="<%=PIhig%>" width="<%=PIwid%>">
编 号  <%= PI_ID%>
名 称  <%= PI_Name%>
型 号  <%= PI_Type%>
价 格  ¥ <%= PI_Price%>
产品介绍
">在线订购
用户反馈
查看大图
<% Response.write "
" End If rs.close %>
<%Call Pagination()%>
<% End If If WebLanguage = 2 Then %><% Response.write "" & chr(13) &chr(10) %>
<%If maxcount > 1 Then%> <%End If%>
<%Call Pagination()%>
<%If rscount > 0 Then Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j PI_ID = rs("PI_ID") PS_ID = rs("PS_ID") PI_Photo = rs("PI_Photo") PI_BigPhoto = rs("PI_BigPhoto") PI_Name = rs("PI_Name") PI_Type = rs("PI_Type") PI_Price = rs("PI_Price") If PI_Photo = "" or IsNull(PI_Photo) = True Then PI_Photo = "/System/SysImage/nophoto.gif" If PI_BigPhoto = "" or IsNull(PI_BigPhoto) = True Then PI_BigPhoto = PI_Photo If i mod NumCol = 1 Then Response.write "" Response.write "" If i mod NumCol = 0 Then Response.write "" rs.movenext Next Response.write "
" %>
<%= PI_Name%>
Serial number  <%= PI_ID%>
Name  <%= PI_Name%>
Type  <%= PI_Type%>
Price  ¥ <%= PI_Price%>
Product Detailed
">Online Orders
User feedback
Big Photo
<% Response.write "
" End If rs.close %>
<%Call Pagination()%>
<% End If End Sub %> <% ' ====================================================================================================================== ' 人才招聘 ' ====================================================================================================================== Sub Job() If NowSSIS = False Then Exit Sub action = Request.Form("action") If action = "add" Then JI_ID = Request.Form("JI_ID") SS_ID = Request.Form("SS_ID") JA_Name = Trim(Request.Form("JA_Name")) JA_Sex = Request.Form("JA_Sex") JA_Birth = Request.Form("JA_Birth") JA_Marry = Request.Form("JA_Marry") JA_College = Trim(Request.Form("JA_College")) JA_Degree = Request.Form("JA_Degree") JA_Speciality = Trim(Request.Form("JA_Speciality")) JA_GraduateDate = Request.Form("JA_GraduateDate") JA_Tel = Trim(Request.Form("JA_Tel")) JA_Email = Trim(Request.Form("JA_Email")) JA_Address = Trim(Request.Form("JA_Address")) JA_StrongSuit = GetSafeStr(Trim(Request.Form("JA_StrongSuit"))) JA_Intro = GetSafeStr(Trim(Request.Form("JA_Intro"))) If JA_Name = "" or JA_College = "" or JA_Speciality = "" Then Response.End() sql = "select * from JobApply order by JA_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then JA_ID = rs("JA_ID") + 1 Else JA_ID = 1 End If rs.addnew rs("JA_ID") = JA_ID rs("JI_ID") = JI_ID rs("SS_ID") = SS_ID rs("JA_Name") = JA_Name rs("JA_Sex") = JA_Sex rs("JA_Birth") = JA_Birth rs("JA_Marry") = JA_Marry rs("JA_College") = JA_College rs("JA_Degree") = JA_Degree rs("JA_Speciality") = JA_Speciality rs("JA_GraduateDate") = JA_GraduateDate rs("JA_Tel") = JA_Tel rs("JA_Email") = JA_Email rs("JA_Address") = JA_Address rs("JA_StrongSuit") = JA_StrongSuit rs("JA_Intro") = JA_Intro rs("JA_Time") = Date() & " " & Time() rs.update rs.close Response.write "" End If action = Request.QueryString("action") If action = "apply" Then JI_ID = Request.QueryString("JI_ID") If JI_ID = "" or IsNumeric(JI_ID) = False Then Exit Sub %>

姓    名:
性    别:
出生日期:
婚姻状况:
毕业院校:
毕业日期:
学    历:
专    业:
电    话:
电子邮箱:
联系地址:
特    长:
个人简介:
 
<% Exit Sub End If %><% If DBType = 1 Then sql = "select * from JobInfo where SS_ID=" & NowSSID & " and JI_StopDate>#"&Date()&"# order by JI_ID desc" Else sql = "select * from JobInfo where SS_ID=" & NowSSID & " and JI_StopDate>'"&Date()&"' order by JI_ID desc" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write "
  暂无新职位发布。" Exit Sub End If For i = 1 to rscount JI_ID = rs("JI_ID") JI_Place = rs("JI_Place") JI_Count = rs("JI_Count") JI_Site = rs("JI_Site") JI_Pay = rs("JI_Pay") JI_StartDate = rs("JI_StartDate") JI_StopDate = rs("JI_StopDate") JI_Request = rs("JI_Request") %>
招聘岗位  <%= JI_Place%>
招聘人数  <%= JI_Count%>
工作地点  <%= JI_Site%>
工资待遇  <%= JI_Pay%>
发布时间  <%= JI_StartDate%>
有效期限  <%= JI_StopDate%>
职位要求  <%= replace((replace(JI_Request,vbcrlf,"
")),chr(32)&chr(32),"  ")%>
 
<% rs.movenext Next rs.close %> <% End Sub %> <% '====================================================================================================================== '首页调用留言提交表单(含单位.SS_ID:栏目ID,IsUnit:是否显示受理单位,MessageUrl:提交留言处理页面地址,IsCode:是否显示验证码,TabWid:表格宽度,TdWid:单元格宽度,TdHig:单元格高度,TxtStyle:文本框样式,ContentStyle:内容框样式,SubStyle:提交按钮样式,RetStyle:重置按钮样式,IsTxt:是否显示文字) '====================================================================================================================== Sub IndexMessageFrame(SS_ID,IsUnit,MessageUrl,IsCode,TabWid,TdWid,TdHig,TxtStyle,ContentStyle,SubStyle,RetStyle,IsTxt) %> <% Response.Write "" if IsUnit<>0 then Response.Write "" end if sqla="select * from MessageExtension where ME_txt_flag=1 order by ME_ID asc" set rsa = LsObject.CreateRs(sqla,1,3) if not rsa.eof then for x=1 to rsa.recordcount if rsa.eof then exit for else Response.Write "" end if rsa.movenext next end if rsa.close Response.Write "" if IsCode<>0 then Response.Write "" end if Response.Write "
* 请选择相关单位
受理:
"&rsa("ME_txt")&":
标题:
内容:
验证码: 
  
" End Sub ' ====================================================================================================================== ' 首页调用留言文字列表(SS_ID:栏目ID,NumRow:行数,NumCol:列数,OrderType:排序类型,TrHig:行高,ItemIcon:前缀小图标,ItemWid:小图标宽度,TitleWid:标题宽度,NumWords:标题字数,ShowResult:显示回复情况) ' ====================================================================================================================== Sub IndexMessageList(SS_ID,NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,ShowResult) NumTr = NumRow * NumCol If SS_ID = "" or IsNumeric(SS_ID) = False or IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumTr&" m_ID,m_Name,m_Subject,m_Date,m_Time,m_RevertIS,m_Revert,m_RevertDate,m_RevertTime,m_RevertBranch" sql = sql & " from MessageBoard where m_ShowIs<>0 and SS_ID="&SS_ID Select Case OrderType Case 0 sql = sql & " order by m_RevertIS asc,m_ID desc" Case 1 sql = sql & " order by m_RevertIS desc,m_ID desc" Case 2 '显示回复信息 sql = sql & " and m_RevertIS<>0" sql = sql & " order by m_ID desc" Case 3 '显示未回复信息 sql = sql & " and m_RevertIS=0" sql = sql & " order by m_ID desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 m_ID = rs("m_ID") m_Name = rs("m_Name") m_Subject = rs("m_Subject") m_Date = rs("m_Date") m_Time = rs("m_Time") m_RevertIS = rs("m_RevertIS") m_Revert = rs("m_Revert") m_RevertDate = rs("m_RevertDate") m_RevertTime = rs("m_RevertTime") m_RevertBranch = rs("m_RevertBranch") mm_Date = Month(m_Date) dm_Date = Day(m_Date) mm_RevertDate = Month(m_RevertDate) dm_RevertDate = Day(m_RevertDate) If mm_Date < 10 Then mm_Date = "0" & mm_Date If dm_Date < 10 Then dm_Date = "0" & dm_Date If mm_RevertDate < 10 Then mm_RevertDate = "0" & mm_RevertDate If dm_RevertDate < 10 Then dm_RevertDate = "0" & dm_RevertDate If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If m_RevertIS <> 0 Then prompt = "已回复" Else prompt = "未回复" End If If ShowResult = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then m_Subject = CutStr(m_Subject,tNumWords) Response.write m_Subject&"" Response.write "" Response.write " "&prompt Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页调用留言表格列表(显示回复状态,回复部门。SS_ID:栏目ID,NumRow:行数,TbColor:单元格颜色,TrHig:行高,ItemIcon:前缀小图标,NumWords:标题字数,ShowTime:是否显示时间,ShowResult:是否显示回复情况,ShowBTime:是否显示回复时间,ShowUnit:是否显示回复单位,OrderType:排序类型) ' ====================================================================================================================== Sub IndexMessageNewList(SS_ID,NumRow,TbColor,TrHig,ItemIcon,NumWords,ShowTime,ShowResult,ShowBTime,ShowUnit,OrderType) If SS_ID = "" or IsNumeric(SS_ID) = False or IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumRow&" m_ID,m_Name,m_Subject,m_Date,m_Time,m_RevertIS,m_Revert,m_RevertDate,m_RevertTime,m_RevertBranch" sql = sql & " from MessageBoard where m_ShowIs<>0 and SS_ID="&SS_ID Select Case OrderType Case 0 sql = sql & " order by m_RevertIS asc,m_ID desc" Case 1 sql = sql & " order by m_RevertIS desc,m_ID desc" Case 2 sql = sql & " and m_RevertIS<>0" sql = sql & " order by m_ID desc" Case 3 sql = sql & " and m_RevertIS=0" sql = sql & " order by m_ID desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > 0 Then response.write"" response.write"" response.write"" if ShowTime<>0 then response.write"" if ShowResult<>0 then response.write"" if ShowUnit<>0 then response.write"" if ShowBTime<>0 then response.write"" response.write"" for xi=1 to rscount if xi mod 2=0 then bgclor="#e7eefa" else bgclor="#ffffff" end if m_ID = rs("m_ID") m_Name = rs("m_Name") m_Subject = rs("m_Subject") m_Date = rs("m_Date") m_Time = rs("m_Time") m_RevertIS = rs("m_RevertIS") m_Revert = rs("m_Revert") m_RevertDate = rs("m_RevertDate") m_RevertTime = rs("m_RevertTime") m_RevertBranch = rs("m_RevertBranch") mm_Date = Month(m_Date) dm_Date = Day(m_Date) mm_RevertDate = Month(m_RevertDate) dm_RevertDate = Day(m_RevertDate) If mm_Date < 10 Then mm_Date = "0" & mm_Date If dm_Date < 10 Then dm_Date = "0" & dm_Date If mm_RevertDate < 10 Then mm_RevertDate = "0" & mm_RevertDate If dm_RevertDate < 10 Then dm_RevertDate = "0" & dm_RevertDate if ItemIcon<>"" then imgstr="" tNumWords = NumWords*2 sm_Subject=m_Subject If NumWords > 0 Then sm_Subject = CutStr(sm_Subject,tNumWords) m_Subject=""&sm_Subject&"" if m_RevertIs = True Then fustr="(已回复)" else hfcolor="#ff0000" fustr="(未回复)" m_RevertBranch="" end if response.write"" response.write"" if ShowTime<>0 then response.write"" if ShowResult<>0 then response.write"" if ShowUnit<>0 then response.write"" if ShowBTime<>0 then response.write"" response.write" " rs.movenext next for sss=xi to NumRow if sss mod 2=0 then bgclor="#f9f8ec" else bgclor="#ffffff" end if response.write"" response.write"" if ShowTime<>0 then response.write"" if ShowResult<>0 then response.write"" if ShowUnit<>0 then response.write"" if ShowBTime<>0 then response.write"" response.write" " next response.write"
主 题留言时间回复状态回复单位回复时间
"&imstr&" "&m_Subject&""&m_Date&""&fustr&""&m_RevertBranch&""&m_RevertDate&"
" Else response.write ErrTxt1 End If rs.close set rs=nothing End Sub '====================================================================================================================== ' 栏目页留言列表(PerNumRow:显示条数,ShowIS:显示提示信息) '====================================================================================================================== Sub GuestBook(PerNumRow,ShowIS,Excl_UI_Path,CommentSSID) If NowSSIS = False Then Exit Sub sql = "SELECT SS_Name FROM SiteStructure WHERE SS_ID = "&SS_ID&"" Set rs = LsObject.CreateConn().Execute("SELECT * FROM SiteStructure WHERE SS_ID = "&NowSSID&"") If Not rs.eof Then SS_ShowComment = rs("SS_ShowComment") IsUnit = rs("IsUnit") IsCode = rs("IsCode") End If If SS_ShowComment = "" or IsNull(SS_ShowComment) Then SS_ShowComment = 2 rs.close action = GetSafeStr(Request("action")) actionx = GetSafeStr(Request("actionx")) '通过ID和密码查询留言 If actionx = "find" Then m_ID = GetSafeStr(Request.Form("m_ID")) m_QueryPasswd = GetSafeStr(Request.Form("m_QueryPasswd")) sql = "select * from MessageBoard where m_ID=" & m_ID & " and m_QueryPasswd='"&m_QueryPasswd&"'" set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Call OutScript("查询编号或密码不正确!") Exit Sub End If m_RevertIS = rs("m_RevertIS") If m_RevertIS = False Then rs.close Call OutScript("您的留言正在处理中,请稍候查询!") Exit Sub End If m_Name = rs("m_Name") m_Subject = rs("m_Subject") m_Contents = rs("m_Contents") m_Date = rs("m_Date") m_Time = rs("m_Time") m_Revert = rs("m_Revert") m_RevertDate = rs("m_RevertDate") m_RevertTime = rs("m_RevertTime") m_RevertBranch = rs("m_RevertBranch") m_RemoteIp = rs("m_RemoteIp") rs.close %>
发件人: <%= m_Name%>
发送时间: <%= m_Date & " " & m_Time%>
主题: <%= m_Subject%>
留言内容: <%= m_Contents%>
回复部门: <%= m_RevertBranch%>
回复时间: <%= m_RevertDate & " " & m_RevertTime%>
回复内容: <%= m_Revert%>

<% Exit Sub End If '显示查询表单 If action = "query" Then %>


查询编号:
查询密码:
<% Exit Sub End If ' If action = "show" or action = "search" Then SearchStr = GetSafeStr(Request.QueryString("SearchStr")) sql = "select * from MessageBoard where m_ShowIs<>0 and SS_ID=" & NowSSID If SearchStr <> "" Then sql = sql & " and (m_Contents like '%" & SearchStr & "%' or m_Name like '%" & SearchStr & "%')" sql = sql & " order by m_ID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount linkpar ="&action=show&SS_ID="&NowSSID&"&SearchStr=" & SearchStr mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 If rscount > 0 Then mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage End If %>
<%Call Pagination()%>
<% UI_Name = "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j m_ID = rs("m_ID") m_UI_ID = rs("m_UI_ID") m_Name = rs("m_Name") m_Subject = rs("m_Subject") m_Email = rs("m_Email") m_Tel = rs("m_Tel") m_Contents = rs("m_Contents") m_Date = rs("m_Date") m_Time = rs("m_Time") m_Revert = rs("m_Revert") m_RevertDate = rs("m_RevertDate") m_RevertTime = rs("m_RevertTime") If m_Email <> "" Then m_Email = ""&m_Email&"" If m_Web <> "" and m_Web <> "http://" Then m_Web = ""&m_Web&"" If m_UI_ID <> "" or m_UI_ID <> 0 or IsNull(m_UI_ID) = False Then UI_Name = LsObject.CreateConn().Execute("SELECT UI_Name From UnitsInfo Where UI_ID = "&m_UI_ID&"")(0) %>
 <%= Txt41%>:<%If UI_Name <> "" Then Response.Write "<"&UI_Name&">"%><%= m_Subject%><%If CInt(SS_ShowComment) = 1 Then%><%End If%>
<%= m_Name%>
 <%= Txt2%> <%= rscount - ((mypage-1) * mypagesize + i) + 1%> <%= Txt6&" "&Txt42&" "&Txt46%> <%= m_Name%>  <%= Txt48%> <%= m_Date & " " & m_Time%> <%= Txt47%>
<%=m_Contents%> <%If m_Revert<>"" Then%>

<%= Txt49%>:<%=m_Revert%>
<%= Txt50%>:<%=m_RevertDate&" "&m_RevertTime%>

<%End If%>
<% rs.movenext Next rs.close If maxcount > 1 Then %>
<%Call Pagination()%>
<%End If%>
<% ' Exit Sub ' End If '提交信息 action = Request.Form("xaction") If action = "add" Then If IsCode Then checkcode = GetSafeStr(Request.Form("checkcode")) If checkcode = "" or checkcode <> Cstr(Session("CheckCode")) Then Call OutScript("验证码输入错误!") Exit Sub End If end if m_UI_ID = GetSafeStr(Request.Form("m_UI_ID")) m_Name = GetSafeStr(Request.Form("m_Name")) m_Email = GetSafeStr(Request.Form("m_Email")) m_Tel = GetSafeStr(Request.Form("m_Tel")) m_QQ = GetSafeStr(Request.Form("m_QQ")) m_Web = GetSafeStr(Request.Form("m_Web")) m_txt1 = GetSafeStr(Request.Form("m_txt1")) m_txt2 = GetSafeStr(Request.Form("m_txt2")) m_txt3 = GetSafeStr(Request.Form("m_txt3")) m_txt4 = GetSafeStr(Request.Form("m_txt4")) m_txt5 = GetSafeStr(Request.Form("m_txt5")) m_Subject = GetSafeStr(Request.Form("m_Subject")) m_Contents = GetSafeStr(Request.Form("m_Contents")) '接收单位路径 if Request.Form("m_Unit")<>"" then m_Unit = Request.Form("m_Unit") end if If m_Name = "" or m_Contents = "" Then Call OutScript(ErrTxt0&ErrTxt10) Randomize Random = Round(Rnd * (99999999 - 10000000 + 1) - 0.5) + 10000000 sql = "select top 1 * from MessageBoard order by m_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then m_ID = rs("m_ID") + 1 Else m_ID = 1 End If rs.addnew rs("m_ID") = m_ID 'If m_UI_ID <> "" then rs("m_UI_ID") = m_UI_ID rs("SS_ID") = NowSSID rs("SS_Path") = NowSSPath rs("m_Name") = m_Name rs("m_Email") = m_Email rs("m_Tel") = m_Tel rs("m_QQ") = m_QQ rs("m_Web") = m_Web rs("m_txt1") = m_txt1 rs("m_txt2") = m_txt2 rs("m_txt3") = m_txt3 rs("m_txt4") = m_txt4 rs("m_txt5") = m_txt5 rs("m_Subject") = m_Subject rs("m_Contents") = replace((replace(m_Contents,vbcrlf,"
")),chr(32)&chr(32),"  ") rs("m_Date") = Date() rs("m_Time") = Time() rs("m_RemoteIp") = Request.ServerVariables("REMOTE_ADDR") rs("m_ShowIs") = ShowIS rs("m_RevertIS") = 0 rs("m_QueryPasswd") = Random if m_Unit<>"" then rs("m_Unit") = m_Unit end if rs.update rs.close '添加到公共标题表 sql="select * from PublicTitle" Set rs = LsObject.CreateRs(sql,1,3) rs.addnew rs("PT_TITLE") = m_Subject rs("PT_DID") = m_ID rs("PT_DTYPE") = 5 rs("PT_CHECKIN") = ShowIS rs("PT_SSID") = NowSSID SS_SiteID = ReadSiteID(NowSSID) rs("PT_SSSiteID") = SS_SiteID rs.update rs.close If ShowIS = 0 Then Response.write "" Else Response.write "" End If End If '显示留言表单 %> <%If WebLanguage = 1 Then%>
<% If IsUnit Then %> <% End If sqla="select * from MessageExtension where ME_txt_flag=1 order by ME_ID asc" set rsa = LsObject.CreateRs(sqla,1,3) if not rsa.eof then for x=1 to rsa.recordcount if rsa.eof then exit for else%> <% end if rsa.movenext next end if rsa.close %> <% If IsCode Then%> <%end if%>
 受理(必填) 
 <%=rsa("ME_txt")%><%if rsa("ME_txt_isfill")=1 then response.Write "(必填)" else response.Write "(可填)" end if%>  " type="text" id="<%=rsa("ME_txt_field")%>" class="maegtxt" size="30" maxlength="50">
主题(必填)
 留言(必填) 

 [查看长度
验证码(必填)  
 
<%End If%> <%If WebLanguage = 2 Then%>
 name 
 email 
 Tel 
subject
 message 

 [Check length
 
<%End If%> <% End Sub %> <% ' ====================================================================================================================== ' 首页视频在线点播(SS_ID:栏目ID,SS_Path:栏目路径,IsPic:是否显示图片0显示视频 1显示图片,VideoUrl:显示视频的链接地址,VodWidth:宽度,VodHeight:高度,IsTitle:是否显示标题,TitleNum:标题字数) ' ====================================================================================================================== Sub VodOnlinePlay(SS_ID,SS_Path,IsPic,VideoUrl,VodWidth,VodHeight,IsTitle,TitleNum) sql = "select top 1 * from VodInfo" If SS_Path <> "" Then sql = sql&" where VodInfo.SS_Path like '%"&SS_Path&"%'" Else sql = sql& " where VodInfo.SS_ID="&SS_ID End If sql = sql&" order by VodInfo.VI_Vouch"&OType&",VodInfo.VI_Date desc,VodInfo.VI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) With Response If Not rs.Eof Then VI_ID = rs("VI_ID") SS_ID = rs("SS_ID") VI_Name = rs("VI_Name") VI_SmallImage = rs("VI_SmallImage") VI_Type = rs("VI_Type") VI_URL = rs("VI_URL") if IsPic <> 0 then response.Write "" else If VI_Type = 1 Then .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" ElseIf VI_Type = 2 Then .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write " " Else .Write "" End If End if If IsTitle Then If TitleNum > 0 Then VI_Name = CutStr(VI_Name,TitleNum*2) .Write "
"&VI_Name&"
" End If Else .Write "暂无相关视频" End If End With rs.close End Sub ' ====================================================================================================================== ' 首页视频点播文字列表(SS_ID:栏目ID,SS_Path:栏目路径,NumRow:函数,NumCol:列数,TrHig:行高,ItemIcon:前缀小图标,ItemWid:宽度,TitleWid:标题宽度,NumWords:标题字数,DateVis:是否显示日期,TimeVis:是否显示时间,HitVis:是否显示点击数) ' ====================================================================================================================== Sub IndexVodList(SS_ID,SS_Path,NumRow,NumCol,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,HitVis) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" VodInfo.*,SiteStructure.SS_URL As SS_URL from VodInfo" sql = sql&" inner join SiteStructure On SiteStructure.SS_ID=VodInfo.SS_ID" If SS_ID <> "" Then sql = sql& " where VodInfo.SS_ID="&SS_ID Else sql = sql&" where VodInfo.SS_Path like '%"&SS_Path&"%'" End If sql = sql&" order by VodInfo.VI_Vouch"&OType&",VodInfo.VI_Date desc,VodInfo.VI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr %> <% If rscount > 0 Then Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") VI_ID = rs("VI_ID") VI_Name = rs("VI_Name") VI_Date = rs("VI_Date") VI_Time = rs("VI_Time") VI_Hit = rs("VI_Hit") SS_URL = rs("SS_URL") VI_Type = rs("VI_Type") mVI_Date = Month(VI_Date) dVI_Date = Day(VI_Date) If mVI_Date < 10 Then mVI_Date = "0" & mVI_Date If dVI_Date < 10 Then dVI_Date = "0" & dVI_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" sqla = "select * from SiteStructure where SS_ID="&SS_ID Set rsa = LsObject.CreateRs(sqla,1,1) if not rsa.eof then VideoUrl=rsa("SI_Domain")&rsa("SS_URL") end if rsa.close Response.write "" If NumWords > 0 Then VI_Name = CutStr(VI_Name,NumWords*2) Response.write VI_Name&"" If DateVis = 1 Then Response.write " "&mVI_Date&"-"&dVI_Date If TimeVis = 1 Then Response.write " "&VI_Time If HitVis = 1 Then Response.write " "&VI_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页视频单个调用 'SS_ID 栏目ID 'SS_Path 栏目路径 'VodID 视频ID 'TitleNum 标题字数 'DescNum 简介字数 'V_Width 视频宽度 'V_Height 视频高度 'IsTitle 是否显示标题 (0--不显示视频标题;1--显示视频标题) 'IsDesc 是否显示视频简介 (0--不显示简介信息;1--显示简介信息) 'Pic_Vod 是显示图片还是播放视频(0--显示图片;1--播放视频) 'AutoPlay 是否自动播放视频(0--不自动播放视频;1--自动播放视频) ' ====================================================================================================================== Sub IndexVodShow(SS_ID,SS_Path,TitleNum,DescNum,V_Width,V_Height,IsTitle,IsDesc,Pic_Vod,AutoPlay) If SS_ID = "" Then Exit Sub If V_Width="" Or Not IsNumeric(V_Width) Then V_Width = 100 If V_Height="" Or Not IsNumeric(V_Height) Then V_Height = 100 sql = "select top 1 VodInfo.*,SiteStructure.SS_URL As SS_URL from VodInfo" sql = sql&" inner join SiteStructure On SiteStructure.SS_ID=VodInfo.SS_ID" If SS_ID <> "" Then sql = sql& " where VodInfo.SS_ID="&SS_ID Else sql = sql&" where VodInfo.SS_Path like '%"&SS_Path&"%'" End If sql = sql&" order by VodInfo.VI_Vouch"&OType&",VodInfo.VI_Date desc,VodInfo.VI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) If Not rs.Eof Then %> <% VI_ID = rs("VI_ID") VI_URL = rs("VI_URL") VI_Name = rs("VI_Name") VI_Intro = rs("VI_Intro") VI_Type = rs("VI_Type") VI_SmallImage = rs("VI_SmallImage") If VI_SmallImage="" Or IsNull(VI_SmallImage) Then VI_SmallImage = "/System/SysImage/nophoto.gif" End If Str = Str & "" Str = Str & "" Str = Str & "" Str = Str & "" If IsTitle = 1 Then'显示标题 VI_Name = CutStr(VI_Name,TitleNum) Str = Str & "" Str = Str & "" Str = Str & " " End If If IsDesc = 1 Then'显示简介 VI_Intro = CutStr(VI_Intro,DescNum) Str = Str & " " Str = Str & "" Str = Str & " " End If Str = Str & "
" Select Case Pic_Vod Case 0'显示图片 sqla = "select * from SiteStructure where SS_ID="&SS_ID Set rsa = LsObject.CreateRs(sqla,1,1) if not rsa.eof then VideoUrl=rsa("SI_Domain")&rsa("SS_URL") end if rsa.close Str = Str & "" Str = Str & "" Str = Str & "" Case 1'播放视频 if VI_Type = 3 then %>
<% else %> <%If VI_Type=1 Then%> width=<%=V_Width%> classid=clsid:22d6f312-b0f6-11d0-94ab-0080c74c7e95> <%Else%>
width=<%=V_Width%> classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA>
classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA>
<%End If%> <% end if End Select Str = Str & "
"&VI_Name&"
"&VI_Intro&"
" End If Response.Write(Str) End Sub ' ====================================================================================================================== ' 视频窗口点播排行 ' ====================================================================================================================== Sub VodHitList(SS_ID,SS_Path,NumRow,NumCol,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,HitVis) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" VodInfo.*,SiteStructure.SS_URL As SS_URL from VodInfo" sql = sql&" inner join SiteStructure On SiteStructure.SS_ID=VodInfo.SS_ID" If SS_ID <> "" Then sql = sql& " where VodInfo.SS_ID="&SS_ID Else sql = sql&" where VodInfo.SS_Path like '%"&SS_Path&"%'" End If sql = sql&" order by VodInfo.VI_Hit desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRow Then rscount = NumRow If rscount > 0 Then Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") VI_ID = rs("VI_ID") VI_Name = rs("VI_Name") VI_Date = rs("VI_Date") VI_Time = rs("VI_Time") VI_Hit = rs("VI_Hit") SS_URL = rs("SS_URL") mVI_Date = Month(VI_Date) dVI_Date = Day(VI_Date) If mVI_Date < 10 Then mVI_Date = "0" & mVI_Date If dVI_Date < 10 Then dVI_Date = "0" & dVI_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then VI_Name = CutStr(VI_Name,NumWords*2) Response.write VI_Name&"" If DateVis = 1 Then Response.write " "&mVI_Date&"-"&dVI_Date If TimeVis = 1 Then Response.write " "&VI_Time If HitVis = 1 Then Response.write " "&VI_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页视频点播图片列表 ' ====================================================================================================================== Sub IndexVodImgList(SS_ID,SS_Path,NumRow,NumCol,ImgWid,ImgHig,TbBdCor,TdBgCor,TbPad,IsTitle,TitleNum) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" VodInfo.*,SiteStructure.SS_URL As SS_URL from VodInfo" sql = sql&" inner join SiteStructure On SiteStructure.SS_ID=VodInfo.SS_ID" If SS_ID <> "" Then sql = sql& " where VodInfo.SS_ID="&SS_ID Else sql = sql&" where VodInfo.SS_Path like '%"&SS_Path&"%'" End If sql = sql&" order by VodInfo.VI_Vouch"&OType&",VodInfo.VI_Date desc,VodInfo.VI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr %> <% If rscount > 0 Then Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") VI_ID = rs("VI_ID") VI_Name = rs("VI_Name") VI_Type = rs("VI_Type") VI_SmallImage = rs("VI_SmallImage") If VI_SmallImage = "" or IsNull(VI_SmallImage) = True Then VI_SmallImage = "/System/SysImage/nophoto.gif" SS_URL = rs("SS_URL") If i mod NumCol = 1 or NumCol = 1 Then Response.write "" Response.write "" If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" sqla = "select * from SiteStructure where SS_ID="&SS_ID Set rsa = LsObject.CreateRs(sqla,1,1) if not rsa.eof then VideoUrl=rsa("SI_Domain")&rsa("SS_URL") end if rsa.close Response.write "" Response.write "" If IsTitle Then If TitleNum > 0 Then VI_Name = CutStr(VI_Name,TitleNum*2) Response.Write "
"&VI_Name&"
" End If Response.Write "
" Else rs.close Response.write ErrTxt1 End If End Sub '====================================================================================================================== '视频打开在线播放 '====================================================================================================================== Sub OnlinePlay() SS_ID=GetSafeStr(request("SS_ID")) VI_ID=GetSafeStr(request("VI_ID")) If IsNumeric(SS_ID) = False Then Exit Sub If IsNumeric(VI_ID) = False Then Exit Sub sql = "select * from VodInfo where VI_ID="&VI_ID Set rs = LsObject.CreateRs(sql,1,3) If Not rs.Eof Then VI_ID = rs("VI_ID") VI_Name = rs("VI_Name") VI_SmallImage = rs("VI_SmallImage") VI_Type = rs("VI_Type") VI_URL = rs("VI_URL") VI_Hit = rs("VI_Hit") rs("VI_Hit") = VI_Hit + 1 rs.update If VI_Type = 1 or VI_Type = 2 Then If Application("VodMemIS") = 1 Then If Session("m_ID") = "" Then Response.write "登录无效!请先登录。

如果您不是本站会员,请先注册。" Response.End() End If End If Response.Write "
" & chr(13) &chr(10) Response.Write "
" Response.Write CutStr(VI_Name,24)&"
" If VI_Type=1 Then Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) else Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write "" & chr(13) &chr(10) Response.Write " " End If Response.Write "

"&VI_Name&"

"&replace((replace(VI_Intro,vbcrlf,"
")),chr(32)&chr(32),"  ")&"
 
" end if If VI_Type = 3 Then If Application("VodMemIS") = 1 Then If Session("m_ID") = "" Then Response.write "登录无效!请先登录。

如果您不是本站会员,请先注册。" Response.End() End If End If Response.Write "
" & chr(13) &chr(10) End If response.write "

"&VI_Name&"
" Else response.write "正在更新中" End If rs.close End Sub '====================================================================================================================== ' 栏目页视频点播列表(PerNumRow:显示条数,ImgWid:图片宽度,ImgHig:图片高度,MemberIS:是否绑定会员,MemberSSID:绑定会员栏目ID,TypeNum:表现形式,ColNum2:列数,TitleNumWords:标题数字,DesNumWords:描述数字,PicIsRight:图片是否显示右边) '====================================================================================================================== Sub VodList(PerNumRow,ImgWid,ImgHig,MemberIS,MemberSSID,TypeNum,ColNum2,TitleNumWords,DesNumWords,PicIsRight) If NowSSIS = False Then Exit Sub Application("VodMemIS") = MemberIS ' ------------------系统启用会员------------------------- If MemberIS = 1 Then Response.write "
" If Session("m_ID") = "" Then Response.write "" Response.write "  " Response.write "" 'Response.write "  "&Txt22&"" Else Response.write "【"&Txt23&":"&Session("m_Name")&"】" Response.write " "&Txt25&"" Response.write " "&Txt24&"" End If Response.write "
" End If ' ------------------验证Post------------------------- action = GetSafeStr(Request.Form("action")) If action = "logincheck" Then '验证会员登录 Call MemberLoginCheck(MemberSSID) Exit Sub End If If action = "registercheck" Then '验证会员注册 Call MemberRegisterCheck(MemberSSID) Exit Sub End If If action = "editcheck" Then '验证会员修改资料 Call MemberEditCheck(MemberSSID) Exit Sub End If If action = "findpasscheckuser" Then '验证密码查询 Call MemberFindPassCheckUser() Exit Sub End If If action = "findpasscheckanswer" Then '验证密码查询 Call MemberFindPassCheckAnswer() Exit Sub End If ' ------------------验证Get------------------------- action = GetSafeStr(Request.QueryString("action")) If action = "login" Then '用户登录表单 %>
会员登陆
<%= Txt28%>   
<%= Txt36%>   
 
忘记密码? 立刻注册
<% Exit Sub End If If action = "register" Then '用户注册表单 %> <%If WebLanguage = 1 Then%> <%If GetSafeStr(Request.QueryString("read")) <> "1" Then%>

继续注册前请先阅读本协议 >>

    欢迎您加入本网站参加交流和讨论,本网站为公共网站,为维护网上公共秩序和社会稳定,请您自觉遵守以下条款:

一、不得利用本站危害国家安全、泄露国家秘密,不得侵犯国家社会集体的和公民的合法权益,不得利用本站制作、复制和传播下列信息:

(一)煽动抗拒、破坏宪法和法律、行政法规实施的;
(二)煽动颠覆国家政权,推翻社会主义制度的;
(三)煽动分裂国家、破坏国家统一的;
(四)煽动民族仇恨、民族歧视,破坏民族团结的;
(五)捏造或者歪曲事实,散布谣言,扰乱社会秩序的;
(六)宣扬封建迷信、淫秽、色情、赌博、暴力、凶杀、恐怖、教唆犯罪的;
(七)公然侮辱他人或者捏造事实诽谤他人的,或者进行其他恶意攻击的;
(八)损害国家机关信誉的;
(九)其他违反宪法和法律行政法规的;
(十)进行商业广告行为的。

二、互相尊重,对自己的言论和行为负责。

    
<%Else%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
注:您输入的资料将作为使用本系统其他功能的数据,请准确地填写,谢谢!
用户名: *
密码: *
确认密码: *
姓名: *
性别:
年龄: *
省份:
城市: *
地址: *
邮编: *
电话: *
传真:
OICQ:
MSN:
Email: *
密码查询问题: *
密码查询答案: *
 
<%End If%> <%End If%> <%If WebLanguage = 2 Then%> <%If GetSafeStr(Request.QueryString("read")) <> "1" Then%>

Please read the agreement before registration continue >>
  You are welcome to participate in the exchange of ideas and discussion added to the website, the website for public website for online maintenance of public order and social stability, you have to consciously abide by the following provisions :
  First, should not be used to judge endangering national security, leaking state secrets, or violate the legitimate national rights and civil society collectively and shall not make use of this website production, reproduction and dissemination of the following information :
    (1) to incite resistance and undermining the Constitution and other laws and administrative regulations;
    (2) inciting subversion of state power to overthrow the socialist system;
    (3) inciting people to split the country and undermining national unity;
    (4) to incite ethnic hatred and discrimination that undermines national unity;
    (5) fabrication or distortion of facts, spread rumors, disturbs social order;
    (6) spread feudal superstition, obscenity, pornography, gambling, violence, murder, terrorism and abetting a crime;
    (7) humiliated others or making up stories to slander others, or other malicious attacks.
    (8) damage to the reputation of state organs;
    (9) violation of the Constitution and other administrative laws and regulations;
    (10) the commercial advertising.
   Second, mutual respect and on his own words and actions.

    
<%Else%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
Note : The information you input will use the system as a function of other data, and accurately completing Thank you!
login: *
password: *
confirmation assword: *
name: *
sex:
age: *
provinces:
city: *
address: *
postcode: *
tel: *
fax:
OICQ:
MSN:
Email: *
question for passwords: *
answer for passwords: *
 
<%End If%> <%End If%> <% Exit Sub End If If action = "View" Then '查看 Call OnlinePlay() Exit Sub End If If action = "edit" Then '用户修改资料表单 Call MemberEdit() Exit Sub End If If action = "findpass" Then '用户查询密码表单 Call MemberFindPass() Exit Sub End If If action = "logout" Then '用户安全退出 Session("m_ID") = "" Session("m_Name") = "" Session("m_ForumRights") = "" Session("m_Level") = "" Session("m_LoginNow") = "" Response.Redirect NowSSURL&"?SS_ID="&NowSSID End If If NowSSSubItem = True Then sql = "select * from VodInfo where SS_Path like '%"&NowSSPath&"%' order by VI_Vouch"&OType&",VI_ID desc" Else sql = "select * from VodInfo where SS_ID="&NowSSID&" order by VI_Vouch"&OType&",VI_ID desc" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If linkpar ="&SS_ID="&NowSSID mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage %> <% '=============================================================================================================================== Select Case TypeNum Case 1 Response.write "
" Response.write "" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j VI_ID = rs("VI_ID") VI_Name = rs("VI_Name") NameFull = VI_Name VI_Name = CutStr(VI_Name,TitleNumWords*2) VI_SmallImage = rs("VI_SmallImage") VI_Type = rs("VI_Type") VI_Intro = rs("VI_Intro") VI_Intro = replace((replace(VI_Intro,vbcrlf,"
")),chr(32)&chr(32),"  ") VI_Des = VI_Intro VI_Intro = CutStr(VI_Intro,DesNumWords*2) VI_Hit = rs("VI_Hit") VI_Date = rs("VI_Date") VI_Time = rs("VI_Time") If VI_SmallImage = "" or IsNull(VI_SmallImage) = True Then VI_SmallImage = "/System/SysImage/nophoto.gif" If VI_Type = 1 Then ItemIcon = "/System/SysImage/mediaicon.gif" If VI_Type = 2 Then ItemIcon = "/System/SysImage/realicon.gif" If VI_Type = 3 Then ItemIcon = "/System/SysImage/flv.gif" Response.write "" '图片单元格 PicStr = "" PicStr = PicStr & "" Else PicStr = PicStr & "" PicStr = PicStr & "" End If If PicIsRight = 0 Then'图片在左边 Response.Write(PicStr) End If Response.write "" If PicIsRight = 1 Then'图片在右边 Response.Write(PicStr) End If Response.write "" rs.movenext Next rs.close If maxcount > 1 Then '视频列表多于1页 Response.write "" End If Response.write "
" Call Pagination() Response.write "
" If MemberIS = 1 and Session("m_ID") = "" Then PicStr = PicStr & "" Response.write "" Response.write "") Else Response.write "" End If Response.write ""&Txt16&"  " Response.write "" Response.write "") Response.write "" Response.write "
"&VI_Name&"" Response.write "
" If MemberIS = 1 and Session("m_ID") = "" Then Response.write " " Response.Write(Txt16&"  
" Response.Write("
"&VI_Intro&"
") Response.Write("
"&VI_Des&"
") Response.Write(" [详细]") Response.Write(" [收起]") Response.Write("
"&Txt7&":"&VI_Hit&"  " Response.write Txt15 & ":"&VI_Date&"  " Response.write "
" Call Pagination() Response.write "
" Response.write "
" Case 2 %> <% Response.write "
" Response.write "" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j Response.write "" For p=1 to ColNum2 RestCol = ColNum2 - p + 1 If rs.Eof and RestCol >0 Then For q=1 to RestCol Response.Write("") If q mod 6 = 0 Then Response.Write("") Next End If If rs.Eof Then Exit For VI_ID = rs("VI_ID") VI_Name = rs("VI_Name") NameFull = VI_Name VI_Name = CutStr(VI_Name,TitleNumWords*2) VI_SmallImage = rs("VI_SmallImage") VI_Type = rs("VI_Type") VI_Intro = rs("VI_Intro") VI_Intro = replace((replace(VI_Intro,vbcrlf,"
")),chr(32)&chr(32),"  ") VI_Des = VI_Intro VI_Intro = CutStr(VI_Intro,DesNumWords*2) VI_Hit = rs("VI_Hit") VI_Date = rs("VI_Date") VI_Time = rs("VI_Time") If VI_SmallImage = "" or IsNull(VI_SmallImage) = True Then VI_SmallImage = "/System/SysImage/nophoto.gif" If VI_Type = 1 Then ItemIcon = "/System/SysImage/mediaicon.gif" If VI_Type = 2 Then ItemIcon = "/System/SysImage/realicon.gif" If VI_Type = 3 Then ItemIcon = "/System/SysImage/flv.gif" Response.write "" rs.Movenext Next If rs.eof Then Exit For rs.movenext Response.write "" Next rs.close If maxcount > 1 Then '视频列表多于1页 Response.write "" End If Response.write "
" Call Pagination() Response.write "
 
" Response.Write "" Response.Write "" Response.write "" Response.write "" Response.write "
" If MemberIS = 1 and Session("m_ID") = "" Then Response.Write "" Else Response.write "" Response.Write "" End If Response.write "
" Response.write "" Response.write "" Response.write "") Response.write "" Response.write "
 "&VI_Name&"" Response.write "
" Response.Write("
"&VI_Intro&"
") Response.Write("
"&Txt7&":"&VI_Hit&"  " Response.write Txt15 & ":"&VI_Date&"  " Response.write "
" Call Pagination() Response.write "
" Response.write "
" End Select '=============================================================================================================================== End Sub %> <% Sub IndexSiteList(SS_ID,NumCol,TbWid,TdHig,IsCSS,CssName,CWid,CHig,CLineHig,CPadLeft,CMarTop,CMarRight,CTextAlign,NumWords,LinkUrl) If IsCSS Then %> <% End If sql = "select * from SiteLink where SS_ID="&SS_ID&" order by SL_Date desc,SL_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount With Response If rscount > 0 Then .Write "" .Write "" .Write "" .Write "" .Write "
" .Write "

" For i = 1 to rscount SL_ID = rs("SL_ID") SL_Name = rs("SL_Name") If NumWords <> "" Then SL_Name = CutStr(SL_Name,NumWords*2) .write ""&SL_Name&"" If i mod NumCol > 0 and i < rscount Then .write "  " If i mod NumCol = 0 Then .write "
" rs.movenext Next .Write "

" .Write "
" End If End With rs.close End Sub '====================================================================================================================== ' 站点链接列表 '====================================================================================================================== Sub SiteList(NumRow,NumCol,TbBgCor,TdBgCor,TbPad,LeftWidth,IntroVis,LinkManVis,TelVis,FaxVis,EmailVis,AddressVis,PostCodeVis) If NowSSIS = False Then Exit Sub NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub SL_ID = GetSafeStr(Request.QueryString("SL_ID")) If SL_ID <> "" Then sql = "select * from SiteLink where SL_ID=" & SL_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then SL_Name = rs("SL_Name") SL_Intro = rs("SL_Intro") End If rs.close Response.write "
"&SL_Name&"
" Response.write "
"&SL_Intro&"
" Exit Sub End If If NowSSSubItem = True Then sql = "select * from SiteLink where SS_Path like '%"&NowSSPath&"%' order by SL_Vouch"&OType&",SL_Date desc,SL_Time desc" Else sql = "select * from SiteLink where SS_ID="&NowSSID&" order by SL_Vouch desc,SL_Date"&OType&",SL_Time desc" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If linkpar = "&SS_ID="&NowSSID mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = NumTr rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "
" Response.write "" Response.write "
" Call Pagination() Response.write "
" Response.write "
" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j SL_ID = rs("SL_ID") SL_Name = rs("SL_Name") SL_URL = rs("SL_URL") SL_SmallImage = rs("SL_SmallImage") SL_LinkMan = rs("SL_LinkMan") SL_Tel = rs("SL_Tel") SL_Fax = rs("SL_Fax") SL_Email = rs("SL_Email") SL_Address = rs("SL_Address") SL_PostCode = rs("SL_PostCode") SL_Vouch = rs("SL_Vouch") SL_Hit = rs("SL_Hit") If SL_SmallImage = "" or IsNull(SL_SmallImage) = True Then SL_SmallImage = "/System/SysImage/nophoto.gif" If i mod NumCol = 1 or NumCol = 1 Then Response.write "" Response.write "" If IntroVis = 1 Then Response.write "" End If If i = j and j > NumCol and i mod NumCol <> 0 Then y = NumCol - (i mod NumCol) For x = 1 to y Response.write "" Next End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" Response.write "
" Response.write SL_Name&"
" Response.write "  "&SL_Name&"" Response.write "  [机构职能]" Response.write "
  网  址:"&SL_URL&"" If LinkManVis = 1 Then Response.write "
  联系人:"&SL_LinkMan&"" If TelVis = 1 Then Response.write "
  电  话:"&SL_Tel&"" If FaxVis = 1 Then Response.write "
  传  真:"&SL_Fax&"" If EmailVis = 1 Then Response.write "
  E-mail:"&SL_Email&"" If AddressVis = 1 Then Response.write "
  地  址:"&SL_Address&"" If PostCodeVis = 1 Then Response.write "
  邮  编:"&SL_PostCode&"" Response.write "
" If maxcount > 1 Then '站点列表多于1页 Response.write "" Response.write "
" Call Pagination() Response.write "
" End If Response.write "
" End Sub %> <% '====================================================================================================================== ' 首页下载列表(SS_ID:栏目ID,SS_Path:栏目路径,NumRow:显示条数,ItemIco:前缀小图标,ItemWid:小图标宽度,TitleWid:标题显示宽度,NumWords:标题显示字数,ViewUrl:链接地址) '====================================================================================================================== Sub IndexDownList(SS_ID,SS_Path,NumRow,ItemIco,ItemWid,TitleWid,NumWords,ViewUrl) If SS_ID = "" Then Exit Sub sql = "select top "&NumRow&" * from DownLoad where DL_CheckIn<>0" If SS_Path <> "" Then sql = sql &" and SS_Path like '%"&SS_Path&"%'" else sql = sql & " and SS_ID="&SS_ID end if sql = sql & " order by DL_Vouch"&OType&",DL_ID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRow Then rscount = NumRow If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") DL_ID = rs("DL_ID") DL_Name = rs("DL_Name") DL_Date = rs("DL_Date") DL_Time = rs("DL_Time") If NumWords > 0 Then DL_Name = CutStr(DL_Name,NumWords*2) Response.write "" Response.write "" Response.write "" rs.movenext Next rs.close Response.write "
"&DL_Name&"
" End Sub '====================================================================================================================== ' 首页下载列表(SS_ID:栏目ID,SS_Path:栏目路径,NumRow:显示条数,ItemIco:前缀小图标,ItemWid:小图标宽度,TitleWid:标题显示宽度,NumWords:标题显示字数,ViewUrl:链接地址) '====================================================================================================================== Sub IndexDownList_new(SS_ID,SS_Path,NumRow,ItemIco,ItemWid,TitleWid,NumWords,ViewUrl) If SS_ID = "" Then Exit Sub sql = "select top "&NumRow&" * from DownLoad where DL_CheckIn<>0" If SS_Path <> "" Then sql = sql &" and SS_Path like '%"&SS_Path&"%'" else sql = sql & " and SS_ID="&SS_ID end if sql = sql & " order by DL_Vouch"&OType&",DL_ID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRow Then rscount = NumRow If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If Response.write "
    " For i = 1 to rscount SS_ID = rs("SS_ID") DL_ID = rs("DL_ID") DL_Name = rs("DL_Name") tDL_Name = rs("DL_Name") DL_Date = rs("DL_Date") DL_Time = rs("DL_Time") If NumWords > 0 Then DL_Name = CutStr(DL_Name,NumWords*2) Response.write "
  • "&DL_Name&"
  • " rs.movenext Next rs.close Response.write "
" End Sub '====================================================================================================================== ' 栏目页下载列表(PerNumRow:每页显示条数,MemberIS:是否启动会员,MemberSSID:绑定会员栏目ID,ColNum:列数,NumWords:标题显示字数,TypeNum:样式序号,TdColor:单元格颜色,Title1Pic:小图标,Title2Pic_Width:下载图片宽度,Title2Pic_Height:下载图片高度,Title2NumWords:标题字数) '====================================================================================================================== Sub DownList(PerNumRow,MemberIS,MemberSSID,NumWords) If NowSSIS = False Then Exit Sub Application("DownMemIS") = MemberIS ' ------------------系统启用会员------------------------- If MemberIS = 1 Then Response.write "
" If Session("m_ID") = "" Then Response.write "" Response.write "  " Response.write "" 'Response.write "  "&Txt22&"" Else Response.write "【"&Txt23&":"&Session("m_Name")&"】" Response.write " "&Txt25&"" Response.write " "&Txt24&"" End If Response.write "
" End If '显示下载详细资料 DL_ID = GetSafeStr(Request.QueryString("DL_ID")) If DL_ID <> "" Then If IsNumeric(DL_ID) = True Then sql = "select * from DownLoad where DL_CheckIn<>0 and DL_ID=" & DL_ID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If DL_Name = rs("DL_Name") DL_Image = rs("DL_Image") DL_Date = rs("DL_Date") DL_Time = rs("DL_Time") DL_URL = rs("DL_URL") DL_Hit = rs("DL_Hit") DL_Intro = rs("DL_Intro") If DL_Image = "" or IsNull(DL_Image) = True Then DL_Image = "/System/SysImage/nophoto.gif" If DL_Intro <> "" Then DL_Intro = replace((replace(DL_Intro,vbcrlf,"
")),chr(32)&chr(32),"  ") rs.close %><% Response.write "" & chr(13)&chr(10) If Title2Pic_Width > 0 Then Response.write "" & chr(13) &chr(10) replstr = "
软件名称  <%= DL_Name%>
发布日期  <%= DL_Date & " " & DL_Time%>
下载次数  <%= DL_Hit%>
下载地址 <% If MemberIS = 1 and Session("m_ID") = "" Then Response.write "" Else Response.write "" End If Response.write "" %>
软件简介  <%= DL_Intro%>
下载说明
·如果您发现本站有任何死链或错链问题,请留言通知管理员,谢谢!
·本站大多数软件采用WinRAR压缩,请在此下载最新版本。
·如果您链接本站本地软件,请注明出处,谢谢您的支持!
·本站提供的软件下载如有侵权,请及时告知我们将之移除!
·欢迎大家到留言板发表和交流您对本栏目的见解!

<% Exit Sub End If End If ' ------------------验证Post------------------------- action = GetSafeStr(Request.Form("action")) If action = "logincheck" Then '验证会员登录 Call MemberLoginCheck(MemberSSID) Exit Sub End If If action = "registercheck" Then '验证会员注册 Call MemberRegisterCheck(MemberSSID) Exit Sub End If If action = "editcheck" Then '验证会员修改资料 Call MemberEditCheck(MemberSSID) Exit Sub End If If action = "findpasscheckuser" Then '验证密码查询 Call MemberFindPassCheckUser() Exit Sub End If If action = "findpasscheckanswer" Then '验证密码查询 Call MemberFindPassCheckAnswer() Exit Sub End If ' ------------------验证Get------------------------- action = GetSafeStr(Request.QueryString("action")) If action = "login" Then '用户登录表单 %>
会员登陆
<%= Txt28%>   
<%= Txt36%>   
 
忘记密码? 立刻注册
<% Exit Sub End If If action = "register" Then '用户注册表单 %> <%If WebLanguage = 1 Then%> <%If GetSafeStr(Request.QueryString("read")) <> "1" Then%>

继续注册前请先阅读本协议 >>

    欢迎您加入本网站参加交流和讨论,本网站为公共网站,为维护网上公共秩序和社会稳定,请您自觉遵守以下条款:

一、不得利用本站危害国家安全、泄露国家秘密,不得侵犯国家社会集体的和公民的合法权益,不得利用本站制作、复制和传播下列信息:

(一)煽动抗拒、破坏宪法和法律、行政法规实施的;
(二)煽动颠覆国家政权,推翻社会主义制度的;
(三)煽动分裂国家、破坏国家统一的;
(四)煽动民族仇恨、民族歧视,破坏民族团结的;
(五)捏造或者歪曲事实,散布谣言,扰乱社会秩序的;
(六)宣扬封建迷信、淫秽、色情、赌博、暴力、凶杀、恐怖、教唆犯罪的;
(七)公然侮辱他人或者捏造事实诽谤他人的,或者进行其他恶意攻击的;
(八)损害国家机关信誉的;
(九)其他违反宪法和法律行政法规的;
(十)进行商业广告行为的。

二、互相尊重,对自己的言论和行为负责。

    
<%Else%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
注:您输入的资料将作为使用本系统其他功能的数据,请准确地填写,谢谢!
用户名: *
密码: *
确认密码: *
姓名: *
性别:
年龄: *
省份:
城市: *
地址: *
邮编: *
电话: *
传真:
OICQ:
MSN:
Email: *
密码查询问题: *
密码查询答案: *
 
<%End If%> <%End If%> <%If WebLanguage = 2 Then%> <%If GetSafeStr(Request.QueryString("read")) <> "1" Then%>

Please read the agreement before registration continue >>
  You are welcome to participate in the exchange of ideas and discussion added to the website, the website for public website for online maintenance of public order and social stability, you have to consciously abide by the following provisions :
  First, should not be used to judge endangering national security, leaking state secrets, or violate the legitimate national rights and civil society collectively and shall not make use of this website production, reproduction and dissemination of the following information :
    (1) to incite resistance and undermining the Constitution and other laws and administrative regulations;
    (2) inciting subversion of state power to overthrow the socialist system;
    (3) inciting people to split the country and undermining national unity;
    (4) to incite ethnic hatred and discrimination that undermines national unity;
    (5) fabrication or distortion of facts, spread rumors, disturbs social order;
    (6) spread feudal superstition, obscenity, pornography, gambling, violence, murder, terrorism and abetting a crime;
    (7) humiliated others or making up stories to slander others, or other malicious attacks.
    (8) damage to the reputation of state organs;
    (9) violation of the Constitution and other administrative laws and regulations;
    (10) the commercial advertising.
   Second, mutual respect and on his own words and actions.

    
<%Else%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
Note : The information you input will use the system as a function of other data, and accurately completing Thank you!
login: *
password: *
confirmation assword: *
name: *
sex:
age: *
provinces:
city: *
address: *
postcode: *
tel: *
fax:
OICQ:
MSN:
Email: *
question for passwords: *
answer for passwords: *
 
<%End If%> <%End If%> <% Exit Sub End If If action = "edit" Then '用户修改资料表单 Call MemberEdit() Exit Sub End If If action = "findpass" Then '用户查询密码表单 Call MemberFindPass() Exit Sub End If If action = "logout" Then '用户安全退出 Session("m_ID") = "" Session("m_Name") = "" Session("m_ForumRights") = "" Session("m_Level") = "" Session("m_LoginNow") = "" Response.Redirect NowSSURL&"?SS_ID="&NowSSID End If If NowSSSubItem = True Then sql = "select * from DownLoad where DL_CheckIn<>0 and SS_Path like '%"&NowSSPath&"%' order by DL_Vouch desc,DL_Date desc,DL_Time desc" Else sql = "select * from DownLoad where DL_CheckIn<>0 and SS_ID="&NowSSID&" order by DL_Vouch desc,DL_Date desc,DL_Time desc" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write ErrTxt1 Exit Sub End If linkpar ="&SS_ID="&NowSSID mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "
" Call Pagination() Response.Write "
" Response.write "
    " j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j Response.write "
  • " DL_ID = rs("DL_ID") DL_Name = rs("DL_Name") DL_Url = rs("DL_Url") DL_Date = rs("DL_Date") DL_Time = rs("DL_Time") Response.write ""&DL_Name&"" Response.write "" rs.movenext Response.write "
  • " If rs.Eof Then Exit For Next rs.close Response.write "
" If maxcount > 1 Then '下载多于1页 Response.write "
" Call Pagination() Response.Write "
" End If End Sub %> <% ' ====================================================================================================================== ' 首页调用论坛贴子列表(SS_ID:栏目ID,SS_Path:栏目路径,NumRow:行数,NumCol:列数,TrHig:行高,ItemIcon:前缀小图标,ItemWid:小图标宽度,TitleWid:标题宽度,NumWords:标题文字,DateVis:是否显示日期,TimeVis:是否显示时间,NameVis:是否显示发帖人,HitVis:是否显示点击数) ' ====================================================================================================================== Sub IndexForumList(SS_ID,SS_Path,NumRow,NumCol,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,NameVis,HitVis) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" Forum.*,SiteStructure.SS_URL As SS_URL from Forum" sql = sql&" inner join SiteStructure On SiteStructure.SS_ID=Forum.SS_ID" sql = sql&" where Forum.PF_ID=0 and Forum.F_CheckIn<>0" If SS_ID <> "" Then sql = sql& " and Forum.SS_ID="&SS_ID If SS_Path <> "" Then sql = sql&" and Forum.SS_Path like '%"&SS_Path&"%'" sql = sql&" order by Forum.F_TopLock"&OType&",Forum.F_Date desc,Forum.F_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRow Then rscount = NumRow If rscount > 0 Then Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") F_ID = rs("F_ID") F_Title = rs("F_Title") F_Date = rs("F_Date") F_Time = rs("F_Time") F_Name = rs("F_Name") F_Hit = rs("F_Hit") SS_URL = rs("SS_URL") mF_Date = Month(F_Date) dF_Date = Day(F_Date) If mF_Date < 10 Then mF_Date = "0" & mF_Date If dF_Date < 10 Then dF_Date = "0" & dF_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or NameVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then F_Title = CutStr(F_Title,NumWords*2) Response.write F_Title&"" If DateVis = 1 Then Response.write " "&mF_Date&"-"&dF_Date If TimeVis = 1 Then Response.write " "&F_Time If NameVis = 1 Then Response.write " "&F_Name If HitVis = 1 Then Response.write " "&F_Hit Response.write "
" Else rs.close Response.write "暂无内容" End If End Sub ' ====================================================================================================================== ' 栏目页论坛分类帖子列表 (PerNumRow:每页显示条数,TbBdCor:单元格背景颜色,ThBgCor:背景色,TrBgCor:背景色,ForumID:栏目ID,CheckIn:是否审核,MemberIS:是否绑定会员,MemberSSID:绑定会员栏目ID,AddCls:发帖样式,ReplayCls:回复样式,LoginCls:登陆样式,RegCls:注册样式,SearchCls:搜索样式,FormBtnCls:表单样式) ' ====================================================================================================================== Sub ForumList(PerNumRow,TbBdCor,ThBgCor,TrBgCor,ForumID,CheckIn,MemberIS,MemberSSID,AddCls,ReplayCls,LoginCls,RegCls,SearchCls,FormBtnCls) If NowSSIS = False Then Exit Sub ' --------------显示发表新帖、回复帖子、登录、注册按钮------------------------------- tF_ID = GetSafeStr(Trim(Request.QueryString("F_ID"))) tF_Title = GetSafeStr(Trim(Request.QueryString("tF_Title"))) If tF_ID <> "" and IsNumeric(tF_ID) = False Then Exit Sub Response.write "" Response.write "" Else Response.write "" End If End If Response.write "
" 'Response.write """ Then Response.write " href="""&NowSSURL&"?SS_ID="&NowSSID&"&action=add""" 'Response.write ">" '发表新贴按钮 Response.Write "" if NowSSID=389 then Response.Write "                      " Response.Write "                      " Response.Write "                  " Response.Write "" Response.Write "2014年度回复情况" end if If tF_ID <> "" Then ' Response.write " " Response.Write "  " End If If MemberIS = 1 Then If Session("m_ID") = "" Then ' Response.write " " ' Response.write "" ' Response.write " " ' Response.write "" ' Response.Write "  " Response.Write "  " Response.write "  我的密码忘了怎么办?【当前用户:"&Session("m_Name")&"】" Response.write " 安全退出" Response.write " 修改资料
" ' --------------表单提交 Post------------------------------- action = GetSafeStr(Request.Form("action")) If action = "add" Then '主题帖子 Call ForumAdd(CheckIn) Exit Sub End If If action = "edit" Then '修改贴子 Call ForumEdit() Exit Sub End If If action = "revert" Then '回复帖子 Call ForumRevert(CheckIn) Exit Sub End If If action = "logincheck" Then '验证会员登录 Call MemberLoginCheck(MemberSSID) Exit Sub End If If action = "registercheck" Then '验证会员注册 Call MemberRegisterCheck(MemberSSID) Exit Sub End If If action = "editcheck" Then '验证会员修改资料 Call MemberEditCheck(MemberSSID) Exit Sub End If If action = "findpasscheckuser" Then '验证密码查询 Call MemberFindPassCheckUser() Exit Sub End If If action = "findpasscheckanswer" Then '验证密码查询 Call MemberFindPassCheckAnswer() Exit Sub End If ' --------------显示表单 Get------------------------------ action = GetSafeStr(Request.QueryString("action")) If action = "add" Then '主题帖子表单 Call ForumAddForm(action,ForumID,CheckIn) Exit Sub End If If action = "edit" Then '修改帖子表单 Call ForumEditForm() Exit Sub End If If action = "del" Then Call ForumDel() Exit Sub End If If action = "login" Then '用户登录表单 %>
会员登陆
<%= Txt28%>   
<%= Txt36%>   
 
忘记密码? 立刻注册
<% Exit Sub End If If action = "register" Then '用户注册表单 %> <%If WebLanguage = 1 Then%> <%If GetSafeStr(Request.QueryString("read")) <> "1" Then%>

继续注册前请先阅读本协议 >>

    欢迎您加入本网站参加交流和讨论,本网站为公共网站,为维护网上公共秩序和社会稳定,请您自觉遵守以下条款:

一、不得利用本站危害国家安全、泄露国家秘密,不得侵犯国家社会集体的和公民的合法权益,不得利用本站制作、复制和传播下列信息:

(一)煽动抗拒、破坏宪法和法律、行政法规实施的;
(二)煽动颠覆国家政权,推翻社会主义制度的;
(三)煽动分裂国家、破坏国家统一的;
(四)煽动民族仇恨、民族歧视,破坏民族团结的;
(五)捏造或者歪曲事实,散布谣言,扰乱社会秩序的;
(六)宣扬封建迷信、淫秽、色情、赌博、暴力、凶杀、恐怖、教唆犯罪的;
(七)公然侮辱他人或者捏造事实诽谤他人的,或者进行其他恶意攻击的;
(八)损害国家机关信誉的;
(九)其他违反宪法和法律行政法规的;
(十)进行商业广告行为的。

二、互相尊重,对自己的言论和行为负责。

    
<%Else%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
注:您输入的资料将作为使用本系统其他功能的数据,请准确地填写,谢谢!
用户名: *
密码: *
确认密码: *
姓名: *
性别:
年龄: *
省份:
城市: *
地址: *
邮编: *
电话: *
传真:
OICQ:
MSN:
Email: *
密码查询问题: *
密码查询答案: *
 
<%End If%> <%End If%> <%If WebLanguage = 2 Then%> <%If GetSafeStr(Request.QueryString("read")) <> "1" Then%>

Please read the agreement before registration continue >>
  You are welcome to participate in the exchange of ideas and discussion added to the website, the website for public website for online maintenance of public order and social stability, you have to consciously abide by the following provisions :
  First, should not be used to judge endangering national security, leaking state secrets, or violate the legitimate national rights and civil society collectively and shall not make use of this website production, reproduction and dissemination of the following information :
    (1) to incite resistance and undermining the Constitution and other laws and administrative regulations;
    (2) inciting subversion of state power to overthrow the socialist system;
    (3) inciting people to split the country and undermining national unity;
    (4) to incite ethnic hatred and discrimination that undermines national unity;
    (5) fabrication or distortion of facts, spread rumors, disturbs social order;
    (6) spread feudal superstition, obscenity, pornography, gambling, violence, murder, terrorism and abetting a crime;
    (7) humiliated others or making up stories to slander others, or other malicious attacks.
    (8) damage to the reputation of state organs;
    (9) violation of the Constitution and other administrative laws and regulations;
    (10) the commercial advertising.
   Second, mutual respect and on his own words and actions.

    
<%Else%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
Note : The information you input will use the system as a function of other data, and accurately completing Thank you!
login: *
password: *
confirmation assword: *
name: *
sex:
age: *
provinces:
city: *
address: *
postcode: *
tel: *
fax:
OICQ:
MSN:
Email: *
question for passwords: *
answer for passwords: *
 
<%End If%> <%End If%> <% Exit Sub End If If action = "editmem" Then '用户修改资料表单 Call MemberEdit() Exit Sub End If If action = "findpass" Then '用户查询密码表单 Call MemberFindPass() Exit Sub End If If action = "logout" Then '用户安全退出 Session("m_ID") = "" Session("m_Name") = "" Session("m_ForumRights") = "" Session("m_Level") = "" Session("m_LoginNow") = "" Response.Redirect NowSSURL&"?SS_ID="&NowSSID End If ' ================================================ ' 显示当前项目帖子列表 ' ================================================ If tF_ID <> "" Then Call ForumArticleList(PerNumRow,tF_ID,TbBdCor,ThBgCor,TrBgCor,CheckIn,MemberIS) Exit Sub End If If action = "notice" Then Response.write "" End If If NowSSSubItem = True Then sql = "select * from Forum where SS_Path like '%"&NowSSPath&"%'" If tF_Title <> "" Then sql = sql & " and F_Title like '%"&tF_Title&"%'" sql = sql & " and PF_ID=0 and F_CheckIn<>0" sql = sql&" order by F_TopLock"&OType&",F_Date desc,F_Time desc" Else sql = "select * from Forum where SS_ID="&NowSSID If tF_Title <> "" Then sql = sql & " and F_Title like '%"&tF_Title&"%'" sql = sql &" and PF_ID=0 and F_CheckIn<>0 " sql = sql&" order by F_TopLock"&OType&",F_Date desc,F_Time desc" End If Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write "
  暂无内容!" Exit Sub End If linkpar ="&SS_ID="&NowSSID mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "" Response.write "
" Call Pagination() Response.write "
" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
关键词:
类型:
" Response.write "" Response.write "
" Response.write " " Response.write "
" If rscount > 0 Then Response.write ""&chr(13)&chr(10) Response.write "
" Response.write "" Response.write "" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j F_ID = rs("F_ID") FSS_ID = rs("SS_ID") F_Title = rs("F_Title") F_Name = rs("F_Name") F_FaceImage = rs("F_FaceImage") F_Date = rs("F_Date") F_Time = rs("F_Time") F_Hit = rs("F_Hit") F_Revert = rs("F_Revert") ' F_LastName = rs("F_LastName") ' F_LastDate = rs("F_LastDate") ' F_LastTime = rs("F_LastTime") mF_Date = Month(F_Date) dF_Date = Day(F_Date) If mF_Date < 10 Then mF_Date = "0" & mF_Date mdF_Date = mF_Date & "-" & dF_Date F_Time = FormatDateTime(F_Time,4) F_LastName = "" F_LastDate = "" F_LastTime = "" lastsql = "select Top 1 F_Name,F_Date,F_Time from Forum where PF_ID = "&F_ID&" and F_CheckIn<>0 order by F_Date desc,F_Time desc " Set lastrs = LsObject.CreateRs(lastsql,1,1) If Not lastrs.Eof Then F_LastName = lastrs("F_Name") F_LastDate = lastrs("F_Date") F_LastTime = lastrs("F_Time") End If lastrs.close If F_LastDate <> "" Then mF_LastDate = Month(F_LastDate) dF_LastDate = Day(F_LastDate) If mF_LastDate < 10 Then mF_LastDate = "0" & mF_LastDate If dF_LastDate < 10 Then dF_LastDate = "0" & dF_LastDate 'mdF_LastDate = mF_LastDate & "-" & dF_LastDate mdF_LastDate=Month(F_LastDate) &"-"&Day(F_LastDate) &" "&F_LastTime 'F_LastTime = FormatDateTime(F_LastTime,4) End If If F_LastName = "" Then mdF_LastDate = "" F_LastTime = "" End If sql1 = "select count(*) as Lcount from Forum where PF_ID=" & F_ID & " and GovResert<>0 and GovResert is not null" Set rs1 = LsObject.CreateRs(sql1,1,1) if not rs1.eof then rscount1=rs1(0) end if Response.write "" if rscount1>0 then Response.write "" else Response.write "" end if Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" rs.movenext Next Response.write "
主 题作 者投诉时间回复时间
 " Response.write ""&F_Title&""&F_Name&""&Year(F_Date)&"-"&mdF_Date&""&mdF_LastDate&"
" End If rs.close If maxcount > 1 Then Call Pagination() Response.write "
" End Sub '====================================================================================================================== ' 显示添加主题帖子表单 '====================================================================================================================== Sub ForumAddForm(action,ForumID,CheckIn) If Member = 1 and Session("m_ID") = "" Then Call OutScript("必须以会员身份登录论坛后才可发帖!") Exit Sub End If '取出论坛根路径 sql = "select * from SiteStructure where SS_ID=" & ForumID & " and SS_Type=7" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If SS_Path = rs("SS_Path") rs.close '生成论坛目录列表表单 sql = "select * from SiteStructure where SS_Path like '%"&SS_Path&"%' order by SS_Path" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount OptionStr = "" %>
<% Response.write " 标题字数不得少于4个字," If CheckIn = 0 Then Response.write "同时您的留言将在审核后才能发布!  " Response.write "谢绝转贴广告、供求信息" %>
主 题(*)
0 then%>value="回应:<%= NowF_Title%>"<%end if%>>* <%'If action="add" Then Response.write "所属栏目"%> <%if action="add" then%>首次发言自动注册<%end if%><%'= OptionStr%>
网 名(*)
"" Then%> value="<%= Session("m_Name")%>" <%End If%>> *
电话/密码(*) (保密号码)*
表 情
验证码(*) *
<%If action="revert" Then%> <%End If%>   
<% End Sub '====================================================================================================================== ' 显示修改帖子表单 '====================================================================================================================== Sub ForumEditForm() F_ID = GetSafeStr(Request.QueryString("F_ID")) SS_ID = GetSafeStr(Request.QueryString("SS_ID")) If F_ID = "" or IsNumeric(F_ID) = False or SS_ID = "" or IsNumeric(SS_ID) = False Then Exit Sub sql = "select * from Forum where F_ID=" & F_ID & " and SS_ID=" & SS_ID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If m_ID = rs("m_ID") If m_ID <> Session("m_ID") and Instr(Session("m_ForumRights"),"|"&SS_ID&"|") = 0 Then '再次验证发贴会员身份 rs.close Exit Sub End If F_ID = rs("F_ID") F_Title = rs("F_Title") F_Name = rs("F_Name") F_Email = rs("F_Email") F_Tel = rs("F_Tel") F_OICQ = rs("F_OICQ") F_FaceImage = rs("F_FaceImage") F_Contents = rs("F_Contents") rs.close F_Contents = F_Contents %>
标题字数不得少于4个字
主 题
*
网 名 * Email
电 话 OICQ
表 情
> > > > > > > > > >
> > > > > > > > > >
  
<% End Sub '====================================================================================================================== ' 提交主题帖子 '====================================================================================================================== Sub ForumAdd(CheckIn) F_Title = GetSafeStr(Request.Form("F_Title")) F_Name = GetSafeStr(Request.Form("F_Name")) F_Email = GetSafeStr(Request.Form("F_Email")) F_Tel = GetSafeStr(Request.Form("F_Tel")) F_OICQ = GetSafeStr(Request.Form("F_OICQ")) F_FaceImage = GetSafeStr(Request.Form("F_FaceImage")) For i = 1 To Request.Form("F_Contents").Count F_Contents = F_Contents & Trim(Request.Form("F_Contents")(i)) Next SS_Name = Request.Form("SS_Name") If F_Title = "" Then Call OutScript("您的标题填写不规范!") If F_Name = "" Then Call OutScript("您的网名填写不规范!") If F_Tel = "" Then Call OutScript("您的电话号码填写不规范!") If F_Contents = "" Then Call OutScript("您的留言填写不规范!") If Request.Form("checkcode") <> Cstr(Session("CheckCode")) Then response.Write("") response.End() End If '判断是否是未注册账户 sql1= "select * from Member where m_Login='" & F_Name & "'" Set rs1 = LsObject.CreateRs(sql1,1,1) If rs1.eof and rs1.bof Then ' ' 'Set Conn=LsObject.CreateConn() ' Insertsql = "insert into Member(m_ID,SS_ID,m_Login,m_Password,m_Name,m_Sex,m_Age,m_LoginTime,m_LastAccessDate,m_LastAccessTime,m_CreateDate,m_CreateTime)" ' Insertsql = Insertsql &" values("&m_ID&","&SS_ID&",'"&m_Login&"','"& LsObject.Encodeuser(F_Tel)&"','"&F_Name&"',1,99,1,'"&Date()&"','"&Time()&"','"&date()&"','"&time()&"')" ' response.Write Insertsql ' response.End() '添加用户信息 sql2 = "select top 1 * from Member order by m_ID desc" Set rs2 = LsObject.CreateRs(sql2,1,3) If not rs2.eof Then m_ID = rs2("m_ID") + 1 Else m_ID = 1 End If rs2.addnew rs2("m_ID") = m_ID rs2("SS_ID") = 390 rs2("m_Login") = F_Name rs2("m_Password") =LsObject.Encodeuser(F_Tel) rs2("m_Name") = F_Name rs2("m_Sex") =1 rs2("m_Age") = 99 rs2("m_LoginTime") = 1 rs2("m_LastAccessDate") = Date() rs2("m_LastAccessTime") = Time() rs2("m_CreateDate") = Date() rs2("m_CreateTime") = Time() rs2("m_CreateIP") = Request.ServerVariables("REMOTE_ADDR") rs2("m_Level") = 1 rs2("m_Lock") = 0 rs2("m_Score") = 0 rs2.update rs2.close end if Ar_SS_Name = Split(SS_Name,"|") SS_Path = Ar_SS_Name(0) SS_ID = Ar_SS_Name(1) d_OriginalFileName = GetSafeStr(Request.Form("d_originalfilename")) d_SaveFileName = GetSafeStr(Request.Form("d_savefilename")) d_SavePathFileName = GetSafeStr(Request.Form("d_savepathfilename")) sql = "select top 1 * from Forum order by F_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then tF_ID = rs("F_ID") + 1 Else tF_ID = 1 End If rs.addnew rs("F_ID") = tF_ID rs("PF_ID") = 0 'rs("SS_ID") = SS_ID rs("SS_ID") = request("SS_ID") rs("SS_Path") = SS_Path rs("F_Title") = F_Title rs("F_FaceImage") = F_FaceImage rs("F_Name") = F_Name rs("F_Email") = F_Email rs("F_Tel") = F_Tel rs("F_OICQ") = F_OICQ rs("F_Contents") = F_Contents rs("F_Date") = Date() rs("F_Time") = Time() rs("F_RemoteIp") = Request.ServerVariables("REMOTE_ADDR") rs("F_Hit") = 0 rs("F_Revert") = 0 rs("F_TopLock") = 0 rs("F_CheckIn") = CheckIn rs("d_OriginalFileName") = d_originalfilename rs("d_SaveFileName") = d_savefilename rs("d_SavePathFileName") = d_savepathfilename If Session("m_ID") <> "" Then rs("m_ID") = Session("m_ID") rs.update rs.close '添加到公共标题表 sql="select * from PublicTitle" Set rs = LsObject.CreateRs(sql,1,3) rs.addnew rs("PT_TITLE") = F_Title rs("PT_DID") = tF_ID rs("PT_DTYPE") = 7 rs("PT_CHECKIN") = CheckIn rs("PT_SSID") = SS_ID SS_SiteID = ReadSiteID(SS_ID) rs("PT_SSSiteID") = SS_SiteID rs.update rs.close '会员积分加300分 If Session("m_ID") <> "" Then sql = "update Member set m_Score=m_Score+300 where m_ID=" & Session("m_ID") Set Conn = LsObject.CreateConn() conn.Execute(sql) conn.close End If If CheckIn = 0 Then Response.Redirect(NowSSURL&"?action=notice&SS_ID=" & request("SS_ID")) Else 'Response.Redirect(NowSSURL&"?SS_ID=" & SS_ID) Response.Redirect(NowSSURL&"?SS_ID=" & SS_ID) End If End Sub '====================================================================================================================== ' 修改帖子 '====================================================================================================================== Sub ForumEdit() F_ID = Request.Form("F_ID") SS_ID = Request.Form("SS_ID") If F_ID = "" or IsNumeric(F_ID) = False or SS_ID = "" or IsNumeric(SS_ID) = False Then Response.End() F_Title = GetSafeStr(Request.Form("F_Title")) F_Name = GetSafeStr(Request.Form("F_Name")) F_Email = GetSafeStr(Request.Form("F_Email")) F_Tel = GetSafeStr(Request.Form("F_Tel")) F_OICQ = GetSafeStr(Request.Form("F_OICQ")) F_FaceImage = Request.Form("F_FaceImage") F_Contents = "" For i = 1 To Request.Form("F_Contents").Count F_Contents = F_Contents & Trim(Request.Form("F_Contents")(i)) Next d_OriginalFileName = GetSafeStr(Request.Form("d_originalfilename")) d_SaveFileName = GetSafeStr(Request.Form("d_savefilename")) d_SavePathFileName = GetSafeStr(Request.Form("d_savepathfilename")) sql = "select * from Forum where F_ID=" & F_ID Set rs = LsObject.CreateRs(sql,1,3) If rs.eof Then rs.close Response.End() End If rs("F_Title") = F_Title rs("F_Name") = F_Name rs("F_Email") = F_Email rs("F_Tel") = F_Tel rs("F_OICQ") = F_OICQ rs("F_FaceImage") = F_FaceImage rs("F_Contents") = F_Contents rs("d_OriginalFileName") = d_originalfilename rs("d_SaveFileName") = d_savefilename rs("d_SavePathFileName") = d_savepathfilename rs.update rs.close '修改公共标题表 sql="select * from PublicTitle Where PT_DTYPE=7 and PT_DID="& F_ID Set rs = LsObject.CreateRs(sql,1,3) if not rs.eof then rs("PT_TITLE") = F_Title rs.update end if rs.close temurl = NowSSURL&"?SS_ID="&SS_ID Response.Redirect(temurl) End Sub '====================================================================================================================== ' 提交回复帖子 '====================================================================================================================== Sub ForumRevert(CheckIn) F_ID = Request.Form("F_ID") SS_ID = Request.Form("SS_ID") SS_Path = Request.Form("SS_Path") F_Title = GetSafeStr(Request.Form("F_Title")) F_Name = GetSafeStr(Request.Form("F_Name")) F_Email = GetSafeStr(Request.Form("F_Email")) F_Tel = GetSafeStr(Request.Form("F_Tel")) F_OICQ = GetSafeStr(Request.Form("F_OICQ")) F_FaceImage = GetSafeStr(Request.Form("F_FaceImage")) For i = 1 To Request.Form("F_Contents").Count F_Contents = F_Contents & Trim(Request.Form("F_Contents")(i)) Next d_OriginalFileName = GetSafeStr(Request.Form("d_originalfilename")) d_SaveFileName = GetSafeStr(Request.Form("d_savefilename")) d_SavePathFileName = GetSafeStr(Request.Form("d_savepathfilename")) If F_Title = "" Then Call OutScript("您的标题填写不规范!") If F_Name = "" Then Call OutScript("您的网名填写不规范!") If F_Contents = "" Then Call OutScript("您的留言填写不规范!") sqlt = "select * from Forum where F_RemoteIp='"&Request.ServerVariables("REMOTE_ADDR")&"' and SS_ID="&NowSSID&" order by F_ID desc" Set rs = LsObject.CreateRs(sqlt,1,1) If not rs.eof Then ftdate =rs("F_Date")&" "&rs("f_time") if datediff("n",ftdate,now())<5 then 'Call OutScript("同一个IP不能在五分钟内连续回帖!") response.Write "" exit sub end if End If rs.close sql = "select top 1 * from Forum order by F_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then tF_ID = rs("F_ID") + 1 Else tF_ID = 1 End If rs.addnew rs("F_ID") = tF_ID rs("PF_ID") = F_ID rs("SS_ID") = request("SS_ID") rs("SS_Path") = SS_Path rs("F_Title") = F_Title rs("F_FaceImage") = F_FaceImage rs("F_Name") = F_Name rs("F_Email") = F_Email rs("F_Tel") = F_Tel rs("F_OICQ") = F_OICQ rs("F_Contents") = F_Contents rs("F_Date") = Date() rs("F_Time") = Time() rs("F_RemoteIp") = Request.ServerVariables("REMOTE_ADDR") rs("F_Hit") = 0 rs("F_Revert") = 0 rs("F_TopLock") = 0 rs("F_CheckIn") = CheckIn rs("d_OriginalFileName") = d_originalfilename rs("d_SaveFileName") = d_savefilename rs("d_SavePathFileName") = d_savepathfilename If Session("m_ID") <> "" Then rs("m_ID") = Session("m_ID") rs.update rs.close '更新最后回复网名、时间、回复次数 sql = "select * from Forum where F_ID=" & F_ID Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then rs("F_LastName") = F_Name rs("F_LastDate") = Date() rs("F_LastTime") = Time() F_Revert = rs("F_Revert") rs("F_Revert") = F_Revert + 1 rs.update End If rs.close '会员积分加100分 If Session("m_ID") <> "" Then sql = "update Member set m_Score=m_Score+100 where m_ID=" & Session("m_ID") Set Conn = LsObject.CreateConn() conn.Execute(sql) conn.close End If If CheckIn = 0 Then Response.Redirect(NowSSURL&"?action=notice&SS_ID="&SS_ID&"&F_ID="&F_ID) Else Response.Redirect(NowSSURL&"?SS_ID="&SS_ID&"&F_ID="&F_ID) End If End Sub '====================================================================================================================== ' 论坛帖子内容 '====================================================================================================================== Sub ForumArticleList(PerNumRow,F_ID,TbBdCor,ThBgCor,TrBgCor,CheckIn,MemberIS) actionnew=GetSafeStr(request("actionnew")) if actionnew="myd" then ztid=request("ztid") rb=request("rb") sql = "select * from Forum where F_ID=" & CInt(ztid) Set rss = LsObject.CreateRs(sql,1,3) If rss.eof Then rss.close Exit Sub End If if rb=1 then rss("f_my")=rss("f_my")+1 else rss("f_bmy")=rss("f_bmy")+1 end if rss.update rss.close end if Response.write ""&chr(13)&chr(10) action = GetSafeStr(Request.QueryString("action")) If action = "notice" Then Response.write "" End If sql = "select * from Forum where F_ID=" & F_ID Set rs = LsObject.CreateRs(sql,1,3) If rs.eof Then rs.close Exit Sub End If NowF_Title = rs("F_Title") F_Name = rs("F_Name") F_Email = rs("F_Email") F_FaceImage = rs("F_FaceImage") F_Contents = rs("F_Contents") F_Date = rs("F_Date") F_Time = rs("F_Time") F_Hit = rs("F_Hit") F_Revert = rs("F_Revert") m_ID = rs("m_ID") ttSS_ID = rs("SS_ID") F_IsClose = rs("F_IsClose") f_my=rs("f_my") f_bmy=rs("f_bmy") If Request("whichpage") = "" Then F_Hit = F_Hit + 1 rs("F_Hit") = F_Hit rs.update End If rs.close sql = "select * from Forum where PF_ID=" & F_ID & " and F_CheckIn<>0 order by F_Date,F_Time" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount linkpar ="&SS_ID="&NowSSID&"&F_ID="&F_ID If rscount > 0 Then mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Else mypage = 1 maxcount = 1 End If Call Pagination() Response.write "" '显示主题帖子 Response.write "" Response.write "" Response.write "" '显示回复帖子 j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j ttF_ID = rs("F_ID") ttSS_ID = rs("SS_ID") F_Title = rs("F_Title") F_Name = rs("F_Name") F_Email = rs("F_Email") F_FaceImage = rs("F_FaceImage") F_Contents = rs("F_Contents") F_Date = rs("F_Date") F_Time = rs("F_Time") m_ID = rs("m_ID") GovResert = rs("GovResert") if GovResert="" or isnull(GovResert) then Response.write "" Response.write "" Response.write "" Response.write "" else Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" if actionnew="myd" then Response.write "" end if end if rs.movenext Next rs.close Response.write "
" Response.write "" Response.write "
主题:"&NowF_Title&"" Response.write " 楼主 
作者:"&F_Name&" ("&F_Date&" "&F_Time&") Email:"&F_Email Response.write " 点击数:"&F_Hit&" 回复数:"&F_Revert&"" If (m_ID <> "" and m_ID = Session("m_ID")) or Instr(Session("m_ForumRights"),"|"&ttSS_ID&"|") > 0 Then Response.write " " Response.write " " End If Response.write "
"&F_Contents&"
" Response.write "" Response.write "
"&F_Title&"" Response.write ""&(mypage-1) * mypagesize + i&" 楼 
作者:"&F_Name&" ("&F_Date&" "&F_Time&") Email:"&F_Email If (m_ID <> "" and m_ID = Session("m_ID")) or Instr(Session("m_ForumRights"),"|"&ttSS_ID&"|") > 0 Then Response.write " " Response.write "" Response.write " " End If Response.write "
"&F_Contents&"
" Response.write "" Response.write "
"&F_Title&"" Response.write ""&(mypage-1) * mypagesize + i&" 楼 
作者:"&F_Name&" ("&F_Date&" "&F_Time&") Email:"&F_Email If (m_ID <> "" and m_ID = Session("m_ID")) or Instr(Session("m_ForumRights"),"|"&ttSS_ID&"|") > 0 Then Response.write " " Response.write "" Response.write " " End If Response.write "
"&F_Contents&"
" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write " " Response.write "
请选择您的对部门在线回复的评价" Response.write "

满意 " Response.write "" Response.write "

不满意 " Response.write " " Response.write "
" Response.write "" Response.write "" Response.write "" Response.write "
" Response.write "
" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
"&F_Title&"的评价结果
满意 "&F_my&"
不满意"&F_bmy&"
" Response.write "
" If maxcount > 1 Then Call Pagination() If F_IsClose Then Response.write "" Response.write "" Response.write "
  此贴已经结贴!!!
" Exit Sub Else If MemberIS = 1 and Session("m_ID") = "" Then Response.write "" Response.write "" Response.write "
  必须以会员身份登录论坛后才可回复帖子!!!
" Exit Sub Else OptionStr = "" action = "revert" %>
<% Response.write " 标题字数不得少于4个字," If CheckIn = 0 Then Response.write "同时您的留言将在审核后才能发布!  " Response.write "谢绝转贴广告、供求信息" %>
主 题(*)
0 then%>value="回应:<%= NowF_Title%>"<%end if%>>* <%'If action="add" Then Response.write "所属栏目"%> <%if action="add" then%>首次发言自动注册<%end if%><%'= OptionStr%>
网 名(*)
"" Then%> value="<%= Session("m_Name")%>" <%End If%>> *
电话/密码(*) (保密号码)*
表 情
验证码(*) *
<%If action="revert" Then%> <%End If%>   
<% End If End If End Sub Sub ClearImage(F_SavePathFileName) Dim y,ywords ywords = Split(F_SavePathFileName,"|") For y = 0 to UBound(ywords) If ywords(y) <> "" Then FileSpecifier = Server.MapPath(ywords(y)) If MyFileObject.FileExists(FileSpecifier) Then MyFileObject.DeleteFile FileSpecifier End If End If Next End Sub Sub ForumDel() '删除相关的图片文件 Set MyFileObject=Server.CreateObject(FsoStr()) F_ID = GetSafeStr(Request.QueryString("F_ID")) If F_ID = "" or IsNumeric(F_ID) = False Then Response.End() sql = "select * from Forum where F_ID=" & F_ID Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then m_ID = rs("m_ID") If m_ID <> Session("m_ID") and Instr(Session("m_ForumRights"),"|"&NowSSID&"|") = 0 Then '再次验证发贴会员身份 rs.close Exit Sub End If PF_ID = rs("PF_ID") d_SavePathFileName = rs("d_SavePathFileName") rs.delete rs.update Call ClearImage(d_SavePathFileName) tPF_ID = PF_ID End if rs.close '减少积分 If m_ID <> "" Then If PF_ID = 0 Then sql = "update Member set m_Score=m_Score-300 where m_ID=" & m_ID Else sql = "update Member set m_Score=m_Score-100 where m_ID=" & m_ID End If Set Conn = LsObject.CreateConn() conn.Execute(sql) conn.close End If If PF_ID = 0 Then '删除相关回复帖子 sql = "select * from Forum where PF_ID=" & F_ID Set rs = LsObject.CreateRs(sql,1,3) rscount = rs.recordcount For i = 1 to rscount d_SavePathFileName = rs("d_SavePathFileName") rs.delete rs.update Call ClearImage(d_SavePathFileName) rs.movenext Next rs.close turl= NowSSURL&"?SS_ID=" & NowSSID Else '更新回复次数 sql = "select * from Forum where F_ID=" & PF_ID Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then tF_Revert = rs("F_Revert") - 1 rs("F_Revert") = tF_Revert rs.update End If rs.close turl = NowSSURL&"?SS_ID="&NowSSID&"&F_ID="&PF_ID End If Set MyFileObject = nothing Response.Redirect(turl) End Sub %> <% '====================================================================================================================== ' 会员积分榜 '====================================================================================================================== Sub MemberTopScore(NumRow) sql = "select top "&NumRow&" * from Member order by m_Score desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRow Then rscount = NumRow If rscount > 0 Then Response.write "" Response.write "" For i = 1 to rscount Response.write "" rs.movenext Next Response.write "
"&rs("m_Name") & " ("&rs("m_Score")&")
" End If rs.close End Sub '====================================================================================================================== ' 当前论坛分类版主 '====================================================================================================================== Sub MemberForumAdmin() If NowSSID = "" Then Exit Sub sql = "select * from Member where m_ForumRights like '%|"&NowSSID&"|%' order by m_ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > 0 Then Response.write "当前版主:" For i = 1 to rscount Response.write " " & rs("m_Name") rs.movenext Next Response.write "" End If rs.close End Sub '====================================================================================================================== ' 验证会员登录 '====================================================================================================================== Sub MemberLoginCheck(MemberSSID) m_Login = GetSafeStr(Trim(Request.Form("m_Login"))) m_Password = GetSafeStr(Trim(Request.Form("m_Password"))) If m_Login = "" or m_Password = "" Then Response.End() sql = "select * from Member Where m_Login='" & m_Login & "' and m_Password='" & LsObject.Encodeuser(m_Password) & "'" Set rs = LsObject.CreateRs(sql,1,3) If rs.eof Then rs.close Call OutScript(ErrTxt0&ErrTxt12) Response.End() End If m_Lock = rs("m_Lock") If m_Lock = True Then rs.close Call OutScript(ErrTxt0&ErrTxt13) Response.End() End If If CInt(MemberSSID) <> rs("SS_ID") Then rs.close Call OutScript(ErrTxt0&ErrTxt14) Response.End() End If m_LoginTime = rs("m_LoginTime") rs("m_LoginTime") = m_LoginTime + 1 rs("m_LastAccessDate") = Date() rs("m_LastAccessTime") = Time() rs("m_LastAccessIP") = Request.ServerVariables("REMOTE_ADDR") Session("m_Name") = rs("m_Name") Session("m_ID") = rs("m_ID") Session("m_Level") = rs("m_Level") Session("m_LoginNow") = Time() Session("m_ForumRights") = rs("m_ForumRights") rs.update rs.close rUrl = "?SS_ID="&NowSSID If NowPSID > 0 Then rUrl = rUrl & "&PS_ID=" & NowPSID Response.Redirect rUrl End Sub '====================================================================================================================== ' 验证会员注册 '====================================================================================================================== Sub MemberRegisterCheck(MemberSSID) If MemberSSID = "" Then Exit Sub If IsNumeric(Request.Form("NoForm")) = False Then Exit Sub m_Login = Trim(Request.Form("m_Login")) m_Password = Trim(Request.Form("m_Password")) m_Name = Trim(Request.Form("m_Name")) m_Sex = CInt(Request.Form("m_Sex")) m_Age = Trim(Request.Form("m_Age")) m_Province = Request.Form("m_Province") m_City = Trim(Request.Form("m_City")) m_Address = Trim(Request.Form("m_Address")) m_PostCode = Trim(Request.Form("m_PostCode")) m_Tel = Trim(Request.Form("m_Tel")) m_Fax = Trim(Request.Form("m_Fax")) m_OICQ = Trim(Request.Form("m_OICQ")) m_MSN = Trim(Request.Form("m_MSN")) m_Email = Trim(Request.Form("m_Email")) m_Question = Trim(Request.Form("m_Question")) m_Answer = Trim(Request.Form("m_Answer")) If m_Login = "" or m_PassWord = "" or m_Name = "" or m_City = "" Then Call OutScript(ErrTxt0&ErrTxt10) If m_Address = "" or m_Tel = "" or m_Email = "" or m_Question = "" or m_Answer = "" Then Call OutScript(ErrTxt0&ErrTxt10) '验证用户名是否重复 sql = "select * from Member where m_Login='" & m_Login & "'" Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then rs.close Call OutScript(ErrTxt0&ErrTxt15) End If rs.close If CInt(Request.Form("NoForm")) <> Session("NoForm") Then Call OutScript(ErrTxt0&ErrTxt11) Exit Sub End If Session("NoForm") = Session("NoForm") + 1 '添加用户信息 sql = "select top 1 * from Member order by m_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then m_ID = rs("m_ID") + 1 Else m_ID = 1 End If rs.addnew rs("m_ID") = m_ID rs("SS_ID") = MemberSSID rs("m_Login") = m_Login rs("m_Password") = LsObject.Encodeuser(m_Password) rs("m_Name") = m_Name rs("m_Sex") = m_Sex rs("m_Age") = CInt(m_Age) rs("m_Province") = m_Province rs("m_City") = m_City rs("m_Address") = m_Address rs("m_PostCode") = m_PostCode rs("m_Tel") = m_Tel If m_Fax <> "" Then rs("m_Fax") = m_Fax If m_OICQ <> "" Then rs("m_OICQ") = m_OICQ If m_MSN <> "" Then rs("m_MSN") = m_MSN rs("m_Email") = m_Email rs("m_Question") = m_Question rs("m_Answer") = m_Answer rs("m_LoginTime") = 1 rs("m_LastAccessDate") = Date() rs("m_LastAccessTime") = Time() rs("m_CreateDate") = Date() rs("m_CreateTime") = Time() rs("m_CreateIP") = Request.ServerVariables("REMOTE_ADDR") rs("m_Level") = 1 rs("m_Lock") = 0 rs("m_Score") = 0 rs.update rs.close Response.write "
    "&Txt38&""&Txt39&"" End Sub '====================================================================================================================== ' 会员修改资料 '====================================================================================================================== Sub MemberEdit() sql = "select * from Member where m_ID=" & Session("m_ID") Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then m_Login = rs("m_Login") m_Password = LsObject.Decodeuser(rs("m_Password")) m_Name = rs("m_Name") m_Sex = rs("m_Sex") m_Age = rs("m_Age") m_Province = rs("m_Province") m_City = rs("m_City") m_Address = rs("m_Address") m_PostCode = rs("m_PostCode") m_Tel = rs("m_Tel") m_Fax = rs("m_Fax") m_OICQ = rs("m_OICQ") m_MSN = rs("m_MSN") m_Email = rs("m_Email") m_Question = rs("m_Question") m_Answer = rs("m_Answer") End If rs.close %> <%If WebLanguage = 1 Then%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
注:您输入的资料将作为使用本系统其他功能的数据,请准确地填写,谢谢!
用户名: * (字母和数字)
密码: *
确认密码: *
姓名: *
性别:
年龄: *
省份:
城市: *
地址: *
邮编: *
电话: *
传真:
OICQ:
MSN:
Email: *
密码查询问题: *
密码查询答案: *
  
<%End If%> <%If WebLanguage = 2 Then%> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>
">
Note : The information you input will use the system as a function of other data, and accurately completing Thank you!
login: * (字母和数字)
password: *
confirmation assword: *
name: *
sex:
age: *
provinces:
city: *
address: *
pastcode: *
tel: *
fax:
OICQ:
MSN:
Email: *
question for passwords: *
answer for passwords: *
  
<%End If%> <% End Sub '====================================================================================================================== ' 验证会员修改资料 '====================================================================================================================== Sub MemberEditCheck(MemberSSID) m_Login = Trim(Request.Form("m_Login")) m_Password = Trim(Request.Form("m_Password")) m_Name = Trim(Request.Form("m_Name")) m_Sex = CInt(Request.Form("m_Sex")) m_Age = Trim(Request.Form("m_Age")) m_Province = Request.Form("m_Province") m_City = Trim(Request.Form("m_City")) m_Address = Trim(Request.Form("m_Address")) m_PostCode = Trim(Request.Form("m_PostCode")) m_Tel = Trim(Request.Form("m_Tel")) m_Fax = Trim(Request.Form("m_Fax")) m_OICQ = Trim(Request.Form("m_OICQ")) m_MSN = Trim(Request.Form("m_MSN")) m_Email = Trim(Request.Form("m_Email")) m_Question = Trim(Request.Form("m_Question")) m_Answer = Trim(Request.Form("m_Answer")) If m_Login = "" or m_PassWord = "" or m_Name = "" or m_City = "" Then Call OutScript(ErrTxt0&ErrTxt10) If m_Address = "" or m_Tel = "" or m_Email = "" or m_Question = "" or m_Answer = "" Then Call OutScript(ErrTxt0&ErrTxt10) '验证用户名是否重复 sql = "select * from Member where SS_ID="&MemberSSID&" and m_Login='" & m_Login & "' and m_ID<>" & Session("m_ID") Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then rs.close Call OutScript(ErrTxt0&ErrTxt15) End If rs.close '修改用户信息 sql = "select * from Member where m_ID=" & Session("m_ID") Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then rs("m_Login") = m_Login rs("m_Password") = LsObject.Encodeuser(m_Password) rs("m_Name") = m_Name rs("m_Sex") = m_Sex rs("m_Age") = m_Age rs("m_Province") = m_Province rs("m_City") = m_City rs("m_Address") = m_Address rs("m_PostCode") = m_PostCode rs("m_Tel") = m_Tel If m_Fax <> "" Then rs("m_Fax") = m_Fax If m_OICQ <> "" Then rs("m_OICQ") = m_OICQ If m_MSN <> "" Then rs("m_MSN") = m_MSN rs("m_Email") = m_Email rs("m_Question") = m_Question rs("m_Answer") = m_Answer rs.update End If rs.close Session("m_ID") = "" Session("m_Name") = "" Response.write ""&chr(13)&chr(10) Response.End() End Sub Sub MemberFindPass() Response.write "" Response.write "
" Response.write "

" Response.write "
" Response.write "" Response.write "" Response.write "
找回密码
"&Txt31&" >>
"&Txt28&":
" Response.write "" Response.write "
" Response.write "
"&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) End Sub Sub MemberFindPassCheckUser() m_Login = GetSafeStr(Trim(Request.Form("m_Login"))) If m_Login = "" Then Exit Sub sql = "select * from Member where m_Login='"&m_Login&"'" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Response.write "
    "&ErrTxt8&"" Exit Sub End If m_Question = rs("m_Question") rs.close Response.write "" Response.write "
" Response.write "
" Response.write "
" Response.write "" Response.write "" Response.write "
找回密码
"&Txt32&" >>
"&Txt29&":"&m_Question&"
"&Txt30&":
" Response.write "" Response.write "" Response.write "
" Response.write "
"&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) End Sub Sub MemberFindPassCheckAnswer() m_Login = GetSafeStr(Trim(Request.Form("m_Login"))) m_Answer = GetSafeStr(Trim(Request.Form("m_Answer"))) If m_Answer = "" or m_Login = "" Then Exit Sub sql = "select * from Member where m_Login='"&m_Login&"'" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If Response.write "

" If m_Answer = rs("m_Answer") Then Response.write "
" Response.write "
找回密码
" Response.write "

  "&Txt37&":"&LsObject.Decodeuser(rs("m_Password"))&"" Response.write "
" Else Response.write "
" Response.write "
找回密码
" Response.write "

  "&ErrTxt9&"" Response.write "
" End If rs.close End Sub %> <% ' ====================================================================================================================== ' 首页企业列表 ' ====================================================================================================================== Sub IndexCorpList(SS_ID,SS_Path,NumRow,NumCol,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,VouchIS,ViewUrl) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" * from CorpInfo where CI_CheckIn<>0" If SS_ID <> "" Then sql = sql & " and SS_ID="&SS_ID If SS_Path <> "" Then sql = sql &" and SS_Path like '%"&SS_Path&"%'" sql = sql&" order by" If VouchIS = 1 Then sql = sql & " CI_Vouch"&OType&"," sql = sql & " CI_CreateDate desc,CI_CreateTime desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount CI_ID = rs("CI_ID") CI_Corporation = rs("CI_Corporation") CI_Date = rs("CI_CreateDate") CI_Time = rs("CI_CreateTime") mCI_Date = Month(CI_Date) dCI_Date = Day(CI_Date) If mCI_Date < 10 Then mCI_Date = "0" & mCI_Date If dCI_Date < 10 Then dCI_Date = "0" & dCI_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then tCI_Corporation = CutStr(CI_Corporation,NumWords*2) Response.write tCI_Corporation&"" Response.write "" If DateVis = 1 Then Response.write " "&mCI_Date&"-"&dCI_Date If TimeVis = 1 Then Response.write " "&CI_Time Response.write "
" Else rs.close Response.write "暂无企业信息" End If End Sub '====================================================================================================================== ' 首页企业产品展示列表 '====================================================================================================================== Sub IndexCorpProductList(CPS_ID,NumRow,NumCol,TbBdCor,TdBgCor,TbPad,ViewUrl) NumTr = NumRow * NumCol If NumTr = "" or IsNumeric(NumTr) = False Then Exit Sub sql = "select * from CorpProductInfo" If CPS_ID <> "" Then sql = sql & " where CPS_ID=" & CPS_ID sql = sql & " order by CPI_Vouch"&OType&",CPI_Date desc,CPI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write "
  暂无产品信息!" Exit Sub End If %><% Response.write "" & chr(13) &chr(10) Response.write "" & chr(13) &chr(10) For i = 1 to CInt(NumRow) Response.write "" For m = 1 to CInt(NumCol) CI_ID = rs("CI_ID") CPI_ID = rs("CPI_ID") CPS_ID = rs("CPS_ID") CPI_Name = rs("CPI_Name") CPI_Type = rs("CPI_Type") CPI_Photo = rs("CPI_Photo") CPI_BigPhoto = rs("CPI_BigPhoto") CPI_Price = rs("CPI_Price") If CPI_Photo = "" or IsNull(CPI_Photo) = True Then CPI_Photo = "/System/SysImage/nophoto.gif" If CPI_BigPhoto = "" or IsNull(CPI_BigPhoto) = True Then CPI_BigPhoto = CPI_Photo Response.write "" rs.movenext If rs.eof Then Exit For Next Response.write "" If rs.eof Then Exit For Next Response.write "
" %>
<%= CPI_Name%>
<%= CPI_Name%>
<% Response.write "
" rs.close %> <% End Sub '====================================================================================================================== ' 企业名片初始化 '====================================================================================================================== Dim CI_ID,Style,CN_ID,CPI_ID,CI_Corporation,CI_Introduce,CI_Contact,CI_Logo Sub CorpCardInit() CI_ID = GetSafeStr(Request.QueryString("CI_ID")) Style = GetSafeStr(Request.QueryString("Style")) CN_ID = GetSafeStr(Request.QueryString("CN_ID")) CPI_ID = GetSafeStr(Request.QueryString("CPI_ID")) If CI_ID = "" or IsNumeric(CI_ID) = False or Style = "" or IsNumeric(Style) = False Then Exit Sub sql = "select * from CorpInfo where CI_ID=" & CI_ID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If CI_Corporation = rs("CI_Corporation") CI_Introduce = rs("CI_Introduce") CI_Contact = rs("CI_Contact") CI_Logo = rs("CI_Logo") If CI_Logo <> "" Then CI_Logo = "" rs.close End Sub '====================================================================================================================== ' 企业名片内容 '====================================================================================================================== Sub CorpCardInfo() If CI_ID = "" or IsNumeric(CI_ID) = False or Style = "" or IsNumeric(Style) = False Then Exit Sub If CN_ID <> "" and IsNumeric(CN_ID) = True Then Call CorpNewsContents() Else If CPI_ID <> "" and IsNumeric(CPI_ID) = True Then Call CorpProductView() Else Select Case Style Case "1" Call CorpIntroduce() Case "2" Call CorpNewsList() Case "3" Call CorpProductList() Case "4" Call CorpContact() End Select End If End If End Sub '====================================================================================================================== ' 企业名片新闻列表 '====================================================================================================================== Sub CorpNewsList() sql = "select * from CorpNews where CN_CheckIn<>0 and CI_ID="&CI_ID&" order by CN_Vouch"&OType&",CN_Date desc,CN_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write "
  暂无内容!" Exit Sub End If linkpar ="&CI_ID="&CI_ID&"&Style="&Style mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = 10 rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "" Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j Response.write "" rs.movenext Next Response.write "
" Call Pagination() Response.write "
·" Response.write rs("CN_Title")&""&"   "&rs("CN_Date")&" "&rs("CN_Time")&"" Response.write "
" rs.close End Sub '====================================================================================================================== ' 企业名片产品列表 '====================================================================================================================== Sub CorpProductList() '产品分类列表 sql = "select * from CorpProductSort where CI_ID="&CI_ID&" order by CPS_ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If Response.write "" For i = 1 to rscount If i mod 6 = 1 Then Response.write "" Response.write "" If i mod 6 = 0 Then Response.write "" rs.movenext Next Response.write "
" Response.write rs("CPS_Name")&"
" rs.close '产品列表 CPS_ID = GetSafeStr(Request.QueryString("CPS_ID")) If CPS_ID <> "" and IsNumeric(CPS_ID) = True Then sql = "select * from CorpProductInfo where CPI_CheckIn<>0 and CI_ID="&CI_ID&" and CPS_ID="&CPS_ID Else sql = "select * from CorpProductInfo where CPI_CheckIn<>0 and CI_ID="&CI_ID End If sql = sql & " order by CPI_Vouch"&OType&", CPI_Date desc,CPI_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write "
  暂无产品资料!" Exit Sub End If linkpar ="&CI_ID="&CI_ID&"&Style="&Style mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = 5 rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage %><% Response.write "" & chr(13) &chr(10) %>
<%If maxcount > 1 Then%> <%End If%>
<%Call Pagination()%>
<%If rscount > 0 Then Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j CPI_ID = rs("CPI_ID") CPS_ID = rs("CPS_ID") CPI_Photo = rs("CPI_Photo") CPI_BigPhoto = rs("CPI_BigPhoto") CPI_Name = rs("CPI_Name") CPI_Type = rs("CPI_Type") CPI_Price = rs("CPI_Price") If CPI_Price = 0 Then CPI_Price = "" If CPI_Photo = "" or IsNull(CPI_Photo) = True Then CPI_Photo = "/System/SysImage/nophoto.gif" If CPI_BigPhoto = "" or IsNull(CPI_BigPhoto) = True Then CPI_BigPhoto = CPI_Photo Response.write "" rs.movenext Next Response.write "
" %>
<%= CPI_Name%>
编 号  <%= CPI_ID%>
名 称  <%= CPI_Name%>
型 号  <%= CPI_Type%>
价 格  ¥ <%= CPI_Price%>
产品介绍
用户反馈
查看大图
<% Response.write "
" End If rs.close %>
<%Call Pagination()%>
<% End Sub '====================================================================================================================== ' 企业名片产品详细资料 '====================================================================================================================== Sub CorpProductView() sql = "select * from CorpProductInfo where CPI_ID=" & CPI_ID Set rs = LsObject.CreateRs(sql,1,3) If rs.eof Then rs.close Exit Sub End If CPI_Name = rs("CPI_Name") CPI_Type = rs("CPI_Type") CPI_Photo = rs("CPI_Photo") CPI_BigPhoto = rs("CPI_BigPhoto") CPI_Hit = rs("CPI_Hit") CPI_Intro = rs("CPI_Intro") If CPI_Photo = "" or IsNull(CPI_Photo) = True Then CPI_Photo = "/System/SysImage/nophoto.gif" If CPI_BigPhoto = "" or IsNull(CPI_BigPhoto) = True Then CPI_BigPhoto = CPI_Photo rs("CPI_Hit") = CPI_Hit + 1 rs.update rs.close %><% Response.write "" & chr(13) &chr(10) %>
<%= CPI_Name%>
查看大图
<%= CPI_Intro%>
 
<% End Sub '====================================================================================================================== ' 企业名片简介 '====================================================================================================================== Sub CorpIntroduce() Response.write CI_Introduce End Sub '====================================================================================================================== ' 企业名片联系方式 '====================================================================================================================== Sub CorpContact() Response.write Replace((Replace(CI_Contact,vbcrlf,"
")),chr(32)&chr(32),"  ") End Sub '====================================================================================================================== ' 企业名片新闻内容 '====================================================================================================================== Sub CorpNewsContents() sql = "select * from CorpNews where CN_ID=" & CN_ID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If CN_Title = rs("CN_Title") CN_Contents = rs("CN_Contents") rs.close Response.write "
"&CN_Title & "

" Response.write CN_Contents & "
" End Sub '====================================================================================================================== ' 企业名称列表 '====================================================================================================================== Sub CorpInfoSort(NumRow,TrHig,TdBgGrd,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,ViewUrl) If NowSSIS = False Then Exit Sub sql = "select * from CorpInfo where CI_CheckIn<>0 and SS_Path like'%" & NowSSPath & "%'" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If linkpar ="&SS_ID="&NowSSID mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(NumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage Response.write "
" Call Pagination() Response.write "" j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j CI_ID = rs("CI_ID") CI_Corporation = rs("CI_Corporation") CI_Date = rs("CI_CreateDate") CI_Time = rs("CI_CreateTime") mCI_Date = Month(CI_Date) dCI_Date = Day(CI_Date) If mCI_Date < 10 Then mCI_Date = "0" & mCI_Date If dCI_Date < 10 Then dCI_Date = "0" & dCI_Date Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 Then Response.write "" End If Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then tCI_Corporation = CutStr(CI_Corporation,NumWords*2) Response.write tCI_Corporation&"" Response.write "" If DateVis = 1 Then Response.write " "&mCI_Date&"-"&dCI_Date If TimeVis = 1 Then Response.write " "&CI_Time Response.write "
" If maxcount > 1 Then Call Pagination() Response.write "
" End Sub '====================================================================================================================== ' 企业名片注册、登录表单 '====================================================================================================================== Sub CorpCardForm() '表单验证 action = Request.Form("action") If action = "logincheck" Then Call CorpLoginCheck() Exit Sub End If If action = "registercheck" Then Call CorpRegisterCheck() Exit Sub End If If action = "findpasscheckuser" Then '验证密码查询 Call CorpMemberFindPassCheckUser() Exit Sub End If If action = "findpasscheckanswer" Then '验证密码查询 Call CorpMemberFindPassCheckAnswer() Exit Sub End If '表单调用 action = Request.QueryString("action") If action = "" and Session("CI_ID") = "" Then action = "login" '登录表单 If action = "login" Then Session("CI_Corporation") = "" Session("CI_ID") = "" Session("CI_Type") = "" Session("CI_LinkMan") = "" Session("CI_LoginNow") = "" Session("CI_LoginTime") = "" Session("SS_ID") = "" Session("CI_CheckIn") = "" Session("SS_SiteID") = "" %>
用 户:
密 码:
   
<% Exit Sub End If If action = "findpass" Then '用户查询密码表单 Call CorpMemberFindPass() Exit Sub End If '显示注册表单 If action = "register" Then '生成企业注册行业列表表单 sql = "select * from SiteStructure where SS_Type=13 order by SS_Path" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount OptionStr = "" %> <%If Session("NoForm") = "" Then Session("NoForm") = 1%>

>>> 您输入的资料将作为使用本系统其他功能的数据,请准确地填写,谢谢!
用户名: * (字母和数字)
密码: *
确认密码: *
密码查询问题: *
密码查询答案: *
单位名称: *
联系人: *
行业: <%= OptionStr%>
省份:
城市: *
地址: *
邮编: *
电话: *
传真:
网址:
Email: *
企业简介:
   
">   
<% Exit Sub End If If Session("CI_ID") <> "" Then Response.Redirect("/System/sys_mem_index.shtml") Exit Sub End If End Sub '====================================================================================================================== ' 验证企业会员登录 '====================================================================================================================== Sub CorpLoginCheck() CI_Login = GetSafeStr(Trim(Request.Form("CI_Login"))) CI_Password = GetSafeStr(Trim(Request.Form("CI_Password"))) If CI_Login = "" or CI_Password = "" Then Response.End() sql = "select * from CorpInfo Where CI_Login='" & CI_Login & "' and CI_Password='" & LsObject.Encodeuser(CI_Password) & "'" Set rs = LsObject.CreateRs(sql,1,3) If rs.eof Then rs.close Call OutScript("用户验证失败!") Exit Sub End If CI_CheckIn = rs("CI_CheckIn") CI_Lock = rs("CI_Lock") If CI_Lock = True Then rs.close Call OutScript("用户已被锁定,请联系管理员!") Exit Sub End If CI_LoginTime = rs("CI_LoginTime") rs("CI_LoginTime") = CI_LoginTime + 1 rs("CI_LastAccessDate") = Date() rs("CI_LastAccessTime") = Time() rs("CI_LastAccessIP") = Request.ServerVariables("REMOTE_ADDR") Session("CI_Corporation") = rs("CI_Corporation") Session("CI_ID") = rs("CI_ID") Session("CI_Type") = rs("CI_Type") Session("CI_LinkMan") = rs("CI_LinkMan") Session("CI_LoginNow") = Now() Session("CI_LoginTime") = CI_LoginTime + 1 SS_ID = rs("SS_ID") Session("SS_ID") = SS_ID Session("CI_CheckIn") = CI_CheckIn rs.update rs.close Session("SS_SiteID") = ReadSiteID(SS_ID) Response.Redirect "?SS_ID="&NowSSID&"" End Sub '====================================================================================================================== ' 验证企业会员注册 '====================================================================================================================== Sub CorpRegisterCheck() If IsNumeric(Request.Form("NoForm")) = False Then Exit Sub CI_Login = Trim(Request.Form("CI_Login")) CI_Password = Trim(Request.Form("CI_Password")) CI_Question = Trim(Request.Form("CI_Question")) CI_Answer = Trim(Request.Form("CI_Answer")) CI_Corporation = Trim(Request.Form("CI_Corporation")) CI_LinkMan = Trim(Request.Form("CI_LinkMan")) SS_Name = Request.Form("SS_Name") CI_Province = Request.Form("CI_Province") CI_City = Trim(Request.Form("CI_City")) CI_Address = Trim(Request.Form("CI_Address")) CI_PostCode = Trim(Request.Form("CI_PostCode")) CI_Tel = Trim(Request.Form("CI_Tel")) CI_Fax = Trim(Request.Form("CI_Fax")) CI_Web = Trim(Request.Form("CI_Web")) CI_Email = Trim(Request.Form("CI_Email")) CI_Introduce = Trim(Request.Form("CI_Introduce")) Ar_SS_Name = Split(SS_Name,"|") SS_Path = Ar_SS_Name(0) SS_ID = Ar_SS_Name(1) If CI_Login="" or CI_PassWord="" or CI_Corporation="" or CI_LinkMan="" Then Call OutScript("提示:\n\n 内容填写不规范!") If CI_Address="" or CI_Tel="" or CI_Email="" or CI_Question="" or CI_Answer="" or CI_Introduce = "" Then Call OutScript("提示:\n\n 内容填写不规范!") End If '验证用户名是否重复 sql = "select * from CorpInfo where CI_Login='" & CI_Login & "'" Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then rs.close Call OutScript("此用户名已被其他企业使用,请更换!") Exit Sub End If rs.close '验证企业名称 sql = "select * from CorpInfo where CI_Corporation='" & CI_Corporation & "'" Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then rs.close Call OutScript("此名称已经被其他用户注册过,请更换!") Exit Sub End If rs.close '验证表单是否重复提交 If CInt(Request.Form("NoForm")) <> Session("NoForm") Then Call OutScript("当前表单不可重复提交!") Exit Sub End If Session("NoForm") = Session("NoForm") + 1 '添加企业用户信息 sql = "select top 1 * from CorpInfo order by CI_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then CI_ID = rs("CI_ID") + 1 Else CI_ID = 1 End If rs.addnew rs("CI_ID") = CI_ID rs("SS_ID") = SS_ID rs("SS_Path") = SS_Path rs("CI_Login") = CI_Login rs("CI_Password") = LsObject.Encodeuser(CI_Password) rs("CI_Question") = CI_Question rs("CI_Answer") = CI_Answer rs("CI_Corporation") = CI_Corporation rs("CI_LinkMan") = CI_LinkMan rs("CI_Province") = CI_Province rs("CI_City") = CI_City rs("CI_Address") = CI_Address rs("CI_PostCode") = CI_PostCode rs("CI_Tel") = CI_Tel rs("CI_Fax") = CI_Fax rs("CI_Web") = CI_Web rs("CI_Email") = CI_Email rs("CI_Introduce") = replace((replace(CI_Introduce,vbcrlf,"
")),chr(32)&chr(32),"  ") rs("CI_LoginTime") = 0 rs("CI_LastAccessDate") = Date() rs("CI_LastAccessTime") = Time() rs("CI_CreateDate") = Date() rs("CI_CreateTime") = Time() rs("CI_CreateIP") = Request.ServerVariables("REMOTE_ADDR") rs("CI_Type") = 1 '缺省普通会员 rs("CI_CheckIn") = 0 '缺省未审核 rs("CI_Lock") = 0 '缺省不锁定 rs("CI_Vouch") = 0 '缺省不推荐 rs.update rs.close Response.Write "" Response.write "
    注册成功,需要经过管理员审核才可正式发布企业信息!由此登录..." End Sub Sub CorpMemberFindPass() Response.write "" Response.write "
" Response.write "
" Response.write "
请输入用户名:" Response.write " " Response.write "" Response.write "
" Response.write "
"&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) End Sub Sub CorpMemberFindPassCheckUser() CI_Login = GetSafeStr(Trim(Request.Form("CI_Login"))) If CI_Login = "" Then Exit Sub sql = "select * from CorpInfo where CI_Login='"&CI_Login&"'" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Response.write "
    系统查无此用户!" Exit Sub End If CI_Question = rs("CI_Question") rs.close Response.write "" Response.write "
" Response.write "
" Response.write "" Response.write "
问 题:"&CI_Question&"
答 案:" Response.write " " Response.write "" Response.write "" Response.write "
" Response.write "
"&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) End Sub Sub CorpMemberFindPassCheckAnswer() CI_Login = GetSafeStr(Trim(Request.Form("CI_Login"))) CI_Answer = GetSafeStr(Trim(Request.Form("CI_Answer"))) If CI_Answer = "" or CI_Login = "" Then Exit Sub sql = "select * from CorpInfo where CI_Login='"&CI_Login&"'" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If If CI_Answer = rs("CI_Answer") Then Response.write "
    请牢记您的密码:"&LsObject.Decodeuser(rs("CI_Password"))&"" Else Response.write "
    对不起!答案不正确,我们不能告诉您密码。" End If rs.close End Sub %> <% Sub OnlineRegister() If NowSSID = "" Then Exit Sub action = Request.Form("action") If action = "add" Then OR_Name = GetSafeStr(Request.Form("OR_Name")) OR_Sex = Request.Form("OR_Sex") OR_Birth = Request.Form("OR_Birth") OR_Degree = Request.Form("OR_Degree") OR_School = GetSafeStr(Request.Form("OR_School")) OR_Address = GetSafeStr(Request.Form("OR_Address")) OR_Postcode = GetSafeStr(Request.Form("OR_Postcode")) OR_Tel = GetSafeStr(Request.Form("OR_Tel")) OR_Class = GetSafeStr(Request.Form("OR_Class")) OR_Email = GetSafeStr(Request.Form("OR_Email")) OR_QQ = GetSafeStr(Request.Form("OR_QQ")) OR_Detail = GetSafeStr(Request.Form("OR_Detail")) If OR_Name = "" or OR_School = "" or OR_Postcode = "" or OR_Class = "" Then Response.End() sql = "select top 1 * from OnlineRegister order by OR_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If Err <> 0 Then Response.write Err.Description If not rs.eof Then OR_ID = rs("OR_ID") + 1 Else OR_ID = 1 End If rs.addnew rs("SS_ID") = NowSSID rs("OR_ID") = OR_ID rs("OR_Name") = OR_Name rs("OR_Sex") = OR_Sex rs("OR_Birth") = OR_Birth rs("OR_Degree") = OR_Degree rs("OR_School") = OR_School rs("OR_Address") = OR_Address rs("OR_Postcode") = OR_Postcode rs("OR_Tel") = OR_Tel rs("OR_Class") = OR_Class If OR_Email <> "" Then rs("OR_Email") = OR_Email If OR_QQ <> "" Then rs("OR_QQ") = OR_QQ If OR_Detail <> "" Then rs("OR_Detail") = OR_Detail rs("OR_IP") = Request.ServerVariables("REMOTE_ADDR") rs("OR_Time") = Date() & " " & Time() rs.update rs.close If Err = 0 Then Response.write "
    报名成功!" Else %>
姓名 *
性别
出生年月
最高学历
毕业院校 *
通讯地址 *
邮政编码 *
联系电话 *
所报专业 *
E-MAIL
QQ

详细说明
 
<% End If End Sub %> <% Sub ECard() If NowSSID = "" Then Exit Sub If NowSSSubItem = True Then Response.Redirect "?SS_ID=" & SubID(1) Exit Sub End If action = Request.Form("action") If action = "sent" Then EC_Bridegroom = GetSafeStr(Request.Form("EC_Bridegroom")) EC_Bride = GetSafeStr(Request.Form("EC_Bride")) EC_Date = GetSafeStr(Request.Form("EC_Date")) EC_Time = GetSafeStr(Request.Form("EC_Time")) EC_Address = GetSafeStr(Request.Form("EC_Address")) EC_Tel = GetSafeStr(Request.Form("EC_Tel")) EC_Remark = GetSafeStr(Request.Form("EC_Remark")) EC_ToEmail = Request.Form("EC_ToEmail") EC_ToName = GetSafeStr(Request.Form("EC_ToName")) EC_FromEmail = GetSafeStr(Request.Form("EC_FromEmail")) EC_Remark = GetSafeStr(Request.Form("EC_Remark")) If EC_Bridegroom = "" or EC_Bride = "" or EC_Date = "" or EC_Time = "" or EC_Address = "" Then Response.End() If EC_ToEmail = "" or EC_ToName = "" or EC_FromEmail = "" Then Response.End() sql = "select top 1 * from ECard order by EC_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If Err <> 0 Then Response.write Err.Description If not rs.eof Then EC_ID = rs("EC_ID") + 1 Else EC_ID = 1 End If rs.addnew rs("EC_ID") = EC_ID rs("SS_ID") = NowSSID rs("SS_Path") = NowSSPath rs("EC_Bridegroom") = EC_Bridegroom rs("EC_Bride") = EC_Bride rs("EC_Date") = EC_Date rs("EC_Time") = EC_Time rs("EC_Address") = EC_Address rs("EC_Tel") = EC_Tel rs("EC_Address") = EC_Address If EC_Remark <> "" Then rs("EC_Remark") = EC_Remark rs("EC_ToEmail") = EC_ToEmail rs("EC_ToName") = EC_ToName rs("EC_FromEmail") = EC_FromEmail rs("EC_FromIP") = Request.ServerVariables("REMOTE_ADDR") rs("EC_FromTime") = Date() & " " & Time() rs.update rs.close '发送Email pullurl = Request.ServerVariables("SCRIPT_NAME") severname = Request.ServerVariables("SERVER_NAME") mailbody = EC_ToName&",您好!"&chr(13)&chr(10)&chr(13)&chr(10) mailbody = mailbody & " 這裡是龙摄影新人世界電子囍帖中心系統。"&chr(13)&chr(10) mailbody = mailbody & " 你的好朋友:"&EC_Bridegroom&",(Email: "&EC_FromEmail&") 在本站留下了一張喜帖給您!"&chr(13)&chr(10) mailbody = mailbody & " 你可以直接点击链結去領取:" mailbody = mailbody & "http://"&severname&pullurl&"?SS_ID="&NowSSID&"&action=read&id="&EC_ID&chr(13)&chr(10) mailbody = mailbody & " 本站將保留您的囍帖100天,感謝您對本網的愛護,謝謝!"&chr(13)&chr(10)&chr(13)&chr(10) mailbody = mailbody & "------------English_Message-----------------------------------------"&chr(13)&chr(10)&chr(13)&chr(10) mailbody = mailbody & EC_ToName&",Hello!"&chr(13)&chr(10)&chr(13)&chr(10) mailbody = mailbody &" Your friend called "&EC_Bridegroom&",(Email:"&EC_FromEmail&") have send you a message!"&chr(13)&chr(10) mailbody = mailbody &" You can get the message by this URL:" mailbody = mailbody & "http://"&severname&pullurl&"?SS_ID="&NowSSID&"&action=read&id="&EC_ID&chr(13)&chr(10) mailbody = mailbody & " We'll keep your message for 100 days. Hope you have a nice day!!"&chr(13)&chr(10) Set Mail = Server.CreateObject("Persits.MailSender") Mail.Host = "192.168.168.3" Mail.From = EC_FromEmail Mail.FromName = EC_Bridegroom ArEC_ToEmail = split(EC_ToEmail,",") Mail.AddAddress ArEC_ToEmail(0) For x = 1 to UBound(ArEC_ToEmail) Mail.AddCC ArEC_ToEmail(x) Next Mail.Subject = EC_Bridegroom &"寄了一张喜帖给你!" Mail.Body = mailbody Mail.Send If Err = 0 Then Response.write "
    喜帖发送成功!" Exit Sub End If If action = "view" Then %><% EC_Bridegroom = GetSafeStr(Request.Form("EC_Bridegroom")) EC_Bride = GetSafeStr(Request.Form("EC_Bride")) EC_Date = GetSafeStr(Request.Form("EC_Date")) EC_Time = GetSafeStr(Request.Form("EC_Time")) EC_Address = GetSafeStr(Request.Form("EC_Address")) EC_Tel = GetSafeStr(Request.Form("EC_Tel")) EC_Remark = GetSafeStr(Request.Form("EC_Remark")) EC_ToEmail = Request.Form("EC_ToEmail") EC_ToName = GetSafeStr(Request.Form("EC_ToName")) EC_FromEmail = GetSafeStr(Request.Form("EC_FromEmail")) EC_Remark = GetSafeStr(Request.Form("EC_Remark")) If Instr(EC_ToEmail,";") > 0 Then Call OutScript("请使用,号分隔多个Email!") If EC_Bridegroom = "" or EC_Bride = "" or EC_Date = "" or EC_Time = "" or EC_Address = "" Then Response.End() If EC_ToEmail = "" or EC_ToName = "" or EC_FromEmail = "" Then Response.End() %>
<%If EC_Remark <> "" Then%> <%End If%>
<%= EC_ToName%>,您好!
    我倆將於時間:<%= FormatDateTime(EC_Date,1)%>,舉行结婚典礼,誠摯地邀请您与我们共享這份喜悅。
相信您的光臨將使婚礼更添色采,也將是我倆万分的光彩。
  地址: <%= EC_Address%>
时间: <%= EC_Time%>
电话: <%= EC_Tel%>
 


新郎:<%= EC_Bridegroom%>
新娘:<%= EC_Bride%>
  鞠躬
  其他事项:<%= replace((replace(EC_Remark,vbcrlf,"
")),chr(32)&chr(32),"  ")%>
 
<%= EC_Bridegroom%> 留
<%= FormatDateTime(Now(),0)%>

 

<% Exit Sub End If action = Request.QueryString("action") If action = "read" Then id = Request.QueryString("id") If id = "" or IsNumeric(id) = False Then Exit Sub sql = "select * from ECard where EC_ID=" & id Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Exit Sub End If EC_Bridegroom = rs("EC_Bridegroom") EC_Bride = rs("EC_Bride") EC_Date = rs("EC_Date") EC_Time = rs("EC_Time") EC_Address = rs("EC_Address") EC_Tel = rs("EC_Tel") EC_Remark = rs("EC_Remark") EC_ToName = rs("EC_ToName") EC_Remark = rs("EC_Remark") rs.close %>
<%If EC_Remark <> "" Then%> <%End If%>
<%= EC_ToName%>,您好!
    我倆將於時間:<%= FormatDateTime(EC_Date,1)%>,舉行结婚典礼,誠摯地邀请您与我们共享這份喜悅。
相信您的光臨將使婚礼更添色采,也將是我倆万分的光彩。
  地址: <%= EC_Address%>
时间: <%= EC_Time%>
电话: <%= EC_Tel%>
 


新郎:<%= EC_Bridegroom%>
新娘:<%= EC_Bride%>
  鞠躬
  其他事项:<%= replace((replace(EC_Remark,vbcrlf,"
")),chr(32)&chr(32),"  ")%>
 
<%= EC_Bridegroom%> 留
<%= FormatDateTime(Now(),0)%>
<% Exit Sub End If %>
我们将于:
      举行结婚典礼,诚挚地邀请您与我们共享这份喜悦。相信您的光
临将使婚礼更添色彩,也将是我俩万分的光彩。
地址:
时间:
电话:
  新郎: 鞠躬
  新娘: 鞠躬
你的E_mail:
收件人姓名:
收件人E_mail: 多人请用","隔开
其它事项:

 

<% End Sub %> <% ' ====================================================================================================================== ' 首页旅游线路列表 ' ====================================================================================================================== Sub IndexTravelList(SS_ID,NumRow,TrHig,NumWords,VouchIS,ViewUrl) If SS_ID = "" or NumRow = "" Then Exit Sub ArSS_ID = split(SS_ID,"|") ArNumRow = split(NumRow,"|") %>
<% For x = 0 to UBound(ArSS_ID) sql = "select top "&ArNumRow(x)&" TT_ID,TL_Name,TL_NameColor,TT_StartDate,TT_EndDate,TT_AdultPrice,TT_ChildrenPrice,TT_SurplusPlaces" sql = sql & " from TravelTerm where TT_CheckIn<>0" If DBType = 1 Then sql = sql&" and TT_EndDate>=#"&Date()&"#" Else sql = sql&" and TT_EndDate>='"&Date()&"'" End If If ArSS_ID(x) <> "" Then sql = sql & " and SS_ID="&ArSS_ID(x) sql = sql&" order by" If VouchIS = 1 Then sql = sql & " TT_Vouch"&OType&"," sql = sql & " TT_EndDate,TT_ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > ArNumRow(x) Then rscount = ArNumRow(x) If rscount > 0 Then For i = 1 to rscount TT_ID = rs("TT_ID") TL_Name = rs("TL_Name") TL_NameColor = rs("TL_NameColor") TT_StartDate = rs("TT_StartDate") TT_EndDate = rs("TT_EndDate") TT_AdultPrice = rs("TT_AdultPrice") TT_ChildrenPrice = rs("TT_ChildrenPrice") TT_SurplusPlaces = rs("TT_SurplusPlaces") If TT_AdultPrice = 0 Then TT_AdultPrice = "-" If TT_ChildrenPrice = 0 Then TT_ChildrenPrice = "-" If NumWords > 0 Then tTL_Name = CutStr(TL_Name,NumWords*2) %> <% rs.movenext Next End If rs.close Next %>
线路名称 出团日期 报名截止 成人价 儿童价 查看
 <%= tTL_Name%> <% = TT_StartDate%> <% = TT_EndDate%> <% = TT_AdultPrice%> <% = TT_ChildrenPrice%>
<% End Sub ' ====================================================================================================================== ' 首页旅游线路列表 ' ====================================================================================================================== Sub IndexTravelList1(SS_ID,NumRow,TrHig,NumWords,VouchIS,ViewUrl) If SS_ID = "" or NumRow = "" Then Exit Sub ArSS_ID = split(SS_ID,"|") ArNumRow = split(NumRow,"|") %>
<% For x = 0 to UBound(ArSS_ID) sql = "select top "&ArNumRow(x)&" TT_ID,TL_Name,TL_NameColor,TT_StartDate,TT_EndDate,TT_AdultPrice,TT_ChildrenPrice,TT_SurplusPlaces" sql = sql & " from TravelTerm where TT_CheckIn<>0" If DBType = 1 Then sql = sql&" and TT_EndDate>=#"&Date()&"#" Else sql = sql&" and TT_EndDate>='"&Date()&"'" End If If ArSS_ID(x) <> "" Then sql = sql & " and SS_ID="&ArSS_ID(x) sql = sql&" order by" If VouchIS = 1 Then sql = sql & " TT_Vouch"&OType&"," sql = sql & " TT_EndDate,TT_ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > ArNumRow(x) Then rscount = ArNumRow(x) If rscount > 0 Then For i = 1 to rscount TT_ID = rs("TT_ID") TL_Name = rs("TL_Name") TL_NameColor = rs("TL_NameColor") TT_StartDate = rs("TT_StartDate") TT_EndDate = rs("TT_EndDate") TT_AdultPrice = rs("TT_AdultPrice") TT_ChildrenPrice = rs("TT_ChildrenPrice") TT_SurplusPlaces = rs("TT_SurplusPlaces") If TT_AdultPrice = 0 Then TT_AdultPrice = "-" If TT_ChildrenPrice = 0 Then TT_ChildrenPrice = "-" If NumWords > 0 Then tTL_Name = CutStr(TL_Name,NumWords*2) %> <% rs.movenext Next End If rs.close Next %>
线路名称 出团日期 报名截止 成人价 儿童价 查看
 <%= tTL_Name%> <% = TT_StartDate%> <% = TT_EndDate%> <% = TT_AdultPrice%> <% = TT_ChildrenPrice%>
<% End Sub ' ====================================================================================================================== ' 栏目页旅游线路列表 ' ====================================================================================================================== Sub TravelList(PerNumRow,TrHig,NumWords,ViewUrl) If NowSSIS = False Then Exit Sub If IsNumeric(PerNumRow) = False Then Exit Sub tTT_StartDate = GetSafeStr(Request.QueryString("tTT_StartDate")) tTT_EndDate = GetSafeStr(Request.QueryString("tTT_EndDate")) tTL_Name = GetSafeStr(Request.QueryString("tTL_Name")) ac = Request.QueryString("ac") sql = "select SS_ID,TT_ID,TL_Name,TL_NameColor,TT_StartDate,TT_EndDate,TT_AdultPrice,TT_ChildrenPrice,TT_SurplusPlaces from TravelTerm" If DBType = 1 Then sql = sql&" where TT_EndDate>=#"&Date()&"#" Else sql = sql&" where TT_EndDate>='"&Date()&"'" End If If ac = "ser" Then If DBType = 1 Then sql = sql&" and TT_StartDate>#"&tTT_StartDate&"# and TT_StartDate<#"&tTT_EndDate&"#" Else sql = sql&" and TT_StartDate>'"&tTT_StartDate&"' and TT_StartDate<'"&tTT_EndDate&"'" End If If tTL_Name <> "" Then sql = sql & " and TL_Name like '%"&tTL_Name&"%'" Else sql = sql&" and TT_CheckIn<>0 and SS_Path like '%"&NowSSPath&"%'" End If sql = sql&" order by TT_Vouch"&OType&",TT_EndDate,TT_ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write "
  暂无线路信息!" Exit Sub End If linkpar ="&SS_ID="&NowSSID mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage %><% If tTT_StartDate = "" Then tTT_StartDate = Date()+1 If tTT_EndDate = "" Then tTT_EndDate = Date()+30 %>
 出团日期从  线路名称:
<% Call Pagination()%>
<% j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j tSS_ID = rs("SS_ID") TT_ID = rs("TT_ID") TL_Name = rs("TL_Name") TL_NameColor = rs("TL_NameColor") TT_StartDate = rs("TT_StartDate") TT_EndDate = rs("TT_EndDate") TT_AdultPrice = rs("TT_AdultPrice") TT_ChildrenPrice = rs("TT_ChildrenPrice") TT_SurplusPlaces = rs("TT_SurplusPlaces") If TT_AdultPrice = 0 Then TT_AdultPrice = "-" If TT_ChildrenPrice = 0 Then TT_ChildrenPrice = "-" If NumWords > 0 Then tTL_Name = CutStr(TL_Name,NumWords*2) %> <% rs.movenext Next rs.close %>
线路名称 出团日期 报名截止 成人价 儿童价 剩余名额 查看
 <%= tTL_Name%> <% = TT_StartDate%> <% = TT_EndDate%> <% = TT_AdultPrice%> <% = TT_ChildrenPrice%> <% = TT_SurplusPlaces%>
<%If maxcount > 1 Then%>
<% Call Pagination()%>
<%End If%> <% End Sub ' ====================================================================================================================== ' 内容页旅游线路 ' ====================================================================================================================== Sub TravelView() TT_ID = GetSafeStr(Request.QueryString("TT_ID")) If TT_ID <> "" and IsNumeric(TT_ID) = True Then sql = "select TravelTerm.*,TravelLine.TL_Intro as TL_Intro,TravelLine.TL_Group as TL_Group,TravelLine.TL_Tel as TL_Tel" sql = sql & " from TravelTerm inner join TravelLine On TravelTerm.TL_ID=TravelLine.TL_ID where TravelTerm.TT_ID=" & TT_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then TT_No = rs("TT_No") TL_ID = rs("TL_ID") TL_Name = rs("TL_Name") TT_StartDate = rs("TT_StartDate") TT_EndDate = rs("TT_EndDate") TT_AdultPrice = rs("TT_AdultPrice") TT_ChildrenPrice = rs("TT_ChildrenPrice") TT_SurplusPlaces = rs("TT_SurplusPlaces") TL_Intro = rs("TL_Intro") TL_Group = rs("TL_Group") TL_Tel = rs("TL_Tel") If TT_AdultPrice = 0 Then TT_AdultPrice = "-" If TT_ChildrenPrice = 0 Then TT_ChildrenPrice = "-" End If rs.close Set Conn = LsObject.CreateConn() sql = "update TravelLine set TL_Hit=TL_Hit+1 where TL_ID="&TL_ID conn.Execute(sql) sql = "update TravelTerm set TT_Hit=TT_Hit+1 where TT_ID="&TT_ID conn.Execute(sql) conn.close End If %>
团队线路信息
团    号  <% = TT_No%>  线路名称  <% = TL_Name%> 
出团日期  <% = TT_StartDate%>  报名截止  <% = TT_EndDate%> 
成 人 价  <% = TT_AdultPrice%>  儿 童 价  <% = TT_ChildrenPrice%> 
组 团 社  <%= TL_Group%>  联系电话  <%= TL_Tel%> 
旅游线路行程说明
<% = TL_Intro%>
相关线路 >>
<% If NowSSID <> "" Then sql = "select top 10 TT_ID,TL_Name,TL_NameColor,TT_StartDate,TT_EndDate,TT_AdultPrice,TT_ChildrenPrice,TT_SurplusPlaces" sql = sql & " from TravelTerm where TT_CheckIn<>0 and SS_ID="&NowSSID&" order by TT_Vouch"&OType&",TT_StartDate,TT_ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > 0 Then For i = 1 to rscount TT_ID = rs("TT_ID") TL_Name = rs("TL_Name") TL_NameColor = rs("TL_NameColor") TT_StartDate = rs("TT_StartDate") TT_EndDate = rs("TT_EndDate") TT_AdultPrice = rs("TT_AdultPrice") TT_ChildrenPrice = rs("TT_ChildrenPrice") TT_SurplusPlaces = rs("TT_SurplusPlaces") If TT_AdultPrice = 0 Then TT_AdultPrice = "-" If TT_ChildrenPrice = 0 Then TT_ChildrenPrice = "-" %> <% rs.movenext Next End If rs.close End If %>
线路名称 发布日期 截止日期 成人价 儿童价 查看
 <%= TL_Name%> <% = TT_StartDate%> <% = TT_EndDate%> <% = TT_AdultPrice%> <% = TT_ChildrenPrice%>
<% End Sub %> <% '====================================================================================================================== ' 文章内容页 '====================================================================================================================== Dim xd_ID,PageNav PageNav = "" Function GetPre() sql = "select top 1 DocContents.d_ID,d_Title,d_TitleColor,DST_URL,d_HtmlUrl from DocContents" sql = sql & " where SS_ID="&NowSSID&" and d_Type=2 and d_ID>" & xd_ID & " order by d_ID" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof or rs.bof Then GetPre = ""&Txt9&""&Txt11&"" Else gd_ID = rs("d_ID") gd_Title = rs("d_Title") gd_TitleColor = rs("d_TitleColor") gDST_URL = rs("DST_URL") gd_HtmlUrl = rs("d_HtmlUrl") If gd_TitleColor <> "" Then gd_Title = ""&gd_Title&"" If WebStyle = 1 Then GetPre = ""&Txt9&""&gd_Title&"" Else GetPre = ""&Txt9&""&gd_Title&"" End If End If rs.close End Function Function GetNext() sql = "select top 1 DocContents.d_ID,d_Title,d_TitleColor,DST_URL,d_HtmlUrl from DocContents" sql = sql & " where SS_ID="&NowSSID&" and d_Type=2 and d_ID<" & xd_ID & " order by d_ID desc" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof or rs.bof Then GetNext = ""&Txt10&""&Txt11&"" Else gd_ID = rs("d_ID") gd_Title = rs("d_Title") gd_TitleColor = rs("d_TitleColor") gDST_URL = rs("DST_URL") gd_HtmlUrl = rs("d_HtmlUrl") If gd_TitleColor <> "" Then gd_Title = ""&gd_Title&"" If WebStyle = 1 Then GetNext = ""&Txt10&""&gd_Title&"" Else GetNext = ""&Txt10&""&gd_Title&"" End If End If rs.close End Function Sub DocContent(DocPlaceIS,RelativeLinkIS,RelativeLinkNumRow,CommentSSID,MaxImgWid) xd_ID = GetSafeStr(Request.QueryString("d_ID")) page = GetSafeStr(Request.QueryString("page")) If xd_ID = "" Then xd_ID = GetSafeStr(Request.QueryString("id")) If page = "" Then page = 1 Else If IsNumeric(page) = False Then page = 1 Else page = CInt(page) If page < 1 Then page = 1 End If End If If xd_ID = "" or IsNumeric(xd_ID) = False Then response.Redirect("/error.html") response.End() end if sql = "select * from DocContents where d_ID=" & xd_ID Set rs = LsObject.CreateRs(sql,1,2) If not rs.eof Then NowSSID = rs("SS_ID") NowSSPath = rs("SS_Path") d_CheckIn = rs("d_CheckIn") ' If d_CheckIn = False and rights = "" Then ' rs.close ' Call OutScript("文章未通过审核!") ' Response.End ' End If td_Title = rs("d_Title") td_TitleColor = rs("d_TitleColor") td_SubTitle = rs("d_SubTitle") td_KeyWords = rs("d_KeyWords") td_Resource = rs("d_Resource") d_Extension=rs("d_Extension") td_Date = rs("d_Date") td_Time = rs("d_Time") td_Contents = rs("d_Contents") td_Author = rs("d_Author") td_Hit = rs("d_Hit") td_HtmlUrl = rs("d_HtmlUrl") d_ShowComment = instr(rs("d_Extension"),"|P010|") td_islook=rs("d_islook") If d_ShowComment = "" or IsNull(d_ShowComment) Then d_ShowComment = 0 rs("d_Hit") = td_Hit + 1 rs.update rs.close If MaxImgWid > 0 Then Response.write "" & chr(13) &chr(10) replstr = " 1 Then td_Contents = Ar_Contents(page-1) If WebStyle = 1 Then linkpar = "&d_ID=" & xd_ID If page = 1 Then PageNav = PageNav & Txt1 & " " Else PageNav = PageNav & ""&Txt1&" " End If If page > 1 Then PageNav = PageNav & ""&Txt12&" " Else PageNav = PageNav & Txt12 & " " End If For y = 1 to MaxPage If y = page Then PageNav = PageNav & " | " & y & " " Else PageNav = PageNav & " | " & y & " " End If Next If page < MaxPage Then PageNav = PageNav & ""&Txt13&" " PageNav = PageNav & ""&Txt14&" " Else PageNav = PageNav & Txt12 & " "&Txt14&" " End If PageNav = PageNav & Txt4 & " " & MaxPage & " " & Txt5 Else '首页 If page = 1 Then PageNav = PageNav & Txt1 & " " Else PageNav = PageNav & ""&Txt1&" " End If '上一页 If page > 1 Then If page > 2 Then PageNav = PageNav & ""&Txt12&" " Else PageNav = PageNav & ""&Txt12&" " End If Else PageNav = PageNav & Txt12 & " " End If '页码 For y = 1 to MaxPage If y = page Then PageNav = PageNav & " | " & y & " " Else If y > 1 Then PageNav = PageNav & " | " & y & " " Else PageNav = PageNav & " | " & y & " " End If End If Next '下一页 尾页 If page < MaxPage Then PageNav = PageNav & ""&Txt13&" " PageNav = PageNav & ""&Txt14&" " Else PageNav = PageNav & Txt12 & " "&Txt14&" " End If PageNav = PageNav & Txt4 & " " & MaxPage & " " & Txt5 End If End If Else rs.close Exit Sub End If NowSSPathNum = UBound(Split(NowSSPath,"-")) '读取分类名称 sql = "select * from SiteStructure where SS_ID="&NowSSID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then NowPSSID = rs("PSS_ID") NowSSName = rs("SS_Name") NowSSURL = rs("SS_URL") NowSSHtmlUrl = rs("SS_HtmlUrl") SS_SiteID = rs("SS_SiteID") End If rs.close '当前位置 If DocPlaceIS = 1 Then If SS_SiteID = "" or IsNumeric(SS_SiteID) = False Then Exit Sub DocNowPlace = "" If SS_SiteID > 0 Then sql = "select * from SiteStructure where SS_ID="&SS_SiteID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Call OutScript(ErrTxt0&ErrTxt4) End If RootSSPath = rs("SS_Path") RootSSPathNum = UBound(Split(RootSSPath,"-")) rs.close Else RootSSPathNum = 0 End If If RootSSPathNum >= NowSSPathNum Then Exit Sub If SS_Type < 4 and WebStyle = 2 Then SS_URL = NowSSHtmlUrl '静态 .html Else SS_URL = "/"&NowSSURL & "?SS_ID=" &NowSSID '动态 .shtml End If DocNowPlace = ""&NowSSName&"" PSS_ID = NowPSSID For i = 2 to NowSSPathNum - RootSSPathNum sql = "select * from SiteStructure where SS_ID="&PSS_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then SS_ID = rs("SS_ID") SS_Name = rs("SS_Name") SS_URL = rs("SS_URL") PSS_ID = rs("PSS_ID") SS_Type = rs("SS_Type") SS_HtmlUrl = rs("SS_HtmlUrl") If SS_Type < 4 and WebStyle = 2 Then SS_URL = SS_HtmlUrl '静态 .html Else SS_URL = "/"&SS_URL & "?SS_ID=" &SS_ID '动态 .shtml End If If DocNowPlace = "" Then DocNowPlace = ""&SS_Name&"" Else DocNowPlace = ""&SS_Name&" > "&DocNowPlace End If End If rs.close Next DocNowPlace = " > "&DocNowPlace End If '相关链接 If RelativeLinkIS = 1 and td_KeyWords <> "" Then scwords = split(td_KeyWords,"|") max = ubound(scwords) For i = 0 to max If i = 0 Then sqlstr = "d_Title like '%" & scwords(i) & "%' or d_KeyWords like '%" & scwords(i) & "%'" Else sqlstr = sqlstr&" or d_Title like '%" & scwords(i) & "%' or d_KeyWords like '%" & scwords(i) & "%'" End if Next sql = "select top "&RelativeLinkNumRow&" d_ID,d_Hit,d_Title,d_TitleColor,d_Date,d_Time,d_Author,DST_URL,d_HtmlUrl" sql = sql&" from DocContents where d_Type=2 and d_CheckIn<>0 and ("&sqlstr&") and d_ID<>" & xd_ID sql = sql&" order by d_TopLock,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then RelativeLink = ErrTxt6 Else RelativeLink = "" For i = 1 to rscount rd_ID = rs("d_ID") rd_Title = rs("d_Title") rd_TitleColor = rs("d_TitleColor") rd_Date = rs("d_Date") rd_Time = rs("d_Time") rd_Hit = rs("d_Hit") rDST_URL = rs("DST_URL") rd_HtmlUrl = rs("d_HtmlUrl") If rd_TitleColor <> "" Then rd_Title = ""&rd_Title&"" RelativeLink = RelativeLink & "" RelativeLink = RelativeLink & "" rs.movenext Next RelativeLink = RelativeLink & "
·" If WebStyle = 1 Then RelativeLink = RelativeLink & "" Else RelativeLink = RelativeLink & "" End If '标题颜色有效期 if int(IndexDocTitDate)<>0 or IndexDocTitCol<>"" then if datediff("d",rd_Date,date())<= int(IndexDocTitDate) then rd_Title = "" & rd_Title & "" end if end if RelativeLink = RelativeLink & rd_Title&"" RelativeLink = RelativeLink & ""&rd_Date&" "&rd_Time&" ["&rd_Hit&"]
" End If rs.close Else RelativeLink = RelativeLink & ErrTxt6 End If '是否开启评论功能。 If d_ShowComment<>0 Then CommentList = "" sql = "select top 10 * from DocComments where c_CheckIn<>0 and d_ID=" & xd_ID & " order by c_ID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > 0 Then CommentList = CommentList & "" For i = 1 to rscount c_ID = rs("c_ID") tc_Date = rs("c_Date") tc_Time = rs("c_Time") tc_Name = rs("c_Name") tc_RemoteIP = rs("c_RemoteIP") tc_Contents = rs("c_Contents") MyIPArray = Split(tc_RemoteIP, ".") tc_RemoteIP = MyIPArray(0)&"."&MyIPArray(1)&"."&MyIPArray(2)&".*" CommentList = CommentList & "" CommentList = CommentList & "" rs.movenext Next CommentList = CommentList & "" CommentList = CommentList & "
评论ID:"&c_ID&" " CommentList = CommentList & tc_Date&" "&tc_Time&" 网友:"&tc_Name&" 来自IP:"&tc_RemoteIP&"
" CommentList = CommentList & Replace((Replace(tc_Contents,vbcrlf,"
")),chr(32)&chr(32),"  ")&"
" CommentList = CommentList & "["&Txt8&"]
" End If rs.close CommentList = CommentList & "" & chr(13) &chr(10) CommentList = CommentList & "
" CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & " " CommentList = CommentList & "
[发表评论]
笔名:" CommentList = CommentList & " " CommentList = CommentList & "
评论:" CommentList = CommentList & "
" CommentList = CommentList & "
" End If '开启热字库 If IndexHotwords=1 then sqla="select * from HotWords order by HW_ID" Set rsa = LsObject.CreateRs(sqla,1,1) if not rsa.eof then for k=1 to rsa.recordcount if rsa.eof then exit for else HW_TITLE=rsa("HW_TITLE") Str_num=instr(td_Contents,HW_TITLE) if Str_num>0 then Str_nums=split(td_Contents,HW_TITLE) for j=0 to ubound(Str_nums) next end if Str_nums=j-1 if rsa("HW_TYPE")=0 THEN HotWords=""&HW_TITLE&"" Else HotWords=""&HW_TITLE&"
"&rsa("HW_CONTENT")&"
" End if if Str_num>=1 then td_Contents=Replace(td_Contents,HW_TITLE,HotWords,1,1) end if end if rsa.movenext next end if rsa.close td_Contents=td_Contents&HotWordsDiv End if '开启敏感词库 If Indexfilterwords=1 then sqla="select * from filterwords order by FW_ID" Set rsa = LsObject.CreateRs(sqla,1,1) if not rsa.eof then for k=1 to rsa.recordcount if rsa.eof then exit for else FW_TITLE=rsa("FW_TITLE") FW_TITLE1=rsa("FW_TITLE1") if instr(td_Contents,FW_TITLE)<>0 then td_Contents=Replace(td_Contents,FW_TITLE,FW_TITLE1) end if end if rsa.movenext next end if rsa.close End if 'if td_islook=true then '只有会员才能浏览 ' td_Contents=td_Contents& chr(13) &chr(10) ' td_Contents=td_Contents& "
 网名(必填)   
 密码(可填)    请牢记您的密码,发贴后将自动注册。下次发贴戓回贴将校验此用户名的密码。
主题(必填)
 内容(必填) 

 [查看长度
验证码(必填)  
 
<% End If Else Call InterViewDocList(PerdocNumRow,IsInPut) End If 'Call InterViewiFrame(iWid,iHei,iScr,iName) Exit Sub End If sql = "select IVS_ID,IVS_SS_ID,IVS_Title,IVS_CheckIn,IVS_LinkImage,IVS_Synopsis,IVS_GuestSynopsis,IVS_SceneImages" sql = sql &",IVS_Moderator,IVS_Abstract,IVS_Date" sql = sql &",IVS_Type,IVS_OrderID,IVS_Open,IVS_originalfilename,IVS_savefilename,IVS_savepathfilename" sql = sql&" from InterViewSort where IVS_SS_ID="&NowSSID&" and IVS_Open<>0" sql = sql&" order by IVS_OrderID,IVS_ID desc" 'Response.Write sql Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount linkpar ="&SS_ID="&NowSSID&"&SearchStr=" & SearchStr mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 If rscount > 0 Then mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage End If %> <% j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j tNumWords = NumWords*2 IVS_ID = rs("IVS_ID") SS_ID = rs("IVS_SS_ID") IVS_Title = rs("IVS_Title") IVS_CheckIn = rs("IVS_CheckIn") IVS_LinkImage = rs("IVS_LinkImage") IVS_Synopsis = rs("IVS_Synopsis") IVS_GuestSynopsis = rs("IVS_GuestSynopsis") IVS_SceneImages = rs("IVS_SceneImages") IVS_Moderator = rs("IVS_Moderator") IVS_Abstract = rs("IVS_Abstract") IVS_Date = rs("IVS_Date") IVS_Type = rs("IVS_Type") 'IVS_LinkImage = "/images/index_198.jpg" IVS_Open = rs("IVS_Open") If IVS_Open Then IVS_OpenStr = "访谈实录 >>" Else IVS_OpenStr = "访谈实录 >>" End If 'Response.Write (DateDiff("h",Now,IVS_EDate)) %> <% rs.movenext Next rs.close %>
图片  |  文字
 主     题:<%=IVS_Title%>
 时     间:<%=IVS_Date%>
 嘉     宾:<%=IVS_GuestSynopsis%>
 访谈摘要:<%=RemoveHTML(IVS_Synopsis)%>
  <%=IVS_OpenStr%> 
<%Call Pagination()%>
<% End Sub ' ============================================================================================================================= ' 类别列表(OrderType值:0默认排序,1推荐文章,2热点文章、3点击排名) ' ============================================================================================================================= Sub InterViewSort(IVS_ID,TitleNum,UrlPath) If IVS_ID = "" or IsNumeric(IVS_ID) = False Then IVS_ID = GetSafeStr(Trim(Request.QueryString("IVS_ID"))) sql = "select IVS_ID,IVS_SS_ID,IVS_Title,IVS_CheckIn,IVS_LinkImage,IVS_Synopsis,IVS_GuestSynopsis,IVS_SceneImages,IVS_Moderator,IVS_Abstract" sql = sql &",IVS_Date,IVS_Type,IVS_OrderID,IVS_Open,IVS_originalfilename,IVS_savefilename,IVS_savepathfilename" sql = sql&" from InterViewSort where " If IVS_ID<>"" Then sql = sql&" IVS_ID="&Cint(IVS_ID)&" and " sql = sql&" IVS_Open<>0 order by IVS_OrderID,IVS_ID desc" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then Exit Sub IVS_ID = rs("IVS_ID") SS_ID = rs("IVS_SS_ID") IVS_LinkImage = rs("IVS_LinkImage") IVS_Title = rs("IVS_Title") IVS_Date = rs("IVS_Date") IVS_Moderator = rs("IVS_Moderator") IVS_GuestSynopsis = rs("IVS_GuestSynopsis") IVS_Synopsis = rs("IVS_Synopsis") TitleNum = TitleNum*2 %>
主    题:<%=CutStr(IVS_Title,TitleNum*2)%>
时    间:<%=IVS_Date%>
嘉    宾:<%=IVS_GuestSynopsis%>
主 持 人:<%=IVS_Moderator%>
访谈摘要:<%=IVS_Synopsis%>
<% End Sub Sub InterViewiFrame(iWid,iHei,iScr,iName) IVS_ID = Trim(Request.QueryString("IVS_ID")) If IVS_ID="" oR IsNumeric(IVS_ID)=False Then Response.End() If iScr="" Then IframeSrc = "/system/sys0_inc_InterView_docshow.shtml?SS_ID="&NowSSID&"&IVS_ID="&IVS_ID&"" iFrameStr = "" Response.Write iFrameStr End Sub '====================================================================================================================== ' 文字列表 (InterViewDocList) '====================================================================================================================== Sub InterViewDocList(PerdocNumRow,IsInPut) If NowSSIS = False Then Exit Sub IVS_ID = Trim(Request.QueryString("IVS_ID")) If IVS_ID="" oR IsNumeric(IVS_ID)=False Then Response.End() If IsInput="" Then IsInput = 0 Action = GetSafeStr(Request.QueryString("Action")) IsiFrame = GetSafeStr(Request.QueryString("IsiFrame")) SearchStr = GetSafeStr(Request.QueryString("SearchStr")) IframeName = GetSafeStr(Request.QueryString("IframeName")) sql = "select IVI_ID,IVI_PID,IVI_IVS_ID,IVI_Subject,IVI_Content,IVI_Name,IVI_Name_Color,IVI_Tel,IVI_Email,IVI_Date,IVI_Time,IVI_RevertIS," sql = sql &"IVI_Revert,IVI_RevertDate,IVI_RevertTime,IVI_RevertGuests,IVI_RevertGuests_Color,IVI_QueryPasswd,IVI_Hit,IVI_RemoteIp" sql = sql&" from InterViewInfo where IVI_IVS_ID="&IVS_ID&" and IVI_ShowIs<>0" sql = sql&" order by IVI_OrderID,IVI_ID desc" 'Response.Write sql Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount linkpar ="&SS_ID="&NowSSID&"&IVS_ID="&IVS_ID&"&IframeName="&IframeName&"&IsiFrame="&IsiFrame&"&Action="&Action&"&SearchStr=" & SearchStr mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 If rscount > 0 Then mypagesize = CInt(PerdocNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage End If %>
 文字实录 >>
间隔:   自动刷新 手动刷新  
<%If rscount > 0 Then%>
<%Call Pagination()%>
<% j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j tNumWords = NumWords*2 IVI_Name = rs("IVI_Name") IVI_Content = rs("IVI_Content") IVI_Date = rs("IVI_Date") IVI_Time = rs("IVI_Time") IVI_RevertIS = rs("IVI_RevertIS") IVI_Revert = rs("IVI_Revert") IVI_RevertDate = rs("IVI_RevertDate") IVI_RevertTime = rs("IVI_RevertTime") IVI_RevertGuests = rs("IVI_RevertGuests") IVI_RemoteIp = rs("IVI_RemoteIp") IVI_Name_Color = rs("IVI_Name_Color") If IVI_Name_Color <> "" Then IVI_Name = "["&IVI_Name&"]" Else IVI_Name = "["&IVI_Name&"]" End If '回复 IVI_RevertIS = rs("IVI_RevertIS") IVI_Revert = rs("IVI_Revert") IVI_RevertDate = rs("IVI_RevertDate") IVI_RevertTime = rs("IVI_RevertTime") IVI_RevertGuests = rs("IVI_RevertGuests") IVI_RevertGuests_Color = rs("IVI_RevertGuests_Color") IVI_RemoteIp = rs("IVI_RemoteIp") IVI_Hit = rs("IVI_Hit") If IVI_RevertGuests_Color <> "" Then IVI_RevertGuests = "["&IVI_RevertGuests&"]" Else IVI_RevertGuests = "["&IVI_RevertGuests&"]" End If %>
<%=IVI_Name%>  <%=IVI_Content%>[<%=IVI_Date&" "&IVI_Time%>]
<%If IVI_RevertIS Then%>
<%=IVI_RevertGuests%>  <%=IVI_Revert%> [<%=IVI_RevertDate&" "&IVI_RevertTime%>]
<%End If%>
 
<% rs.movenext Next rs.close %>
<%Call Pagination()%>
<%Else%>
暂无内容!
<%End If%>
 
<% '提交信息 action = Trim(Request.Form("xaction")) If action = "add" Then Call InTerView_EAdd() Exit Sub End If If IsInPut = 1 Then %>
 网名(必填)   
 密码(可填)    请牢记您的密码,发贴后将自动注册。下次发贴戓回贴将校验此用户名的密码。
主题(必填)
 内容(必填) 

 [查看长度
验证码(必填)  
 
<% End If End Sub Sub InterView_Put() IVS_ID = Trim(Request.QueryString("IVS_ID")) If IVS_ID="" oR IsNumeric(IVS_ID)=False Then Response.End() Action = Trim(Request.QueryString("Action")) If Action="docshow" Then %>
 网名(必填)   
 密码(可填)    请牢记您的密码,发贴后将自动注册。下次发贴戓回贴将校验此用户名的密码。
主题(必填)
 内容(必填) 

 [查看长度
验证码(必填)  
 
<% End If End Sub Sub InTerView_EAdd() checkcode = GetSafeStr(Request.Form("checkcode")) If checkcode = "" or checkcode <> Cstr(Session("CheckCode")) Then Call OutScript("验证码输入错误!") Exit Sub End If IVI_Name = GetSafeStr(Request.Form("IVI_Name")) VIV_Password = GetSafeStr(Request.Form("VIV_Password")) IVI_Subject = GetSafeStr(Request.Form("IVI_Subject")) IVI_Content = GetSafeStr(Request.Form("IVI_Content")) IVS_ID = GetSafeStr(Request.Form("IVS_ID")) If IVS_ID="" Or IsNumeric(IVS_ID)=False Then Response.End() If IVI_Name = "" or IVI_Content = "" Then Call OutScript(ErrTxt0&ErrTxt10) sql = "select IVS_CheckIn,IVS_Open from InterViewSort where IVS_ID="&Cint(IVS_ID) Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then IVS_Open = rs("IVS_Open") IVS_CheckIn = rs("IVS_CheckIn") If IVS_CheckIn Then IVI_ShowIs = 0 Else IVI_ShowIs = 1 End If Else Exit Sub End If If IVS_Open=False Then Call OutScript("访谈尚未开启,不能提交数据!") Exit Sub End If ' Randomize ' Random = Round(Rnd * (99999999 - 10000000 + 1) - 0.5) + 10000000 ' sql = "select top 1 * from InterViewInfo order by IVI_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then IVI_ID = rs("IVI_ID") + 1 Else IVI_ID = 1 End If rs.addnew rs("IVI_ID") = IVI_ID rs("IVI_PID") = 0 rs("IVI_SS_ID") = NowSSID rs("IVI_SS_Path") = NowSSPath rs("IVI_IVS_ID") = IVS_ID rs("IVI_Subject") = "" rs("IVI_Content") = IVI_Content rs("IVI_Name") = IVI_Name rs("IVI_Tel") = "" rs("IVI_Email") = "" rs("IVI_Date") = Date() rs("IVI_Time") = Time() rs("IVI_RevertIS") = 0 rs("IVI_RemoteIp") = Request.ServerVariables("REMOTE_ADDR") rs("IVI_Hit") = 0 rs("IVI_ShowIs") = IVI_ShowIs rs("IVI_OrderID") = IVI_ID rs.update rs.close If IVS_CheckIn Then Response.write "" Else Response.write "" End If End Sub ' ============================================================================================================================= ' 文字列表(OrderType值:0默认排序,1推荐文章,2热点文章、3点击排名) ' ============================================================================================================================= Sub IndexInterViewDocList(IVS_ID,SubIS,NumRow,NumCol,OrderType,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,AuthorVis,HitVis) NumTr = NumRow * NumCol If IVS_ID = "" or IsNumeric(IVS_ID) = False Then IVS_ID = GetSafeStr(Trim(Request.QueryString("IVS_ID"))) If IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_Date,d_Time,DST_URL,d_HtmlUrl,SI_Domain," sql = sql & "d_Author,d_Vouch,d_Hot,d_New,d_Hit,d_Extension from InterViewContents where d_Type=2 and d_CheckIn<>0" 'If SubIS = 1 and SS_ID > 0 Then ' sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" 'Else sql = sql & " and IVC_IVS_ID="&IVS_ID 'End If Select Case OrderType Case 0 sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 1 sql = sql & " and instr(d_Extension,'|P002|')<>0" sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 2 sql = sql & " and instr(d_Extension,'|P005|')<>0" sql = sql & " order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Case 3 sql = sql & " order by d_Hit desc" End Select Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount tNumWords = NumWords*2 d_ID = rs("d_ID") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") d_Date = rs("d_Date") d_Time = rs("d_Time") d_Author = rs("d_Author") 'd_Hot = rs("d_Hot") ' d_New = rs("d_New") ' d_Vouch = rs("d_Vouch") d_Extension=rs("d_Extension") d_Hit = rs("d_Hit") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") md_Date = Month(d_Date) dd_Date = Day(d_Date) d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Hot = True Then tNumWords = tNumWords - 6 If d_New = True Then tNumWords = tNumWords - 4 If d_Redirect = True Then DocURL = d_RedirectLink Else DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID End If If md_Date < 10 Then md_Date = "0" & md_Date If dd_Date < 10 Then dd_Date = "0" & dd_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or AuthorVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then d_Title = CutStr(d_Title,tNumWords) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" Response.write d_Title&"" Call Doc_Extension(d_Extension,"|P003|")'加新 Call Doc_Extension(d_Extension,"|P005|") '加热点 Response.write "" If DateVis = 1 Then Response.write " "&md_Date&"-"&dd_Date If TimeVis = 1 Then Response.write " "&d_Time If AuthorVis = 1 Then Response.write " "&d_Author If HitVis = 1 Then Response.write " "&d_Hit Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页图片列表(IndexImageList) ' ====================================================================================================================== Sub IndexInterViewImageList(SS_ID,SubIS,NumRow,NumCol,TbBdCor,TdBgCor,TbPad,ImgWid,ImgHig,ImgBdWid,ImgBdCor,TitleVis,NumWords) NumTr = NumRow * NumCol If IVS_ID = "" or IsNumeric(IVS_ID) = False Then IVS_ID = GetSafeStr(Trim(Request.QueryString("IVS_ID"))) If IsNumeric(NumTr) = False Then Exit Sub sql = "select top "&NumTr&" d_ID,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,d_LinkImage,DST_URL,d_HtmlUrl,SI_Domain" sql = sql&" from InterViewContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn<>0" sql = sql & " and IVC_IVS_ID="&IVS_ID sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumTr Then rscount = NumTr If rscount > 0 Then Response.write "" For i = 1 to rscount If i mod NumCol = 1 or NumCol = 1 Then Response.write "" d_ID = rs("d_ID") d_Title = rs("d_Title") d_LinkImage = rs("d_LinkImage") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID End If Response.write "" If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" Response.write " "" Then Response.write " style=""border-color:"&ImgBdCor&";""" Response.write " border="""&ImgBdWid&""" alt="""&d_Title&""">" If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) If d_TitleColor <> "" Then d_Title = ""&d_Title&"" If TitleVis = 1 Then Response.write "
"&d_Title&"
" Response.write "
" Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页图片展示(ImageShow) ' ====================================================================================================================== Sub InterViewImageShow(SS_ID,SubIS,NumRow,SpaceTime,ShowType,ImgWid,ImgHig,ImgBdWid,ImgBdCor,CellSpc,CellPad,TbBgCor,TdBgCor,NumWords,WordsVis,NavVis) If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumRow) = False Then Exit Sub sql = "select top "&NumRow&" d_ID,d_LinkImage,d_Title,d_TitleColor,d_Redirect,d_RedirectLink,DST_URL,d_HtmlUrl,SI_Domain" sql = sql&" from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If If rscount > 0 Then Response.write "
" For j = 1 to rscount d_ID = rs("d_ID") d_LinkImage = rs("d_LinkImage") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) If d_TitleColor <>"" Then d_Title = ""&d_Title&"" Response.write "" Response.write "" Response.write "" rs.movenext If rs.eof Then Exit For Next rs.close Response.write "
" Response.write "" &chr(13)&chr(10) Response.write " "" Then Response.write " bgcolor="""&TbBgCor&"""" Response.write ">" Response.write "" Response.write "" Response.write "" If NavVis = 1 Then Response.write "" Else Response.write "" End If Response.write "" &chr(13)&chr(10) If WordsVis = 1 Then Response.write "" Else Response.write "" End If Response.write "" Response.write "
"" Then Response.write " bgcolor="""&TdBgCor&"""" Response.write ">" Response.write " "" Then Response.write "border-color:"&ImgBdCor&";" Response.write """ width="""&ImgWid&""" height="""&ImgHig&"""" If ImgBdWid <> "" Then Response.write " border="""&ImgBdWid&"""" Response.write ">
" Response.write "" Response.write "
" Response.write "" &chr(13)&chr(10) Else rs.close Response.write ErrTxt1 End If End Sub ' ====================================================================================================================== ' 首页图片幻灯(ImageSlide) ' ====================================================================================================================== Sub InterViewImageSlide(SS_ID,SubIS,NumRow,ImgWid,ImgHig,ImgBdWid,ImgBdCor,TbBgCor,TdBgCor,NumWords,NavVis) If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumRow) = False Then Exit Sub sql = "select top "&NumRow&" d_ID,d_LinkImage,d_Redirect,d_RedirectLink,d_Title,d_TitleColor,DST_URL,d_HtmlUrl,SI_Domain" sql = sql&" from DocContents where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If For i =1 to rscount d_ID = rs("d_ID") d_LinkImage = rs("d_LinkImage") d_Title = rs("d_Title") d_TitleColor = rs("d_TitleColor") DST_URL = rs("DST_URL") d_HtmlUrl = rs("d_HtmlUrl") SI_Domain = rs("SI_Domain") d_Redirect = rs("d_Redirect") d_RedirectLink = rs("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If If NumWords > 0 Then d_Title = CutStr(d_Title,NumWords*2) If d_TitleColor <>"" Then d_Title = ""&d_Title&"" If i = 1 Then Response.write "" Response.write "
" Response.write "
" Response.write "" Response.write "" If NavVis = 1 Then Response.write "" End If Response.write "
"&d_Title&"
" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
" Response.write "
"&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) End Sub ' ====================================================================================================================== ' 首页图片flash展示(ImageFlash) ' ====================================================================================================================== Sub InterViewImageFlash(SS_ID,SubIS,NumRow,ImgWid,ImgHig,TxtHig,NumWords) If SS_ID = "" or IsNumeric(SS_ID) = False or (SubIS <> 0 and SubIS <> 1) or IsNumeric(NumRow) = False Then Exit Sub sql = "select top "&NumRow&" d_ID,d_LinkImage,d_Redirect,d_RedirectLink,d_Title,DST_URL,d_HtmlUrl,SI_Domain from DocContents" sql = sql&" where d_Type=2 and d_ShowImageLink<>0 and d_CheckIn <> 0" If SubIS = 1 and SS_ID > 0 Then sql = sql & " and SS_Path like '%"&ReadSSPath(SS_ID)&"%'" Else sql = sql & " and SS_ID="&SS_ID End If sql = sql&" order by d_TopLock"&OType&",d_No desc,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Exit Sub End If Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write ""&chr(13)&chr(10) Response.write " "&chr(13)&chr(10) End Sub %> <% '====================================================================================================================== ' 文章内容页 '====================================================================================================================== Dim IVI_ID,InterViewPageNav InterViewPageNav = "" Function GetPre1() sql = "select top 1 DocContents.d_ID,d_Title,d_TitleColor,DST_URL,d_HtmlUrl from DocContents" sql = sql & " where SS_ID="&NowSSID&" and d_Type=2 and d_ID>" & IVI_ID & " order by d_ID" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof or rs.bof Then GetPre = ""&Txt9&""&Txt11&"" Else gd_ID = rs("d_ID") gd_Title = rs("d_Title") gd_TitleColor = rs("d_TitleColor") gDST_URL = rs("DST_URL") gd_HtmlUrl = rs("d_HtmlUrl") If gd_TitleColor <> "" Then gd_Title = ""&gd_Title&"" If WebStyle = 1 Then GetPre = ""&Txt9&""&gd_Title&"" Else GetPre = ""&Txt9&""&gd_Title&"" End If End If rs.close End Function Function GetNext1() sql = "select top 1 DocContents.d_ID,d_Title,d_TitleColor,DST_URL,d_HtmlUrl from DocContents" sql = sql & " where SS_ID="&NowSSID&" and d_Type=2 and d_ID<" & IVI_ID & " order by d_ID desc" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof or rs.bof Then GetNext = ""&Txt10&""&Txt11&"" Else gd_ID = rs("d_ID") gd_Title = rs("d_Title") gd_TitleColor = rs("d_TitleColor") gDST_URL = rs("DST_URL") gd_HtmlUrl = rs("d_HtmlUrl") If gd_TitleColor <> "" Then gd_Title = ""&gd_Title&"" If WebStyle = 1 Then GetNext = ""&Txt10&""&gd_Title&"" Else GetNext = ""&Txt10&""&gd_Title&"" End If End If rs.close End Function Sub DocContent1(DocPlaceIS,RelativeLinkIS,RelativeLinkNumRow,CommentIS,CommentSSID,MaxImgWid) xd_ID = GetSafeStr(Request.QueryString("d_ID")) page = GetSafeStr(Request.QueryString("page")) If xd_ID = "" Then xd_ID = GetSafeStr(Request.QueryString("id")) IVI_ID = GetSafeStr(Request.QueryString("d_ID")) page = GetSafeStr(Request.QueryString("page")) If IVI_ID = "" Then IVI_ID = GetSafeStr(Request.QueryString("id")) If page = "" Then page = 1 Else If IsNumeric(page) = False Then page = 1 Else page = CInt(page) If page < 1 Then page = 1 End If End If If IVI_ID = "" or IsNumeric(IVI_ID) = False Then Exit Sub If MaxImgWid > 0 Then Response.write "" & chr(13) &chr(10) End If sql = "select * from DocContents where d_ID=" & IVI_ID Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then NowSSID = rs("SS_ID") NowSSPath = rs("SS_Path") d_CheckIn = rs("d_CheckIn") ' If d_CheckIn = False and rights = "" Then ' rs.close ' Call OutScript("文章未通过审核!") ' Response.End ' End If td_Title = rs("d_Title") td_TitleColor = rs("d_TitleColor") td_SubTitle = rs("d_SubTitle") td_KeyWords = rs("d_KeyWords") td_Date = rs("d_Date") td_Time = rs("d_Time") td_Contents = rs("d_Contents") td_Author = rs("d_Author") td_Hit = rs("d_Hit") td_HtmlUrl = rs("d_HtmlUrl") rs("d_Hit") = td_Hit + 1 rs.update rs.close If MaxImgWid > 0 Then replstr = " 1 Then td_Contents = Ar_Contents(page-1) If WebStyle = 1 Then linkpar = "&d_ID=" & IVI_ID If page = 1 Then InterViewPageNav = InterViewPageNav & Txt1 & " " Else InterViewPageNav = InterViewPageNav & ""&Txt1&" " End If If page > 1 Then InterViewPageNav = InterViewPageNav & ""&Txt12&" " Else InterViewPageNav = InterViewPageNav & Txt12 & " " End If For y = 1 to MaxPage If y = page Then InterViewPageNav = InterViewPageNav & " | " & y & " " Else InterViewPageNav = InterViewPageNav & " | " & y & " " End If Next If page < MaxPage Then InterViewPageNav = InterViewPageNav & ""&Txt13&" " InterViewPageNav = InterViewPageNav & ""&Txt14&" " Else InterViewPageNav = InterViewPageNav & Txt12 & " "&Txt14&" " End If InterViewPageNav = InterViewPageNav & Txt4 & " " & MaxPage & " " & Txt5 Else '首页 If page = 1 Then InterViewPageNav = InterViewPageNav & Txt1 & " " Else InterViewPageNav = InterViewPageNav & ""&Txt1&" " End If '上一页 If page > 1 Then If page > 2 Then InterViewPageNav = InterViewPageNav & ""&Txt12&" " Else InterViewPageNav = InterViewPageNav & ""&Txt12&" " End If Else InterViewPageNav = InterViewPageNav & Txt12 & " " End If '页码 For y = 1 to MaxPage If y = page Then InterViewPageNav = InterViewPageNav & " | " & y & " " Else If y > 1 Then InterViewPageNav = InterViewPageNav & " | " & y & " " Else InterViewPageNav = InterViewPageNav & " | " & y & " " End If End If Next '下一页 尾页 If page < MaxPage Then InterViewPageNav = InterViewPageNav & ""&Txt13&" " InterViewPageNav = InterViewPageNav & ""&Txt14&" " Else InterViewPageNav = InterViewPageNav & Txt12 & " "&Txt14&" " End If InterViewPageNav = InterViewPageNav & Txt4 & " " & MaxPage & " " & Txt5 End If End If Else rs.close Exit Sub End If NowSSPathNum = UBound(Split(NowSSPath,"-")) '读取分类名称 sql = "select * from SiteStructure where SS_ID="&NowSSID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then NowPSSID = rs("PSS_ID") NowSSName = rs("SS_Name") NowSSURL = rs("SS_URL") NowSSHtmlUrl = rs("SS_HtmlUrl") SS_SiteID = rs("SS_SiteID") End If rs.close '当前位置 If DocPlaceIS = 1 Then If SS_SiteID = "" or IsNumeric(SS_SiteID) = False Then Exit Sub DocNowPlace = "" If SS_SiteID > 0 Then sql = "select * from SiteStructure where SS_ID="&SS_SiteID Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then rs.close Call OutScript(ErrTxt0&ErrTxt4) End If RootSSPath = rs("SS_Path") RootSSPathNum = UBound(Split(RootSSPath,"-")) rs.close Else RootSSPathNum = 0 End If If RootSSPathNum >= NowSSPathNum Then Exit Sub If SS_Type < 4 and WebStyle = 2 Then SS_URL = NowSSHtmlUrl '静态 .html Else SS_URL = "/"&NowSSURL & "?SS_ID=" &NowSSID '动态 .shtml End If DocNowPlace = ""&NowSSName&"" PSS_ID = NowPSSID For i = 2 to NowSSPathNum - RootSSPathNum sql = "select * from SiteStructure where SS_ID="&PSS_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then SS_ID = rs("SS_ID") SS_Name = rs("SS_Name") SS_URL = rs("SS_URL") PSS_ID = rs("PSS_ID") SS_Type = rs("SS_Type") SS_HtmlUrl = rs("SS_HtmlUrl") If SS_Type < 4 and WebStyle = 2 Then SS_URL = SS_HtmlUrl '静态 .html Else SS_URL = "/"&SS_URL & "?SS_ID=" &SS_ID '动态 .shtml End If If DocNowPlace = "" Then DocNowPlace = ""&SS_Name&"" Else DocNowPlace = ""&SS_Name&" > "&DocNowPlace End If End If rs.close Next DocNowPlace = " > "&DocNowPlace End If '相关链接 If RelativeLinkIS = 1 and td_KeyWords <> "" Then scwords = split(td_KeyWords,"|") max = ubound(scwords) For i = 0 to max If i = 0 Then sqlstr = "d_Title like '%" & scwords(i) & "%' or d_KeyWords like '%" & scwords(i) & "%'" Else sqlstr = sqlstr&" or d_Title like '%" & scwords(i) & "%' or d_KeyWords like '%" & scwords(i) & "%'" End if Next sql = "select top "&RelativeLinkNumRow&" d_ID,d_Hit,d_Title,d_TitleColor,d_Date,d_Time,d_Author,DST_URL,d_HtmlUrl" sql = sql&" from DocContents where d_Type=2 and d_CheckIn<>0 and ("&sqlstr&") and d_ID<>" & IVI_ID sql = sql&" order by d_TopLock,d_Date desc,d_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then RelativeLink = ErrTxt6 Else RelativeLink = "" For i = 1 to rscount rd_ID = rs("d_ID") rd_Title = rs("d_Title") rd_TitleColor = rs("d_TitleColor") rd_Date = rs("d_Date") rd_Time = rs("d_Time") rd_Hit = rs("d_Hit") rDST_URL = rs("DST_URL") rd_HtmlUrl = rs("d_HtmlUrl") If rd_TitleColor <> "" Then rd_Title = ""&rd_Title&"" RelativeLink = RelativeLink & "" RelativeLink = RelativeLink & "" rs.movenext Next RelativeLink = RelativeLink & "
·" If WebStyle = 1 Then RelativeLink = RelativeLink & "" Else RelativeLink = RelativeLink & "" End If RelativeLink = RelativeLink & rd_Title&"" RelativeLink = RelativeLink & ""&rd_Date&" "&rd_Time&" ["&rd_Hit&"]
" End If rs.close Else RelativeLink = RelativeLink & ErrTxt6 End If '热字库 If IndexHotwords=1 then sqla="select * from HotWords order by HW_ID" Set rsa = LsObject.CreateRs(sqla,1,1) if not rsa.eof then for k=1 to rsa.recordcount if rsa.eof then exit for else HW_TITLE=rsa("HW_TITLE") Str_num=instr(td_Contents,HW_TITLE) if Str_num>0 then Str_nums=split(td_Contents,HW_TITLE) for j=0 to ubound(Str_nums) next end if Str_nums=j-1 if rsa("HW_TYPE")=0 THEN HotWords=""&HW_TITLE&"" Else HotWords=""&HW_TITLE&"
"&rsa("HW_CONTENT")&"
" End if if Str_num>=1 then td_Contents=Replace(td_Contents,HW_TITLE,HotWords,1,1) end if end if rsa.movenext next end if rsa.close td_Contents=td_Contents&HotWordsDiv End if '敏感词库 If Indexfilterwords=1 then sqla="select * from filterwords order by FW_ID" Set rsa = LsObject.CreateRs(sqla,1,1) if not rsa.eof then for k=1 to rsa.recordcount if rsa.eof then exit for else FW_TITLE=rsa("FW_TITLE") FW_TITLE1=rsa("FW_TITLE1") if instr(td_Contents,FW_TITLE)<>0 then td_Contents=Replace(td_Contents,FW_TITLE,FW_TITLE1) end if end if rsa.movenext next end if rsa.close End if End Sub %> <% '站点文章排序 Sub SiteSort(IsMainSite,SortNum,TbBorder,TbSpc,TbPad,TbBgC,TrHig,SiteTitWid,IsShowHeader,SiteHeader,NewCountHeader,TdAlign,TdNavBgC,TdBgC) If SortNum = "" Then sql = "SELECT SI_Name,COUNT(d_ID) as DocCount from DocContents,SiteInfo where d_Type=2 and d_CheckIn<>0 and DocContents.SS_SiteID=SiteInfo.SS_SiteID" Else sql = "SELECT Top "&SortNum&" SI_Name,COUNT(d_ID) as DocCount from DocContents,SiteInfo where d_Type=2 and d_CheckIn<>0 and DocContents.SS_SiteID=SiteInfo.SS_SiteID" End If If IsMainSite = False Then sql = sql & " and SiteInfo.SS_SiteID<>1" End If sql = sql & " GROUP BY SI_Name ORDER BY COUNT(d_ID) DESC" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount With Response If rscount > 0 Then .write "" If IsShowHeader THen .Write "" .Write "" .Write "" .Write "" End If For k = 1 to rscount SI_Name = rs("SI_Name") DocCount = rs("DocCount") .write "" .write "" .write "" .write "" rs.movenext Next .write "
"&SiteHeader&""&NewCountHeader&"
" .write SI_Name .write " " .Write DocCount .write " 
" Else .Write "暂无站点信息" End If End With rs.close End Sub 'Call SiteSort(True,"",0,1,0,"#F1F0EF",25,200,True,"站点名称","新闻数","center","#F1F0EF","#FFFFFF") '单位文章排序 Sub UnitSort(UI_Path,Excl_UI_ID,Excl_UI_Path,TbBorder,TbSpc,TbPad,TbBgC,TrHig,UnitTitWid,IsShowHeader,TdAlign,TdNavBgC,TdBgC,UnitHeader,NewCountHeader) Dim UnitID(),UnitName(),UnitTotalCount(),ArticleArr() sql = "select * from UnitsInfo where UI_ID > 0" If UI_Path <> "" Then sql = sql & " and UI_ID in (select UI_ID from UnitsInfo where UI_Path = '%"&UI_Path&"%')" If Excl_UI_ID <> "" Then sql = sql & " and UI_ID not in (Excl_UI_ID)" If Excl_UI_Path <> "" Then sql = sql & " and UI_ID not in (select UI_ID from UnitsInfo where UI_Path = '%"&Excl_UI_Path&"%')" sql = sql & " order by UI_ID" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount k = rscount-1 With Response If rscount >0 Then Redim Preserve UnitID(k),UnitName(k) for i = 0 to rscount-1 UnitID(i) = rs("UI_ID") UnitName(i) = rs("UI_Name") rs.movenext Next Else .Write("暂无注册单位") .End() End If rs.close Redim Preserve UnitTotalCount(k) For i = 0 to Ubound(UnitName) '各单位发布的新闻总数 sql = "select count(d_ID) as totalCount from DocContents where d_CheckIn <> 0 and UI_Name like '%"&UnitName(i)&"'" Set rs = LsObject.CreateRs(sql,1,1) totalCount = rs("totalCount") rs.close If totalCount = "" or IsNull(totalCount) Then totalCount = 0 End If UnitTotalCount(i) = totalCount Next Redim ArticleArr(k+1,3) For i = 0 to Ubound(UnitID) ArticleArr(i,0) = UnitID(i) ArticleArr(i,1) = UnitName(i) ArticleArr(i,2) = UnitTotalCount(i) Next For i = 0 to k For m = 0 to k-i If ArticleArr(m,2) < ArticleArr(m+1,2) Then For j = 0 to 2 temp = ArticleArr(m+1,j) ArticleArr(m+1,j) = ArticleArr(m,j) ArticleArr(m,j) = temp Next End If Next Next .write "" If IsShowHeader THen .Write "" .Write "" .Write "" .Write "" End If If SortNum <> "" Then k = SortNum For i = 0 to k .Write("") For j = 1 to 2 If j=1 Then .write "" Else .write "" End If Next .Write("") Next .write "
"&UnitHeader&""&NewCountHeader&"
" .write ArticleArr(i,j) .write " " .write ArticleArr(i,j) .write " 
" End With End Sub 'Call UnitSort("","","",0,1,0,"#F1F0EF",25,200,True,"center","#F1F0EF","#FFFFFF","单位","新闻数") %> <% Function WriteArticle() SS_ID = GetsafeStr(Request.QueryString("SS_ID")) xd_ID = GetsafeStr(Request.QueryString("xd_ID")) '验证新闻是否启用在线投稿 sql = "Select * from DocContents where d_id="&xd_ID&"" Set rs = LsObject.CreateRs(sql,1,1) If Not rs.Eof Then If DBType = 1 Then 'Access d_Article = instr(rs("d_Extension"),"|P011|") else d_Article = charindex("|P011|",rs("d_Extension")) end if End If rs.close If d_Article = "" Or IsNull(d_Article) Or Cint(Trim(d_Article)) = 0 Then Exit Function Action_str = "?xd_ID="&xd_ID&"&SS_ID="&SS_ID&"&actions=add" If SS_ID = "" Or Not IsNumeric(SS_ID) Then OutScript("操作失误导致系统故障1"):REsponse.End() If xd_ID = "" Or Not IsNumeric(xd_ID) Then OutScript("操作失误导致系统故障2"):REsponse.End() If Request.QueryString("actions") = "add" Then sql = "Select * from DocContents where d_id="&xd_ID&"" Set rs = LsObject.CreateRs(sql,1,1) If Not rs.Eof Then SI_Domain = rs("SI_Domain") SS_Path = rs("SS_Path") DST_URL = rs("DST_URL") End If rs.close SS_SiteID = 1 d_LinkWords = Request.Form("d_LinkWords") d_Title = Request.Form("d_Title") d_KeyWords = Request.Form("d_KeyWords") d_Author = Request.Form("d_Author") UI_Name = Request.Form("UI_Name") d_Date = Request.Form("d_Date") d_Time = Request.Form("d_Time") d_Contents = trim(Request.Form("d_Contents")) '验证文章摘要 If Len(d_LinkWords) > 200 Then d_LinkWords = Left(d_LinkWords,200) '验证日期和时间的格式 If IsDate(d_Date) = False Then Call OutScript("日期格式不正确,请返回重新填写!") If IsDate(d_Time) = False Then Call OutScript("时间格式不正确,请返回重新填写!") '验证文章内容 If d_Date = "" Then Call OutScript("时间不能为空!") If d_Time = "" Then Call OutScript("时间不能为空!") If d_Title = "" Then Call OutScript("文章标题不能为空!") If d_Contents = "" Then Call OutScript("文章内容不能为空!") d_ShowImageLink = 0 d_Redirect = 0 d_TopLock = 0 d_Vouch = 0 d_Hot = 0 d_New = 0 d_Sharing = 0 '添加文章 Randomize Random = Round(Rnd * (99999999 - 10000000 + 1) - 0.5) + 10000000 CreateDir = DocHtmlDir & SS_SiteID & "/" & Year(d_Date) & "/" & Month(d_Date) & "/" & Day(d_Date) & "/" '创建Html目录 FolderSpecifier = Server.MapPath(CreateDir) Set MyFileObject = Server.CreateObject(FsoStr()) If MyFileObject.FolderExists(FolderSpecifier) = False Then FolderSpecifier = Server.MapPath(DocHtmlDir & SS_SiteID & "/") If MyFileObject.FolderExists(FolderSpecifier) = False Then MyFileObject.CreateFolder FolderSpecifier FolderSpecifier = Server.MapPath(DocHtmlDir & SS_SiteID & "/" & Year(d_Date) & "/") If MyFileObject.FolderExists(FolderSpecifier) = False Then MyFileObject.CreateFolder FolderSpecifier FolderSpecifier = Server.MapPath(DocHtmlDir & SS_SiteID & "/" & Year(d_Date) & "/" & Month(d_Date) & "/") If MyFileObject.FolderExists(FolderSpecifier) = False Then MyFileObject.CreateFolder FolderSpecifier FolderSpecifier = Server.MapPath(DocHtmlDir & SS_SiteID & "/" & Year(d_Date) & "/" & Month(d_Date) & "/" & Day(d_Date) & "/") MyFileObject.CreateFolder FolderSpecifier End If Set MyFileObject = Nothing sql="select top 1 * from DocContents order by d_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then d_ID = rs("d_ID") + 1 Else d_ID = 1 End If rs.addnew rs("d_ID") = d_ID rs("d_No") = d_ID rs("SS_ID") = SS_ID rs("SS_Path") = SS_Path rs("SS_SiteID") = SS_SiteID rs("SI_Domain") = SI_Domain rs("d_Type") = 2 rs("d_Title") = d_Title rs("d_ShowTitle") = d_Title rs("d_SubTitle") = d_SubTitle rs("d_ShowImageLink") = d_ShowImageLink rs("d_LinkImage") = d_LinkImage rs("d_LinkWords") = d_LinkWords rs("d_Redirect") = d_Redirect rs("d_RedirectLink") = d_RedirectLink rs("d_KeyWords") = d_KeyWords rs("d_Contents") = d_Contents rs("d_Date") = d_Date rs("d_Time") = d_Time rs("d_Author") = d_Author rs("d_TopLock") = 0 rs("d_Vouch") = 0 rs("d_Hot") = 0 rs("d_New") = 0 rs("d_Sharing") = 0 rs("d_Hit") = 0 rs("d_OriginalFileName") = d_OriginalFileName rs("d_SaveFileName") = d_SaveFileName rs("d_SavePathFileName") = d_SavePathFileName rs("DST_ID") = DST_ID rs("DST_URL") = DST_URL rs("d_CheckIn") = 0 rs("d_AdminLock") = 0 rs("d_yy") = 0 rs("d_HtmlUrl") = CreateDir & Random & d_ID & ".html" rs("UA_ID") = Session("UA_ID") rs("UI_Name") = UI_Name rs.update rs.close Response.Write("") Response.End() End If Ent_Date = date() Ent_Time = Time() EntriesTime = Ent_Date & " " & Ent_Time %> <% Dim Rules_Str Rules_Str = "" Rules_Str = Rules_Str & " " Rules_Str = Rules_Str & "   
" Rules_Str = Rules_Str & " 排版规则:
" Rules_Str = Rules_Str & "本站投稿程序后台完善了自动排版功能,一键轻松 实现稿件规范排版
" Rules_Str = Rules_Str & " 1、计算文本框里的稿件字数。每次投稿,不超过15000字,超过分(1)(2)形式连载。
" Rules_Str = Rules_Str & "2、删除文章中多余空行。
" Rules_Str = Rules_Str & "3、让每个自然段落前空出两格。
" Rules_Str = Rules_Str & "4、如果你投稿的是诗歌,每行开头也请空出两格,直接点。但请注意:诗句中必要的间距也会被删除。
" Rules_Str = Rules_Str & "5、如果对稿件有错误操作,可将鼠标定位在投稿文本框里,按Ctrl+Z逐步恢复,对编辑器无效。
" Rules_Str = Rules_Str & "6、这是最便捷的排版工具了,如果稿件还不符合版式规范,编辑只能做退稿处理了。" Rules_Str = Rules_Str & " " %>
<%Response.Write(Rules_Str)%>
标  题(必填):   
副 标 题(可填):   
新闻概要(可填):   
关 键 字(可填):   
作  者(可填):   
来  源(可填):   
投稿时间(必填):   
新闻内容(必填): 


  

  

  

  

  
 
   
<% End Function %> <% Sub PicAutoPlay() If sNull(IsPicJS)<>"" Then Exit Sub %> <% IsPicJS = 1 End Sub %> <% '====================================================================================================================== ' 领导之窗左侧列表 (LeaderList):栏目SS_ID,表格宽度TabWin,表格高度TabHig,表边框颜色TabBorderCol,单元格高度TdHig,单元格背景TdBg,单元格字体样式TdFontStyle,链接样式LinkFontStyle,领导分类间距LineHeight,列表是否隐藏IsHidden '====================================================================================================================== Sub LeaderList(SS_ID,TabWin,TabHig,TabBorderCol,TdHig,TdBg,TdFontStyle,TdPad,LinkFontStyle,LineHeight,IsHidden) Response.Write "" Response.Write "" %> <% Response.Write "
" sql = "select * from LeaderClass where LC_SSID=" & SS_ID &" order by LC_ID ASC" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount p=0 For k = 1 to rscount Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "
"&rs("LC_TITLE")&"" if IsHidden=0 then Response.Write "1 then Response.Write " lowsrc=/Tmp/Images/icojia.gif src=/Images/icojia.gif " else Response.Write " lowsrc=/Tmp/Images/icojian.gif src=/Images/icojian.gif " end if Response.Write "width=14 height=14 style='cursor:hand;' onClick=""HdorDpTable('"&k&"')"">" end if Response.Write "
1 then Response.Write " style=""DISPLAY: none"" id=tb"&k&"" else Response.Write " id=tb"&k&"" end if end if Response.Write ">
" sqla = "select * from LeaderWindow where SS_ID=" & SS_ID &" and LW_LeaderClass = "& rs("LC_ID")&" AND LW_CheckIn<>0 order by LW_Order asc,LW_ID ASC" Set rsa = LsObject.CreateRs(sqla,1,1) rscounta = rsa.recordcount For i = 1 to rscounta Response.Write ""&rsa("LW_TITLE")&"
" p=p+1 rsa.movenext Next rsa.close Response.Write "
" Response.Write "
" rs.movenext Next rs.close Response.Write "
" End Sub '====================================================================================================================== ' 领导之窗右侧内容 (LeaderContent)站点SS_SiteID,栏目SS_ID,表格宽度TabWin,表格边框颜色TabBorderCol,表格背景TabBg,栏目图片ImgSrc,工作简历后面的图片ImgSrc1,工作范围高度DivHig1,工作简介高度DivHig2,相关新闻背景图ImgSrc3,相关新闻高度DivHig3,相关新闻前面的标题图片ImgSrc4 '====================================================================================================================== Sub LeaderContent(SS_SiteID,SS_ID,TabWin,TabBorderCol,TabBg,ImgSrc,ImgSrc1,DivHig1,DivHig2,ImgSrc3,DivHig3,ImgSrc4) sqla1 = "select * from LeaderWindow where SS_ID=" & SS_ID &" AND LW_CheckIn<>0 order by LW_Leaderclass asc,LW_Order asc,LW_ID ASC" Set rsa1 = LsObject.CreateRs(sqla1,1,1) rscounta1 = rsa1.recordcount For j = 1 to rscounta1 Response.Write "" sql = "select * from LeaderWindow where LW_ID=" & rsa1("LW_ID") Set rs = LsObject.CreateRs(sql,1,1) if not rs.eof then Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" end if rs.close Response.Write "
" Response.Write "
" Response.Write "
" if rs("LW_LinkImage")="" then Response.Write "暂无数据更新..." else Response.Write "" end if Response.Write "
" if rs("LW_Contents1")="" then Response.Write "暂无数据更新..." else Response.Write rs("LW_Contents1") end if Response.Write "
 工作简历 
"&rs("LW_Contents")&"
" Response.Write "
" Response.Write "
相关新闻
" Response.Write "
" sqla = "select d_ID,SI_Domain,d_Title,d_Redirect,d_RedirectLink,d_LinkWords,d_Date,d_Time,d_Author,d_Vouch,d_Hit,DST_URl,d_HtmlUrl" sqla = sqla&" from DocContents where d_Type=2 and d_CheckIn<>0 and SS_SiteID="&SS_SiteID sqla = sqla&" and (d_Title like '%"&rs("LW_Name")&"%' or d_Contents like '%"&rs("LW_Name")&"%')" sqla = sqla&" order by d_ID desc" Set rsa = LsObject.CreateRs(sqla,1,1) if rsa.eof then Response.Write "暂无数据更新..." else Response.Write "" for i=1 to rsa.recordcount if rsa.eof then exit for else d_ID = rsa("d_ID") SI_Domain = rsa("SI_Domain") d_Title = rsa("d_Title") d_Date = rsa("d_Date") DST_URL = rsa("DST_URL") d_HtmlUrl = rsa("d_HtmlUrl") d_Redirect = rsa("d_Redirect") d_RedirectLink = rsa("d_RedirectLink") If d_Redirect = True Then DocURL = d_RedirectLink Else If WebStyle = 1 Then DocURL = SI_Domain & DST_URL&"?d_ID="&d_ID Else DocURL = SI_Domain & d_HtmlUrl End If End If Response.Write "" end if rsa.movenext next Response.Write "
"&d_Title&" "&d_Date&"
" end if rsa.close Response.Write "
" Rsa1.movenext next End Sub %> <% '====================================================================================================================== ' 政民互动栏目页显示 '====================================================================================================================== Sub InterActiveList(PerNumRow) If NowSSIS = False Then Exit Sub IS_ID = GetSafeStr(Trim(Request.QueryString("IS_ID"))) '通过ID和密码查询留言 formaction = Trim(Request.Form("action")) If formaction = "find" Then I_ID = GetSafeStr(Request.Form("I_ID")) VerifyCode = request.Form("VerifyCode") I_QueryPasswd = GetSafeStr(Request.Form("I_QueryPasswd")) sql = "SELECT UnitsInfo.UI_Name as ReceiveUnits, UnitsInfo_1.UI_Name as RevertUnits, InteractiveInfo.*" sql = sql & " FROM (InteractiveInfo LEFT JOIN UnitsInfo ON InteractiveInfo.I_ReceiveUnits=UnitsInfo.UI_ID) " sql = sql & " LEFT JOIN UnitsInfo AS UnitsInfo_1 ON InteractiveInfo.I_RevertUnits=UnitsInfo_1.UI_ID" sql = sql & " Where InteractiveInfo.I_ID=" & Cint(I_ID) & " and InteractiveInfo.I_QueryPasswd='"&I_QueryPasswd&"'" set rs = LsObject.CreateRs(sql,1,1) if VerifyCode <> Trim(Session("VerifyCode")) then Call OutScript("验证码错误!") Response.end end if If rs.eof Then rs.close Call OutScript("查询编号或密码不正确!") Exit Sub End If I_RevertIS = rs("I_RevertIS") If I_RevertIS = True Then rs.close Call OutScript("您的留言正在处理中,请稍候查询!") Exit Sub End If I_Name = rs("I_Name") I_Subject = rs("I_Subject") I_Content = rs("I_Content") I_Date = rs("I_Date") I_Time = rs("I_Time") I_Revert = rs("I_Revert") I_RevertDate = rs("I_RevertDate") I_RevertTime = rs("I_RevertTime") I_RevertUnits = rs("RevertUnits") I_RemoteIp = rs("I_RemoteIp") rs.close %>
发件人: <%= I_Name%>
发送时间: <%= I_Date & " " & I_Time%>
主题: <%= I_Subject%>
留言内容: <%= I_Content%>
回复部门: <%= I_RevertUnits%>
回复时间: <%= I_RevertDate & " " & I_RevertTime%>
回复内容: <%= I_Revert%>

<% Exit Sub End If If formaction="AppraiseAdd" Then I_ID = GetSafeStr(Request.Form("I_ID")) Appraise = GetSafeStr(Request.Form("Appraise")) I_QueryPasswd = GetSafeStr(Request.Form("I_QueryPasswd")) If I_ID<>"" And IsNumeric(I_ID) Then sql = "select * from InteractiveInfo where I_ID="&Cint(I_ID)&" And I_QueryPasswd='"&I_QueryPasswd&"'" Set rs = LsObject.CreateRs(sql,1,3) If Not rs.eof Then I_Appraise = rs("I_Appraise") If I_Appraise<>"" Then Call OutScript("您已经评价!") Exit Sub End If rs("I_Appraise") = Appraise rs.update rs.close Else rs.close Call OutScript("查询编号或密码不正确!") Exit Sub End If End If End If getaction = GetSafeStr(Trim(Request.QueryString("action"))) If getaction = "defind" Then I_ID = GetSafeStr(Trim(Request.QueryString("I_ID"))) If I_ID="" Or IsNumeric(I_ID)=False Then Response.End() I_QueryPasswd = GetSafeStr(Request.Form("I_QueryPasswd")) sql = "SELECT UnitsInfo.UI_Name as ReceiveUnits, InteractiveInfo.*" sql = sql & " FROM (InteractiveInfo LEFT JOIN UnitsInfo ON InteractiveInfo.I_ReceiveUnits=UnitsInfo.UI_ID) " sql = sql & " Where InteractiveInfo.I_ID=" & Clng(I_ID) & " And I_ShowIs<>0" set rs = LsObject.CreateRs(sql,1,3) If Not rs.eof Then I_Name = rs("I_Name") I_Number = rs("I_Number") I_Subject = rs("I_Subject") I_Content = rs("I_Content") I_CheckIn = rs("I_CheckIn") I_Name = rs("I_Name") I_Tel = rs("I_Tel") I_Email = rs("I_Email") I_Pcode = rs("I_Pcode") I_Address = rs("I_Address") I_CheckInP = rs("I_CheckInP") I_Date = rs("I_Date") I_Time = rs("I_Time") I_RevertIS = rs("I_RevertIS") I_Revert = rs("I_Revert") I_RevertDate = rs("I_RevertDate") I_RevertTime = rs("I_RevertTime") I_ReceiveUnits=RS("ReceiveUnits") IF I_RevertUnits="" OR ISNULL(I_RevertUnits) THEN I_RevertUnits=I_ReceiveUnits I_RemoteIp = rs("I_RemoteIp") I_Appraise = rs("I_Appraise") I_Hit = rs("I_Hit") 'If IsNull(I_Hit) Then I_Hit = 1 'rs("I_Hit") = I_Hit+1 rs.update rs.close End If sql = "select I_Hit from InteractiveInfo where I_ID=" & Clng(I_ID) & "" Set rs = LsObject.CreateRs(sql,1,3) If Not rs.eof Then If IsNull(I_Hit) Then I_Hit = 1 rs("I_Hit") = I_Hit+1 rs.update End If rs.close If IS_ID<>"" And IsNumeric(IS_ID) Then sql = "select * from InteractiveSort where IS_ID="&Cint(IS_ID) Set rs = LsObject.CreateRs(sql,1,1) If Not rs.eof Then IS_Name = rs("IS_Name") Else IS_Name = "" End If rs.close End If %>
 信件详细信息
信件编号:  <%= I_ID %>
信件类型:  <%= IS_Name %>
来源类型:  网上
来信标题:  <%= I_Subject %>
来信时间:  <%= I_Date %>
来信内容:  <%= I_Content %>
 来信件人详细信息
<%If I_CheckInP Then%> <%Else%> <%End If%>
姓 名:  <%= I_Name %>
联系电话:  <%= I_Tel %>
电子邮箱:  <%= I_Email %>
邮 编:  <%= I_Pcode %>
地 址:  <%= I_Address %>
   不公开
<%If I_RevertIS=1 Or I_RevertIS=2 Then%>
 回复内容
回复部门:  <%= I_RevertUnits %>
办理时间:  <%= I_RevertDate %>
回复内容:  <%= I_Revert %>
<%End If%>
 办理评价
<% If I_Appraise="" Or IsNull(I_Appraise) Then Response.Write "暂无评价信息!" Else Response.write "   "&I_Appraise&"" End If %>
信件密码
是否满意   满意 比较满意 一般 不满意 很不满意

<% Set rs = Nothing Exit Sub End If '显示查询表单 'action = GetSafeStr(Request.QueryString("action")) If getaction = "query" Then %>


查询编号:
查询密码:
<% Exit Sub End If ' If action = "show" or action = "search" Then SearchStr = Request.QueryString("SearchStr") IS_ID = Trim(Request.QueryString("IS_ID")) 'sql = "SELECT I_ID,IS_ID,I_Number,I_Subject,I_Content,I_Name,I_Tel,I_Email,I_Pcode,I_Address,I_Date,I_Time" ' sql = sql & ",I_RevertIS,I_Revert,I_RevertDate,I_RevertTime,I_ReceiveUnits,I_RemoteIp,I_Hit" ' sql = sql & " FROM InteractiveInfo " ' sql = sql & " Where InteractiveInfo.SS_ID="&NowSSID&" and InteractiveInfo.I_ShowIs<>0" sql = "SELECT UnitsInfo.UI_Name as ReceiveUnits, InteractiveInfo.*" sql = sql & " FROM (InteractiveInfo LEFT JOIN UnitsInfo ON InteractiveInfo.I_ReceiveUnits=UnitsInfo.UI_ID) " sql = sql & " Where InteractiveInfo.SS_ID="&NowSSID&" and InteractiveInfo.I_ReceiveUnits<>0 And InteractiveInfo.I_ShowIs<>0" If IS_ID<>"" And IsNumeric(IS_ID) Then sql = sql & " and InteractiveInfo.IS_ID=" & Cint(IS_ID) & "" If SearchStr <> "" Then sql = sql & " and (InteractiveInfo.I_Content like '%" & SearchStr & "%' or InteractiveInfo.I_Name like '%" & SearchStr & "%')" if request.QueryString("df")="0" then sql = sql & " And InteractiveInfo.I_RevertIS=0" elseif request.QueryString("df")="1" then sql = sql & " And InteractiveInfo.I_RevertIS<>0" end if sql = sql & " order by InteractiveInfo.I_ID desc" response.Write("") Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount linkpar ="&action=show&SS_ID="&NowSSID&"&IS_ID="&IS_ID&"&SearchStr=" & SearchStr&"&df="&request.QueryString("df") mypage = Request("whichpage") If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 If rscount > 0 Then mypagesize = CInt(PerNumRow) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage End If %>
<%Call Pagination()%>
<% j = rscount - (mypage-1) * mypagesize If j > mypagesize Then j = mypagesize For i = 1 to j I_ID = rs("I_ID") IS_ID = rs("IS_ID") I_Number = rs("I_Number") I_Subject = rs("I_Subject") I_Content = rs("I_Content") I_Name = rs("I_Name") I_Tel = rs("I_Tel") I_Email = rs("I_Email") I_Pcode = rs("I_Pcode") I_Address = rs("I_Address") I_Date = rs("I_Date") I_Time = rs("I_Time") I_ReceiveUnits = rs("I_ReceiveUnits") I_RevertIS = rs("I_RevertIS") I_Revert = rs("I_Revert") I_RevertDate = rs("I_RevertDate") I_RevertTime = rs("I_RevertTime") 'I_RevertUnits = rs("RevertUnits") I_RevertUnits = rs("ReceiveUnits") I_RemoteIp = rs("I_RemoteIp") I_Hit = rs("I_Hit") If IsNull(I_Hit) Then I_Hit = 0 If I_RevertUnits="" Or IsNull(I_RevertUnits) Then I_RevertUnits = "暂无回复" End If If I_RevertIS=0 Then RevertIStr = "未回复" ElseIf I_RevertIS=1 Then RevertIStr = "已回复" ElseIf I_RevertIS=2 Then RevertIStr = "已办结" End If If I_Email <> "" Then I_Email = ""&I_Email&"" 'If m_Web <> "" and m_Web <> "http://" Then m_Web = ""&m_Web&"" %> <% rs.movenext Next rs.close %>
主题 回复部门 发布时间 处理状态 点击数
 <%=CutStr(I_Subject,44)%> <%=I_RevertUnits%> <%=I_Date%> <%=RevertIStr%> <%=I_Hit%>
<%If maxcount > 1 Then%>
<%Call Pagination()%>
<%End If%>
<% ' Exit Sub ' End If '提交信息 action = Request.Form("xaction") If action = "add" Then checkcode = GetSafeStr(Request.Form("checkcode")) If checkcode = "" or checkcode <> Cstr(Session("CheckCode")) Then Call OutScript("验证码输入错误!") Exit Sub End If IS_ID = GetSafeStr(Request.Form("IS_ID")) I_Name = GetSafeStr(Request.Form("I_Name")) I_CheckIn = GetSafeStr(Request.Form("I_CheckIn")) I_CheckInP = GetSafeStr(Request.Form("I_CheckInP")) I_Email = GetSafeStr(Request.Form("I_Email")) I_Tel = GetSafeStr(Request.Form("I_Tel")) I_Address = GetSafeStr(Request.Form("I_Address")) I_Subject = GetSafeStr(Request.Form("I_Subject")) I_Tel=GetSafeStr(Request.Form("I_Tel")) InteractiveType = GetSafeStr(Request.Form("InteractiveType")) ReceiveUnits = GetSafeStr(Request.Form("ReceiveUnits")) If InteractiveType<>"" And IsNumeric(InteractiveType) Then sql = "select IS_ConChk from InteractiveSort where IS_ID="&Clng(InteractiveType) Set rs = LsObject.CreateRs(sql,1,1) If Not rs.eof Then IS_ConChk = rs("IS_ConChk") End If rs.close If IS_ConChk Then IS_ConChk= True Else IS_ConChk = False End If End If I_Contents = GetSafeStr(Request.Form("I_Contents")) If I_Name = "" or I_Contents = "" Then Call OutScript(ErrTxt0&ErrTxt10) Randomize Random = Round(Rnd * (99999999 - 10000000 + 1) - 0.5) + 10000000 sql = "select top 1 * from InterActiveInfo order by I_ID desc" Set rs = LsObject.CreateRs(sql,1,3) If not rs.eof Then I_ID = rs("I_ID") + 1 Else I_ID = 1 End If rs.addnew I_Number = GetDateCode("",6) & String(3-len(SS_No),48) & I_ID rs("I_ID") = I_ID rs("SS_ID") = NowSSID rs("SS_Path") = NowSSPath rs("I_Number") = I_Number rs("IS_ID") = InteractiveType rs("I_Name") = I_Name rs("I_Subject") = I_Subject rs("I_Email") = I_Email rs("I_Tel") = I_Tel rs("I_Content") = replace((replace(I_Contents,vbcrlf,"
")),chr(32)&chr(32),"  ") rs("I_Date") = Date() rs("I_Time") = Time() rs("I_RemoteIp") = Request.ServerVariables("REMOTE_ADDR") rs("I_CheckIn") = I_CheckIn rs("I_CheckInP") = I_CheckInP rs("I_RevertIS") = 0 rs("I_Hit") = 0 If InStr(ReceiveUnits,"|")>0 Then arrI_ReceiveUnits = split(ReceiveUnits,"|") If arrI_ReceiveUnits(2)<>"" Then rs("I_ReceiveUnits") = arrI_ReceiveUnits(2) rs("I_Move") = arrI_ReceiveUnits(2)&"|" ELSE rs("I_ReceiveUnits")=ReceiveUnits rs("I_Move") = ReceiveUnits&"|" End If rs("I_ShowIs") = IS_ConChk rs("I_QueryPasswd") = Random rs.update rs.close '添加到公共标题表 sql="select * from PublicTitle" Set rs = LsObject.CreateRs(sql,1,3) rs.addnew rs("PT_TITLE") = I_Subject rs("PT_DID") = I_ID rs("PT_DTYPE") = 97 rs("PT_SSID") = NowSSID rs("PT_SSSiteID") = ReadSiteID(NowSSID) rs.update rs.close If IS_ConChk=0 Then Response.write "" Else Response.write "" End If End If '显示留言表单 %> <%If WebLanguage = 1 Then%>
受理(可填)
类型(必填)
 姓名(必填)      个人信息是否公开 公开 不公开
 邮箱(必填)      信件内容是否公开 公开 不公开
 电话(必填)      请如实填写个人电话和邮箱,
住址(可填)     以便核实和回复,否则将不予受理。
主题(必填)
 内容(必填) 

 [查看长度
验证码(必填)  
 
<%End If%> <%If WebLanguage = 2 Then%>
 name 
 email 
 Tel 
subject
 message 

 [Check length
 
<%End If%> <% End Sub ' ====================================================================================================================== ' 首页政民互动表格列表(SS_ID:栏目ID,ISID:分类ID,TopNum:显示条数,trheight:行高,trbgcolor:背景色,trMouseOver:鼠标移上去背景色,trMouseOut:鼠标移出背景色,inUrl:链接地址,intarget:调整方式,titleNum:标题字数) ' ====================================================================================================================== Sub IndexInterActiveInfolist(SS_ID,ISID,TopNum,trheight,trbgcolor,trMouseOver,trMouseOut,inUrl,intarget,titleNum) %> <% sql = "SELECT top "&TopNum&" UnitsInfo.UI_Name as ReceiveUnits, UnitsInfo_1.UI_Name as RevertUnits, InteractiveInfo.*" sql = sql & " FROM (InteractiveInfo LEFT JOIN UnitsInfo ON InteractiveInfo.I_ReceiveUnits=UnitsInfo.UI_ID) " sql = sql & " LEFT JOIN UnitsInfo AS UnitsInfo_1 ON InteractiveInfo.I_RevertUnits=UnitsInfo_1.UI_ID" sql = sql & " Where InteractiveInfo.SS_ID="&SS_ID&" And InteractiveInfo.I_ShowIs<>0" if ISID=1 then sql = sql & " and InteractiveInfo.I_RevertIS=1" elseif ISID=2 then sql = sql & " and InteractiveInfo.I_RevertIS=0" else sql = sql & " " end if sql = sql & " order by InteractiveInfo.I_ID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.RecordCount For i = 1 to rscount titleNum = titleNum*2 I_ID = rs("I_ID") IS_ID = rs("IS_ID") SSS_ID = rs("SS_ID") I_Number = rs("I_Number") I_Subject = rs("I_Subject") I_Content = rs("I_Content") I_CheckIn = rs("I_CheckIn") I_Name = rs("I_Name") I_Tel = rs("I_Tel") I_Email = rs("I_Email") I_Pcode = rs("I_Pcode") I_Address = rs("I_Address") I_Date = rs("I_Date") I_Time = rs("I_Time") I_CheckInP = rs("I_CheckInP") I_ReceiveUnits = rs("ReceiveUnits") I_RevertIS = rs("I_RevertIS") 'I_RevertDate = rs("I_RevertDate") 'I_RevertTime = rs("I_RevertTime") I_RevertUnits = rs("RevertUnits") I_ReceiveUnits = rs("ReceiveUnits") if I_RevertUnits="" or isnull(I_RevertUnits) then I_RevertUnits=I_ReceiveUnits I_RemoteIp = rs("I_RemoteIp") I_Hit = rs("I_Hit") If IsNull(I_Hit) Then I_Hit = 0 If I_RevertUnits="" Or IsNull(I_RevertUnits) Then I_RevertUnits = "暂无回复" End If If I_RevertIS=0 Then RevertIStr = "未回复" ElseIf I_RevertIS=1 Then RevertIStr = "已回复" ElseIf I_RevertIS=2 Then RevertIStr = "已办结" End If if I_Number="" or isnull(I_Number) then I_Number=replace(cstr(I_Date),"-","")&"000"&I_ID %> <% rs.movenext Next rs.close %>
受理编号 标题 回复部门 发布时间 处理状态
<%=I_Number%> <%= CutStr(I_Subject,20)%> <%=I_RevertUnits%> <%=I_Date%> <%=RevertIStr%>
<% End Sub FUNCTION L_ChangeName(UName) select case UName case "环保局" L_ChangeName="环境保护局" case "计生局" L_ChangeName="人口与计生局" case "住房和城乡建设局" L_ChangeName="住建局" case "经促局" L_ChangeName="经济促进局" case "发统局" L_ChangeName="发改和统计局" case else L_ChangeName=UName End Select End FUNCTION 'topNum条数 Sub UnitsInfoCount (topNum) sql = "select top "&topNUm&" * from InterActionCount Where refercount>0 order by refercount desc,UI_ID desc" 'Response.write sql Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then Exit Sub xRscount = rs.recordcount %> <% For i = 1 to xRscount UI_ID = rs("UI_ID") UI_Name = rs("UI_Name") refercount = rs("refercount") revertcount = rs("revertcount") RU_Percent = rs("RU_Percent") %> <% rs.movenext Next rs.close %>
部门名称 咨询 回复 回复率
<%=CutStr(UI_Name,12)%> <%=refercount%> <%=revertcount%> <%=RU_Percent%> %
<% End Sub Sub UnitsDocCount(topNum) sql = "select top "&topNUm&" * from DocContentsCount Where UnitsDocCount>0 and UI_ID<>3 order by UnitsDocCount desc,UI_ID desc" Set rs = LsObject.CreateRs(sql,1,1) If rs.eof Then Exit Sub xRscount = rs.recordcount %> <% For i = 1 to xRscount UI_ID = rs("UI_ID") UI_Name = rs("UI_Name") DocCount = rs("UnitsDocCount") %> <% rs.movenext Next rs.close %>
部门名称 发文统计
<%=CutStr(UI_Name,12)%> <%=DocCount%>
<% End Sub Public Function GetDateCode(ByVal sDate,ByVal sMode) Dim sReturn If Not IsDate(sDate) Or IsNull(sDate) Then sDate = Now() sReturn=Year(sDate) & Right("0" & Month(sDate),2) & Right("0" & Day(sDate),2) select Case sMode Case "1" sReturn=sReturn & Right("0" & Hour(sDate),2) Case "2" sReturn=sReturn & Right("0" & Hour(sDate),2) & Right("0" & Minute(sDate),2) Case "3" sReturn=sReturn & Right("0" & Hour(sDate),2) & Right("0" & Minute(sDate),2) & Right("0" & Second(sDate),2) Case "4" sReturn = Year(sDate) &"-"& Right("0" &"-"& Month(sDate),2) &"-"& Right("0" & Day(sDate),2) Case "5" sReturn = Year(sDate) &"/"& Right("0" &"/"& Month(sDate),2) &"/"& Right("0" & Day(sDate),2) Case "6" sReturn = Year(sDate) & Right("0" & Month(sDate),2) & Right("0" & Day(sDate),2) End select GetDateCode=sReturn End Function '政民互动 Sub InterActiveNav(NowCor,NowBgCor,NowBgGrd,TbWid,TdHig,TdBgCor,TdBgGrd,TdAlign,paddingLeft,ItemIcon,NavVis,SubUrl) NowSSID = GetSafeStr(Trim(Request.QueryString("SS_ID"))) NowISID = GetSafeStr(Trim(Request.QueryString("IS_ID"))) sql = "select * from InteractiveSort where SS_ID="&NowSSID&" order by IS_Path" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount SubNum = rscount If rscount = 0 Then rs.close Exit Sub End If str = " "" Then str = str & " width="""&TbWid&"""" str = str & ">" For i = 1 to rscount If SubUrl<>"" Then SubUrll = SubUrl & "?SS_ID=" &NowSSID&"&IS_ID="&rs("IS_ID")&"" Else SubUrll = "?SS_ID=" &NowSSID&"&IS_ID="&rs("IS_ID")&"" End If If "t"&rs("IS_ID") = "t"&NowISID Then str = str & " "" Then str = str & " Height="""&TdHig&"""" If NowBgCor <> "" Then str = str & " bgcolor="""&NowBgCor&"""" If NowBgGrd <> "" Then str = str & " background="""&NowBgGrd&"""" If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&paddingLeft&"px"">" If ItemIcon <> "" Then str = str & " " str = str & ""&""&rs("IS_Name")&"" str = str & "" Else str = str & " "" Then str = str & " Height="""&TdHig&"""" If TdBgCor <> "" Then str = str & " bgcolor="""&TdBgCor&"""" If TdBgGrd <> "" Then str = str & " background="""&TdBgGrd&""" onMouseOver=""this.background='"&NowBgGrd&"'""" str = str & " onMouseOut=""this.background='"&TdBgGrd&"'""" End If If TdAlign <> "" Then str = str & " align="""&TdAlign&"""" str = str & " style=""padding-left:"&paddingLeft&"px"">" If ItemIcon <> "" Then str = str & " " str = str & ""&rs("IS_Name")&"" End If rs.movenext Next rs.close str = str & "
" If NavVis = 1 Then Response.write str End Sub ' ====================================================================================================================== ' 政民互动当前位置 ' ====================================================================================================================== Function NowInterActiveName() NowIS_ID = GetSafeStr(Request.QueryString("IS_ID")) If NowIS_ID <>"" and IsNumeric(NowIS_ID) Then sql = "select IS_Name from InterActiveSort where IS_ID="&Cint(NowIS_ID) Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then IS_Name__ = " > "&rs("IS_Name") Else IS_Name__ = "" End If rs.close End If NowInterActiveName = IS_Name__ End Function Public Sub inNet() Dim HTTP_REFERER,SERVER_NAME HTTP_REFERER = Cstr(Request.ServerVariables("HTTP_REFERER")) SERVER_NAME = Cstr(Request.ServerVariables("SERVER_NAME")) If Mid(HTTP_REFERER,8,Len(SERVER_NAME))<>SERVER_NAME then Response.Write "False" Response.End End if End Sub %> <% '====================================================================================================================== ' 自定义查询模块--查询左侧分类显示部分 '====================================================================================================================== Sub CommonDBinfo(TabWid,TdHig,TdBg,LinkStyle) Response.Write "" sql = "select * from DBInfo order by DB_ID desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount>0 Then For i =1 to rscount Response.Write "" rs.movenext Next End If Response.Write "
"&rs("DB_Title")&"
" End Sub '====================================================================================================================== ' 自定义查询模块--查询显示部分 '====================================================================================================================== Sub CommonQuery(DB_ID,Qtbbgcolor,Qtrbgcolor,Qtdbgcolor,Rtbbgcolor,Rbkgroud,Rtrbgcolor,Rtdbgcolor) Dim queryTitle,str,action,dataconn,StrConn,sqlstr '查询操作 action = request("action") If action = "query" Then '从主表里取出数据库相关信息 sql = "select * from DBInfo where DB_ID = "&DB_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof Then DB_TYPE = rs("DB_TYPE") DB_FILE = rs("DB_FILE") DB_ADDR = rs("DB_ADDR") DB_NAME = rs("DB_NAME") DB_USER = rs("DB_USER") DB_PWD = rs("DB_PWD") TABLE_NAME = rs("TABLE_NAME") DB_SFNAME = rs("DB_SFNAME") DB_SFMEAN = rs("DB_SFMEAN") End If rs.close Call DBConnEnd() '获取外部数据库数据库连接字符串 Strconn = GetStrConn(DB_TYPE,DB_FILE,DB_ADDR,DB_NAME,DB_USER,DB_PWD) '根据外部数据库信息创建数据库连接 Set dataconn = Server.CreateObject("Adodb.Connection") dataconn.Open StrConn '查询初始SQL sqlstr = "select * from "&TABLE_NAME&" where 1=1" '根据以上所得外部数据库ID从子表查询出用于查询条件的各字段与类型,放入数组,用于下一步追加查询条件 sql = "select * from QerFields where DB_ID = "&DB_ID Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount Dim QField(),QType() If rscount>0 Then Redim QField(rscount) Redim QType(rscount) For i = 1 to rscount QField(i) = rs("Q_FNAME") QType(i) = rs("Q_FOTYPE") rs.movenext Next End If rs.close Call DBConnEnd() '显示字段的提示性文本 DB_SFMEAN = split(DB_SFMEAN,"|") '显示字段名 DB_SFNAME = split(DB_SFNAME,"|") '追加SQL查询条件,TypeName()函数在/System/Include/EasyBuildSiteConn.shtml里,通过数据库类型追加 dim k k = 0 For j = 1 to rscount If Request.Form(QField(j))<>"" Then k = k+1 sqlstr = sqlstr&TypeName(DB_TYPE,QField(j),Request.Form(QField(j)),QType(j)) End If Next id = Request.QueryString("id") queryfieldnum = Request.Form("queryfieldnum") If CInt(k) < CInt(queryfieldnum) Then Call OutScript("查询条件不足,请认真填写!") If k = 0 and id="" Then Call OutScript("非法查询!") If id <> "" Then sqlstr = sqlstr & " and "& DB_SFMEAN(1)&"='"&id&"'" End If '用以上组成的SQL语句进行外部数据库查询并将结果以表格形式输出 Set qrs = Server.CreateObject("ADODB.Recordset") qrs.open sqlstr,dataconn,1,3 'response.Write(sqlstr) Response.Write "" If id <> "" Then Response.Write " " Response.Write "" If not qrs.eof Then '循环输出显示字段单元格并将相应查询结果输入其中 For k = 1 to Ubound(DB_SFMEAN) If k mod 2 = 0 Then trcolor = "#F4F4F4" Else trcolor = "#FFFFFF" End If Response.Write "" Response.Write "" FeildVal = qrs(trim(DB_SFMEAN(k))) Response.Write "" Response.Write "" Next End If Else Response.Write " " For i = 1 to Ubound(DB_SFNAME) Response.Write "" Next Response.Write "" Response.Write "" If qrs.recordcount>0 Then '循环输出查询出的结果 For j = 1 to qrs.recordcount If j mod 2 = 0 Then trcolor = "#F4F4F4" Else trcolor = "#FFFFFF" End If Response.Write "" '循环输出显示字段单元格并将相应查询结果输入其中 For k = 1 to Ubound(DB_SFNAME) FeildVal = qrs(trim(DB_SFNAME(k))) FeildVal = CutStr(FeildVal,30) Response.Write "" Next Response.Write "" Response.Write "" qrs.movenext Next else '无查询结果输出提示说明 Response.Write "" Response.Write "" End If End If qrs.close dataconn.close Set qrs = nothing Set dataconn = nothing Response.Write "
" Response.Write "详细信息" Response.Write "
"&DB_SFMEAN(k)&"" Response.Write FeildVal Response.Write "
" Response.Write DB_SFNAME(i) Response.Write "" Response.Write "操作" Response.Write "
" Response.Write FeildVal Response.Write "" Response.Write "" Response.Write "
" Response.Write "没有查询到您所查询的相关信息" Response.Write "
" Response.End() End If '查询结果 '查询页输出开始 '接收外部数据库ID,根据此ID设置查询功能 '从主表中查询出查询标题 sql = "select * from DBInfo where DB_ID = "& DB_ID Set rs = LsObject.CreateRs(sql,1,1) If not rs.eof then queryTitle = rs("DB_TITLE") DB_INTRO = rs("DB_INTRO") End If rs.close Call DBConnEnd() '查询页面字符串初始化 str="" '从字段属性表中查询出各个字段名用于表单元素名,各个字段提示性文本 sql = "select * from QerFields where DB_ID = "&DB_ID Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount str = str&"
" str = str&"" str = str & "" str = str&"" If rscount > 0 Then If DB_INTRO <> "" Then str = str&" " str = str&"" End If For i = 1 to rscount str = str&"" str = str&"" str = str&"" rs.movenext Next End If rs.close Call DBConnEnd() str = str&"" str = str&"" str = str&"
"&queryTitle&"
" str = str&"查询须知:" str = str&"
"&replace(DB_INTRO,"\n","
")&"
" str = str&"
"&rs("Q_FSHOW")&"" str = str&"" If rs("Q_FISNULL") = 1 then str = str&"* " End If If rs("Q_FALERT") <>"" then str = str&" "&rs("Q_FALERT") End If str = str&"" str = str&"
" str = str&"" str = str&"" str = str&"" str = str&"
" response.Write(str) End Sub %> <% ' ============================================================================== ' 统计数据表格 '============================================================================== Sub CountForum2List() Response.Write "
" Set Conn = LsObject.CreateConn() '今日发贴 If DBType = 1 Then sql = "select Count(F_ID) as todayF_Count from Forum2 where F_Date=#"&Date&"#" Else sql = "select Count(F_ID) as todayF_Count from Forum2 where F_Date='"&Date&"'" End If set rs1 = conn.Execute(sql) todayF_Count = rs1("todayF_Count") If IsNull(todayF_Count) = True Then todayF_Count = 0 '昨日发贴 If DBType = 1 Then sql = "select Count(F_ID) as yesF_Count from Forum2 where F_Date=#"&Date-1&"#" Else sql = "select Count(F_ID) as yesF_Count from Forum2 where F_Date='"&Date-1&"'" End If set rs1 = conn.Execute(sql) yesF_Count = rs1("yesF_Count") If IsNull(yesF_Count) = True Then yesF_Count = 0 '所有发贴 sql = "select Count(F_ID) as allF_Count from Forum2" set rs1 = conn.Execute(sql) allF_Count = rs1("allF_Count") If IsNull(allF_Count) = True Then allF_Count = 0 '所有发贴 sql = "select Sum(F_Hit) as allF_Hit from Forum2" set rs1 = conn.Execute(sql) allF_Hit = rs1("allF_Hit") If IsNull(allF_Hit) = True Then allF_Hit = 0 conn.close nowtime = Time() If nowtime >= "0:00" and nowtime < "8:00" Then onlinebase =1 If nowtime >= "8:00" and nowtime < "10:00" Then onlinebase =15 If nowtime >= "10:00" and nowtime < "12:00" Then onlinebase =16 If nowtime >= "12:00" and nowtime < "14:00" Then onlinebase =12 If nowtime >= "14:00" and nowtime < "16:00" Then onlinebase =16 If nowtime >= "16:00" and nowtime < "18:00" Then onlinebase =14 If nowtime >= "18:00" and nowtime < "20:00" Then onlinebase =12 If nowtime >= "20:00" and nowtime < "22:00" Then onlinebase =16 If nowtime >= "22:00" and nowtime <= "23:59" Then onlinebase =7 Response.Write "
今日发贴: "& todayF_Count&" 篇
昨日发贴: "& yesF_Count&" 篇
发贴总数: "& allF_Count&" 
点击总数: "& allF_Hit&" 
" Response.Write "
" End Sub ' ====================================================================================================================== ' 红牌督办论坛贴子列表 ' ====================================================================================================================== Sub RedForumList(SS_ID,SS_Path,FieldIs,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,NameVis,HitVis) If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select F_ID,SS_ID,F_Title,F_Date,F_Time,F_Name,F_RevertCount" sql = sql & ",(select SS_URL from SiteStructure where Forum2.SS_ID=SiteStructure.SS_ID) As SS_URL" sql = sql & " from Forum2" sql = sql & " where PF_ID=0 and F_CheckIn<>0 and (F_RevertIS<>1 or F_RevertIS is null)" If DBType = 1 Then sql = sql & " and (datediff('d',Forum2.F_Date,'"&Date()&"')>10)" else sql = sql & " and (datediff(day,Forum2.F_Date,'"&Date()&"')>10)" end if sql = sql & " and Forum2.F_Title like '%]%'" If SS_ID <> "" Then sql = sql& " and SS_ID="&SS_ID If SS_Path <> "" Then sql = sql&" and SS_Path like '%"&SS_Path&"%'" sql = sql & " order by F_Date desc" 'Response.Write sql Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount Response.Write "" Response.Write "" Response.Write "
 " Response.Write "红牌督办贴 ["&rscount&"]" Response.Write "
" If rscount > 0 Then Response.write "" For i = 1 to rscount F_ID = rs("F_ID") SS_ID = rs("SS_ID") F_Title = rs("F_Title") F_Date = rs("F_Date") F_Time = rs("F_Time") F_Name = rs("F_Name") ' F_Hit = rs("F_Hit") SS_URL = rs("SS_URL") F_RevertCount = rs("F_RevertCount") 'F_ID,SS_ID,F_Title,F_Date,F_Time,F_Name,SS_URL,F_RevertCount mF_Date = Month(F_Date) dF_Date = Day(F_Date) If mF_Date < 10 Then mF_Date = "0" & mF_Date If dF_Date < 10 Then dF_Date = "0" & dF_Date Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or NameVis = 1 or HitVis = 1 Then Response.write "" End If Response.write "" LsObject.CreateConn().Execute("Update Forum2 Set RedForumNum=1,RedDate='"&Date()&"' where F_ID="&F_ID&"") rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then F_Title = CutStr(F_Title,NumWords*2) F_Title = Replace(Replace(F_Title,"[","["),"]","]") Response.write F_Title&"" If DateVis = 1 Then Response.write " "&mF_Date&"-"&dF_Date If TimeVis = 1 Then Response.write " "&F_Time If NameVis = 1 Then Response.write " "&F_Name If HitVis = 1 Then Response.write " "&F_Hit Response.write "
" Else rs.close Response.write "暂无内容" End If Response.Write "
" Set rs = Nothing End Sub ' ====================================================================================================================== ' 黄牌警示论坛贴子列表 ' ====================================================================================================================== Sub YellowForumList(SS_ID,SS_Path,FieldIs,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,NameVis,HitVis) If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select F_ID,SS_ID,F_Title,F_Date,F_Time,F_Name,F_RevertCount" sql = sql & ",(select SS_URL from SiteStructure where Forum2.SS_ID=SiteStructure.SS_ID) As SS_URL" sql = sql & " from Forum2" sql = sql & " where Forum2.PF_ID=0 and Forum2.F_CheckIn<>0 and (Forum2.F_RevertIS<>1 or Forum2.F_RevertIS is null)" If DBType = 1 Then sql = sql & " and (datediff('d',Forum2.F_Date,'"&Date()&"')>5 and datediff('d',Forum2.F_Date,'"&Date()&"')<10)" else sql = sql & " and (datediff(day,Forum2.F_Date,'"&Date()&"')>5 and datediff(day,Forum2.F_Date,'"&Date()&"')<10)" end if sql = sql & " and Forum2.F_Title like '%]%'" If SS_ID <> "" Then sql = sql& " and Forum2.SS_ID="&SS_ID If SS_Path <> "" Then sql = sql&" and Forum2.SS_Path like '%"&SS_Path&"%'" sql = sql&" order by Forum2.F_Date desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount Response.Write "" Response.Write "" Response.Write "
 " Response.Write "黄牌警示贴 ["&rscount&"]" Response.Write "
" If rscount > 0 Then Response.write "" For i = 1 to rscount F_ID = rs("F_ID") SS_ID = rs("SS_ID") F_Title = rs("F_Title") F_Date = rs("F_Date") F_Time = rs("F_Time") F_Name = rs("F_Name") ' F_Hit = rs("F_Hit") SS_URL = rs("SS_URL") F_RevertCount = rs("F_RevertCount") mF_Date = Month(F_Date) dF_Date = Day(F_Date) If mF_Date < 10 Then mF_Date = "0" & mF_Date If dF_Date < 10 Then dF_Date = "0" & dF_Date Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or NameVis = 1 or HitVis = 1 Then Response.write "" End If Response.write "" LsObject.CreateConn().Execute("Update Forum2 Set YellowForumNum=1,YellowDate='"&Date()&"' where F_ID="&F_ID&"") rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then F_Title = CutStr(F_Title,NumWords*2) F_Title = Replace(Replace(F_Title,"[","["),"]","]") Response.write F_Title&"" If DateVis = 1 Then Response.write " "&mF_Date&"-"&dF_Date If TimeVis = 1 Then Response.write " "&F_Time If NameVis = 1 Then Response.write " "&F_Name If HitVis = 1 Then Response.write " "&F_Hit Response.write "
" Else rs.close Response.write "暂无内容" End If Response.Write "
" Set rs = Nothing End Sub ' ============================================================================== ' 部门回复列表 '============================================================================== Sub Forum2BmhfList(SS_ID) Response.Write "
" sql = "select * from bmdfpm order by hfl desc,hf desc" set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount For i = 1 to rscount bm = rs("bm") ts = rs("ts") thf = rs("hf") thfl = rs("hfl") Response.write "" rs.movenext Next rs.close Set rs = Nothing Response.Write "
回复部门咨询回复回复率
"&bm&""&ts&""&thf&""&thfl&"%
" End Sub ' ============================================================================== ' 更新主题贴有几个未审核回复贴字段(用于后台排序) '============================================================================== Sub UpForumNote(F_ID) Set Conn = LsObject.CreateConn() sql = "select Count(F_ID) as F_Count from Forum2 where PF_ID=" & F_ID & " and F_CheckIn=0" Set rs = Conn.Execute(sql) F_Count = rs("F_Count") rs.close If IsNull(F_Count) Then F_Count = 0 sql = "update Forum2 set F_RevertNew="&F_Count&" where F_ID=" & F_ID Conn.Execute(sql) Conn.close End Sub ' ================================================================================== ' 首页调用论坛贴子列表 '================================================================================== Sub IndexForum2List(SS_ID,SS_Path,NumRow,NumCol,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,NameVis,HitVis) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" F_ID,SS_ID,F_Title,F_Date,F_Time,F_Name,F_Hit" sql = sql & ",(select SS_URL from SiteStructure where Forum2.SS_ID=SiteStructure.SS_ID) As SS_URL" sql = sql & " from Forum2" sql = sql & " where Forum2.PF_ID=0 and Forum2.F_CheckIn<>0" If SS_ID <> "" Then sql = sql& " and Forum2.SS_ID="&SS_ID If SS_Path <> "" Then sql = sql&" and Forum2.SS_Path like '%"&SS_Path&"%'" sql = sql&" order by Forum2.F_TopLock"&OType&",Forum2.F_Date desc,Forum2.F_Time desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRow Then rscount = NumRow If rscount > 0 Then Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") F_ID = rs("F_ID") F_Title = rs("F_Title") F_Date = rs("F_Date") F_Time = rs("F_Time") F_Name = rs("F_Name") F_Hit = rs("F_Hit") SS_URL = rs("SS_URL") mF_Date = Month(F_Date) dF_Date = Day(F_Date) If mF_Date < 10 Then mF_Date = "0" & mF_Date If dF_Date < 10 Then dF_Date = "0" & dF_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or NameVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then F_Title = CutStr(F_Title,NumWords*2) Response.write F_Title&"" If DateVis = 1 Then Response.write " "&mF_Date&"-"&dF_Date If TimeVis = 1 Then Response.write " "&F_Time If NameVis = 1 Then Response.write " "&F_Name If HitVis = 1 Then Response.write " "&F_Hit Response.write "
" Else rs.close Response.write "暂无内容" End If End Sub ' ================================================================= ' 首页调用论坛贴子列表 '================================================================= Sub IndexForum2List1(SS_ID,SS_Path,FieldIs,NumRow,NumCol,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,NameVis,HitVis) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" Forum2.*,SiteStructure.SS_URL As SS_URL from Forum2" sql = sql&" inner join SiteStructure On SiteStructure.SS_ID=Forum2.SS_ID" sql = sql&" where Forum2.PF_ID=0 and Forum2.F_CheckIn<>0 and Forum2.F_Vouch<>0 " If SS_ID <> "" Then sql = sql& " and Forum2.SS_ID="&SS_ID If SS_Path <> "" Then sql = sql&" and Forum2.SS_Path like '%"&SS_Path&"%'" sql = sql&" order by Forum2.F_Hit desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRow Then rscount = NumRow If rscount > 0 Then Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") F_ID = rs("F_ID") F_Title = rs("F_Title") F_Date = rs("F_Date") F_Time = rs("F_Time") F_Name = rs("F_Name") F_Hit = rs("F_Hit") SS_URL = rs("SS_URL") mF_Date = Month(F_Date) dF_Date = Day(F_Date) If mF_Date < 10 Then mF_Date = "0" & mF_Date If dF_Date < 10 Then dF_Date = "0" & dF_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or NameVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then F_Title = CutStr(F_Title,NumWords*2) F_Title = Replace(Replace(F_Title,"[","["),"]","]") Response.write F_Title&"" If DateVis = 1 Then Response.write " "&mF_Date&"-"&dF_Date If TimeVis = 1 Then Response.write " "&F_Time If NameVis = 1 Then Response.write " "&F_Name If HitVis = 1 Then Response.write " "&F_Hit Response.write "
" Else rs.close Response.write "暂无内容" End If End Sub ' ======================================================================= ' 首页调用点击数高的贴子列表 ' ======================================================================= Sub IndexForum2List2(SS_ID,SS_Path,FieldIs,NumRow,NumCol,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,NameVis,HitVis) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" Forum2.*,SiteStructure.SS_URL As SS_URL from Forum2" sql = sql&" inner join SiteStructure On SiteStructure.SS_ID=Forum2.SS_ID" If DBType = 1 Then sql = sql&" where Forum2.PF_ID=0 and Forum2.F_CheckIn<>0 and Forum2.F_Date>=#"&Year(Date())&"-"&Month(Date())&"-1"&"#" ELSE sql = sql&" where Forum2.PF_ID=0 and Forum2.F_CheckIn<>0 and Forum2.F_Date>='"&Year(Date())&"-"&Month(Date())&"-1"&"'" END IF If SS_ID <> "" Then sql = sql& " and Forum2.SS_ID="&SS_ID If SS_Path <> "" Then sql = sql&" and Forum2.SS_Path like '%"&SS_Path&"%'" sql = sql&" order by Forum2.F_Hit desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRow Then rscount = NumRow If rscount > 0 Then Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") F_ID = rs("F_ID") F_Title = rs("F_Title") F_Date = rs("F_Date") F_Time = rs("F_Time") F_Name = rs("F_Name") ' F_Hit = rs("F_Hit") SS_URL = rs("SS_URL") F_RevertCount = rs("F_RevertCount") mF_Date = Month(F_Date) dF_Date = Day(F_Date) If mF_Date < 10 Then mF_Date = "0" & mF_Date If dF_Date < 10 Then dF_Date = "0" & dF_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" 'If DateVis = 1 or TimeVis = 1 or NameVis = 1 or HitVis = 1 Then Response.write "" 'End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then F_Title = CutStr(F_Title,NumWords*2) F_Title = Replace(Replace(F_Title,"[","["),"]","]") Response.write F_Title&"" If DateVis = 1 Then Response.write " "&mF_Date&"-"&dF_Date If TimeVis = 1 Then Response.write " "&F_Time If NameVis = 1 Then Response.write " "&F_Name Response.write " "&F_Hit Response.write "
" Else rs.close Response.write "暂无内容" End If End Sub Sub IndexForum2List3(SS_ID,SS_Path,NumRow,NumCol,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,NameVis,HitVis) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" Forum2.*,SiteStructure.SS_URL As SS_URL from Forum2" sql = sql&" inner join SiteStructure On SiteStructure.SS_ID=Forum2.SS_ID" sql = sql&" where Forum2.PF_ID=0 and Forum2.F_CheckIn<>0 and Forum2.F_RevertIS<>0" 'If SS_ID <> "" Then sql = sql& " and Forum2.SS_ID="&SS_ID If SS_Path <> "" Then sql = sql&" and Forum2.SS_Path like '%"&SS_Path&"%'" sql = sql&" order by Forum2.F_TopLock"&OType&",Forum2.F_LastDate desc,Forum2.F_LastTime desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount > NumRow Then rscount = NumRow If rscount > 0 Then Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") F_ID = rs("F_ID") F_Title = rs("F_Title") F_Date = rs("F_LastDate") F_Time = rs("F_Time") F_Name = rs("F_Name") F_Hit = rs("F_Hit") SS_URL = rs("SS_URL") mF_Date = Month(F_Date) dF_Date = Day(F_Date) If mF_Date < 10 Then mF_Date = "0" & mF_Date If dF_Date < 10 Then dF_Date = "0" & dF_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or NameVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then F_Title = CutStr(F_Title,NumWords*2) Response.write F_Title&"" If DateVis = 1 Then Response.write " "&mF_Date&"-"&dF_Date If TimeVis = 1 Then Response.write " "&F_Time If NameVis = 1 Then Response.write " "&F_Name If HitVis = 1 Then Response.write " "&F_Hit Response.write "
" Else rs.close Response.write "暂无内容" End If End Sub Sub IndexForum2List4(SS_ID,SS_Path,NumRow,NumCol,TrHig,ItemIcon,ItemWid,TitleWid,NumWords,DateVis,TimeVis,NameVis,HitVis) NumTr = NumRow * NumCol If IsNumeric(NumTr) = False Then Exit Sub If SS_ID = "" and SS_Path = "" Then Exit Sub sql = "select top "&NumTr&" Forum2.*,SiteStructure.SS_URL As SS_URL from Forum2" sql = sql&" inner join SiteStructure On SiteStructure.SS_ID=Forum2.SS_ID" sql = sql&" where Forum2.PF_ID=0 and Forum2.F_CheckIn<>0 " If SS_ID <> "" Then sql = sql& " and Forum2.SS_ID="&SS_ID 'If SS_Path <> "" Then sql = sql&" and Forum2.SS_Path like '%"&SS_Path&"%'" sql = sql&" order by Forum2.F_TopLock"&OType&",Forum2.F_LastDate desc,Forum2.F_LastTime desc" Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount 'if Request.QueryString("tt")="tt" then Response.Write(sql) ' Response.End() If rscount > NumRow Then rscount = NumRow If rscount > 0 Then Response.write "" For i = 1 to rscount SS_ID = rs("SS_ID") F_ID = rs("F_ID") F_Title = rs("F_Title") F_Date = rs("F_LastDate") F_Time = rs("F_Time") F_Name = rs("F_Name") F_Hit = rs("F_Hit") SS_URL = rs("SS_URL") mF_Date = Month(F_Date) dF_Date = Day(F_Date) If mF_Date < 10 Then mF_Date = "0" & mF_Date If dF_Date < 10 Then dF_Date = "0" & dF_Date If i mod NumCol = 1 or NumCol = 1 Then Response.write "" If ItemIcon <> "" Then Response.write "" Response.write "" If DateVis = 1 or TimeVis = 1 or NameVis = 1 or HitVis = 1 Then Response.write "" End If If i mod NumCol = 0 Then Response.write "" rs.movenext Next rs.close Response.write "
" Response.write "" If NumWords > 0 Then F_Title = CutStr(F_Title,NumWords*2) Response.write F_Title&"" If DateVis = 1 Then Response.write " "&mF_Date&"-"&dF_Date If TimeVis = 1 Then Response.write " "&F_Time If NameVis = 1 Then Response.write " "&F_Name If HitVis = 1 Then Response.write " "&F_Hit Response.write "
" Else rs.close Response.write "暂无内容" End If End Sub ' ====================================================================================================================== ' 栏目页论坛分类帖子列表 ' ====================================================================================================================== Sub Forum2List(PerNumRow,TbBdCor,ThBgCor,TrBgCor,ForumID,CheckIn,MemberIS,MemberSSID) sType = GetSafeStr(Trim(Request.QueryString("sType"))) if sType<>"" then Call ForumList_20100701(PerNumRow,TbBdCor,ThBgCor,TrBgCor,ForumID,CheckIn,MemberIS,MemberSSID) else if GetSafeStr(request.QueryString("action"))="zuori" or GetSafeStr(request.QueryString("action"))="jinri"then thisdate=date() zuotime=DateAdd("d",-1,thisdate) ssss="昨日" if request.QueryString("action")="jinri" then zuotime=thisdate ssss="今日" end if response.Write("
") sql = "select F_ID,SS_ID,F_Title,F_Name,F_FaceImage,F_Date,F_Time,F_Hit,F_RevertCount,F_LastName" sql = sql & ",F_LastDate,F_LastTime,F_RevertIS,F_TitleColor from Forum2 where 1=1 " If DBType = 1 Then sql = sql & " and F_Date=#"&zuotime&"#" else sql = sql & " and F_Date='"&zuotime&"'" end if sql = sql & " and PF_ID=0 and F_CheckIn<>0" sql = sql & " order by F_LastDate desc,F_LastTime desc" 'response.Write(sql) Set rs = LsObject.CreateRs(sql,1,1) rscount = rs.recordcount If rscount = 0 Then rs.close Response.write "
  新帖暂无内容" else linkpar ="&SS_ID="&NowSSID&"&tF_Title="&server.URLEncode(Request.QueryString("tF_Title"))&"&tp="&server.URLEncode("bt") mypage = GetSafeStr(Request("whichpage")) If mypage = "" or IsNumeric(mypage) = False Then mypage = 1 mypage = CInt(mypage) If mypage < 1 Then mypage = 1 mypagesize = CInt(1000) rs.PageSize = mypagesize maxcount = rs.pageCount If mypage > maxcount Then mypage = maxcount rs.Absolutepage = mypage If rscount > 0 Then Response.write ""&chr(13)&chr(10) Response.write "
" response.Write("
 "&ssss&"("&zuotime&")新帖
") Response.write "" Response.write "" Response.write "" j
表情主 题网名最后回复人 气