📄 cl_function_movie.asp
字号:
<%
'===================================================
' CreateLive CMS Version 4.0
' Powered by Aspoo.CoM
'===================================================
' File: Cl_Function_Movie.asp
' Date: 2005-10-31
' Mail: support@aspoo.cn, Info@aspoo.cn
' Q Q: 3315263, 596197794
' Msn : support@aspoo.cn, Clw866@hotmail.com
' Web : http://www.aspoo.com, http://www.aspoo.net
' Bbs : http://bbs.aspoo.com, http://bbs.aspoo.net
' Copyright (C) 2005-2007 Aspoo.CoM All Rights Reserved.
'===================================================
Public Sub Movie_Setting()
CurrentPath = Cl.Language.selectSingleNode("//CurrentPath").text & "<a href='" & Cl.Web_info(4) & "'>" & Cl.Web_info(0) & "</a> >> <a href='" & Cl.WebDir & Cl.ChannelDir & "'>" & Cl.ChannelName & "</a>"
Cl.Title = Cl.NoHtml(Cl.ChannelName) & " " & Cl.GotTopic(Cl.ChannelReadMe,50) & "[" & Cl.Web_info(1) & "]"
if InfoID>0 then
Set rs = Cl.Execute("select * from Cl_Movie where InfoID=" & InfoID)
if rs.bof and rs.eof then
rs.Close : Set rs=Nothing
Call Cl.OutErr(0,Replace(Cl.Language.selectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.ChannelItemName))
end if
if rs("ChannelID")<>ChannelID Or rs("Deleted")=True Or rs("Status")<>1 Then
rs.Close : Set rs=Nothing
Call Cl.OutErr(0,Replace(Cl.Language.selectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.ChannelItemName))
end If
ClassID = rs("ClassID")
InfoTitle = rs("MovieName")
if rs("Hot")=False then
if rs("Hits")>=Clng(Cl.Web_Setting(14)) then Cl.Execute("Update Cl_Movie Set Hot=" & TrueType & " where InfoID=" & InfoID & "")
end if
Template.TemplateID = 0
If CLng(Cl.Channel.selectSingleNode("@info_projectid").text)>0 Then
Template.ProjectID = CLng(Cl.Channel.selectSingleNode("@info_projectid").text)
If CLng(Cl.Channel.selectSingleNode("@info_templateid").text)>0 Then Template.TemplateID = CLng(Cl.Channel.selectSingleNode("@info_templateid").text)
If CLng(Cl.Channel.selectSingleNode("@info_cssid").text)>0 Then Template.CssID = CLng(Cl.Channel.selectSingleNode("@info_cssid").text)
End if
end if
if ClassID>0 Then
Set tClass = Application(Cl.CacheName&"_classlist").documentElement.selectSingleNode("class[@classid="&ClassID&"]")
If tClass Is Nothing Then Call Cl.OutErr(0,Cl.Language.selectSingleNode("//ClassNoFind").text)
ClassName = tClass.selectSingleNode("@classname").text
ParentID = CLng(tClass.selectSingleNode("@parentid").text)
ParentPath = tClass.selectSingleNode("@parentpath").text
ClassDir = tClass.selectSingleNode("@classdir").text
ParentDir = tClass.selectSingleNode("@parentdir").text
RootID = CLng(tClass.selectSingleNode("@rootid").text)
Depth = CLng(tClass.selectSingleNode("@depth").text)
Child = CLng(tClass.selectSingleNode("@child").text)
arrChildID = tClass.selectSingleNode("@arrchildid").text
BrowsePurview=CLng(tClass.selectSingleNode("@browsepurview").text)
VipUser = tClass.selectSingleNode("@vipuser").text
ClassProjectID= CLng(tClass.selectSingleNode("@projectid").text)
ClassTemplateID = CLng(tClass.selectSingleNode("@templateid").text)
ClassCssID = CLng(tClass.selectSingleNode("@cssid").text)
If CLng(Cl.Channel.selectSingleNode("@class_projectid").text)>0 Then
Cl.ProjectID = CLng(Cl.Channel.selectSingleNode("@class_projectid").text)
'Template.TemplateID = CLng(Cl.Channel.selectSingleNode("@class_templateid").text)
Cl.CssID = CLng(Cl.Channel.selectSingleNode("@class_cssid").text)
End if
If ClassProjectID > 0 Then
Cl.ProjectID = ClassProjectID
Cl.CssID = ClassCssID
End if
If ParentID>0 Then
Dim tNode,tParent,i
tParent = Split(ParentPath,",")
For i=1 To UBound(tParent)
Set tNode = Application(Cl.CacheName&"_classlist").documentElement.selectSingleNode("class[@classid=" & tParent(i) & "]")
If Not tNode Is Nothing Then
CurrentPath=CurrentPath & " >> <a href='" & tNode.selectSingleNode("@linkurl").text & "'>" & tNode.selectSingleNode("@classname").text & "</a>"
End If
Set tNode=Nothing
Next
tParent = Null
End If
CurrentPath=CurrentPath & " >> <a href='" & tClass.selectSingleNode("@linkurl").text & "'>" & ClassName & "</a>"
Set tClass = Nothing
end if
End Sub
'Rem 影片
Function GetMovie(Byval sChannelID,Byval sClassID,Byval sSpecialID,Byval TopNum,Byval IncludeChild,Byval ShowType, _
Byval ColsNum,Byval IsHot,Byval IsElite,Byval DateNum,Byval OrderType,Byval Style1,Byval Style2,Byval Style3)
Dim JsSQL,sHTML,sTitleMaxLen,TitleStr,LinkUrl,FileType
Dim Author,AuthorName,AuthorEmail
Dim SystemTopDir,SystemDir
Dim Rs,i
On Error Resume Next
SystemTopDir = "http://"&Request.servervariables("Server_Name")
SystemDir = SystemTopDir & Cl.WebDir
sChannelID = Clng(sChannelID)
sClassID = Clng(sClassID)
sSpecialID = Clng(sSpecialID)
TopNum = Clng(TopNum)
IncludeChild = CBool(IncludeChild)
ShowType = Clng(ShowType)
ColsNum = Clng(ColsNum)
IsHot = CBool(IsHot)
IsElite = CBool(IsElite)
DateNum = CLng(DateNum)
OrderType = CLng(OrderType)
Style1 = Trim(Style1)
Style2 = Trim(Style2)
Style3 = Trim(Style3)
if Err then Err.Clear : GetMovie="GetMovie参数错误。":Exit Function
On Error GoTo 0
if TopNum > 0 then
JsSQL="select top " & TopNum & " "
else
JsSQL="select top 100 "
end if
JsSQL=JsSQL & " M.InfoID,M.ChannelID,M.ChannelDir,M.ClassID,C.ClassName,C.ParentPath,C.ClassDir,C.ParentDir,M.MovieName,M.Prefixion,M.Keyword,M.Director,M.ActName,M.PicUrl,M.MovieUrl,M.Intro,M.MovieFormat,M.MovieLong,M.MovieCorner,M.MovieLanguage,M.Stars,M.IsOnline,M.IsDownLoad,M.OnTop,M.Hot,M.Elite,M.Hits,M.DayHits,M.WeekHits,M.MonthHits,M.DownNums,M.InfoGroup,M.InfoPoint,M.DownLoadGroup,M.DownLoadPoint,M.UpdateTime,M.Status,M.IsHtml,M.HtmlFileUrl from Cl_Movie M"
JsSQL=JsSQL & " inner join Cl_Class C on M.ClassID=C.ClassID where M.Deleted="&FalseType&" and M.Status=1"
if sChannelID>0 then JsSQL=JsSQL & " and M.ChannelID="&sChannelID&" "
if sClassID>0 then
if IncludeChild=True then
Dim tClass
set tClass=Cl.Execute("select ClassID,ParentPath,arrChildID From Cl_Class where ClassID=" & sClassID)
if tClass.bof and tClass.eof then
GetMovie="找不到指定的栏目。" : set tClass=Nothing : Exit Function
else
JsSQL=JsSQL & " and M.ClassID in (" & tClass(2) & ")"
end if
set tClass=Nothing
else
JsSQL=JsSQL & " and M.ClassID=" & sClassID & ""
end if
end if
if sSpecialID>0 then JsSQL=JsSQL & " and M.SpecialID like '%," & sSpecialID & ",%'"
if ShowType >= 2 then JsSQL=JsSQL & " and M.PicUrl<>''"
if IsHot=True then JsSQL=JsSQL & " and M.Hot="&TrueType&""
if IsElite=True then JsSQL=JsSQL & " and M.Elite="&TrueType&""
if DateNum>0 then
if IsSqlDatabase=1 then
JsSQL=JsSQL & " and datediff(d,M.UpdateTime,"&SQLNowString&")<=" & DateNum & " "
else
JsSQL=JsSQL & " and datediff('d',M.UpdateTime,"&SQLNowString&")<=" & DateNum & " "
end if
end if
JsSQL=JsSQL & " order by M.OnTop asc"
Select Case OrderType
Case 1 : JsSQL=JsSQL & " ,M.InfoID desc"
Case 2 : JsSQL=JsSQL & " ,M.InfoID asc"
Case 3 : JsSQL=JsSQL & " ,M.UpDateTime desc, M.InfoID desc"
Case 4 : JsSQL=JsSQL & " ,M.UpDateTime asc, M.InfoID desc"
Case 5 : JsSQL=JsSQL & " ,M.Hits desc, M.InfoID desc"
Case 6 : JsSQL=JsSQL & " ,M.Hits asc, M.InfoID desc"
Case else : JsSQL=JsSQL & " ,M.InfoID desc"
End Select
set Rs=server.createObject("Adodb.recordset")
OpenConn : Rs.open JsSQL,Conn,1,1
if Rs.bof and Rs.eof then
GetMovie = "当前没有记录！"
Rs.close:set Rs=Nothing : Exit Function
End if
JsSQL=Rs.GetRows(-1)
Rs.close:set Rs=Nothing
Dim TempBody
Dim regEx,Matches,Match,TempStr
Dim PropertyImg,ClassFileUrl,sImgUrl
TempBody="" : sHTML=""
Set regEx = New RegExp
regEx.Pattern = "{\$.[^{\$}]*}"
regEx.IgnoreCase = True
regEx.Global = True
For i=0 to Ubound(JsSQL,2)
if JsSQL(37,i)=True then
LinkUrl = SystemDir & JsSQL(38,i)
else
LinkUrl = SystemDir & JsSQL(2,i) & "/ShowInfo.asp?InfoID=" & JsSQL(0,i)
end if
if JsSQL(23,i)=True then
PropertyImg = "<img src=""" & InstallDir & "Images/MoiveOntop.gif"" alt=""固顶"" />"
elseif JsSQL(25,i)=True then
PropertyImg = "<img src=""" & InstallDir & "Images/MoiveElite.gif"" alt=""推荐"" />"
else
PropertyImg = "<img src=""" & InstallDir & "Images/MoiveCommon.gif"" alt=""普通"" />"
end if
ClassFileUrl = SystemDir & JsSQL(2,i) & "/ShowClass.asp?ClassID=" & JsSQL(3,i)
'ClassFileUrl = SystemDir & Cl.GetClassUrl(Cl.Channel.selectSingleNode("@createpathtype").text,Cl.HtmlDir,Cl.Channel.selectSingleNode("@channeldir").text,JsSQL(3,i),JsSQL(1,i),JsSQL(5,i),JsSQL(4,i),Cl.Channel.selectSingleNode("@iscreatehtml").text,Cl.Channel.selectSingleNode("@createfileext").text)
if ShowType >= 2 then
FileType=right(lcase(JsSQL(13,i)),3)
JsSQL(13,i) = Cl.GetPicUrl(JsSQL(13,i))
Select Case FileType
Case "swf"
sImgUrl = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0"" width=""{$ImgWidth}"" height=""{$ImgHeight}""><param name=""movie"" value=""" & JsSQL(13,i) & """><param name=""quality"" value=""high""><embed src=""" & JsSQL(13,i) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""{$ImgWidth}"" height=""{$ImgHeight}""></embed></object>"
Case "jpg", "bmp", "png", "gif"
sImgUrl = "<img src=""" & JsSQL(13,i) & """ width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=0>"
Case Else
sImgUrl = "<img src=""" & SystemDir & "images/NoPic2.jpg"" width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=0>"
End Select
end if
TempBody = Style2
TempBody = Replace(TempBody,"{$infoid}",JsSQL(0,i))
TempBody = Replace(TempBody,"{$Prefixion}",JsSQL(9,i)&"")
TempBody = Replace(TempBody,"{$PropertyImg}",PropertyImg)
TempBody = Replace(TempBody,"{$LinkUrl}",LinkUrl)
TempBody = Replace(TempBody,"{$ClassID}",JsSQL(3,i))
TempBody = Replace(TempBody,"{$ClassName}",JsSQL(4,i))
TempBody = Replace(TempBody,"{$ClassUrl}",ClassFileUrl)
TempBody = Replace(TempBody,"{$Director}",JsSQL(11,i))
TempBody = Replace(TempBody,"{$ActName}",JsSQL(12,i))
'===========
TempBody = Replace(TempBody,"{$MovieFormat}",JsSQL(16,i))
TempBody = Replace(TempBody,"{$MovieLong}",JsSQL(17,i))
TempBody = Replace(TempBody,"{$MovieCorner}",JsSQL(18,i))
TempBody = Replace(TempBody,"{$MovieLanguage}",JsSQL(19,i))
'===========
TempBody = Replace(TempBody,"{$Hits}",JsSQL(26,i))
TempBody = Replace(TempBody,"{$DayHits}",JsSQL(27,i))
TempBody = Replace(TempBody,"{$WeekHits}",JsSQL(28,i))
TempBody = Replace(TempBody,"{$MonthHits}",JsSQL(29,i))
Set Matches = regEx.Execute(TempBody)
For Each Match in Matches
TempStr = Replace(Match.Value,"{$","")
TempStr = Replace(TempStr,"}","")
TempStr = Replace(TempStr,"(",",")
TempStr = Replace(TempStr,")","")
TempStr = Replace(TempStr,"""","")
TempStr = Split(Lcase(TempStr),",")
Select Case TempStr(0)
Case "title"
TitleStr = Cl.GotTopic(JsSQL(8,i),TempStr(1))
TempBody = Replace(TempBody,Match.Value,TitleStr)
Case "imgurl"
sImgUrl = Replace(sImgUrl,"{$ImgWidth}",TempStr(1))
sImgUrl = Replace(sImgUrl,"{$ImgHeight}",TempStr(2))
TempBody = Replace(TempBody,Match.Value,sImgUrl)
Case "intro"
TempBody = Replace(TempBody,Match.Value,Left(Cl.NoHtml(JsSQL(15,i)),TempStr(1)))
Case "updatetime"
TempBody = Replace(TempBody,Match.Value,Cl.Format_Time(JsSQL(35,i),TempStr(1)))
End Select
Next
sHTML = sHTML & TempBody
if (i+1) mod ColsNum=0 then sHTML = sHTML & Style3
Next
GetMovie=Replace(Style1,"{$ContentBody}",sHTML)
JsSQL=Empty
End Function
'=================================================
'过程名：ShowClassMovie(sChannelID,sClassID,ModNum,TopNum)
'参 数：
' sChannelID ---- 频道ID
' sClassID ---- 指定栏目，多个用“|”分隔，不指定请留空或0
' ModNum --- 多少个换行
' TopNum --- 最多显示记录数
'=================================================
Function ShowClassMovie(Byval sChannelID,Byval sClassID,Byval ModNum,Byval TopNum)
Dim sqlRoot,rsRoot,ClassCount,iClassID,nClassID
Dim sTemp,strValue,ClassLinkUrl
sChannelID = Cl.GetClng(sChannelID)
sClassID = Trim(sClassID)
ModNum = Cl.GetClng(ModNum)
if sClassID="" or sClassID="0" then
TopNum = Cl.GetClng(TopNum)
if TopNum=0 then TopNum = 6
sqlRoot="select Top "&TopNum&" ClassID,ClassName,ParentPath,ClassDir,ParentDir,RootID,Child,arrChildID,Readme From Cl_Class where ChannelID="&sChannelID&" and ParentID=0 and IsElite="&TrueType&" and IsOuter=0 order by RootID"
Else
sqlRoot="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,RootID,Child,arrChildID,Readme From Cl_Class where ChannelID="&sChannelID&" and IsElite="&TrueType&" and IsOuter=0 and ClassID In ("&Replace(sClassID,"|",",")&") order by RootID"
End if
Set rsRoot= Cl.Execute(sqlRoot)
if rsRoot.bof and rsRoot.eof then
sTemp="还没有任何栏目，请首先添加栏目。"
rsRoot.Close:Set rsRoot=Nothing:Exit Function
end if
sqlRoot=rsRoot.GetRows(-1)
rsRoot.Close:Set rsRoot=Nothing
Dim TemplateHTMLStr
TemplateHTMLStr = Template.GetTemplate(Cl.GetDefaultTemplateID(4,9,Template.ProjectID))
TemplateHTMLStr = Replace(TemplateHTMLStr,"{$webdir}",InstallDir)
TemplateHTMLStr = Replace(TemplateHTMLStr,"{$csspicurl}",Cl.WebDir & Cl.CssPicUrl)
TemplateHTMLStr = Split(TemplateHTMLStr,"@@@")
'If ChannelID=0 Then ChannelID = sChannelID
nClassID = Ubound(sqlRoot,2)
for iClassID=0 to nClassID
ClassID = sqlRoot(0,iClassID)
ClassLinkUrl = Cl.GetClassLinkUrl(sqlRoot(0,iClassID))
strValue=TemplateHTMLStr(1)
strValue=Replace(strValue,"{$channelid}",sChannelID)
strValue=Replace(strValue,"{$classid}",sqlRoot(0,iClassID))
strValue=Replace(strValue,"{$classtitle}",sqlRoot(8,iClassID)&"")
strValue=Replace(strValue,"{$classname}",sqlRoot(1,iClassID))
strValue=Replace(strValue,"{$classfileurl}",ClassLinkUrl)
strValue=Replace(strValue,"{$classlinkurl}",ClassLinkUrl)
strValue=Template.ReplaceFlag(strValue,"showmovie","")
If iClassID<nClassID then
if ((iClassID+1) mod ModNum) = 0 then
strValue = strValue & TemplateHTMLStr(3)
else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -