【www.hzclsc.cn--热门资讯】

我们有时候可能会有这样的要求,如果我们输入了一段带有链接的文字,如:“　今天，我访问了中央电视台的网站：http://www.cctv.com ”那么，我们希望能自动为我们的“http://www.cctv.com”这几个字符加上链接，事实上，很多网站都有这个功能，因此，阿余也试着写了一段这样的小程序，一个可以用来方便大家，另一个也可以为初学者提供一点源代码，所以，代码的过程阿余尽可能的写得简单易懂，所以有的地方看起来就有一点罗索了。当然，高手看了就要给阿余提点意见了。阿余的站在：http://www.zydn.net/index.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,"
")

  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)&"
")

   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)   &""&te3(ii,2)&""

 ELSE

  newte=newte&te3(ii,1)   

 END IF

next

'以上一段插入链接

  CTOU=NEWTE

ELSE

  CTOU=TE1

END IF

END Function

本文来源：http://www.hzclsc.cn/news/26467.html