cl_function_collect.asp

正版创力4.1SQL商业版!!!ASP版。

<%
'========================================
'	Edit by GDWneo
'	Last modify at 9:22 2007-9-6
'========================================
'==================================================
'过程名：ShowChannel_Name
'作  用：显示频道名称
'参  数：ChannelID ------频道ID
'==================================================
Function ShowChannel_Name(ChannelID)
	Dim Sqlc,Rsc,Tempstr
	ChannelID=Clng(ChannelID)
	Sqlc ="select Top 1 ChannelName From Cl_Channel Where ChannelID=" & ChannelID	
	Set Rsc=Cl.execute(sqlc)
	If Rsc.eof And Rsc.bof Then
		Tempstr="无指定频道"	
	Else
		Tempstr=Rsc("ChannelName")
	End If
	Rsc.Close : Set Rsc=Nothing
	ShowChannel_Name=Tempstr
End Function
'==================================================
'过程名：ShowClass_Name
'作  用：显示栏目名称
'参  数：ChannelID ------频道ID
'参  数：ClassID ------栏目ID
'==================================================
Function ShowClass_Name(ChannelID,ClassID)	
	Dim Sqlc,Rsc,Tempstr
	ChannelID=Clng(ChannelID)
	ClassID=Clng(ClassID)
	Sqlc ="select Top 1 ClassName From Cl_Class Where ChannelID=" & ChannelID & " And ClassID=" & ClassID	
	Set Rsc=Cl.execute(sqlc)
	If Rsc.eof And Rsc.bof Then	
		Tempstr="无指定栏目"	
	Else
		Tempstr=Rsc("ClassName")
	End If	
	Rsc.Close : Set Rsc=Nothing
	ShowClass_Name=Tempstr
End Function 

'==================================================
'过程名：ShowSpecial_Name
'作  用：显示专题名称
'参  数：ChannelID ------频道ID
'参  数：SpecialID ------专题ID
'==================================================
Function ShowSpecial_Name(ChannelID,SpecialID)	
	Dim Sqlc,Rsc,Tempstr
	ChannelID=Clng(ChannelID)
	If SpecialID="" Then
		ShowSpecial_Name="<Option>无指定专题</Option>"
		Exit Function
	End If
	Tempstr=""
	Sqlc ="select SpecialName From Cl_Special Where SpecialID In ("& SpecialID &")"
	Set Rsc=Cl.execute(sqlc)
	If Rsc.eof And Rsc.bof Then
		Tempstr="<Option>无指定专题</Option>"
	Else
		Do While Not Rsc.eof
			Tempstr=Tempstr&"<Option>"&Rsc("SpecialName")&"</Option>"
			Rsc.movenext
		Loop
	End If
	Rsc.Close : Set Rsc=Nothing
	ShowSpecial_Name=Tempstr
End Function
'==================================================
'过程名：ShowChannel_Option
'作  用：显示频道选项
'参  数：ChannelID ------频道ID
'参  数：ModuleID ------模块ID
'==================================================
Function ShowChannel_Option(ModuleID,ChannelID)
	Dim Sqlc,Rsc,ChannelName,Tempstr
	ChannelID=Clng(ChannelID)
	ModuleID=Clng(ModuleID)
	If ModuleID=0 Then
		Sqlc ="select ChannelID,ChannelName From Cl_Channel Where ChannelID>0 And ChannelID<>6 And Channeltype<2"
	Else
		Sqlc ="select ChannelID,ChannelName From Cl_Channel Where ChannelID>0 And ChannelID<>6 And Channeltype<2 And ModuleID="& ModuleID
	End If
	Set Rsc=Cl.execute(sqlc)
	Tempstr="<Option Value=""0"">请选择频道</Option>"
	If Rsc.eof And Rsc.bof Then
		Tempstr=Tempstr & "<Option Value=""0"">请添加频道</Option>"
	Else
		Do While Not Rsc.eof
			Tempstr=Tempstr & "<Option Value=" & """" & Rsc("ChannelID") & """" & ""
			If ChannelID=Rsc("ChannelID") Then
				Tempstr=Tempstr & " Selected"
			End If
			Tempstr=Tempstr & ">" & Rsc("ChannelName")
			Tempstr=Tempstr & "</Option>"
		Rsc.movenext
		Loop
	End If
	Rsc.Close
	Set Rsc=Nothing	
	ShowChannel_Option=Tempstr
End Function

'==================================================
'过程名：setChannel
'作  用：动态频道菜单
'参  数：ModuleID ------模块ID
'==================================================
Sub SetChannel(ModuleID)
Dim Arr_Channel,i_Channel,i_Class,i_Special,tmpDepth,i
Dim ClassID,ClassName,SpecialID,SpecialName
if ModuleID=0 Then
	Sql = "select ChannelID from Cl_Channel where ChannelID>=1 and ChannelID<>6 and ChannelType<2"
else
	Sql = "select ChannelID from Cl_Channel where ChannelID>=1 and ChannelID<>6 and ChannelType<2 and ModuleID=" & Cint(ModuleID)
