一个为字符串中的网址加上链接的程序例子
类别: ASP教程
1. 首先,找出一段文字中有哪一些链接,把它们存于数组中
2.找出们在文本中的位置,把它们存放于数组中.
3.根据这些位置,把一整段文本分成一个个的小段,以便在中间插入链接.
4.在中间插入链接,并把这一段段的文本组合起来.
好了,基本思想就是这样,其实前面的3步完全可以合在一起完成的,但为了程序容易看懂,我就把它们分开了.
为了方便使用,我把它们做成了一个子函数,并顺便起了个名字叫CTOU()
用法:
1 把下面的代码复制到文件的任何一个位置,
2 如要把存于变量 MYDOC中的字符加上链接,就用MYDOC=CTOU(MYDOC)就行了.
代码如下:
Function CTOU(MYCH)
On Error Resume next
TE1=MYCH
IF INSTR(TE1,"_bLaNk")=0 THEN
TE2=LCASE(TE1)
zcd=len(te2)
dim star(100),myend(100),myurl(100),te3(100,2)
for i=1 to 100
CD=LEN(TE2)
STA=INSTR(TE2,"http://")
if sta=0 then
STAR(I)=ZCD+1
exit for
END IF
urla=mid(te2,sta,50)
urcd=instr(urla," ")
if urcd=0 then urcd=instr(urla," ")
if urcd=0 then urcd=instr(urla,"<br>")
if urcd=0 then urcd=instr(urla,chr(34))
if urcd=0 then urcd=instr(urla,"\'")
if urcd=0 then urcd=50
myurl(i)=mid(te2,sta,urcd-1)
MYEN=STA+URCD
if myen >= CD then exit for
te2=right(te2,CD-myen+2)
next
\'以上一段找出有哪一些URL
TE2=LCASE(TE1)
FOR II=1 TO I
IF MYURL(II)<>"" THEN
STAR(II)=INSTR(TE2,MYURL(II)&" ")
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II)&" ")
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II)&"<br>")
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II)&chr(34))
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II)&"\'")
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II))
MYEND(II)=STAR(II)+LEN(MYURL(II))
END IF
NEXT
\'以上一段找出这些URL的开始和结束位置
TE2=TE1
for i1=1 to i
if i1=1 then
te3(i1,1)=mid(te2,1,star(i1)-1)
else
te3(i1,1)=mid(te2,myend(i1-1),star(i1)-myend(i1-1))
end if
te3(i1,2)=mid(te2,star(i1),len(myurl(i1)))
next
\'以上一段把原来的字符串分成一个小的小段以便插入链接
for ii=1 to i
IF MYURL(II)<>"" THEN
newte=newte&te3(ii,1) &"<a target=\'_bLaNk\' href=\'"&te3(ii,2)&"\'>"&te3(ii,2)&"</a>"
ELSE
newte=newte&te3(ii,1)
END IF
next
\'以上一段插入链接
CTOU=NEWTE
ELSE
CTOU=TE1
END IF
END Function
2.找出们在文本中的位置,把它们存放于数组中.
3.根据这些位置,把一整段文本分成一个个的小段,以便在中间插入链接.
4.在中间插入链接,并把这一段段的文本组合起来.
好了,基本思想就是这样,其实前面的3步完全可以合在一起完成的,但为了程序容易看懂,我就把它们分开了.
为了方便使用,我把它们做成了一个子函数,并顺便起了个名字叫CTOU()
用法:
1 把下面的代码复制到文件的任何一个位置,
2 如要把存于变量 MYDOC中的字符加上链接,就用MYDOC=CTOU(MYDOC)就行了.
代码如下:
Function CTOU(MYCH)
On Error Resume next
TE1=MYCH
IF INSTR(TE1,"_bLaNk")=0 THEN
TE2=LCASE(TE1)
zcd=len(te2)
dim star(100),myend(100),myurl(100),te3(100,2)
for i=1 to 100
CD=LEN(TE2)
STA=INSTR(TE2,"http://")
if sta=0 then
STAR(I)=ZCD+1
exit for
END IF
urla=mid(te2,sta,50)
urcd=instr(urla," ")
if urcd=0 then urcd=instr(urla," ")
if urcd=0 then urcd=instr(urla,"<br>")
if urcd=0 then urcd=instr(urla,chr(34))
if urcd=0 then urcd=instr(urla,"\'")
if urcd=0 then urcd=50
myurl(i)=mid(te2,sta,urcd-1)
MYEN=STA+URCD
if myen >= CD then exit for
te2=right(te2,CD-myen+2)
next
\'以上一段找出有哪一些URL
TE2=LCASE(TE1)
FOR II=1 TO I
IF MYURL(II)<>"" THEN
STAR(II)=INSTR(TE2,MYURL(II)&" ")
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II)&" ")
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II)&"<br>")
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II)&chr(34))
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II)&"\'")
IF STAR(II)=0 THEN STAR(II)=INSTR(TE2,MYURL(II))
MYEND(II)=STAR(II)+LEN(MYURL(II))
END IF
NEXT
\'以上一段找出这些URL的开始和结束位置
TE2=TE1
for i1=1 to i
if i1=1 then
te3(i1,1)=mid(te2,1,star(i1)-1)
else
te3(i1,1)=mid(te2,myend(i1-1),star(i1)-myend(i1-1))
end if
te3(i1,2)=mid(te2,star(i1),len(myurl(i1)))
next
\'以上一段把原来的字符串分成一个小的小段以便插入链接
for ii=1 to i
IF MYURL(II)<>"" THEN
newte=newte&te3(ii,1) &"<a target=\'_bLaNk\' href=\'"&te3(ii,2)&"\'>"&te3(ii,2)&"</a>"
ELSE
newte=newte&te3(ii,1)
END IF
next
\'以上一段插入链接
CTOU=NEWTE
ELSE
CTOU=TE1
END IF
END Function
- 上一篇: ASP项目中的通用条件查询模块
- 下一篇: 用AGENT+ASP技术制作语音聊天室
-= 资 源 教 程 =-
文 章 搜 索