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 use a Soundex function 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
15-Aug-02
Category
Algorithm
Language
Delphi 2.x
Views
76
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

Soundex function

Answer:

Solve 1:

This function will scan a string, and return a 'soundex' value. Comparing soundex 
values will give an indication of 'how alike' two strings sound... Play with it and 
see!!!
1   
2   function Soundex(S: string): string;
3   const
4     CvTable: array['B'..'Z'] of char = (
5       '1', '2', '3', '0', '1', {'B' .. 'F'}
6       '2', '0', '0', '2', '2', {'G' .. 'K'}
7       '4', '5', '5', '0', '1', {'L' .. 'P'}
8       '2', '6', '2', '3', '0', {'Q' .. 'U'}
9       '1', '0', '2', '0', '2'); {'V' .. 'Z'}
10  var
11    i, j: Integer;
12    aGroup, Ch: Char;
13  
14    function Group(Ch: Char): Char;
15    begin
16      if (Ch in ['B'..'Z']) and not (Ch in ['E', 'H', 'I', 'O', 'U', 'W', 'Y']) then
17        Result := CvTable[Ch]
18      else
19        Result := '0';
20    end;
21  
22  begin
23    Result := '000';
24    if S = '' then
25      exit;
26  
27    S := Uppercase(S);
28    i := 2;
29    j := 1;
30    while (i <= Length(S)) and (j <= 3) do
31    begin
32      Ch := S[i];
33      aGroup := Group(Ch);
34      if (aGroup <> '0') and (Ch <> S[i - 1]) and
35        ((J = 1) or (aGroup <> Result[j - 1])) and
36        ((i > 2) or (aGroup <> Group(S[1]))) then
37      begin
38        Result[j] := aGroup;
39        Inc(j);
40      end;
41      Inc(i);
42    end; {while}
43  
44    Result := S[1] + '-' + Result;
45  end;



Solve 2:
46  
47  function StrSoundEx(const OrgString: string): string;
48  var
49    s: string;
50    PrevCh: char;
51    Ch: char;
52    i: integer;
53  begin
54    s := UpperCase(Trim(OrgString));
55    if s <> '' then
56    begin
57      PrevCh := #0;
58      result := s[1];
59      for i := 2 to Length(s) do
60      begin
61        if Length(result) = 4 then
62          break;
63        Ch := s[i];
64        if (Ch <> PrevCh) then
65        begin
66          if Ch in ['B', 'P', 'F', 'V'] then
67            result := result + '1'
68          else if Ch in ['C', 'S', 'K', 'G', 'J', 'Q', 'X', 'Z'] then
69            result := result + '2'
70          else if Ch in ['D', 'T'] then
71            result := result + '3'
72          else if Ch in ['L'] then
73            result := result + '4'
74          else if Ch in ['M', 'N'] then
75            result := result + '5'
76          else if Ch in ['R'] then
77            result := result + '6';
78          PrevCh := Ch;
79        end;
80      end;
81    end;
82    while Length(result) < 4 do
83      result := result + '0';
84  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