end if
Set Rs=Cl.Execute(Sql)
If Not Rs.Eof Then:Arr_Channel=Rs.GetRows(-1)
Rs.Close:Set Rs=Nothing

If IsArray(Arr_Channel)= True then
	i_Class=0
	i_Special=0
	For i=0 To Ubound(ArrShowLine)
		ArrShowLine(i)=False
	Next
%>
<script language="JavaScript" type="text/javascript">
var count_class;
var count_special;
arr_class = new Array();
arr_special= new Array();
<%
	For i_Channel=0 To Ubound(Arr_Channel,2)
	Sql = "select * from Cl_Class where ChannelID=" & Arr_Channel(0,i_Channel) & " order by RootID,OrderID"
	Set Rs=Cl.execute(Sql)
%>
arr_class[<%=i_Class%>] = new Array("<%=Arr_Channel(0,i_Channel)%>","0","请选择栏目");
<%
	i_Class=i_Class+1
	If Not Rs.Eof Then
		Do While Not Rs.Eof
		ClassName="" 
		tmpDepth=Rs("Depth")
		If Rs("NextID")>0 then
			ArrShowLine(tmpDepth)=True
		Else
			ArrShowLine(tmpDepth)=False
		End if
		If Rs("Child")>0 or Rs("IsOuter")=1 then
			ClassID=0
		Else
			ClassID=Rs("ClassID")
		End If
		If TmpDepth>0 then
			For i=1 To TmpDepth
				If i=TmpDepth then
				If Rs("NextID")>0 then
					ClassName=ClassName & " ├ "
				Else
					ClassName=ClassName & "  └ "
				End If
				Else
					If ArrShowLine(i)=True then
						ClassName=ClassName & "│"
					Else
						ClassName=ClassName & "  "
					End If
				End if
			Next
		End if
		ClassName=ClassName & Rs("ClassName")
		If Rs("IsOuter")=1 then
			ClassName=ClassName & "(外)"
		End If
%>
arr_class[<%=i_Class%>] = new Array("<%=Arr_Channel(0,i_Channel)%>","<%=ClassID%>","<%=ClassName%>");
<%
		i_Class = i_Class + 1
		Rs.MoveNext
		Loop
	End if
	Rs.Close:Set Rs=Nothing

	Sql = "select SpecialID,SpecialName from Cl_Special where ChannelID=" & Arr_Channel(0,i_Channel) & " order by SpecialID"
	Set Rs=Cl.execute(Sql)
%>
arr_special[<%=i_Special%>] = new Array("<%=Arr_Channel(0,i_Channel)%>","0","不属于任何专题");
<%
	i_Special=i_Special+1
	If Not Rs.Eof then
		Do While Not Rs.Eof
%>
arr_special[<%=i_Special%>] = new Array("<%=Arr_Channel(0,i_Channel)%>","<%=Rs("SpecialID")%>","<%=Rs("SpecialName")%>");
<% 
		i_Special=i_Special + 1
		Rs.MoveNext
		Loop
	End if
	Rs.Close:Set Rs=Nothing  
	Next
%>
count_class=<%=i_Class%>;
count_special=<%=i_Special%>;

function changelocation(locationid)
	{
	document.myform.ClassID.length = 0; 
	document.myform.SpecialID.length = 0;
	var locationid=locationid;
	var i;
	for (i=0;i < count_class; i++)
		{
		if (arr_class[i][0] == locationid)
		{ 
			document.myform.ClassID.options[document.myform.ClassID.length] = new Option(arr_class[i][2], arr_class[i][1]);
		}		
		}
	for (i=0;i < count_special; i++)
		{
		if (arr_special[i][0] == locationid)
		{ 
			document.myform.SpecialID.options[document.myform.SpecialID.length] = new Option(arr_special[i][2], arr_special[i][1]);
		}		
		}
	}	
</script>
<%
End if
End sub

'==================================================
'过程名：Showitem_Name
'作  用：显示项目名称
'参  数：ItemID ------项目ID
'==================================================
Function Showitem_Name(ItemID)
	Dim Sqlc,Rsc,Tempstr
	ItemID=Clng(ItemID)
	Sqlc ="select Top 1 ItemName From Item Where ItemID=" & ItemID
	Set Rsc=server.createobject("adodb.recordset")
	Rsc.open Sqlc,Conn_C,1,1
	If Rsc.eof And Rsc.bof Then
		Tempstr="无指定项目"
	Else
		Tempstr=Rsc("itemName")
	End If
	Rsc.Close : Set Rsc=Nothing
	Showitem_Name=Tempstr
End Function

