A program example that adds links to URLs in a string

Source: Internet
Author: User
Tags exit chr insert
We may sometimes have such a request, if we enter a paragraph with the link text, such as: "Today, I visited the CCTV website: http://www.cctv.com" Then, we hope to automatically for our "http://www.cctv.com" These characters plus links, in fact, many sites have this feature, therefore, Ayu also tried to write a piece of such a small program, one can be used to facilitate everyone, another can also provide beginners with a bit of source code, so the process of the code as far as possible to write as simple and understandable, so some places seem to have a little Russell. Of course, the master will give Ayuti point of view. Ah Yu's standing: http://www.zydn.net/index.asp welcome experts to criticize.

All right. Here are some basic ideas for this program

1. First, find out what links are in the text and put them in the array

2. Find out where they are in the text and place them in an array.

3. According to these positions, a whole paragraph of text is divided into small paragraphs to insert a link in the middle.

4. Insert the link in the middle and combine the text of the paragraph.

Well, the basic idea is this, in fact, the previous 3 steps can be fully completed together, but for the program easy to understand, I will separate them.

For ease of use, I made them into a child function and, by the way, a name called Ctou ()

Usage:

1 Copy the following code to any location in the file,

2 If you want to add a link to the characters stored in the variable MYDOC, use Mydoc=ctou (MYDOC) on the line.

The code is as follows:

Function Ctou (Mych)
On Error Resume Next
Te1=mych
IF INSTR (TE1, "_blank") =0 THEN
Te2=lcase (TE1)
Zcd=len (TE2)
Dim Star (MB), Myend (M), Myurl (M), 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
' The above section finds out which URLs
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) &AMP;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
' The above section finds out where these URLs start and end.
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
The above paragraph divides the original string into a small segment to insert the link
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
' Above paragraph insert link
Ctou=newte
ELSE
Ctou=te1
End IF
End Function



Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.