📄 qqcf_myfunction.asp

📁 动态自定义报表,真正的中国式报表,可自行编辑
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
 ClassTopCode=Replace(ClassTopCode,"|folderpath|","../")
 
 ClassBottomCode=FSOFileRead("qqcf_mb/qqcf_bottom.htm")
 ClassBottomCode=Replace(ClassBottomCode,"|folderpath|","../")

  
 ClassNameCode=GetClassName(ClassID)

 ClassMenuCode=GetClassMenu(ClassID)

 ClassXjCode=GetClassXJ(ClassID)

 ClassUrlCode=GetClassUrl(ClassID)

 ClassCode=Replace(ClassCode,"|classname|",ClassNameCode)
 ClassCode=Replace(ClassCode,"|classtop|",ClassTopCode)
 ClassCode=Replace(ClassCode,"|classbottom|",ClassBottomCode)
 ClassCode=Replace(ClassCode,"|classmenu|",ClassMenuCode)
 ClassCode=Replace(ClassCode,"|classxj|",ClassXjCode)
 ClassCode=Replace(ClassCode,"|classurl|",ClassUrlCode)
 
 FilePath="list/list_"&ClassID&".htm"
 Set fso = Server.CreateObject("Scripting.FileSystemObject")
 Set fout = fso.Createtextfile(server.mappath(FilePath),true)
 Fout.WriteLine ClassCode
 Fout.Close

 If WebsiteUpdate=1 And (RsSet("UrlHtm")=-1 Or Application("UrlHtm")=-1) Then
  Set RsClassWebSite=Server.CreateObject("ADODB.RecordSet")
  Sql="Select ID From WWW_QQCF_COM_CFWZ_WebSite Where ClassID="&ClassID
  RsClassWebSite.Open Sql,Conn,1,1
  While Not RsClassWebSite.Eof
   Call WebSiteGx(RsClassWebSite("ID"))
  RsClassWebSite.MoveNext
  Wend
  RsClassWebSite.Close
 End If
  
End Function


