Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to Search Strings by the way they sound Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
07-Jul-03
Category
Algorithm
Language
Delphi 3.x
Views
125
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Raghunath Dhungel

Did you ever want to find a string - But were not sure of it's spelling? A typical 
case would be names (Micael/Maical/Michael/Maichael) all sound same but differ in 
spelling!

Answer:

Most of you may already be familiar with the magical "Soundex" function which is 
present in many Db environments ranging from FoxPro to Oracle/SQL Server. Few of 
you may wonder how it works! Well, here is the implementation of the Soundex 
function in Pascal based on an algorithm that I found in a computer magazine long 
time back. The original program worked in Turbo Pascal, but I have modified it for 
Delphi (The only change being use of ShortString instead of String!) 

The function seems to return the same values as does SQL Server for the little 
tests that I conducted. However, as you will have already guessed, I provide you no 
gurantee that it will provide same values for all strings. 

Please save the code below in a file called Soundx.pas. You will need to include 
the file in your source (Uses Soundx) and then you will have access to the 
Soundex() function. 

For the example given in the Question/Problem/Abstract, Soundex returns the same 
value (M240) for each of Micael/Maical/Michael/Maichael 

Wishing you all a "Sound" search (Ha!) 
1   
2   {******************************************************}
3   {* Description: Implementation of Soundex function    *}
4   {******************************************************}
5   {* Last Modified : 12-Nov-2000                        *}
6   {* Author        : Paramjeet Singh Reen               *}
7   {* eMail         : Paramjeet.Reen@EudoraMail.com      *}
8   {******************************************************}
9   {* This program is based on the algorithm that I had  *}
10  {* found in a magazine. I do not gurantee the fitness *}
11  {* of this program. Please use it at your own risk.   *}
12  {******************************************************}
13  {* Category :Freeware.                                *}
14  {******************************************************}
15  
16  unit Soundx;
17  
18  interface
19  
20  type
21    SoundexStr = string[4];
22  
23    //Returns the Soundex code for the specified string.
24  function Soundex(const InpStr: ShortString): SoundexStr;
25  
26  implementation
27  
28  const
29    Alphs: array['A'..'Z'] of Char = ('0', '1', '2', '3', '0', '1', '2', '0', '0', 
30  '2',
31      '2',
32      '4', '5', '5', '0', '1', '2', '6', '2', '3', '0', '1',
33      '0', '2', '0', '2');
34  
35  function Soundex(const InpStr: ShortString): SoundexStr;
36  var
37    vStr: ShortString;
38    vCh1: Char;
39    i: Word;
40  
41  begin
42    //Store the given InpStr in local variable in uppercase
43    vStr := '';
44    for i := 1 to Length(InpStr) do
45      vStr := vStr + UpCase(InpStr[i]);
46  
47    //Replace all occurances of "PH" with "F"
48    i := Pos('PH', vStr);
49    while (i > 0) do
50    begin
51      Delete(vStr, i, 2);
52      Insert('F', vStr, i);
53      i := Pos('PH', vStr);
54    end;
55  
56    //Replace all occurances of "CHR" with "CR"
57    i := Pos('CHR', vStr);
58    while (i > 0) do
59    begin
60      Delete(vStr, i, 3);
61      Insert('CR', vStr, i);
62      i := Pos('CHR', vStr);
63    end;
64  
65    //Replace all occurances of "Z" with "S"
66    for i := 1 to Length(vStr) do
67      if (vStr[i] = 'Z') then
68        vStr[i] := 'S';
69  
70    //Replace all occurances of "X" with "KS"
71    i := Pos('X', vStr);
72    while (i > 0) do
73    begin
74      Delete(vStr, i, 1);
75      Insert('KS', vStr, i);
76      i := Pos('X', vStr);
77    end;
78  
79    //Remove all adjacent duplicates
80    i := 2;
81    while (i <= Length(vStr)) do
82      if (vStr[i] = vStr[i - 1]) then
83        Delete(vStr, i, 1)
84      else
85        Inc(i);
86  
87    //Starting from 2nd char, remove all chars mapped to '0' in Alphs table
88    i := 2;
89    while (i <= Length(vStr)) do
90      if (Alphs[vStr[i]] = '0') then
91        Delete(vStr, i, 1)
92      else
93        Inc(i);
94  
95    //Assemble Soundex string from Alphs table
96    vCh1 := vStr[1];
97    for i := 1 to Length(vStr) do
98      vStr[i] := Alphs[vStr[i]];
99  
100   //Remove all adjacent duplicates from assembled Soundex string
101   i := 2;
102   while (i <= Length(vStr)) do
103     if (vStr[i] = vStr[i - 1]) then
104       Delete(vStr, i, 1)
105     else
106       Inc(i);
107 
108   //Final assembly of Soundex string
109   vStr := vCh1 + Copy(vStr, 2, 255);
110   for i := Length(vStr) to 3 do
111     vStr := vStr + '0';
112   Soundex := vStr;
113 end;
114 
115 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC