SoundEx Search

This code has been declared by its author to be Public Domain code.

SoundEx Search by Dr. Wildrick

2005

This function generates SoundEx codes. Soundex is way of comparing what words sound like. So if two words have the same Soundex code they sound similar. This can be used for spell checking (to suggest entries in the dictionary that might be what they were trying to spell), database searches, Artificial intelligence the list goes on. Basically if you have a word and you want to find any word or entry that sounds similar to it... this function is for you. Its use is simple you call the function with the word as a parameter. You get back a 4 byte string. A letter followed by 3 numbers. The letter helps you narrow down your search to just words that start with that letter, This makes Dictionary comparison simple and easy to code.
Constructive criticism or comments are welcome, flames will be laughed at and ignored.
Enjoy!

Function SoundEx$(sWord$)
;****************************************************************
; SoundEx code Generator - Cherry Cola Film Studios LLC
;****************************************************************

; Set the input lookup table and the return codes
; note the return code is the position of the letter in the
; first string +1 This weeds out non-letters. Any return code of
; 0 will return a null string
; Note A,E,I,O,U,Y,H, and W return a Null string

; to use this function is simple:
; B$ = SoundEx$(A$)
; Where A$ is the word you want the SoundEx code for
; and B$ is the returned SoundEx code as a 4 byte string
; For example the word "Gothic" returns a code of "G320"


l1$= "BFPVCGJKQSXZDTLMNR"
l2$="0111122222222334556"


    ; Get the First letter
    Num$ = Upper$(Mid$(sWord$, 1, 1)) 
    sLastCode$ = num$
		sLastCode$=Mid$(l2$,(Instr(l1$,sLastCode$)+1),1) 
		If  sLastCode$= "0" Then sLastCode$ = ""
		
   lWordLength = Len(sWord$)
        
    ;Create the code starting at the second letter.
    For I = 2 To lWordLength
        sChar$ = Upper$(Mid$(sWord$, I, 1))

	    sChar$=Mid$(l2$,(Instr(l1$,sChar$)+1),1) 
		If sChar$= "0" Then sChar$ = ""
	
        ; If two letters that are the same are Next To Each other
        ; only count one of them
        If Len(sChar$) > 0 And sLastCode$ <> sChar$ Then
            Num$ = Num$ + sChar$
        End If
        sLastCode$ = sChar$
    Next
    ; Make sure code isn't longer Then 4 letters
    SEx$ = Mid$(Num$, 1, 4) 
    ;Make sure the code is at least 4 characters long
    If Len(Num$) < 4 Then
        SEx$ = SEx$  + String$("0",4 - Len(Num$))
    End If
Return sex$

Comments

None.

Code Archives Forum