汉字转换为首字母(VB.NET源码)

汉字转换为首字母(VB.NET源码)

Function IndexCode(ByVal IndexTxt As String) As String

        Dim i As Integer

        For i = 1 To IndexTxt.Length

            IndexCode = IndexCode & GetOneIndex(Mid(IndexTxt, i, 1))

        Next

    End Function

    '得到单个字符的首字母

    Private Function GetOneIndex(ByVal OneIndexTxt As String) As String

        If Asc(OneIndexTxt) >= 0 And Asc(OneIndexTxt) < 256 Then

            GetOneIndex = OneIndexTxt

        Else

            GetOneIndex = GetX(CInt(Format((Asc(OneIndexTxt) + 65536) \ 256 - 160, "00") & Format((Asc(OneIndexTxt) + 65536) Mod 256 - 160, "00")))

        End If

    End Function

    '根据区位得到首字母

    Private Function GetX(ByVal GBCode As Integer) As String

        '判断一级汉字

        If GBCode >= 1601 And GBCode < 1637 Then GetX = "A"

        If GBCode >= 1637 And GBCode < 1833 Then GetX = "B"

        If GBCode >= 1833 And GBCode < 2078 Then GetX = "C"

        If GBCode >= 2078 And GBCode < 2274 Then GetX = "D"

        If GBCode >= 2274 And GBCode < 2302 Then GetX = "E"

        If GBCode >= 2302 And GBCode < 2433 Then GetX = "F"

        If GBCode >= 2433 And GBCode < 2594 Then GetX = "G"

        If GBCode >= 2594 And GBCode < 2787 Then GetX = "H"

        If GBCode >= 2787 And GBCode < 3106 Then GetX = "J"

        If GBCode >= 3106 And GBCode < 3212 Then GetX = "K"

        If GBCode >= 3212 And GBCode < 3472 Then GetX = "L"

        If GBCode >= 3472 And GBCode < 3635 Then GetX = "M"

        If GBCode >= 3635 And GBCode < 3722 Then GetX = "N"

        If GBCode >= 3722 And GBCode < 3730 Then GetX = "O"

        If GBCode >= 3730 And GBCode < 3858 Then GetX = "P"

        If GBCode >= 3858 And GBCode < 4027 Then GetX = "Q"

        If GBCode >= 4027 And GBCode < 4086 Then GetX = "R"

        If GBCode >= 4086 And GBCode < 4390 Then GetX = "S"

        If GBCode >= 4390 And GBCode < 4558 Then GetX = "T"

        If GBCode >= 4558 And GBCode < 4684 Then GetX = "W"

        If GBCode >= 4684 And GBCode < 4925 Then GetX = "X"

        If GBCode >= 4925 And GBCode < 5249 Then GetX = "Y"

        If GBCode >= 5249 And GBCode <= 5589 Then GetX = "Z"

        '判断二级汉字

        If GBCode >= 5601 And GBCode <= 8794 Then

            Dim CodeData As String

            CodeData = "cjwgnspgcenegypbtwxzdxykygtpjnmjqmbsgzscyjsyyfpggbzgydywjkgaljswkbjqhyjwpdzlsgmrybywwccgznkydgttngjeyekzydcjnmcylqlypyqbqrpzslwbdgkjfyxjwcltbncxjjjjcxdtqsqzycdxxhgckbphffsspybgmxjbbyglbhlssmzmpjhsojnghdzcdklgjhsgqzhxqgkezzwymcscjnyetxadzpmdssmzjjqjyzcjjfwqjbdzbjgdnzcbwhgxhqkmwfbpbqdtjjzkqhylcgxfptyjyyzpsjlfchmqshgmmxsxjpkdcmbbqbefsjwhwwgckpylqbgldlcctnmaeddksjngkcsgxlhzaybdbtsdkdylhgymylcxpycjndqjwxqxfyyfjlejbzrwccqhqcsbzkymgplbmcrqcflnymyqmsqtrbcjthztqfrxchxmcjcjlxqgjmshzkbswxemdlckfsydsglycjjssjnqbjctyhbftdcyjdgwyghqfrxwckqkxebpdjpxjqsrmebwgjlbjslyysmdxlclqkxlhtjrjjmbjhxhwywcbhtrxxglhjhfbmgykldyxzpplggpmtcbbajjzyljtyanjgbjflqgdzyqcaxbkclecjsznslyzhlxlzcghbxzhznytdsbcjkdlzayffydlabbgqszkggldndnyskjshdlxxbcghxyggdjmmzngmmccgwzszxsjbznmlzdthcqydbdllscddnlkjyhjsycjlkohqasdhnhcsgaehdaashtcplcpqybsdmpjlpcjaqlcdhjjasprchngjnlhlyyqyhwzpnccgwwmzffjqqqqxxaclbhkdjxdgmmydjxzllsygxgkjrywzwyclzmcsjzldbndcfcxyhlschycjqppqagmnyxpfrkssbjlyxyjjglnscmhcwwmnzjjlhmhchsyppttxrycsxbyhcsmxjsxnbwgpxxtaybgajcxlypdccwqocwkccsbnhcpdyznbcyytyckskybsqkkytqqxfcwchcwkelcqbsqyjqcclmthsywhmktlkjlychwheqjhtjhppqpqscfymmcmgbmhglgsllysdllljpchmjhwljcyhzjxhdxjlhxrswlwzjcbxmhzqxsdzpmgfcsglsdymjshxpjxomyqknmyblrthbcftpmgyxlchlhlzylxgsssscclsldclepbhshxyyfhbmgdfycnjqwlqhjjcywjztejjdhfblqxtqkwhdchqxagtlxljxmsljhdzkzjecxjcjnmbbjcsfywkbjzghysdcpqyrsljpclpwxsdwejbjcbcnaytmgmbapclyqbclzxcbnmsggfnzjjbzsfqyndxhpcqkzczwalsbccjxpozgwkybsgxfcfcdkhjbstlqfsgdslqwzkxtmhsbgzhjcrglyjbpmljsxlcjqqhzmjczydjwbmjklddpmjegxyhylxhlqyqhkycwcjmyhxnatjhyccxzpcqlbzwwwtwbqcmlbmynjcccxbbsnzzljpljxyztzlgcldcklyrzzgqtgjhhgjljaxfgfjzslcfdqzlclgjdjcsnclljpjqdcclcjxmyzftsxgcgsbrzxjqqcczhgyjdjqqlzxjyldlbcyamcstylbdjbyregklzdzhldszchznwczcllwjqjjjkdgjcolbbzppglghtgzcygezmycnqcycyhbhgxkamtxyxnbskyzzgjzlqjdfcjxdygjqjjpmgwgjjjpkjsbgbmmcjssclpqpdxcdyykypcjddyygywchjrtgcnyqldkljczzgzccjgdyksgpzmdlcphnjafyzdjcnmwescsglbtzcgmsdllyxqsxsbljsbbsgghfjlwpmzjnlyywdqshzxtyywhmcyhywdbxbtlmswyyfsbjcbdxxlhjhfpsxzqhfzmqcztqcxzxrdkdjhnnyzqqfnqdmmgnydxmjgdhcdycbffallztdltfkmxqzdngeqdbdczjdxbzgsqqddjcmbkxffxmkdmcsychzcmljdjynhprsjmkmpcklgdbqtfzswtfgglyplljzhgjjgypzltcsmcnbtjbhfkdhbyzgkpbbymtdlsxsbnpdkleycjnycdykzddhqgsdzsctarlltkzlgecllkjljjaqnbdggghfjtzqjsecshalqfmmgjnlyjbbtmlycxdcjpldlpcqdhsycbzsckbzmsljflhrbjsnbrgjhxpdgdjybzgdlgcsezgxlblgyxtwmabchecmwyjyzlljjshlgndjlslygkdzpzxjyyzlpcxszfgwyydlyhcljscmbjhblyjlycblydpdqysxktbytdkdxjypcnrjmfdjgklccjbctbjddbblblcdqrppxjcglzcshltoljnmdddlngkaqakgjgyhheznmshrphqqjchgmfprxcjgdychghlyrzqlcngjnzsqdkqjymszswlcfqjqxgbggxmdjwlmcrnfkkfsyyljbmqammmycctbshcptxxzzsmphfshmclmldjfyqxsdyjdjjzzhqpdszglssjbckbxyqzjsgpsxjzqznqtbdkwxjkhhgflbcsmdldgdzdblzkycqnncsybzbfglzzxswmsccmqnjqsbdqsjtxxmbldxcclzshzcxrqjgjylxzfjphymzqqydfqjjlcznzjcdgzygcdxmzysctlkphtxhtlbjxjlxscdqccbbqjfqzfsltjbtkqbsxjjljchczdbzjdczjccprnlqcgpfczlclcxzdmxmphgsgzgszzqjxlwtjpfsyaslcjbtckwcwmytcsjjljcqlwzmalbxyfbpnlschtgjwejjxxglljstgshjqlzfkcgnndszfdeqfhbsaqdgylbxmmygszldydjmjjrgbjgkgdhgkblgkbdmbylxwcxyttybkmrjjzxqjbhlmhmjjzmqasldcyxyqdlqcafywyxqhz"

            GetX = Mid(CodeData, (Microsoft.VisualBasic.Left(CStr(GBCode), 2) - 56) * 94 + (Microsoft.VisualBasic.Right(CStr(GBCode), 2)), 1)

        End If

    End Function