PB/DOS - Soundex function

[Matthias Hoffmann]

'------------------------------------------------------------------------------
'      Unit: soundex.pbl
'     Zweck: Phonetische Ähnlichkeit von Zeichenketten (Namen) beurteilen
'     Stand: 11.12.94
'   Version: 1.00
'     Autor: (C) PC-Magazine USA; angepaßt M.Hoffmann
'   Sprache: PowerBASIC 3.x
'------------------------------------------------------------------------------

$com      0
$compile  unit
$cpu      80386
$debug    map-,pbdebug-,path-,unit-
$dim      all
$error    bounds-,numeric-,overflow-,stack-
$event    off
$float    emulate
$lib      com-,lpt-,cga-,ega-,vga-,fullfloat-,iprint-
$optimize size
$option   cntlbreak-,gosub-,signed-
$sound    0
$stack    &h800
$static
$string   1

function soundex (text as string, count as integer) public as string

   dim word as local string
   dim code as local string
   dim snd  as local string
   dim i    as local integer
   dim e    as local byte
   dim this as local string
   dim prev as local string
   dim l    as local integer

   word = ucase$(Text$)
   do until instr(word,"Ä") = 0
      replace "Ä" with "AE" in word
   loop
   do until instr(word,"Ö") = 0
      replace "Ö" with "OE" in word
   loop
   do until instr(word,"Ü") = 0
      replace "Ü" with "UE" in word
   loop
   do until instr(word,"ß") = 0
      replace "ß" with "SS" in word
   loop

   code = "01230120022455012623010202"
   rem -> "abcdefghijklmnopqrstuvwxyz"
 ' snd  = left$(word,1)    Originalcodierung: 1.Zeichen zurückgeben
   if count = 0 then
      l = len(word)
   else
      l = count
   end if

   for i=1 to len(word)  ' Original: i=2
      e = ascii(mid$(word,i,1))-64
      if e > 0 and e < 27 then
         this = mid$(code,e,1)
         if ascii(this) <> 0 and this <> prev then
            snd  = snd+this
            prev = this
         end if
      end if
   next i

   soundex = left$(snd,l) ' Original: left$(snd+"0000",l)

end function

------------------