[SRC] + [Function] Check_Similar_Words [by *PsYkE1*]

Hi all, I present my last function: Check_Similar_Words

What does
Search for similar words in a text string, you will get a result similar to typical Google: "Did you mean ..."

How it works
What it does is storage in an array all the words it finds in the string to be parsed once here, decompose the word to search for in the shares of the number of matches we want to look, I'll give you an example:
Suppose you want to find the word "little" and tells the function to look for similar words with three matches, then split the word to look like this:

Quote:

---

lit
itt
ttl
tle

---

The formula to get the number of fragments is:

Code:

---

(X - n) + 1

---

Where x is the number of digits of the word n the digits in which you want to spread the word ... : D

Would check if the words of the string containing some of these pieces and would get into a Collection.
The funny thing is that according to the number of matches to say, the search will be more or less strict. :)

vb Code:

'==================================================================================================
' º Function *: Check_Similar_Words
' º Version * : 1.2
' º Author * *: Mr.Frog ©
' º Country * : Spain
' º Mail * * *: [email protected]
' º Twitter * : http://twitter.com/#!/PsYkE1
' º Recommended Websites :
' * * * http://visual-coders.com.ar
' * * * http://InfrAngeluX.Sytes.Net
'==================================================================================================
 
Option Explicit
Option Base 0
 
Private Declare Function lstrcmpi Lib "kernel32" Alias "lstrcmpiA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
 
Public Function Check_Similar_Words(ByVal sStringToAnalyze As String, ByVal sWord As String, ByVal bvComparationLevel As Byte) As Collection
Const sNullChars * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *As String = ".,"
Dim cTemp * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * As New Collection
Dim sCompareWord() * * * * * * * * * * * * * * * * * * * * * * * * * * * * *As String
Dim sTextWord() * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * As String
Dim sActualWord * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * As String
Dim lTotalCompWords * * * * * * * * * * * * * * * * * * * * * * * * * * * * As Long
Dim lTotalWords * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * As Long
Dim lLenWord * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *As Long
Dim Q * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * As Long
Dim G * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * As Long
 * *
 * *If CBool(bvComparationLevel) Then
 * * * *lLenWord = Len(sWord)
 * * * *If (lLenWord > 2) And (Len(sStringToAnalyze) > lLenWord) Then
 * * * * * *If (bvComparationLevel < lLenWord) Then
 * * * * * * * *If Not (InStrB(sWord, vbNewLine)) Then
 * * * * * * * * * *G = 1
 * * * * * * * * * *
 * * * * * * * * * *lTotalCompWords = (lLenWord - bvComparationLevel) + 1
 * * * * * * * * * *ReDim sCompareWord(lTotalCompWords) As String
 * * * * * * * * * *
 * * * * * * * * * *Do Until Q = lTotalCompWords
 * * * * * * * * * * * *sCompareWord$(Q) = Mid$(sWord, G, bvComparationLevel)
 * * * * * * * * * * * *G = G + 1
 * * * * * * * * * * * *Q = Q + 1
 * * * * * * * * * *Loop
 * * * * * * * * * *
 * * * * * * * * * *sStringToAnalyze = Replace$(sStringToAnalyze, vbNewLine, Space$(1))
 * * * * * * * * * *sTextWord() = Split(sStringToAnalyze, Space$(1))
 * * * * * * * * * *
 * * * * * * * * * *lTotalWords = UBound(sTextWord)
 * * * * * * * * * *lTotalCompWords = lTotalCompWords - 1
 * * * * * * * * * *
 * * * * * * * * * *For Q = 0 To lTotalWords
 * * * * * * * * * * * *sActualWord = sTextWord(Q)
 * * * * * * * * * * * *If Len(sActualWord) >= bvComparationLevel Then
 * * * * * * * * * * * * * *For G = 0 To lTotalCompWords
 * * * * * * * * * * * * * * * If CBool(lstrcmpi(sWord, sActualWord)) Then
 * * * * * * * * * * * * * * * * * *If InStrB(1, sActualWord, sCompareWord(G), vbTextCompare) Then
 * * * * * * * * * * * * * * * * * * * *If InStrB(sNullChars$, Right$(sActualWord, 1)) Then
 * * * * * * * * * * * * * * * * * * * * * *sActualWord = Left$(sActualWord, Len(sActualWord) - 1)
 * * * * * * * * * * * * * * * * * * * *End If
 * * * * * * * * * * * * * * * * * * * *On Error Resume Next
 * * * * * * * * * * * * * * * * * * * *cTemp.Add sActualWord, sActualWord
 * * * * * * * * * * * * * * * * * *End If
 * * * * * * * * * * * * * * * *End If
 * * * * * * * * * * * * * *Next G
 * * * * * * * * * * * *End If
 * * * * * * * * * *Next Q
 * * * * * * * * * *
 * * * * * * * * * *Set Check_Similar_Words = cTemp
 * * * * * * * *End If
 * * * * * *End If
 * * * *End If
 * *End If
End Function

A practical example:

I have a TextBox (named Text1) this:

Quote:

---

Cervantes's inspiration to compose this work came, apparently, the so-called Romance, which was earlier (although this is disputed). His argument ridicules believing a farmer who goes mad hero of romance. The farmer left his wife, and fell to the roads, as did Don Quixote. This appetizer has a double reading: it is also a criticism of Lope de Vega, who, after having written many autobiographical romances where it had his love, left his wife and went to the Armada. Interest is known by the ballads of Cervantes and his resentment at being kicked out of the theaters by the most successful of Lope de Vega, and whether they are of great appetizers. One argument in favor of this hypothesis would be that, despite the narrator tells us that Don Quixote is mad because of reading books of chivalry, in his first start romances recited constantly, especially in times of more madness. Therefore, it could be a plausible hypothesis. To this was added the influence of the White Joanot Tirante Martorell, that of Pulci Morgante of Luigi and the Orlando Furioso of Ludovico Ariosto.

---

I make a call like this:

vb Code:

Private Sub Form_Load()
    Dim vItem         As Variant
 
    Debug.Print "--------------->"; Time$
    For Each vItem In Check_Similar_Words(Text1.Text, "argumento", 3)
        Debug.Print vItem
    Next vItem
End Sub

And get this in the ListBox:

Quote:

---

apparently
went
resentment

---

In contrast, if instead of 3 in the call put 4 the search becomes more similar words strictest and obtain this:

Quote:

---

resentment

---

I hope you liked it! : -*

Sorry for my English, becouse I'm spanish...:sick:

Hi and welcome to the forum.

I didn't test your code, but I like the description of what it is supposed to do. I'll give it a try later (don't have VB6 at the moment).

I just have two comments. First, the formating is a bit of with [/code] and [/quote] tags, a few line breaks also. Two, this section of the forum is mainly for asking questions and getting help. If you want to share some function or working code you made, you should look into the CodeBank section that is set up just for that. I'll notify the mods to move it there for you.

Keep up the good work!

EDIT: Comment #3, you might want to remove your e-mail address from the post, as spammers have bots that scavange websites and forums for email addresses. Publishing it like that is a good way of ending up on a spammers list and getting tons of it. ;)

hahahaha ok :blush:
sorry for the mistakes, will not happen again, I would like you to give me your opinion after that you test it, ¿ok? :thumb:
See you :wave:

EDIT: i fixed what you told me

Don't worry about it. There are a lot of sections on the forums so it takes some time to get used to. I'll post my comments as soon as I give it a try.

Moved To The CodeBank

I tested the function and I corrected mistakes so please try it!;)

Bye

I have greatly improved function. Especially the speed.
See it again please and give me your opinion.