ks.labelcls.asp

本系统是根据科汛系统编写的程序

		Function GetSlide(ChannelID,FolderID, I_S_C, Width, Height, Num, OpenType, ShowTitle, T_Len, T_Css, ChangeTime,SlideType,SpecialID)
		     
			 Dim SqlStr, Param
			 If FolderID = "-1" Then FolderID = Application(KS.SiteSN & "RefreshFolderID")
			 If FolderID = "" Or FolderID = "0" Then Param="" Else If CBool(I_S_C) = True Then Param="Tid In (" & KS.GetFolderTid(FolderID) & ") And" Else Param="Tid='" & FolderID & "' And"
			 Select Case KS.C_S(ChannelID,6)
			  Case 1:SqlStr = "SELECT TOP " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,Changes,PicUrl FROM " & KS.C_S(ChannelID,2) &" Where " & Param & " Verific=1 AND DelTF=0 AND PicNews=1 AND Slide=1  And " & KS.GetSpecialPara(SpecialID) & " ORDER BY ID Desc"
			  Case 2:SqlStr = "SELECT TOP " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,PhotoUrl FROM " & KS.C_S(ChannelID,2) &" Where " & Param & " Verific=1 AND DelTF=0 AND Slide=1 And " & KS.GetSpecialPara(SpecialID) & " ORDER BY ID Desc"
			  Case 3:SqlStr = "SELECT TOP " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,PhotoUrl FROM " & KS.C_S(ChannelID,2) &" Where " & Param & " Verific=1 AND DelTF=0 AND Slide=1 And " & KS.GetSpecialPara(SpecialID) & " ORDER BY ID Desc"
			  Case 4:SqlStr = "SELECT TOP " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,PhotoUrl FROM KS_Flash Where " & Param & " Verific=1 AND DelTF=0 AND Slide=1 And " & KS.GetSpecialPara(SpecialID)& " ORDER BY ID Desc"
			  Case 5:SqlStr = "SELECT TOP " & Num & " ID,Title,Tid,0,0,Fname,0,PhotoUrl FROM KS_Product Where " & Param & " Verific=1 AND DelTF=0 AND Slide=1 ORDER BY ID Desc"
			  Case 7:SqlStr = "SELECT TOP " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,PhotoUrl FROM KS_Movie Where " & Param & " Verific=1 AND DelTF=0 AND Slide=1 And " & KS.GetSpecialPara(SpecialID)& " ORDER BY ID Desc"
			 End Select
			 GetSlide = KS_Slide(ChannelID,SqlStr, Width, Height,KS.G_O_T_S(OpenType), ShowTitle, T_Len, T_Css, ChangeTime,SlideType)
		End Function

		'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
		'函数名:KS_Rolls
		'作 用: 通用连续图片滚动函数
		'参 数: ChannelID模块ID，SqlStr 待查询的SQL语句等
		'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	Function KS_Rolls(ChannelID,SqlStr,M_Dir, M_Width, M_Height, OpenType, ShowTitle, Width, Height, M_Speed, T_Len, T_Css, BorderType, Border)
	         Dim ImgStr, TempPicStr, T_CssStr,Title, TempTitleStr, O_T_S,Url
			 Dim SQL,K,RS:Set RS=Conn.Execute(SqlStr)
			 If RS.EOF Then	 KS_Rolls="":RS.Close:Set RS=Nothing:Exit Function
			 SQL=RS.GetRows(-1):RS.Close:Set RS = Nothing

				T_CssStr = KS.GetCss(T_Css):O_T_S = KS.G_O_T_S(OpenType)
				If LCase(M_Dir) = "left" Or LCase(M_Dir) = "right" Then
						   ImgStr = "<table width=""100%"" height=""100%"" border=""0"">" & vbCrLf
						   ImgStr = ImgStr & "<tr>" & vbCrLf
						  For K=0 To Ubound(SQL,2)
							 Title = SQL(1,K)
							 TempPicStr=GetPicUrl(SQL(7,K))
							 Url=KS.GetInfoUrl(ChannelID,SQL(2,K),SQL(0,K),SQL(5,K),SQL(3,K),SQL(4,K),SQL(6,K))

							 '-------------------------给图片加边框开始-------------------------------------------------
							 Dim TempBorder
							 If BorderType = 1 And Border <> "" Then
							   TempBorder = TempPicStr    '得到原图片
							   TempPicStr = Border        '将原图片设定为透明边框
							 Else
							   TempBorder = Border:TempPicStr = TempPicStr
							 End If
							 
							 Dim LinkAndPicStr: LinkAndPicStr = "<a href=""" & Url & """" & O_T_S & " title=""" & Title & """><Img Src=""" & TempPicStr & """ border=""0"" width=""" & Width & """ height=""" & Height & """ align=""absmiddle""/></a>"
							 TempPicStr = KS.GetPhotoBorder(LinkAndPicStr, BorderType, TempBorder)
							 '-----------------------给图片加边框结束--------------------------------------------------
							 TempTitleStr = "<a" & T_CssStr & " href=""" & Url & """" & O_T_S & " title=""" & Title & """>" & KS.GotTopic(Title, T_Len) & "</a>"
				
							 ImgStr = ImgStr & "<td>" & vbCrLf
							 ImgStr = ImgStr & "<table boder=""0"" width=""100%"" height=""100%"">" & vbCrLf
							 ImgStr = ImgStr & "<tr><td align=""center"">" & TempPicStr & "</td></tr>" & vbCrLf
							If Cbool(ShowTitle) = True Then
							 ImgStr = ImgStr & "<tr><td align=""center"">" & TempTitleStr & " </td></tr>" & vbCrLf
							End If
							 ImgStr = ImgStr & "</table>" & vbCrLf
							 ImgStr = ImgStr & "</td>" & vbCrLf
					   Next
						   ImgStr = ImgStr & "</tr></table>" & vbCrLf
				Else
						ImgStr = "<table width=""100%"" height=""100%"" border=""0"">" & vbCrLf
						For K=0 To Ubound(SQL,2)
							 Title = SQL(1,K)
							 TempPicStr=GetPicUrl(SQL(7,K))
							 Url=KS.GetInfoUrl(ChannelID,SQL(2,K),SQL(0,K),SQL(5,K),SQL(3,K),SQL(4,K),SQL(6,K))
							 '-------------------------给图片加边框开始-------------------------------------------------
							 If BorderType = 1 And Border <> "" Then
							   TempBorder = TempPicStr    '得到原图片
							   TempPicStr = Border        '将原图片设定为透明边框
							 Else
							   TempBorder = Border
							   TempPicStr = TempPicStr
							 End If
							 LinkAndPicStr = "<a href=""" & URL & """" & O_T_S & " title=""" & Title & """><Img Src=""" & TempPicStr & """ border=""0"" width=""" & Width & """ height=""" & Height & """ align=""absmiddle""/></a>"
							 TempPicStr = KS.GetPhotoBorder(LinkAndPicStr, BorderType, TempBorder)
							 '-----------------------给图片加边框结束--------------------------------------------------
							 TempTitleStr = "<a" & T_CssStr & " href=""" & URL & """" & O_T_S & " title=""" & Title & """>" & KS.GotTopic(Title, T_Len) & "</a>"
				
							ImgStr = ImgStr & "<tr><td>" & vbCrLf
							ImgStr = ImgStr & "<table boder=""0"" width=""100%"" height=""100%"">" & vbCrLf
							ImgStr = ImgStr & "<tr><td align=""center"">" & TempPicStr & "</td></tr>" & vbCrLf
						   If Cbool(ShowTitle) = True Then ImgStr = ImgStr & "<tr><td align=""center"">" & TempTitleStr & " </td></tr>" & vbCrLf
							ImgStr = ImgStr & "</table>" & vbCrLf
							ImgStr = ImgStr & "</td></tr>" & vbCrLf
				        Next
						 ImgStr = ImgStr & "</table>" & vbCrLf
			   End If
					Select Case M_Dir
					 Case "up"
					   KS_Rolls = KS_Rolls & "<div id=demoup style=""overflow:hidden; width:" & M_Width & "px; height:" & M_Height & "px;"" > " & vbCrLf
					   KS_Rolls = KS_Rolls & "<div id=demoup1>" & vbCrLf
					   KS_Rolls = KS_Rolls & ImgStr
					   KS_Rolls = KS_Rolls & "</div>" & vbCrLf
					   KS_Rolls = KS_Rolls & "<div id=demoup2></div>" & vbCrLf
					   KS_Rolls = KS_Rolls & "</div>" & vbCrLf
					   KS_Rolls = KS_Rolls & "<script language=""javascript"">" & vbCrLf
					   KS_Rolls = KS_Rolls & " var upspeed = " & M_Speed & ";" & vbCrLf
					   KS_Rolls = KS_Rolls & " demoup2.innerHTML = demoup1.innerHTML;" & vbCrLf
					   KS_Rolls = KS_Rolls & " function MarqueeUP(){" & vbCrLf
					   KS_Rolls = KS_Rolls & " if(demoup2.offsetTop-demoup.scrollTop<=0)" & vbCrLf
					   KS_Rolls = KS_Rolls & " demoup.scrollTop-=demoup1.offsetHeight" & vbCrLf
					   KS_Rolls = KS_Rolls & " else{" & vbCrLf
					   KS_Rolls = KS_Rolls & " demoup.scrollTop++" & vbCrLf
					   KS_Rolls = KS_Rolls & "}" & vbCrLf
					   KS_Rolls = KS_Rolls & "}" & vbCrLf
					   KS_Rolls = KS_Rolls & "var MyMarUP = setInterval(MarqueeUP, upspeed)" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoup.onmouseover=function() {clearInterval(MyMarUP)}" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoup.onmouseout=function() {MyMarUP=setInterval(MarqueeUP,upspeed)}" & vbCrLf
					   KS_Rolls = KS_Rolls & "</script>" & vbCrLf
					 Case "down"
					   KS_Rolls = KS_Rolls & "<div id=demodown style=""overflow:hidden; width:" & M_Width & "px; height:" & M_Height & "px;"">" & vbCrLf
					   KS_Rolls = KS_Rolls & "<div id=demodown1>" & vbCrLf
					   KS_Rolls = KS_Rolls & ImgStr
					   KS_Rolls = KS_Rolls & "</div>" & vbCrLf
					   KS_Rolls = KS_Rolls & "<div id=demodown2></div>" & vbCrLf
					   KS_Rolls = KS_Rolls & "</div>" & vbCrLf
					   KS_Rolls = KS_Rolls & "<script language=""javascript"">" & vbCrLf
					   KS_Rolls = KS_Rolls & "var downspeed = " & M_Speed & ";" & vbCrLf
					   KS_Rolls = KS_Rolls & "demodown2.innerHTML = demodown1.innerHTML;" & vbCrLf
					   KS_Rolls = KS_Rolls & "demodown.scrollTop = demodown.scrollHeight" & vbCrLf
					   KS_Rolls = KS_Rolls & "function MarqueeDown(){" & vbCrLf
					   KS_Rolls = KS_Rolls & "if(demodown1.offsetTop-demodown.scrollTop>=0)" & vbCrLf
					   KS_Rolls = KS_Rolls & "demodown.scrollTop+=demodown2.offsetHeight" & vbCrLf
					   KS_Rolls = KS_Rolls & "else{" & vbCrLf
					   KS_Rolls = KS_Rolls & "demodown.scrollTop--" & vbCrLf
					   KS_Rolls = KS_Rolls & "}}" & vbCrLf
					   KS_Rolls = KS_Rolls & "var MyMardown = setInterval(MarqueeDown, downspeed)" & vbCrLf
					   KS_Rolls = KS_Rolls & "demodown.onmouseover=function() {clearInterval(MyMardown)}" & vbCrLf
					   KS_Rolls = KS_Rolls & "demodown.onmouseout=function() {MyMardown=setInterval(MarqueeDown,downspeed)}" & vbCrLf
					   KS_Rolls = KS_Rolls & "</script>" & vbCrLf
					 Case "left"
					   KS_Rolls = KS_Rolls & "<div id=demoleft style=""overflow:hidden;height:" & M_Height & "px;width:" & M_Width & "px;"">" & vbCrLf
					   KS_Rolls = KS_Rolls & "<table align=left cellpadding=0 cellspace=0 border=0>" & vbCrLf
					   KS_Rolls = KS_Rolls & "<tr><td id=demoleft1 valign=top>" & vbCrLf
					   KS_Rolls = KS_Rolls & ImgStr
					   KS_Rolls = KS_Rolls & "</td>" & vbCrLf
					   KS_Rolls = KS_Rolls & "<td id=demoleft2 valign=top></td>" & vbCrLf
					   KS_Rolls = KS_Rolls & "</tr></table>" & vbCrLf
					   KS_Rolls = KS_Rolls & "</div>" & vbCrLf
					   KS_Rolls = KS_Rolls & "<script laguage=""javascript"">" & vbCrLf
					   KS_Rolls = KS_Rolls & "var leftspeed = " & M_Speed & ";" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoleft2.innerHTML = demoleft1.innerHTML" & vbCrLf
					   KS_Rolls = KS_Rolls & "function MarqueeLeft(){" & vbCrLf
					   KS_Rolls = KS_Rolls & "if(demoleft2.offsetWidth-demoleft.scrollLeft<=0)" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoleft.scrollLeft-=demoleft1.offsetWidth" & vbCrLf
					   KS_Rolls = KS_Rolls & "else{" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoleft.scrollLeft++" & vbCrLf
					   KS_Rolls = KS_Rolls & "}}" & vbCrLf
					   KS_Rolls = KS_Rolls & "var MyMarleft = setInterval(MarqueeLeft, leftspeed)" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoleft.onmouseover=function() {clearInterval(MyMarleft)}" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoleft.onmouseout=function() {MyMarleft=setInterval(MarqueeLeft,leftspeed)}" & vbCrLf
					   KS_Rolls = KS_Rolls & "</script>" & vbCrLf
					 Case "right"
					   KS_Rolls = KS_Rolls & "<div id=demoright style=""overflow:hidden;height:" & M_Height & "px;width:" & M_Width & "px;"">" & vbCrLf
					   KS_Rolls = KS_Rolls & "<table align=left cellpadding=0 cellspace=0 border=0><tr><td id=demoright1 valign=top>" & vbCrLf
					   KS_Rolls = KS_Rolls & ImgStr
					   KS_Rolls = KS_Rolls & "</td><td id=demoright2 valign=top></td></tr></table></div>" & vbCrLf
					   KS_Rolls = KS_Rolls & "<script>" & vbCrLf
					   KS_Rolls = KS_Rolls & "var rightspeed = " & M_Speed & ";" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoright2.innerHTML = demoright1.innerHTML;" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoright.scrollLeft = demoright.scrollWidth;" & vbCrLf
					   KS_Rolls = KS_Rolls & "function MarqueeRight(){" & vbCrLf
					   KS_Rolls = KS_Rolls & "if(demoright.scrollLeft<=0)" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoright.scrollLeft+=demoright2.offsetWidth" & vbCrLf
					   KS_Rolls = KS_Rolls & "else{" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoright.scrollLeft--" & vbCrLf
					   KS_Rolls = KS_Rolls & "}}" & vbCrLf
					   KS_Rolls = KS_Rolls & "var MyMarRight = setInterval(MarqueeRight, rightspeed)" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoright.onmouseover=function() {clearInterval(MyMarRight)}" & vbCrLf
					   KS_Rolls = KS_Rolls & "demoright.onmouseout=function() {MyMarRight=setInterval(MarqueeRight,rightspeed)}" & vbCrLf
					   KS_Rolls = KS_Rolls & "</script>" & vbCrLf
				  End Select
		End Function
		'取得连续滚动图片