home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / basic / soundex / soundex.bas
Encoding:
BASIC Source File  |  1989-09-15  |  1014 b   |  47 lines
  1. Start:
  2.   Input "Enter First  String: ",Fs$
  3.   Input "Enter Second String: ",Ss$
  4.   Call Soundex(Fs$,Code1$)
  5.   Call Soundex(Ss$,Code2$)
  6.   print "Soundex for First :",Code1$
  7.   print "Soundex for Second:",Code2$
  8. goto Start
  9.  
  10. sub Soundex(St$,Code$) static
  11.     Lettr$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ'-, "
  12.     Numbr$ = "012301200224550126230102020000"
  13.     for Up%=1 to len(St$)
  14.         if asc(mid$(St$,Up%,1)) > 96 then
  15.             mid$(St$,Up%,1) = chr$(asc(mid$(St$,Up%,1)) - 32)
  16.         end if
  17.     next Up%
  18.  
  19.     Code$   = mid$(St$,1,1)
  20.     Posy%   = 2
  21.     Cnt%    = 2
  22.     Prior$  = "0"
  23.     Length% = len(St$)
  24.     if Code$ = mid$(St$,2,1) then
  25.         Posy% = 3
  26.     end if
  27.     while Posy% <= Length%
  28.         Cnum$ = mid$(Numbr$,instr(Lettr$,mid$(St$,Posy%,1)),1)
  29.         if Cnum$ <> "0" then
  30.             if Cnum$ <> Prior$ then
  31.                 if Cnt% <= 4 then
  32.                     Code$ = Code$ + Cnum$
  33.                     Prior$ = Cnum$
  34.                     Cnt% = Cnt% + 1
  35.                 end if
  36.             end if
  37.         else
  38.             Prior$ = "0"
  39.         end if
  40.         Posy% = Posy% + 1
  41.     wend
  42.  
  43.     'while len(Code$) < 4
  44.     '   Code$ = Code$ + "0"
  45.     'wend
  46. end sub
  47.