Posted By

Scooter on 03/14/09


Tagged


Versions (?)

Who likes this?

1 person have marked this snippet as a favorite

asifrizvigmailcom


Soundex


 / Published in: ASP
 

URL: http://reusablecode.blogspot.com/2009/03/soundex.html

Convert individual characters or entire strings to their soundex equivalents. Requires my str_pad() function.

  1. <%
  2. ' Copyright (c) 2009, reusablecode.blogspot.com; some rights reserved.
  3. '
  4. ' This work is licensed under the Creative Commons Attribution License. To view
  5. ' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
  6. ' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
  7. ' 94305, USA.
  8.  
  9. ' http://en.wikipedia.org/wiki/Soundex
  10.  
  11. ' Calculate soundex code for entire strings, and soundex digits for individual characters.
  12. ' REQUIRES: str_pad()
  13. function soundex(someString)
  14. dim result
  15.  
  16. ' Rather than write a separate function to convert consonants to digits, I decided to overload the soundex function.
  17. if len(someString) = 1 then
  18. ' Calculate soundex digit for an individual character.
  19. select case lcase(someString)
  20. case "b", "f", "p", "v"
  21. soundex = "1"
  22. case "c", "g", "j", "k", "q", "s", "x", "z"
  23. soundex = "2"
  24. case "d", "t"
  25. soundex = "3"
  26. case "l"
  27. soundex = "4"
  28. case "m", "n"
  29. soundex = "5"
  30. case "r"
  31. soundex = "6"
  32. case else
  33. ' Remove vowels right away instead of during a later step.
  34. soundex = ""
  35. end select
  36. else
  37. ' Calculate soundex code for an entire string.
  38.  
  39. ' The first letter remains intact.
  40. result = ucase(left(someString, 1))
  41.  
  42. ' Replace consonants with digits and remove vowels.
  43. for i = 2 to Len(someString)
  44. result = result & soundex(mid(someString, i, 1))
  45. next
  46.  
  47. ' Collapse adjacent identical digits into a single digit of that value.
  48. for i = 1 to 6
  49. do until inStr(result, cStr(i & i)) = 0
  50. result = replace(result, cStr(i & i), cStr(i))
  51. loop
  52. next
  53.  
  54. ' Return the starting letter and the first three remaining digits.
  55. ' If needed, append zeroes to make it a letter and three digits.
  56. soundex = str_pad(left(result, 4), 4, "0", STR_PAD_RIGHT)
  57. end if
  58. end function
  59. %>

Report this snippet  

You need to login to post a comment.