Soundex

2015/11/13 52691

清华大佬耗费三个月吐血整理的几百G的资源，免费分享！....>>>

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