|
发表于 2006-10-3 00:15:31
|
显示全部楼层
") For i = 0 To UBound(arrTempContents) ArrayList = Split(arrTempContent(i), ",") strTemp = Replace(strTemp, arrTempContents(i), NewsPictureAndText(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10), ArrayList(11), ArrayList(12), ArrayList(13), ArrayList(14), ArrayList(15), ArrayList(16), ArrayList(17))) Next End If ReadNewsPicAndText = strTemp End Function '================================================ '函数名:SoftPictureAndText '作 用:软件图文混排列表 '================================================ Public Function SoftPictureAndText(ByVal chanid, ByVal ClassID, ByVal specid, _ ByVal stype, ByVal height, ByVal width, ByVal maxlen, _ ByVal maxline, ByVal hspace, ByVal vspace, ByVal align, _ ByVal divcss, ByVal target, ByVal start, ByVal showpic, _ ByVal showclass, ByVal showdate, ByVal dateformat)
Dim Rs, SQL, i, strContent, foundstr Dim ChildStr, HtmlFileUrl, HtmlFileName, strPicture Dim SoftTopic, ClassName, softname, SoftTime
chanid = Newasp.ChkNumeric(chanid) ClassID = Newasp.ChkNumeric(ClassID) specid = Newasp.ChkNumeric(specid) stype = Newasp.ChkNumeric(stype)
On Error Resume Next Newasp.LoadChannel(chanid)
If CInt(stype) >= 3 And CLng(ClassID) <> 0 Then SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID = " & chanid & " And ClassID = " & ClassID Set Rs = Newasp.Execute(SQL) If Rs.BOF And Rs.EOF Then Set Rs = Nothing SoftPictureAndText = "" Exit Function Else ChildStr = Rs("ChildStr") End If Rs.Close Else ChildStr = "0" End If Select Case CInt(stype) Case 0: foundstr = "ORDER BY A.SoftTime DESC ,A.softid DESC" Case 1: foundstr = "And A.isBest > 0 ORDER BY A.SoftTime DESC ,A.softid DESC" Case 2: foundstr = "ORDER BY A.AllHits DESC ,A.softid DESC" Case 3: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.SoftTime DESC ,A.softid DESC" Case 4: foundstr = "And A.ClassID in (" & ChildStr & ") And A.isBest > 0 ORDER BY A.SoftTime DESC ,A.softid DESC" Case 5: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.AllHits DESC ,A.softid DESC" Case Else foundstr = "ORDER BY A.SoftTime DESC ,A.softid DESC" End Select If CInt(stype) >= 3 And CLng(ClassID) = 0 Then foundstr = "ORDER BY A.SoftTime DESC ,A.softid DESC" End If If CLng(specid) > 0 Then foundstr = "And A.SpecialID =" & CLng(specid) & " " & foundstr End If SQL = " A.softid,A.ClassID,A.ColorMode,A.FontMode,A.SoftName,A.SoftVer,A.AllHits,A.SoftTime,A.HtmlFileDate,A.isBest," SQL = "SELECT TOP " & CInt(maxline) & SQL & " C.ClassName,C.ColorModes,C.FontModes,C.HtmlFileDir FROM [NC_SoftList] A INNER JOIN [NC_Classify] C ON A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & chanid & " " & foundstr & "" Set Rs = Newasp.Execute(SQL) i = 0 strContent = "" If Rs.BOF And Rs.EOF Then strContent = "还没有添加任何软件!" Else Do While Not Rs.EOF SoftTopic = Newasp.ReadTopic(Trim(Rs("SoftName") & " " & Rs("SoftVer")), CInt(maxlen)) SoftTopic = Newasp.ReadFontMode(SoftTopic, Rs("ColorMode"), Rs("FontMode")) ClassName = Newasp.ReadFontMode(Rs("ClassName"), Rs("ColorModes"), Rs("FontModes")) HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("softid"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "") If CInt(Newasp.ChannelUseHtml) > 0 Then HtmlFileUrl = Newasp.ChannelPath & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName ClassName = "[<a href='" & Newasp.ChannelPath & Rs("HtmlFileDir") & "index" & Newasp.ChannelHtmlExt & "'>" & ClassName & "</a>]" Else HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("softid") ClassName = "[<a href='" & Newasp.ChannelPath & "list.asp?classid=" & Rs("ClassID") & "'>" & ClassName & "</a>]" End If If CInt(showclass) = 1 Then ClassName = ClassName Else ClassName = "" End If If CInt(showdate) = 1 Then SoftTime = Newasp.ShowDateTime(Rs("SoftTime"), CInt(dateformat)) Else SoftTime = "" End If softname = "<div " & divcss & ">" & start & ClassName & " <a href=""" & HtmlFileUrl & """ target=""" & target & """ title=""" & Newasp.ChannelModule & "标题:" & Rs("SoftName") & " " & Rs("SoftVer") & "
发布时间:" & Rs("SoftTime") & "
阅览次数:" & Rs("AllHits") & """ class=showlist>" & SoftTopic & "</a> " & SoftTime & "</div>" strContent = strContent & softname Rs.MoveNext i = i + 1 Loop End If Rs.Close: Set Rs = Nothing Dim sExtName, ExtName, SoftImage If CInt(showpic) = 1 Then SQL = " A.softid,A.ClassID,A.SoftName,A.SoftVer,A.AllHits,A.SoftTime,A.HtmlFileDate,A.SoftImage," SQL = "SELECT " & SQL & " C.HtmlFileDir,B.ChannelDir,B.ModuleName,B.BindDomain,B.DomainName,B.IsCreateHtml,B.HtmlExtName,B.HtmlPath,B.HtmlForm,B.HtmlPrefix,B.LeastHotHist FROM ([NC_SoftList] A INNER JOIN [NC_Classify] C ON A.ClassID=C.ClassID) INNER JOIN [NC_Channel] B On A.ChannelID=B.ChannelID WHERE A.isAccept>0 And A.ChannelID=" & CInt(chanid) & " And A.SoftImage<>'' " & foundstr & "" Set Rs = Newasp.Execute(SQL) If Rs.BOF And Rs.EOF Then strPicture = "<img src='" & Newasp.SiteUrl & Newasp.InstallDir & "images/no_pic.gif' width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """ border=""0"">" Else HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("softid"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "") If CInt(Newasp.ChannelUseHtml) <> 0 Then HtmlFileUrl = Newasp.ChannelPath & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName Else HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("softid") End If SoftImage = Newasp.GetImageUrl(Rs("SoftImage"), Newasp.ChannelData(1)) sExtName = Split(Rs("SoftImage"), ".") ExtName = sExtName(UBound(sExtName)) Select Case LCase(ExtName) Case "swf", "swi" strPicture = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """>" & vbNewLine strPicture = strPicture & " <param name=""movie"" value=""" & SoftImage & """>" & vbNewLine strPicture = strPicture & " <param name=""quality"" value=""high"">" & vbNewLine strPicture = strPicture & " <embed src=""" & SoftImage & """ width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """ quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash""></embed>" & vbNewLine strPicture = strPicture & "</object>" & vbNewLine Case Else strPicture = "<a href=""" & HtmlFileUrl & """ target=""" & target & """ title=""" & Newasp.ChannelModule & "标题:" & Rs("SoftName") & " " & Rs("SoftVer") & "
发布时间:" & Rs("SoftTime") & "
阅览次数:" & Rs("AllHits") & """><img src=""" & SoftImage & """ width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """ border=""0""></a>" End Select End If Rs.Close: Set Rs = Nothing Else strPicture = "" End If SoftPictureAndText = strPicture & strContent End Function '================================================ '函数名:ReadSoftPicAndText '作 用:读取软件图文混排列表 '参 数:str ----原字符串 '================================================ Public Function ReadSoftPicAndText(ByVal str) On Error Resume Next Dim strTemp, i, sTempContent Dim nTempContent, ArrayList Dim arrTempContent, arrTempContents
strTemp = str If InStr(strTemp, "{$SoftPictureAndText(") > 0 Then sTempContent = Newasp.CutMatchContent(strTemp, "{$SoftPictureAndText(", ")}", 1) nTempContent = Newasp.CutMatchContent(strTemp, "{$SoftPictureAndText(", ")}", 0) arrTempContents = Split(sTempContent, " |
|