账号通
    

账号  

密码  

3316

查看

5

回复
主题:[原创]自动读取已有文章正文200字节写入文章导读 [收藏主题] 本贴被认定为精华 转到:  
gxda112 当前离线

194

主题

1

广播

2

粉丝
添加关注
级别:一年级

用户积分:4384 分
登录次数:295 次
注册时间:2007/7/30
最后登录:2016/12/15
gxda112 发表于:2007/12/25 10:58:00   | 只看该作者 查看该作者主题 楼主 
科汛在线考试系统(NET)

把下面代码保存成 get_intro.asp 传到根目录。运行后删除。((如果想导读不为空也自动截取,请把红色去掉。))

本帖在这里发布过。http://bbs.kesion.com/dispbbs.asp?boardid=41&id=39804&star=2&page=1

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!--#include file="Conn.asp"-->
<%'批量取内容的前N个字符做导读
dim strlen '截取的字符数
strlen=200 '默认200个字符(100个汉字)
sql="select ChannelID,ChannelTable,ChannelName from KS_Channel where BasicType=1"
set mors=server.CreateObject("adodb.recordset")
mors.open sql,conn,1,1
if not (mors.bof and mors.eof) then
do while not mors.eof
sql="select Intro,ArticleContent from "&mors(1)&" where TID in(select id from KS_Class where ChannelID="&mors(1)&") and rtrim(Intro)='' or isnull(Intro) "
set rs=server.CreateObject("adodb.recordset")
rs.open sql,conn,1,3
if not (rs.bof and rs.eof) then
do while not rs.eof
rs(0)=GotTopic(LoseHtml(replace(rs(1),"[NextPage]","")),strlen)

'如果想去掉所有空格请把上面那句注释用下面这句

'rs(0)=GotTopic(replace(replace(LoseHtml(replace(rs(1),"[NextPage]",""))," ",""),"&nbsp;",""),strlen)
rs.update
rs.movenext
loop
response.write ""&mors(2)&"共批量替换了"&rs.recordcount&"条记录<br>"
else
response.write ""&mors(2)&"没有可替换的内容<br>"
end if
rs.close
set rs=nothing
mors.movenext
loop
response.write "批量替换完成"
else
response.write "没有可替换的内容<br>"
end if
conn.close
set conn=nothing


Function LoseHtml(ContentStr)
On Error Resume Next
Dim TempLoseStr, regEx
If ContentStr="" Or ContentStr=Null Then Exit Function
TempLoseStr = CStr(ContentStr)
Set regEx = New RegExp
regEx.Pattern = "<\/*[^<>]*>"
regEx.IgnoreCase = True
regEx.Global = True
TempLoseStr = regEx.Replace(TempLoseStr, "")
LoseHtml = TempLoseStr
End Function
'*************************************************************************
'函数名:gotTopic
'作 用:截字符串,汉字一个算两个字符,英文算一个字符
'参 数:str ----原字符串
' strlen ----截取长度
'返回值:截取后的字符串
'*************************************************************************
Function GotTopic(ByVal Str, ByVal strlen)
If Str = "" OR IsNull(Str) Then GotTopic = "":Exit Function
If strlen=0 Then GotTopic=Str:Exit Function
Dim l, T, c, I, strTemp
Str = Replace(Replace(Replace(Replace(Str, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
l = Len(Str)
T = 0
strTemp = Str
strlen = CLng(strlen)
For I = 1 To l
c = Abs(Asc(Mid(Str, I, 1)))
If c > 255 Then
T = T + 2
Else
T = T + 1
End If
If T >= strlen Then
strTemp = Left(Str, I)
Exit For
End If
Next
If strTemp <> Str Then strTemp = strTemp
GotTopic = Replace(Replace(Replace(Replace(strTemp, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
End Function%>


[此贴子已经被作者于2007-12-25 11:03:29编辑过]

 
  支持(0) | 反对(0) 回到顶部顶端 回到底部底部
gshch 当前离线

71

主题

0

广播

0

粉丝
添加关注
级别:学前班

用户积分:732 分
登录次数:64 次
注册时间:2007/1/21
最后登录:2009/2/18
gshch 发表于:2008/4/1 17:08:00   | 只看该作者 查看该作者主题 沙发 
科汛在线网校系统

太好了 正需要这个 那 非常感谢 看我历害

 
  支持(0) | 反对(0) 回到顶部顶端 回到底部底部
zhenfengdz 当前离线

3821

主题

0

广播

1

粉丝
添加关注
级别:大三

用户积分:21733 分
登录次数:436 次
注册时间:2007/1/9
最后登录:2013/4/24
zhenfengdz 发表于:2008/1/15 21:01:00   | 只看该作者 查看该作者主题 藤椅 
以下是引用rickson在2008-1-15 16:54:58的发言:
我早已发过:http://bbs.kesion.com/dispbbs.asp?BoardID=41&replyID=29366&id=36261&skin=0

不一样的,看仔细了。

 
  支持(0) | 反对(0) 回到顶部顶端 回到底部底部
rickson 当前离线

204

主题

0

广播

0

粉丝
添加关注
级别:二年级

用户积分:1621 分
登录次数:44 次
注册时间:2006/7/21
最后登录:2017/2/25
rickson 发表于:2008/1/15 16:54:00   | 只看该作者 查看该作者主题 板凳 
科汛在线考试系统(NET)
我早已发过:http://bbs.kesion.com/dispbbs.asp?BoardID=41&replyID=29366&id=36261&skin=0
 
  支持(0) | 反对(0) 回到顶部顶端 回到底部底部
gxda112 当前离线

194

主题

1

广播

2

粉丝
添加关注
级别:一年级

用户积分:4384 分
登录次数:295 次
注册时间:2007/7/30
最后登录:2016/12/15
gxda112 发表于:2008/1/15 15:13:00   | 只看该作者 查看该作者主题 报纸 
 
  支持(0) | 反对(0) 回到顶部顶端 回到底部底部
wubi 当前离线

611

主题

0

广播

0

粉丝
添加关注
级别:六年级

用户积分:2901 分
登录次数:89 次
注册时间:2007/12/1
最后登录:2008/1/25
wubi 发表于:2007/12/25 11:55:00   | 只看该作者 查看该作者主题 地板 
 
  支持(0) | 反对(0) 回到顶部顶端 回到底部底部
<上一主题 | 下一主题 >
Powered By KesionCMS Version X1
厦门科汛软件有限公司 © 2006-2016 页面执行1.28516秒 powered by KesionCMS 9.0