Function WebSiteGx(ByVal ID)
 If RsSet("UrlHtm")=-1 Or Application("UrlHtm")=-1 Then
  Set RsWebSite=Server.CreateObject("ADODB.RecordSet")
  Sql="Select Title,Url From WWW_QQCF_COM_CFWZ_WebSite Where ID="&ID
  RsWebSite.Open Sql,Conn,1,1
   Mystr="<iframe src=../cf.asp?id="&ID&" frameBorder=0 width=0 height=0 marginheight=0 marginwidth=0 scrolling=no></iframe>"
   Mystr=Mystr&"<html>"
   Mystr=Mystr&"<head>"
   Mystr=Mystr&"<title>"&RsWebSite("Title")&"</title>"
   Mystr=Mystr&"<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
   Mystr=Mystr&"<META HTTP-EQUIV=""Refresh"" CONTENT=""0;URL="&RsWebSite("Url")&""">"
   Mystr=Mystr&"</head>"
   Mystr=Mystr&"<body topmargin=""0"" leftmargin=""0"">"
   Mystr=Mystr&"</body>"
  RsWebSite.Close
  
   FilePath="go/go_"&ID&".htm"
   Set fso = Server.CreateObject("Scripting.FileSystemObject")
   Set fout = fso.Createtextfile(server.mappath(FilePath),true)
   Fout.WriteLine Mystr
   Fout.Close 
  End If
End Function

Function GetIndexClass()
MyStr="<table border=0 width=100% cellspacing=0 cellpadding=2>"

Sql="select * from WWW_QQCF_COM_CFWZ_Class where state=-1"
set RsIndexClass=server.createobject("adodb.recordset")
RsIndexClass.open Sql,conn,1,1
jishu=1
while not RsIndexClass.eof
	if jishu=1 or jishu mod 8 = 1 then
		if int(jishu/8) mod 2 = 0 then
		 MyStr= MyStr&"<tr height='20'  bgcolor='#E6FAFF'><td width='72' align='center'>&brvbar;&nbsp;"
		 MyStr=MyStr&"<a href='list/list_"&RsIndexClass("ClassID")&".htm'>"&RsIndexClass("classname")&"</a></td>"
		else
		 MyStr=MyStr& "<tr height='20' bgcolor='#CEF5FF'><td width='72' align='center'>&brvbar;&nbsp;"
		 MyStr=MyStr&"<a href='list/list_"&RsIndexClass("ClassID")&".htm'>"&RsIndexClass("classname")&"</a></td>"
		end if
	else
		MyStr=MyStr& "<td width='72' align='left'>&brvbar;&nbsp; "
		MyStr=MyStr&"<a href='list/list_"&RsIndexClass("ClassID")&".htm'>"&RsIndexClass("classname")&"</a></td>"
	end if
	if jishu mod 8=0 then MyStr=MyStr& "</tr>"
	jishu=jishu+1
	RsIndexClass.movenext
wend

jishu=jishu-1

if jishu mod 8 <> 0 then

for i= 1 to 8-(jishu mod 8)
	MyStr=MyStr& "<td width='"&tdwidth&"'　align='left'>&nbsp;</td>"
	if  i = 8-(jishu mod 8) then MyStr=MyStr& "</tr>"
next
end if '判断最后一行tr是否正好闭合,否则增加td,里面填入空格

MyStr=MyStr& "</table>"

RsIndexClass.Close

GetIndexClass=MyStr
End Function

Function GetClassName(ByVal ClassID)
 Set RsClassName=Server.CreateObject("ADODB.RecordSet")
 Sql="Select * From WWW_QQCF_COM_CFWZ_Class Where ClassID="&ClassID
 RsClassName.Open Sql,Conn,1,1
 GetClassName=RsClassName("ClassName")
 RsClassName.Close
End Function

Function GetClassMenu(ByVal ClassID)

Set RsClassMenu=Server.CreateObject("ADODB.RecordSet")
Sql="Select * From WWW_QQCF_COM_CFWZ_Class Where ClassID="&ClassID
RsClassMenu.Open Sql,Conn,1,1


If RsClassMenu("UpID")=0 Then
 ClassMenu="＞"&RsClassMenu("ClassName")
Else
 Sql="Select * From WWW_QQCF_COM_CFWZ_Class Where ClassID="&RsClassMenu("UpID")
 Set RsClassMenu2=Server.CreateObject("Adodb.RecordSet")
 RsClassMenu2.Open Sql,Conn,1,1
 ClassMenu="＞<a href='list_"&RsClassMenu2("ClassID")&".htm'>"&RsClassMenu2("ClassName")&"</a>＞"&RsClassMenu("ClassName")
 RsClassMenu2.Close
End If

RsClassMenu.Close


GetClassMenu="<b><font color=#424242>上网导航：</font><a href='../' class='title'>首页</a>"&ClassMenu&"</b>"

End Function

Function GetClassXJ(ByVal ClassID)
Mystr="本分类的下级分类：</b>"

Sql="Select * From WWW_QQCF_COM_CFWZ_Class where UpID="&ClassID
Set RsClassXJ = Server.CreateObject("ADODB.Recordset")
RsClassXJ.open sql,conn,1,1
If RsClassXJ.Eof And RsClassXJ.Bof Then Mystr=Mystr& "****无下级分类***"


Mystr=Mystr&"<table width=98% border=0 align=center cellpadding=0 cellspacing=0>"

linenum=4
tdwidth=int(100/linenum)&"%"
jishu=1
while not RsClassXJ.eof
if jishu mod linenum=1 or linenum=1 then
Mystr=Mystr& "<tr>"
end if
Mystr=Mystr&"<td valign=top width="&tdwidth&"> "
Mystr=Mystr&"<a href='#"&RsClassXJ("ClassID")&"'><Font color=#FF0000><b>"&RsClassXJ("ClassName")&"</b></Font></a></td>"

if jishu mod linenum=0 then
 Mystr=Mystr& "</tr>"
end if
jishu=jishu+1
RsClassXJ.movenext
wend

jishu=jishu-1
if jishu mod linenum <> 0 then
for i= 1 to linenum-(jishu mod linenum)
	Mystr=Mystr& "<td width='"&tdwidth&"'>&nbsp;</td>"
	if  i = linenum-(jishu mod linenum) then Mystr=Mystr& "</tr>"
next
end if

Mystr=Mystr&"</table>"
RsClassXJ.Close
GetClassXJ=Mystr

End Function

Function GetClassUrl(Byval ClassID)

Sql="Select * From WWW_QQCF_COM_CFWZ_Class Where ClassID="&ClassID&" And State=-1 Order By ListID"
Set RsClass=Server.CreateObject("Adodb.RecordSet")
RsClass.Open Sql,Conn,1,1

MyStr= MyStr&"<table bgcolor='#FFFFEC' bordercolorlight='#FF9933' border=1 cellspacing=0 cellpadding=3 bordercolordark='#FFFFFF' width=780 align='center'>"

If RsClass("Menu")=0 Then
 Sql="Select * From WWW_QQCF_COM_CFWZ_WebSite Where ClassID="&ClassID&" And State=-1 Order By ListID"
 Set RsClassUrl=Server.CreateObject("Adodb.RecordSet")
 RsClassUrl.Open Sql,Conn,1,1

 MyStr= MyStr&"<tr><td align=center vAlign=center width=700 colspan=4 bgcolor=#FFFFCC style='font-size: 14px; color: #FF0000'>"&RsClass("classname")&"</TD></tr>"

 jishu=1
 while not RsClassUrl.eof
	if jishu=1 or jishu mod 4 = 1 then
	  If RsSet("UrlHtm")=-1 Or Application("UrlHtm")=-1 Then
		MyStr= MyStr&"<tr><td width='25%' height='20'><a href='../go/go_"&RsClassUrl("id")&".htm' target='_blank'>"&RsClassUrl("title")&"</a></td>"
      Else
	    MyStr= MyStr&"<tr><td width='25%' height='20'><a href='../go.asp?id="&RsClassUrl("id")&"&url="&RsClassUrl("Url")&"' target='_blank'>"&RsClassUrl("title")&"</a></td>"
	  End If
	else
	  If RsSet("UrlHtm")=-1 Or Application("UrlHtm")=-1 Then
		MyStr= MyStr&"<td width='25%' height='20'><a href='../go/go_"&RsClassUrl("id")&".htm' target='_blank'>"&RsClassUrl("title")&"</a></td>"
	  Else
	    MyStr= MyStr&"<td width='25%' height='20'><a href='../go.asp?id="&RsClassUrl("id")&"&url="&RsClassUrl("Url")&"' target='_blank'>"&RsClassUrl("title")&"</a></td>"
	  End If
	end if
	if jishu mod 4 =0  then MyStr=MyStr&"</tr>"
	jishu=jishu+1
	RsClassUrl.movenext
 wend

 jishu=jishu-1
 if jishu mod 4 <> 0 then
  for i= 1 to 4-(jishu mod 4)
	MyStr=MyStr& "<td width='25%'>&nbsp;</td>"
	if  i = 4-(jishu mod 4) then MyStr=MyStr& "</tr>"
  next
 end if
End If


If RsClass("Menu")=-1 Then
 Sql="Select * From WWW_QQCF_COM_CFWZ_Class Where UpID="&ClassID&" And State=-1 Order By ListID"
 Set RsClass_2=Server.CreateObject("Adodb.RecordSet")
 RsClass_2.Open Sql,Conn,1,1

 While Not RsClass_2.Eof
  Sql="Select * From WWW_QQCF_COM_CFWZ_WebSite Where ClassID="&RsClass_2("ClassID")&" And State=-1 Order By ListID"
  Set RsClassUrl=Server.CreateObject("Adodb.RecordSet")
  RsClassUrl.Open Sql,Conn,1,1

  MyStr= MyStr&"<tr><td align=center vAlign=center width=700 colspan=4 bgcolor=#FFFFCC style='font-size: 14px; color: #FF0000'>"&RsClass_2("classname")&"<a name='"&RsClass_2("ClassID")&"'></a>&nbsp;&nbsp;<a href='#'>返回页首↑</a></TD></tr>"

  jishu=1
  while not RsClassUrl.eof
	if jishu=1 or jishu mod 4 = 1 then
	  If RsSet("UrlHtm")=-1 Or Application("UrlHtm")=-1 Then
		MyStr= MyStr&"<tr><td width='25%' height='20'><a href='../go/go_"&RsClassUrl("id")&".htm' target='_blank'>"&RsClassUrl("title")&"</a></td>"
      Else
	    MyStr= MyStr&"<tr><td width='25%' height='20'><a href='../go.asp?id="&RsClassUrl("id")&"&url="&RsClassUrl("Url")&"' target='_blank'>"&RsClassUrl("title")&"</a></td>"
	  End If
    else
	  If RsSet("UrlHtm")=-1 Or Application("UrlHtm")=-1 Then
		MyStr= MyStr&"<td width='25%' height='20'><a href='../go/go_"&RsClassUrl("id")&".htm' target='_blank'>"&RsClassUrl("title")&"</a></td>"
	  Else
	    MyStr= MyStr&"<td width='25%' height='20'><a href='../go.asp?id="&RsClassUrl("id")&"&url="&RsClassUrl("Url")&"' target='_blank'>"&RsClassUrl("title")&"</a></td>"
	  End If
	end if
	if jishu mod 4 =0  then MyStr=MyStr&"</tr>"
	jishu=jishu+1
	RsClassUrl.movenext
   wend

   jishu=jishu-1
  if jishu mod 4 <> 0 then
   for i= 1 to 4-(jishu mod 4)
	MyStr=MyStr& "<td width='25%'>&nbsp;</td>"
	if  i = 4-(jishu mod 4) then MyStr=MyStr& "</tr>"
   next
  end if
  
  RsClass_2.MoveNext
  Wend
 End If

Mystr=Mystr&"</table>"

GetClassUrl=MyStr
End Function
%>
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -