📄 ks.rcls.asp
字号:
Function RefreshPictureContent(RS,ChannelID)
Dim TFileContent, F_C, FilePath, FilePathAndName, FilePathAndNameTemp,Fname, FExt, TempFileContent
Dim FolderDomain, PicUrls, PicUrlsArr, TotalPage, I, N, CurrPage, PageStr,Flag
on error resume next
Application(KS.SiteSN & "RefreshType") = "PictureContent"
Application(KS.SiteSN & "RefreshFolderID") = RS("Tid")
Application(KS.SiteSN & "RefreshInfoID") = RS("ID")
TempFileContent = LoadTemplate(RS("TemplateID"))
TempFileContent = ReplaceAllLabel(TempFileContent)
If InStr(TempFileContent, "{$GetCorrelativePicture(") <> 0 Then
TempFileContent = Replace(TempFileContent, "{$GetCorrelativePicture(", "[$GetCorrelativePicture(")
Flag = True
Else
Flag = False
End If
'为了提高刷新速度,采用Application缓存,仅当没有包含相关图片组标签
If Flag = True Then
TFileContent = ReplaceLableFlag(ReplaceGeneralLabelContent(TempFileContent))
ElseIf ((RS("TemplateID") <> Application(KS.SiteSN & "RefreshTemplateID")) Or (Trim(RS("Tid")) <> Trim(Application(KS.SiteSN & "RefreshCurrTid"))) Or Application(KS.SiteSN & "RefreshTempFileContent") = "") Then
Application(KS.SiteSN & "RefreshCurrTid") = RS("Tid")
Application(KS.SiteSN & "RefreshTemplateID") = RS("TemplateId")
Application(KS.SiteSN & "RefreshTempFileContent") = ReplaceLableFlag(ReplaceGeneralLabelContent(TempFileContent)) '替换函数标签
TFileContent = Application(KS.SiteSN & "RefreshTempFileContent")
Else
TFileContent = Application(KS.SiteSN & "RefreshTempFileContent")
End If
FExt = Mid(Trim(RS("Fname")), InStrRev(Trim(RS("Fname")), ".")) '分离出扩展名
Fname = Replace(Trim(RS("Fname")), FExt, "") '分离出文件名 如 2005/9-10/1254ddd
FilePathAndNameTemp =Replace(KS.Setting(3) & KS.C_S(ChannelID,8),"//","/")& KS.C_C(RS("Tid"),2)
Dim ShowUrl:ShowUrl =KS.GetFolderPath(RS("Tid"))
FilePathAndName = FilePathAndNameTemp & RS("Fname")
FilePath = Replace(FilePathAndName, Mid(FilePathAndName, InStrRev(FilePathAndName, "/")), "")
Call KS.CreateListFolder(FilePath)
PicUrls = RS("PicUrls")
If IsNull(PicUrls) Then PicUrls = ""
PicUrlsArr = Split(PicUrls, "|||")
TotalPage = UBound(PicUrlsArr) + 1
Dim NextUrl,PicSrc
If InStr(TempFileContent, "{=GetPhotoPage") <> 0 Then
Dim HtmlLabel:HtmlLabel = KSLabel.GetFunctionLabel(TempFileContent, "{=GetPhotoPage")
Dim Param:Param = split(KSLabel.GetFunctionLabelParam(HtmlLabel, "{=GetPhotoPage"),",")
Dim Rows:Rows=Param(0)
Dim Cols:Cols=Param(1)
Dim Width:Width=Param(2)
Dim Height:Height=Param(3)
Dim r,c,str
if ((ubound(PicUrlsArr)+1) mod (cols*rows))=0 then
TotalPage=(ubound(PicUrlsArr)+1)\(cols*rows)
else
TotalPage=(ubound(PicUrlsArr)+1)\(cols*rows) + 1
end if
For I = 1 To TotalPage
str="<table class=text_9 cellspacing=20 cellpadding=0 align=center border=0>"
if TotalPage<=1 then
n=0
else
n=(cols*rows)*(I-1)
end if
For r=1 to rows
str=str & "<tr>"
For c=1 To Cols
dim thumbsphoto
if n<=ubound(PicUrlsArr) Then
PicSrc=Split(PicUrlsArr(n), "|")(2)
If (Lcase(Left(PicSrc,4))<>"http") Then PicSrc=KS.Setting(2) & PicSrc
thumbsphoto="<table cellspacing=0 cellpadding=0 width=""100%"" align=center border=0><tr><td style='border:1px #999999 solid;background:#FFFFFF;padding:10px;text-align:center'><a href='" & KS.Setting(3) & KS.C_S(ChannelID,10) & "/show.asp?id=" &rs("id") & "&n="&n &"' target='_blank'><img width='" & width &"' height='" & height & "' src='" & PicSrc & "' style='border:1px #999999 solid' border='0'></a></td></tr></table>"
else
thumbsphoto=""
end if
str=str & "<td valign=bottom>" & thumbsphoto & "</td>"
n=n+1
Next
str=str & "</tr>"
Next
str=str &"</table>"
PageStr="<table style='BORDER-BOTTOM: #8eacca 1px solid' cellSpacing=0 cellPadding=0 width='95%' align=center border=0><tr><td width='54%' height=25> 共 <font color=#6699ff><strong>" & TotalPage &" </strong></font>页 第 <font color=#6699ff><strong>" & I & "</strong></font> 页</td><td align=right width='33%'>"
startpage=1:k=0
if (I>=10) then startpage=(I\10-1)*10+I mod 10+2
PageStr=PageStr & "<a href=""" & ShowUrl & RS("Fname") & """ title=""首页"">首页</a> "
if I<>1 then
if I=2 then
PageStr=PageStr & "<a href=""" & ShowUrl & RS("Fname") & """ title=""上一页""><<</a> "
else
PageStr=PageStr & "<a href=""" & ShowUrl & Fname & "_" & I-1 & FExt & """ title=""上一页""><<</a> "
end if
end if
For N = cint(startpage) To TotalPage
If N = 1 Then
If I = N Then
PageStr = PageStr & "<a href=""#""><font color=""red"">" & N & "</font></a> "
Else
PageStr = PageStr & "<a href=" & ShowUrl & RS("Fname") & ">" & N & "</a> "
End If
Else
If I = N Then
PageStr = PageStr & "<a href=""#""><font color=""red"">" & N & "</font></a> "
Else
PageStr = PageStr & "<a href=" & ShowUrl & Fname & "_" & N & FExt & ">" & N & "</a> "
End If
End If
k=K+1
If k >= 10 Then exit for
Next
If I <>totalpage Then
PageStr=PageStr & "<a href=""" & ShowUrl & Fname & "_" & I+1 & FExt & """ title=""下一页"">>></a> "
end if
PageStr=PageStr & "<a href=""" & ShowUrl & Fname & "_" & TotalPage & FExt & """ title=""末页"">末页</a> "
PageStr=PageStr & "</div>"
PageStr=PageStr & "</td><td align=""right"" width=""13%""><Select style=""color: #6699ff"" onchange=""javascript:window.location=this.value;"" name=""nPage"">"
For K=1 To TotalPage
if k=I then
if k=1 then
PageStr=PageStr & "<Option value='" & ShowUrl & RS("Fname") & "' selected>第" & K & "页</Option>"
else
PageStr=PageStr & "<Option value='" & ShowUrl & Fname & "_" & k & FExt & "' selected>第" & K & "页</Option>"
end if
else
if k=1 then
PageStr=PageStr & "<Option value='" & ShowUrl & RS("Fname") & "'>第" & K & "页</Option>"
else
PageStr=PageStr & "<Option value='" & ShowUrl & Fname & "_" & k & FExt & "'>第" & K & "页</Option>"
end if
end if
Next
PageStr=PageStr & "</Select> </td></tr></table>"
If I <> 1 Then FilePathAndName = FilePathAndNameTemp & Fname & "_" & I & FExt
F_C = TFileContent
F_C=Replace(F_C, HtmlLabel,str)
F_C=Replace(F_C,"{$PageStr}",PageStr)
If InStr(F_C, "[$GetCorrelativePicture(") <> 0 Then F_C = ReplaceLableFlag(Replace(F_C, "[$GetCorrelativePicture(", "{$GetCorrelativePicture("))
F_C = ReplacePictureContent(ChannelID,RS, F_C, "")
F_C = ReplaceRA(F_C, Trim(KS.C_C(RS("Tid"),4)))
Call FSOSaveFile(F_C, FilePathAndName)
Next
ElseIf InStr(TempFileContent, "{$GetPictureByPage}") <> 0 Then '按分页方式生成图片内容页
For I = LBound(PicUrlsArr) To TotalPage - 1
CurrPage = I + 1
If TotalPage > 1 Then
PageStr="<div class=""kspage"">" & vbcrlf & "<div style=""text-align:center"">"
If I = 0 Then
PageStr = PageStr & "<a href=" & ShowUrl & Fname & "_" & (CurrPage + 1) & FExt & ">下一张>></a><br>"
NextUrl=ShowUrl & Fname & "_" & (CurrPage + 1) & FExt
ElseIf I = 1 And I <> TotalPage - 1 Then '对于最后一张刚好是第二张的要做特殊处理
PageStr = PageStr &"<a href=" & ShowUrl & RS("Fname") & "><<上一张</a> <a href=" & ShowUrl & Fname & "_" & (CurrPage + 1) & FExt & ">下一张>></a><br>"
NextUrl=ShowUrl & Fname & "_" & (CurrPage + 1) & FExt
ElseIf I = 1 And I = TotalPage - 1 Then
PageStr = PageStr &"<a href=" & ShowUrl & RS("Fname") & "><<上一张</a><br>"
NextUrl=ShowUrl & RS("Fname")
ElseIf I = TotalPage - 1 Then
PageStr = PageStr &"<a href=" & ShowUrl & Fname & "_" & (CurrPage - 1) & FExt & "><<上一张</a>"
NextUrl=ShowUrl & RS("Fname")
Else
PageStr = PageStr &"<a href=" &ShowUrl & Fname & "_" & (CurrPage - 1) & FExt & "><<上一张</a> <a href=" &ShowUrl & Fname & "_" & (CurrPage + 1) & FExt & ">下一张>></a>"
NextUrl=ShowUrl & Fname & "_" & (CurrPage + 1) & FExt
End If
PageStr =PageStr & "</div>"
PageStr = PageStr & "<br /><div style=""text-align:left"">" & Split(PicUrlsArr(CurrPage-1), "|")(0) & "</div>"
dim startpage,k
startpage=1:k=0
if (CurrPage>=10) then startpage=(CurrPage\10-1)*10+CurrPage mod 10+2
PageStr = PageStr & "<br /><div style=""text-align:center""><a href=""#"">共<font color=""red""> " & startpage & "/" & TotalPage & "</font> 张</a> "
PageStr=PageStr & "<a href=""" & ShowUrl & RS("Fname") & """ title=""首页"">首页</a> "
if CurrPage<>1 then
if currpage=2 then
PageStr=PageStr & "<a href=""" & ShowUrl & RS("Fname") & """ title=""上一页""><<</a> "
else
PageStr=PageStr & "<a href=""" & ShowUrl & Fname & "_" & CurrPage-1 & FExt & """ title=""上一页""><<</a> "
end if
end if
For N = cint(startpage) To TotalPage
If N = 1 Then
If CurrPage = N Then
PageStr = PageStr & "<a href=""#""><font color=""red"">" & N & "</font></a> "
Else
PageStr = PageStr & "<a href=" & ShowUrl & RS("Fname") & ">" & N & "</a> "
End If
Else
If CurrPage = N Then
PageStr = PageStr & "<a href=""#""><font color=""red"">" & N & "</font></a> "
Else
PageStr = PageStr & "<a href=" & ShowUrl & Fname & "_" & N & FExt & ">" & N & "</a> "
End If
End If
k=K+1
If k >= 10 Then exit for
Next
If CurrPage <>totalpage Then
PageStr=PageStr & "<a href=""" & ShowUrl & Fname & "_" & CurrPage+1 & FExt & """ title=""下一页"">>></a> "
end if
PageStr=PageStr & "<a href=""" & ShowUrl & Fname & "_" & TotalPage & FExt & """ title=""末页"">末页</a> "
PageStr=PageStr & "</div>"
Else
PageStr = ""
End If
If CurrPage <> 1 Then FilePathAndName = FilePathAndNameTemp & Fname & "_" & CurrPage & FExt
F_C = TFileContent
If InStr(F_C, "[$GetCorrelativePicture(") <> 0 Then F_C = ReplaceLableFlag(Replace(F_C, "[$GetCorrelativePicture(", "{$GetCorrelativePicture("))
PicSrc=Split(PicUrlsArr(I), "|")(1)
If (Lcase(Left(PicSrc,4))<>"http") Then PicSrc=KS.Setting(2) & PicSrc
F_C = ReplacePictureContent(ChannelID,RS, F_C, "<div align=""center""><a href=""" & NextUrl & """><Img onmousewheel=""return bbimg(this)"" onload=""javascript:resizepic(this)"" src="""& PicSrc & """ border=""0""></a></div>" & PageStr)
F_C = ReplaceRA(F_C, Trim(KS.C_C(RS("Tid"),4)))
Call FSOSaveFile(F_C, FilePathAndName)
Next
Else '图片播放器方式
F_C = TFileContent
If InStr(F_C, "[$GetCorrelativePicture(") <> 0 Then F_C = ReplaceLableFlag(Replace(F_C, "[$GetCorrelativePicture(", "{$GetCorrelativePicture("))
F_C = ReplacePictureContent(ChannelID,RS, F_C, GetPicturePlayer(PicUrlsArr,ChannelID))
F_C = ReplaceRA(F_C, Trim(KS.C_C(RS("Tid"),5))) '如果采用根相对路径,则替换绝对路径为根相对路径
Call FSOSaveFile(F_C, FilePathAndName)
End If
End Function
Function GetPicturePlayer(PicUrlsArr,ChannelID)
Dim I, TotalPictureNum,PictureIDArrayStr,ImageSrcArrayStr,ThumbSrcArrayStr
TotalPictureNum = UBound(PicUrlsArr) + 1
For I = 0 To TotalPictureNum - 1
PictureIDArrayStr = PictureIDArrayStr & "'" & Split(PicUrlsArr(I), "|")(0) & "',"
ImageSrcArrayStr = ImageSrcArrayStr & "'" & Split(PicUrlsArr(I), "|")(1) & "',"
ThumbSrcArrayStr=ThumbSrcArrayStr & "'" & Split(PicUrlsArr(I),"|")(2) &"',"
Next
PictureIDArrayStr = Left(PictureIDArrayStr, Len(PictureIDArrayStr) - 1)
ImageSrcArrayStr = Left(ImageSrcArrayStr, Le⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -