home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / IQB9202.ZIP / SOUNDEX.BAS < prev   
Encoding:
BASIC Source File  |  1992-01-21  |  1.6 KB  |  68 lines
  1. ' Soundex.Bas - Program to demonstrate the Soundex
  2. '               string matching algorithm
  3.  
  4. CONST FALSE = 0, TRUE = NOT FALSE
  5.  
  6. DIM SHARED sxData AS STRING * 26
  7.  
  8. DECLARE SUB Soundex (InLine$, Output$)
  9.  
  10.  
  11. ' Initialize the soundex letter category table
  12.  
  13. sxData = "01230120022455012623010202"
  14. FOR I% = 1 TO 26
  15.    IF MID$(sxData, I%, 1) = "0" THEN MID$(sxData, I%, 1) = CHR$(0)
  16. NEXT I%
  17.  
  18. ' Get a word from the user, then generate and display
  19. ' the corresponding soundex code.
  20.  
  21. DO
  22.    InLine$ = "": Output$ = ""
  23.    PRINT : PRINT "Enter a word or press ENTER to quit:";
  24.    INPUT InLine$
  25.    IF LEN(InLine$) THEN
  26.      Soundex InLine$, Output$
  27.      PRINT "The soundex code for "; InLine$; " is "; Output$
  28.    END IF
  29. LOOP WHILE InLine$ <> ""
  30. END
  31.  
  32.  
  33. SUB Soundex (InLine$, Output$)
  34. ' Soundex - Generate a soundex code for the string in InLine$
  35. '       and return the result in the string Output$
  36.  
  37. DIM Ix AS INTEGER
  38. DIM Ox AS INTEGER
  39. DIM cTmp AS INTEGER
  40.  
  41. IF LEN(InLine$) THEN
  42.   Ox = 1
  43.   Output$ = "0000"
  44.   InLen% = LEN(InLine$)
  45.   
  46.   FOR Ch% = 1 TO InLen%
  47.      cTmp = ASC(MID$(InLine$, Ch%, 1)) AND &H5F
  48.      IF Ox = 1 THEN
  49.        MID$(Output$, Ox, 1) = CHR$(cTmp)
  50.        Ox = Ox + 1
  51.      ELSE
  52.        cTmp = ASC(MID$(sxData, cTmp - &H40, 1))
  53.        IF cTmp THEN
  54.          IF ASC(MID$(Output$, Ox - 1, 1)) <> cTmp THEN
  55.            MID$(Output$, Ox, 1) = CHR$(cTmp)
  56.            Ox = Ox + 1
  57.          END IF
  58.        END IF
  59.        IF Ox > 4 THEN EXIT FOR
  60.      END IF
  61.   NEXT Ch%
  62. ELSE  
  63.   Output$ = ""             ' null input string, return null output
  64. END IF
  65.  
  66. END SUB
  67.  
  68.