?
Solved

another stupid vb question.... finding a hyper link in a string

Posted on 2003-03-03
9
Medium Priority
?
224 Views
Last Modified: 2010-04-07
Ok...I need to find a hyperlink in a string coming from one text box to another...
expample:

dim sData as string
dim TheLink as string
private sub cmdSend_Click()
text1.text = text2.text & vbcrlf
sData = text2.text
Text2.text = ""

Now I need to tell if sdata has a hyperlink in it and if so catch the hyperlink starting at (http://) would do and
end at (.com,.net,.org etc) so that is link is populated with the hyperlink... (http://www.whatever.com)...then, to finish, I need to obviously make the link blue and underlined and if possible, clickable and change the mouse pointer etc... like yahoo messanger or msn messanger. I can user RTF text boxes if needed, but normal text boxes might be better, i also have a legit copy of txtext control v6 if someone has an example or something using that... I knwo this has been done already and I really don't want to re-invent the wheel here...

I breifly tried
Private Function IsHyper()
If sData = "" Then
'Do nothing
Else
Dim LookHyper 'Store the string
LookHyper = Split(sData, "http://", -1) 'check for hyperlink
If LookHyper(0) <> "" Then ' if "" then nothing found otherwise we have a hyper link
IsHyper = True ' set is hyperlink to true
Else
IsHyper = False ' no hyperlink found
LookHyper = "" ' clear the string
sData = ""
msgbox IsHyper
End If

I always get true after sending a link...hmmmmmm

I will set the points to 50.

again thanks for looking at this.
0
Comment
Question by:flosoft
9 Comments
 
LVL 22

Expert Comment

by:Mohammed Nasman
ID: 8060598
Hello

  Try to initialize the IsHayber first

Private Function IsHyper()
IsHyper = False
...
...
...

so in this situation you will get IsHyper True when there's a link
0
 
LVL 32

Expert Comment

by:Brendt Hess
ID: 8060615
You should check the UBOUND() of the LookHyper array, e.g.:

If UBound(LookHyper) > 0 Then '.....

Reason:  If not http:// is found, then the SPLIT will place all of the incoming text in LookHyper(0) (so it will not be "").  UBound will be 0.

If UBound is > 0, then at least one instance of http:// was found, and you need to parse for hyperlinks.

(BTW, would it not be easier to use:

Dim I as Integer
I = InStr(1, sData, "http://", vbCompareText)
If I > 0 Then  ' Found a hyperlink, and know it starts at position I
0
 

Author Comment

by:flosoft
ID: 8060832
I was kinda looking for a decent example of the entire process including the underlining and coloring and maybe linking the text in the receiving box as I know this has been done a zillion times, and this part (as well as a few others) I am still kinda novice at. I increased the points to 100 in hopes of getting such an example.

Thanks
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 2

Expert Comment

by:navneet77
ID: 8062211
Hi,

Here is a function i wrote which will tell if the input string is a hyperlink. It will check if it start with http:// and end with .com/.net/.org you can add more domains

Private Sub check(str As String)
Dim b As Boolean
Dim c As Boolean
Dim s As Long
b = True
c = False
s = InStr(1, str, "http://", vbTextCompare)
If s = 0 Then
b = False
End If
s = InStr(Len(str) - 3, str, ".com", vbTextCompare)
If s > 0 Then
c = True
End If
s = InStr(Len(str) - 3, str, ".net", vbTextCompare)
If s > 0 Then
c = True
End If

s = InStr(Len(str) - 3, str, ".org", vbTextCompare)
If s > 0 Then
c = True
End If

MsgBox b And c
End Sub

To display the link with underline you can use various free components and change the font property and you can use shellexecute api to go to the link when user clicks

some links are:
http://www.codetoad.com/vb_activex_controls.asp 
http://www.vbweb.co.uk/search.aspx

hope this helps
0
 
LVL 2

Expert Comment

by:navneet77
ID: 8062235
Or better use this if you want to check if it start with http://

Private Sub check(str As String)
Dim b As Boolean
Dim c As Boolean
Dim s As Long
b = True
c = False
'changed to check if the string start with http://
's = InStr(1, str, "http://", vbTextCompare)
'If s = 0 Then
'b = False
'End If
If Left$(str, 7) <> "http://" Then
b = False
End If

s = InStr(Len(str) - 3, str, ".com", vbTextCompare)
If s > 0 Then
c = True
End If
s = InStr(Len(str) - 3, str, ".net", vbTextCompare)
If s > 0 Then
c = True
End If

s = InStr(Len(str) - 3, str, ".org", vbTextCompare)
If s > 0 Then
c = True
End If

MsgBox b And c
End Sub
0
 

Author Comment

by:flosoft
ID: 8084653
Any suggestions then on how to highlight just the hyperlink line in the receiving textbox? This is a standard textbox... or perhaps a rtf text box could be used... once it recieves the text, how do you select just the hyperlink to set fontcolor =  vbblue set font underline = true... Everytime I try this I get all the text changes...as far as the link, I can have the program store a line number for the text box?? can you determine a line number in a text box and look at just that lines value and then set font color etc?? This would be great because then when the filter detects a link it could capture the text box line number, set the link as underline / blue and then save that hyperlink to match that line, then you could launch the exact link even if the textbox recieves links in every line.... Should I raise the points??
0
 
LVL 2

Accepted Solution

by:
navneet77 earned 200 total points
ID: 8085067
flosoft i dont know how to color a line but you can edit the richtextbox by something like this.
rtb is a richtextbox
the code will color and underline all http://somedomain.com

Private Sub Command1_Click()
Dim a As String
Dim c As String
Dim l As Long
Dim x As String
rtb.Text = "sometext here http://somedomain.com" & vbNewLine & "http://asdhjadhk.com"

l = InStr(1, rtb.TextRTF, "}}", vbTextCompare)

c = vbNewLine & "{\colortbl;\red0\green0\blue255;}"
x = Left$(rtb.TextRTF, l + 1) & c & Mid$(rtb.TextRTF, l + 2)
a = Replace(x, "http:", "\cf1\ul http:")
a = Replace(a, ".com", ".com\cf0\ulnone ")
rtb.TextRTF = a
Text1.Text = rtb.TextRTF
End Sub


Hope it help
 Navneet
0
 

Author Comment

by:flosoft
ID: 8178802
none of the suggestions here seem to be what I was asking for... I would to close out the Q, how do you do this...or does someone know the code to at least take the link and underline it and make it blue? clickable would be better yet...??
0
 

Author Comment

by:flosoft
ID: 8269096
not exactly what I was looking for, but helpful. Thanks
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses
Course of the Month9 days, 19 hours left to enroll

571 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question