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
