📄 powereasy.photo.asp
字号:
Public Function GetPicPhoto(iChannelID, arrClassID, IncludeChild, iSpecialID, PhotoNum, IsHot, IsElite, DateNum, OrderType, ShowType, ImgWidth, ImgHeight, TitleLen, ContentLen, ShowTips, Cols, UrlType)
Dim sqlPic, rsPic, iCount, strPic, strLink, strAuthor, InfoUrl
Dim strPhotoThumb, strLink_PhotoThumb, strTitle, strLink_Title, strContent, strLink_Content
iCount = 0
PhotoNum = PE_CLng(PhotoNum)
ShowType = PE_CLng(ShowType)
ImgWidth = PE_CLng(ImgWidth)
ImgHeight = PE_CLng(ImgHeight)
UrlType = PE_CLng(UrlType)
Cols = PE_CLng1(Cols)
If PhotoNum < 0 Or PhotoNum >= 100 Then PhotoNum = 10
If ShowType < 1 And ShowType > 5 Then ShowType = 2
If ImgWidth < 0 Or ImgWidth > 1000 Then ImgWidth = 150
If ImgHeight < 0 Or ImgHeight > 1000 Then ImgHeight = 150
If ShowType = 5 Then UrlType = 1
If Cols <= 0 Then Cols = 5
FoundErr = False
If iChannelID <> PrevChannelID Or ChannelID = 0 Then
Call GetChannel(iChannelID)
End If
PrevChannelID = iChannelID
If FoundErr = True Then
GetPicPhoto = ErrMsg
Exit Function
End If
sqlPic = "select"
If PhotoNum > 0 Then
sqlPic = sqlPic & " top " & PhotoNum
End If
sqlPic = sqlPic & " P.ChannelID,P.ClassID,P.PhotoID,P.PhotoName,P.Author,P.UpdateTime,P.Hits,P.InfoPurview,P.InfoPoint,P.PhotoThumb"
If ContentLen > 0 Then
sqlPic = sqlPic & ",P.PhotoIntro"
End If
sqlPic = sqlPic & ",C.ClassName,C.ClassDir,C.ParentDir,C.ClassPurview"
sqlPic = sqlPic & GetSqlStr(iChannelID, arrClassID, IncludeChild, iSpecialID, IsHot, IsElite, "", DateNum, OrderType, False, True)
Set rsPic = Server.CreateObject("ADODB.Recordset")
rsPic.Open sqlPic, Conn, 1, 1
If ShowType < 4 Then strPic = "<table width='100%' cellpadding='0' cellspacing='5' border='0' align='center'><tr valign='top'>"
If rsPic.BOF And rsPic.EOF Then
If PhotoNum = 0 Then totalPut = 0
If ShowType < 4 Then
strPic = strPic & "<td align='center'><img class='pic3' src='" & strInstallDir & "images/nopic.gif' width='" & ImgWidth & "' height='" & ImgHeight & "' border='0'><br>" & R_XmlText_Class("PicPhoto/NoFound", "没有任何{$ChannelShortName}") & "</td></tr></table>"
ElseIf ShowType = 4 Then
strPic = strPic & "<div class=""pic_photo""><img class='pic3' src='" & strInstallDir & "images/nopic.gif' width='" & ImgWidth & "' height='" & ImgHeight & "' border='0'><br>" & R_XmlText_Class("PicPhoto/NoFound", "没有任何{$ChannelShortName}") & "</div>"
End If
rsPic.Close
Set rsPic = Nothing
GetPicPhoto = strPic
Exit Function
End If
If PhotoNum = 0 And ShowType < 5 Then
totalPut = rsPic.RecordCount
If totalPut > 0 Then
If CurrentPage < 1 Then
CurrentPage = 1
End If
If (CurrentPage - 1) * MaxPerPage > totalPut Then
If (totalPut Mod MaxPerPage) = 0 Then
CurrentPage = totalPut \ MaxPerPage
Else
CurrentPage = totalPut \ MaxPerPage + 1
End If
End If
If CurrentPage > 1 Then
If (CurrentPage - 1) * MaxPerPage < totalPut Then
iMod = 0
If CurrentPage > UpdatePages Then
iMod = totalPut Mod MaxPerPage
If iMod <> 0 Then iMod = MaxPerPage - iMod
End If
rsPic.Move (CurrentPage - 1) * MaxPerPage - iMod
Else
CurrentPage = 1
End If
End If
End If
End If
If ShowType = 5 Then Set XMLDOM = Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
Do While Not rsPic.EOF
If iChannelID = 0 Then
If rsPic("ChannelID") <> PrevChannelID Then
Call GetChannel(rsPic("ChannelID"))
PrevChannelID = rsPic("ChannelID")
End If
End If
ChannelUrl = UrlPrefix(UrlType, ChannelUrl) & ChannelUrl
ChannelUrl_ASPFile = UrlPrefix(UrlType, ChannelUrl_ASPFile) & ChannelUrl_ASPFile
If ShowType < 5 Then
InfoUrl = GetPhotoUrl(rsPic("ParentDir"), rsPic("ClassDir"), rsPic("UpdateTime"), rsPic("PhotoID"), rsPic("ClassPurview"), rsPic("InfoPurview"), rsPic("InfoPoint"))
strPhotoThumb = GetPhotoThumb(rsPic("PhotoThumb"), ImgWidth, ImgHeight)
strLink_PhotoThumb = GetInfoList_GetStrInfoLink(strList_Title, ShowTips, 1, "", strPhotoThumb, InfoUrl, rsPic("PhotoName"), rsPic("Author"), rsPic("UpdateTime"))
If ShowType = 4 Then
strPic = strPic & "<div class=""pic_photo"">" & vbCrLf
strPic = strPic & "<div class=""pic_photo_img"">" & strLink_PhotoThumb & "</div>" & vbCrLf
Else
strPic = strPic & "<td align='center'>"
strPic = strPic & strLink_PhotoThumb
End If
If TitleLen <> 0 Then
strTitle = GetInfoList_GetStrTitle(rsPic("PhotoName"), TitleLen, 0, "")
strLink_Title = GetInfoList_GetStrInfoLink(strList_Title, ShowTips, 1, "", strTitle, InfoUrl, rsPic("PhotoName"), rsPic("Author"), rsPic("UpdateTime"))
Select Case PE_CLng(ShowType)
Case 1, 2
strPic = strPic & "<br>" & strLink_Title
Case 3
strPic = strPic & "</td><td valign='top' align='left'>" & strLink_Title
Case 4
strPic = strPic & "<div class=""pic_photo_title"">" & strLink_Title & "</div>" & vbCrLf
End Select
End If
If ContentLen > 0 Then
strContent = Left(Replace(Replace(nohtml(rsPic("PhotoIntro")), ">", ">"), "<", "<"), ContentLen) & "……"
strLink_Content = GetInfoList_GetStrInfoLink(strList_Title, ShowTips, 1, "", strContent, InfoUrl, rsPic("PhotoName"), rsPic("Author"), rsPic("UpdateTime"))
Select Case PE_CLng(ShowType)
Case 1, 3
strPic = strPic & "<br><div align='left'>" & strLink_Content & "</div>"
Case 2
strPic = strPic & "</td><td valign='top' align='left'>" & strLink_Content
Case 4
strPic = strPic & "<div class=""pic_photo_content"">" & strLink_Content & "</div>" & vbCrLf
End Select
End If
If ShowType = 4 Then
strPic = strPic & "</div>" & vbCrLf
Else
strPic = strPic & "</td>"
End If
Else
strTitle = GetInfoList_GetStrTitle(rsPic("PhotoName"), TitleLen, 0, "")
strLink = GetPhotoUrl(rsPic("ParentDir"), rsPic("ClassDir"), rsPic("UpdateTime"), rsPic("PhotoID"), rsPic("ClassPurview"), rsPic("InfoPurview"), rsPic("InfoPoint"))
strAuthor = GetInfoList_GetStrAuthor_RSS(rsPic("Author"))
If ContentLen > 0 Then
strContent = Left(Replace(Replace(xml_nohtml(rsPic("PhotoIntro")), ">", ">"), "<", "<"), ContentLen)
End If
strPic = strPic & GetInfoList_GetStrRSS(xml_nohtml(strTitle), strLink, strContent, strAuthor, xml_nohtml(rsPic("ClassName")), rsPic("UpdateTime"))
End If
rsPic.MoveNext
iCount = iCount + 1
If PhotoNum = 0 And iCount >= MaxPerPage Then Exit Do
If ((iCount Mod Cols = 0) And (Not rsPic.EOF)) And ShowType < 4 Then strPic = strPic & "</tr><tr valign='top'>"
Loop
If ShowType < 4 Then strPic = strPic & "</tr></table>"
rsPic.Close
Set rsPic = Nothing
If ShowType = 5 And RssCodeType = False Then strPic = unicode(strPic)
GetPicPhoto = strPic
End Function
'=================================================
'函数名：GetSlidePicPhoto
'作 用：以幻灯片效果显示图片
'参 数：
'0 iChannelID ---- 频道ID
'1 arrClassID ---- 栏目ID数组，0为所有栏目
'2 IncludeChild ---- 是否包含子栏目，仅当arrClassID为单个栏目ID时才有效，True----包含子栏目，False----不包含
'3 iSpecialID ---- 专题ID，0为所有图片（含非专题图片），如果为大于0，则只显示相应专题的图片
'4 PhotoNum ---- 最多显示多少个图片
'5 IsHot ---- 是否是热门图片
'6 IsElite ---- 是否是推荐图片
'7 DateNum ---- 日期范围，如果大于0，则只显示最近几天内更新的图片
'8 OrderType ---- 排序方式，1--按图片ID降序，2--按图片ID升序，3--按更新时间降序，4--按更新时间升序，5--按点击数降序，6--按点击数升序，7--按评论数降序，8--按评论数升序
'9 ImgWidth ---- 图片宽度
'10 ImgHeight ---- 图片高度
'11 TitleLen ---- 图片标题字数限制，0为不显示，-1为显示完整标题
'12 iTimeOut ---- 效果变换间隔时间，以毫秒为单位
'13 effectID ---- 图片转换效果，0至22指定某一种特效，23表示随机效果
'=================================================
Public Function GetSlidePicPhoto(iChannelID, arrClassID, IncludeChild, iSpecialID, PhotoNum, IsHot, IsElite, DateNum, OrderType, ImgWidth, ImgHeight, TitleLen, iTimeOut, effectID)
Dim sqlPic, rsPic, i, strPic
Dim PhotoThumb, strTitle
PhotoNum = PE_CLng(PhotoNum)
ImgWidth = PE_CLng(ImgWidth)
ImgHeight = PE_CLng(ImgHeight)
If PhotoNum <= 0 Or PhotoNum > 100 Then PhotoNum = 10
If ImgWidth < 0 Or ImgWidth > 1000 Then ImgWidth = 150
If ImgHeight < 0 Or ImgHeight > 1000 Then ImgHeight = 150
If iTimeOut < 1000 Or iTimeOut > 100000 Then iTimeOut = 5000
If effectID < 0 Or effectID > 23 Then effectID = 23
FoundErr = False
If iChannelID <> PrevChannelID Or ChannelID = 0 Then
Call GetChannel(iChannelID)
End If
PrevChannelID = iChannelID
If FoundErr = True Then
GetSlidePicPhoto = ErrMsg
Exit Function
End If
sqlPic = "select top " & PhotoNum & " P.ChannelID,P.ClassID,P.PhotoID,P.PhotoName,P.UpdateTime,P.InfoPurview,P.InfoPoint,P.PhotoThumb"
sqlPic = sqlPic & ",C.ClassName,C.ClassDir,C.ParentDir,C.ClassPurview"
sqlPic = sqlPic & GetSqlStr(iChannelID, arrClassID, IncludeChild, iSpecialID, IsHot, IsElite, "", DateNum, OrderType, False, True)
Dim ranNum
Randomize
ranNum = Int(900 * Rnd) + 100
strPic = "<script language=JavaScript>" & vbCrLf
strPic = strPic & "<!--" & vbCrLf
strPic = strPic & "var SlidePic_" & ranNum & " = new SlidePic_Photo(""SlidePic_" & ranNum & """);" & vbCrLf
strPic = strPic & "SlidePic_" & ranNum & ".Width = " & ImgWidth & ";" & vbCrLf
strPic = strPic & "SlidePic_" & ranNum & ".Height = " & ImgHeight & ";" & vbCrLf
strPic = strPic & "SlidePic_" & ranNum & ".TimeOut = " & iTimeOut & ";" & vbCrLf
strPic = strPic & "SlidePic_" & ranNum & ".Effect = " & effectID & ";" & vbCrLf
strPic = strPic & "SlidePic_" & ranNum & ".TitleLen = " & TitleLen & ";" & vbCrLf
Set rsPic = Server.CreateObject("ADODB.Recordset")
rsPic.Open sqlPic, Conn, 1, 1
Do While Not rsPic.EOF
If iChannelID = 0 Then
If rsPic("ChannelID") <> PrevChannelID Then
Call GetChannel(rsPic("ChannelID"))
PrevChannelID = rsPic("ChannelID")
End If
End If
If Left(rsPic("PhotoThumb"), 1) <> "/" And InStr(rsPic("PhotoThumb"), "://") <= 0 Then
PhotoThumb = ChannelUrl & "/" & UploadDir & "/" & rsPic("PhotoThumb")
Else
PhotoThumb = rsPic("PhotoThumb")
End If
If TitleLen = -1 Then
strTitle = rsPic("PhotoName")
Else
strTitle = GetSubStr(rsPic("PhotoName"), TitleLen, ShowSuspensionPoints)
End If
strPic = strPic & "var oSP = new objSP_Photo();" & vbCrLf
strPic = strPic & "oSP.ImgUrl = """ & PhotoThumb & """;" & vbCrLf
strPic = strPic & "oSP.LinkUrl = """ & GetPhotoUrl(rsPic("ParentDir"), rsPic("ClassDir"), rsPic("UpdateTime"), rsPic("PhotoID"), rsPic("ClassPurview"), rsPic("InfoPurview"), rsPic("InfoPoint")) & """;" & vbCrLf
strPic = strPic & "oSP.Title = """ & strTitle & """;" & vbCrLf
strPic = strPic & "SlidePic_" & ranNum & ".Add(oSP);" & vbCrLf
rsPic.MoveNext
Loop
strPic = strPic & "SlidePic_" & ranNum & ".Show();" & vbCrLf
strPic = strPic & "//-->" & vbCrLf
strPic = strPic & "</script>" & vbCrLf
rsPic.Close
Set rsPic = Nothing
GetSlidePicPhoto = strPic
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -