'by Borje Hagsten
'
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Soundex search is used for searches of similar sounding words/names.
' bSoundEx for PB/DLL - returns a 4-byte Soundex string for passed string.
' Saw some SoundEx samples here, but unfortunately, none of them fulfills
' all "rules" given at http://www.myatt.demon.co.uk/sxalg.htm
' Wrote my own, to fulfill those rules, and to fulfill the need for high
' speed. Tested against all names given on above web-page, it returns correct
' results, so it seems to be accurate. Public Domain by Borje Hagsten, Sept 2001
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
FUNCTION bSoundEx (BYVAL source AS STRING) AS STRING
  LOCAL J AS BYTE, tmp AS BYTE, _
        Letter AS BYTE PTR, Letter2 AS BYTE PTR, sResult AS STRING

  source = UCASE$(source)     'source string must be upper case
  sResult  = "0000"           'initiate zero-padded result string
  Letter2  = STRPTR(sResult)  'pointer to result string
  J = 1                       'position in result string

  FOR Letter = STRPTR(source) TO STRPTR(source) + LEN(source)
     IF @Letter > 64 AND @Letter < 91 THEN        'only A-Z are regarded (ASC 65 - 90)
        IF J = 1 THEN                             'if first character in result string
           @Letter2 = @Letter                     'just add what we got
           INCR Letter2 : INCR J                  'increase pointer and pos holder
           SELECT CASE @Letter                    'in case it is a consonant, we must store it because
                                                  'rules says next should not be from same group
              CASE 66, 70, 80, 86                 : tmp = 49  '1 - BFPV
              CASE 67, 71, 74, 75, 81, 83, 88, 90 : tmp = 50  '2 - CGJKQSXZ
              CASE 68, 84                         : tmp = 51  '3 - DT
              CASE 76                             : tmp = 52  '4 - L
              CASE 77, 78                         : tmp = 53  '5 - MN
              CASE 82                             : tmp = 54  '6 - R
           END SELECT

        ELSE
           SELECT CASE @Letter                                'else, look at the rest
              CASE 65, 69, 73, 79, 85, 89 : tmp = 0 : ITERATE 'AEIOUY ignore these and reset tmp
              CASE 72, 87                           : ITERATE 'HW - ignore these too, but don't reset tmp
              CASE ELSE                                       '     (HW between consonants are ignored)
                 SELECT CASE @Letter
                    CASE 66, 70, 80, 86                 : @Letter = 49  '1 - BFPV
                    CASE 67, 71, 74, 75, 81, 83, 88, 90 : @Letter = 50  '2 - CGJKQSXZ
                    CASE 68, 84                         : @Letter = 51  '3 - DT
                    CASE 76                             : @Letter = 52  '4 - L
                    CASE 77, 78                         : @Letter = 53  '5 - MN
                    CASE 82                             : @Letter = 54  '6 - R
                    CASE ELSE                           : ITERATE
                 END SELECT
           END SELECT

           IF @Letter <> tmp THEN          'no doublettes, please
              @Letter2 = @Letter : INCR J  'set character value in result string, increase pos
              IF J > 4 THEN EXIT FOR       'result string is filled, no need to continue
              INCR Letter2 : tmp = @Letter 'point to next result string character and store value
           END IF
        END IF
     END IF
  NEXT

  FUNCTION = sResult 'return the result
END FUNCTION