'==================================================
'过程名：Showitem_Option
'作  用：显示项目选项
'参  数：ItemID ------项目ID
'	sType	------类型
'==================================================
Function Showitem_Option(ItemID,sType)
	Dim Sqli,rsi,Tempstr
	ItemID=Clng(ItemID)
	If sType="" Or sType=0 Then
		Sqli ="select ItemID,itemName From Item Order By ItemID Desc"
	Else
		Sqli ="select ItemID,itemName From Item Where ModuleID="& sType &" Order By ItemID Desc"
	End If
	Set Rsi=server.createobject("adodb.recordset")
	Rsi.open Sqli,Conn_C,1,1
	Tempstr="<select Name=""ItemID"" ID=""ItemID"">"
	If Rsi.eof And Rsi.bof Then
		Tempstr=Tempstr & "<Option Value=""0"">请添加项目</Option>"
	Else
		Tempstr=Tempstr & "<Option Value=""0"">请选择项目</Option>"
		Do While Not Rsi.eof
			Tempstr=Tempstr & "<Option Value=" & """" & Rsi("ItemID") & """" & ""
			If ItemID=rsi("ItemID") Then
				Tempstr=Tempstr & " Selected"
			End If
			Tempstr=Tempstr & ">" & Rsi("itemName")
			Tempstr=Tempstr & "</Option>"
		Rsi.movenext
		Loop
	End If
	Rsi.Close
	Set Rsi=Nothing	
	Tempstr=Tempstr & "</select>"
	Showitem_Option=Tempstr
End Function

'*************************************************************************************
'函数名:GetInfoID
'作  用:生成文章,图片或下载等的唯一ID
'参  数:ModuleID--模块ID
'*************************************************************************************
Function GetInfoID(ModuleID)
	Dim MaxaID,tableNamestr
	Select Case ModuleID
	Case 1
		TableNamestr = "select Max(InfoID) From Cl_article"
	Case 2
		TableNamestr = "select Max(InfoID) From Cl_soft"
	Case 3
		TableNamestr = "select Max(InfoID) From Cl_Photo"
	Case 4
		TableNamestr = "select Max(InfoID) From Cl_movie"
	End Select
	MaxaID=Cl.execute(tableNamestr)(0)
	If Isnull(maxaID) Or Not Isnumeric(maxaID) Then MaxaID=0
	GetInfoID=maxaID+1
End Function

'==================================================
'函数名：definiteurl
'作  用：将相对地址转换为绝对地址
'参  数：primitiveurl ------要转换的相对地址
'参  数：consulturl ------当前网页地址
'==================================================
Function Definiteurl(byval Primitiveurl,byval Consulturl)
	Dim Contemp,pritemp,pi,ci,priarray,conarray
	If Primitiveurl="" Or Consulturl="" Or Primitiveurl="$False$" Or Consulturl="$False$" Then
		Definiteurl="$False$"
		Exit Function
	End If
	If Left(lcase(consulturl),7)<>"http://" Then
		Consulturl= "http://" & Consulturl
	End If
	Consulturl=replace(consulturl,"\","/")
	Consulturl=replace(consulturl,"://",":\\")
	Primitiveurl=replace(primitiveurl,"\","/")

	If Right(consulturl,1)<>"/" Then
		If Instr(consulturl,"/")>0 Then
			If Instr(right(consulturl,len(consulturl)-instrrev(consulturl,"/")),".")>0 Then	
			Else
				Consulturl=consulturl & "/"
			End If
		Else
			Consulturl=consulturl & "/"
		End If
	End If
	Conarray=split(consulturl,"/")

	If Left(lcase(primitiveurl),7) = "http://" Then
		Definiteurl=replace(primitiveurl,"://",":\\")
	Elseif Left(primitiveurl,1) = "/" Then
		Definiteurl=conarray(0) & Primitiveurl
	Elseif Left(primitiveurl,2)="./" Then
		Primitiveurl=right(primitiveurl,len(primitiveurl)-2)
		If Right(consulturl,1)="/" Then	
			Definiteurl=consulturl & Primitiveurl
		Else
			Definiteurl=left(consulturl,instrrev(consulturl,"/")) & Primitiveurl
		End If
	Elseif Left(primitiveurl,3)="../" Then
		Do While Left(primitiveurl,3)="../"
		Primitiveurl=right(primitiveurl,len(primitiveurl)-3)
			Pi=pi+1
		Loop				
		For Ci=0 To (ubound(conarray)-1-pi)
			If Definiteurl<>"" Then
				Definiteurl=definiteurl & "/" & Conarray(ci)
			Else
				Definiteurl=conarray(ci)
			End If
		Next
		Definiteurl=definiteurl & "/" & Primitiveurl
	Else
		If Instr(primitiveurl,"/")>0 Then
			Priarray=split(primitiveurl,"/")
			If Instr(priarray(0),".")>0 Then
				If Right(primitiveurl,1)="/" Then
					Definiteurl="http:\\" & Primitiveurl
				Else
					If Instr(priarray(ubound(priarray)-1),".")>0 Then 
						Definiteurl="http:\\" & Primitiveurl
					Else
						Definiteurl="http:\\" & Primitiveurl & "/"
					End If
				End If		
			Else
				If Right(consulturl,1)="/" Then	
					Definiteurl=consulturl & Primitiveurl
				Else
					Definiteurl=left(consulturl,instrrev(consulturl,"/")) & Primitiveurl
				End If
			End If
		Else
			If Instr(primitiveurl,".")>0 Then