在文章内容中，我发现前端时间大家在讨论文章显示内容画中画的功能，实际上这个功能对于本人是没有什么用的，因为本人是写JAVA的，对于ASP这种东西我也不是太懂！！！但是本着学习风讯的态度，本着贡献的态度，就草草的写了一个实现出来，希望大家不要笑话我！！！如果有什么不对的地方或者代码可以写的更漂亮的地方，希望大家给予我修改一下，同时告诉大家，这种实现，我已经在风讯的管理控制台上，增加了相应的控制画中画的代码，并且可以控制画中画显示的日期长短！！！！你也可以根据你的需要来不停的修改画中画显示的方式。
主要是要分析文章找到适当的插入画中画广告的位置，就是再那个字符后面插入的问题，你仔细看看我上面的图片，就会发现是断了句子的，这个不好，最好的方式是增加我下面代码中分析功能的那个函数的分析功能，智能判断如果不是新的行，就继续下移一个插入字符，直到找到新的行位置，再插入，比较好
2。找到Function GetNewsContent(TempletContent,NewsRecordSet,NewsContent) 这个函数，大约在282行左右，不一定，因为我更改了很多的风讯的东西。
Function GetNewsContent(TempletContent,NewsRecordSet,NewsContent)
TempletContent = Replace(TempletContent,"{News_Title}",NewsRecordSet("Title"))
if Not IsNull(NewsRecordSet("SubTitle")) then
TempletContent = Replace(TempletContent,"{News_SubTitle}",NewsRecordSet("SubTitle"))
else
TempletContent = Replace(TempletContent,"{News_SubTitle}","")
end if
if Not IsNull(NewsRecordSet("Author")) then
TempletContent = Replace(TempletContent,"{News_Author}",NewsRecordSet("Author"))
else
TempletContent = Replace(TempletContent,"{News_Author}","")
end if
'====================================================开始
'分析文章内容，插入广告代码,todo:将在数据中设置一个字段来设置是否文章中包含广告内容
Dim LeftContent,MidAdContent,RightContent,ModifyContent,headlen,tempStr,headAdStr,tailAdStr
'截取字符串
if len(NewsContent)<400 then
headlen=len(NewsContent)/2
else
headlen=400
end if
tempStr=NewsContent
LeftContent=InterceptString(tempStr,headlen)
'获取实际的截取的长度
RightContent=Right(NewsContent,Len(NewsContent)-Len(LeftContent))
headAdStr="<table border=0 cellspacing=0 cellpadding=0 align=left><tr><td><div id=""embedAd"" name=""embedAd"" style=""DISPLAY:""><!--画中画广告开始--><table border=0 cellspacing=0 cellpadding=0 style=""margin-top:5px;margin-bottom:3px;margin-left:7px;margin-right:8px""><tr><td><!--画中画开始-->"
tailAdStr="<!--画中画开始--></td></tr></table></td></tr></table><!--画中画广告结束--></div>"
ModifyContent=LeftContent & headAdStr & "<script src=/JS/AdsJS/801.js>< /script>" & tailAdStr & RightContent
TempletContent = Replace(TempletContent,"{News_Content}",ModifyContent)
'TempletContent = Replace(TempletContent,"{News_Content}",NewsContent)
'===================================================结束if Not IsNull(NewsRecordSet("TxtSource")) then
TempletContent = Replace(TempletContent,"{News_TxtSource}",NewsRecordSet("TxtSource"))
else
TempletContent = Replace(TempletContent,"{News_TxtSource}","")
end if
if Not IsNull(NewsRecordSet("Editer")) then
TempletContent = Replace(TempletContent,"{News_TxtEditer}",NewsRecordSet("Editer"))
else
TempletContent = Replace(TempletContent,"{News_TxtEditer}","")
end if
if Not IsNull(NewsRecordSet("AddDate")) then
TempletContent = Replace(TempletContent,"{News_AddDate}",NewsRecordSet("AddDate"))
else
TempletContent = Replace(TempletContent,"{News_AddDate}","")
end if
TempletContent = Replace(TempletContent,"{News_SendFriend}","<a href=" & AvailableDoMain & "/" & "Sendmail.asp?NewsID=" & NewsRecordSet("NewsID") & " target=""_blank"">发送给好友</a>")
TempletContent = Replace(TempletContent,"{News_ClickNum}","<script src=" & AvailableDoMain & "/" & "Click.asp?NewsID="& RefreshID &"></script>")
TempletContent = Replace(TempletContent,"{News_ReviewContent}","<script src=" & AvailableDoMain & "/" & "ReviewContent.asp?NewsID="& NewsRecordSet("NewsID") &"></script>")
'Added By Koolls at 2005.10.11
TempletContent = Replace(TempletContent,"{News_Favorite}","<a target=""_blank"" Href=" & AvailableDoMain & "/" & UserDir &"/AddFavorite.asp?NewsID="& NewsRecordSet("ID") &">添加到收藏夹</a>")
Dim ReviewStr
if NewsRecordSet("ReviewTF") = 1 then
ReviewStr = "<table width=""100%"" border=""0"" cellpadding=""3"" cellspacing=""1""><form name=""form1"" method=""post"" action=""" & AvailableDoMain & "/" & "NewsReview.asp?action=add&NewsID=" & NewsRecordSet("NewsID") & """><tr>"
ReviewStr = ReviewStr & "<td width=""21%""><div align=right>会员名称：</div></td>"
ReviewStr = ReviewStr & "<td width=""79%""> <input name=""MemName"" type=""text"" id=""MemName"" size=""10"" value="""">密码：<input name=""Password"" type=""password"" size=""8"" id=""Password""><input name=""NoName"" type=""checkbox"" id=""NoName"" value=""1"">匿名 <font color=""#FF0000"">·</font><a href=""" & AvailableDoMain & "/"& UserDir &"/sRegister.asp""><font color=""#FF0000"">注册</font></a>·<a href=""" & AvailableDoMain & "/"& UserDir &"/User_GetPassword.asp"">忘记密码？</a></td></tr>"
ReviewStr = ReviewStr & "<td> <input name=""NewsID"" type=""hidden"" id=""NewsID"" value=""" & NewsRecordSet("NewsID") & """>"
ReviewStr = ReviewStr & "<input name=""action"" type=""hidden"" id=""action"" value=""add""></tr>"
ReviewStr = ReviewStr & "<tr><td> <div align=""right"">评论内容：<br>(最多300个字符) </div></td><td> <textarea name=""RevContent"" cols=""40"" rows=""5"" id=""RevContent""></textarea></td></tr>"
ReviewStr = ReviewStr & "<tr><td></td><td> <input type=""submit"" name=""Submit"" value=""发表""> <a href=""" & AvailableDoMain & "/" & "NewsReview.asp?NewsID=" & NewsRecordSet("NewsID") & """><font color=red><b>查看评论</b></font></a></td></tr></form></table>"
else
ReviewStr = ""
end if
TempletContent = Replace(TempletContent,"{News_Review}",ReviewStr)
GetNewsContent = TempletContent
End Function
'"************ 截取字符串 **************
Function InterceptString(txt,length)
Dim x,y,ii,c,ischines,isascii,tempStr
txt=trim(txt)
x = len(txt)
y = 0
if x >= 1 then
for ii = 1 to x
c=asc(mid(txt,ii,1))
if c< 0 or c >255 then
'说明是一个中文字符
y = y + 2
ischines=1
isascii=0
else
'说明是一个ascii码
y = y + 1
ischines=0
isascii=1
end if
'如果长度已经大于定义子字符串长度，就判断是否包含敏感字符串是否分开
if y >= length then
if ischines=1 and StrCount(left(trim(txt),ii),"<a")=StrCount(left(trim(txt),ii),"</a>") then
txt = left(trim(txt),ii) '"字符串限长
exit for
else
if isascii=1 then x=x+1
end if
end if
next
InterceptString = txt
else
InterceptString = ""
end if
End Function
'判断字符串出现的次数
Function StrCount(Str,SubStr)
Dim iStrCount
Dim iStrStart
Dim iTemp
iStrCount = 0
iStrStart = 1
iTemp = 0
Str=LCase(Str)
SubStr=LCase(SubStr)
Do While iStrStart < Len(Str)
iTemp = Instr(iStrStart,Str,SubStr,vbTextCompare)
If iTemp <=0 Then
iStrStart = Len(Str)
Else
iStrStart = iTemp + Len(SubStr)
iStrCount = iStrCount + 1
End If
Loop
StrCount = iStrCount
End Function
