碰巧我这有段资料(vb.net),你参考一下,改改就能用
-----------
汉字转换拼音
Public Function hz2py(hz As String) As String
Dim sarr As Byte() = System.Text.Encoding.Default.GetBytes(hz)
Dim len As Integer = sarr.Length
If len > 1 Then
Dim array(2) As Byte
array = System.Text.Encoding.Default.GetBytes(hz)
Dim i1 As Integer = CShort(array(0) - ControlChars.NullChar)
Dim i2 As Integer = CShort(array(1) - ControlChars.NullChar)
'上面的代码有问题, 经过试验,我将它们换成
'Dim i1 As Integer = CShort(array(0))
'Dim i2 As Integer = CShort(array(1))
Dim tmp As Integer = i1 * 256 + i2
Dim getpychar As String = "*"
If tmp >= 45217 And tmp <= 45252 Then
getpychar = "A"
End If
If tmp >= 45253 And tmp <= 45760 Then
getpychar = "B"
End If
If tmp >= 47761 And tmp <= 46317 Then
getpychar = "C"
End If
If tmp >= 46318 And tmp <= 46825 Then
getpychar = "D"
End If
If tmp >= 46826 And tmp <= 47009 Then
getpychar = "E"
End If
If tmp >= 47010 And tmp <= 47296 Then
getpychar = "F"
End If
If tmp >= 47297 And tmp <= 47613 Then
getpychar = "G"
End If
If tmp >= 47614 And tmp <= 48118 Then
getpychar = "H"
End If
If tmp >= 48119 And tmp <= 49061 Then
getpychar = "J"
End If
If tmp >= 49062 And tmp <= 49323 Then
getpychar = "K"
End If
If tmp >= 49324 And tmp <= 49895 Then
getpychar = "L"
End If
If tmp >= 49896 And tmp <= 50370 Then
getpychar = "M"
End If
If tmp >= 50371 And tmp <= 50613 Then
getpychar = "N"
End If
If tmp >= 50614 And tmp <= 50621 Then
getpychar = "O"
End If
If tmp >= 50622 And tmp <= 50905 Then
getpychar = "P"
End If
If tmp >= 50906 And tmp <= 51386 Then
getpychar = "Q"
End If
If tmp >= 51387 And tmp <= 51445 Then
getpychar = "R"
End If
If tmp >= 51446 And tmp <= 52217 Then
getpychar = "S"
End If
If tmp >= 52218 And tmp <= 52697 Then
getpychar = "T"
End If
If tmp >= 52698 And tmp <= 52979 Then
getpychar = "W"
End If
If tmp >= 52980 And tmp <= 53640 Then
getpychar = "X"
End If
If tmp >= 53689 And tmp <= 54480 Then
getpychar = "Y"
End If
If tmp >= 54481 And tmp <= 55289 Then
getpychar = "Z"
End If
Return getpychar
Else
Return hz
End If
End Function 'hz2py
Public Function transpy(strhz As String) As String
Dim strtemp As String = ""
Dim strlen As Integer = strhz.Length
Dim i As Integer
For i = 0 To strlen - 1
strtemp += hz2py(strhz.Substring(i, 1))
Next i
Return strtemp
End Function 'transpy
-----------
汉字转换拼音
Public Function hz2py(hz As String) As String
Dim sarr As Byte() = System.Text.Encoding.Default.GetBytes(hz)
Dim len As Integer = sarr.Length
If len > 1 Then
Dim array(2) As Byte
array = System.Text.Encoding.Default.GetBytes(hz)
Dim i1 As Integer = CShort(array(0) - ControlChars.NullChar)
Dim i2 As Integer = CShort(array(1) - ControlChars.NullChar)
'上面的代码有问题, 经过试验,我将它们换成
'Dim i1 As Integer = CShort(array(0))
'Dim i2 As Integer = CShort(array(1))
Dim tmp As Integer = i1 * 256 + i2
Dim getpychar As String = "*"
If tmp >= 45217 And tmp <= 45252 Then
getpychar = "A"
End If
If tmp >= 45253 And tmp <= 45760 Then
getpychar = "B"
End If
If tmp >= 47761 And tmp <= 46317 Then
getpychar = "C"
End If
If tmp >= 46318 And tmp <= 46825 Then
getpychar = "D"
End If
If tmp >= 46826 And tmp <= 47009 Then
getpychar = "E"
End If
If tmp >= 47010 And tmp <= 47296 Then
getpychar = "F"
End If
If tmp >= 47297 And tmp <= 47613 Then
getpychar = "G"
End If
If tmp >= 47614 And tmp <= 48118 Then
getpychar = "H"
End If
If tmp >= 48119 And tmp <= 49061 Then
getpychar = "J"
End If
If tmp >= 49062 And tmp <= 49323 Then
getpychar = "K"
End If
If tmp >= 49324 And tmp <= 49895 Then
getpychar = "L"
End If
If tmp >= 49896 And tmp <= 50370 Then
getpychar = "M"
End If
If tmp >= 50371 And tmp <= 50613 Then
getpychar = "N"
End If
If tmp >= 50614 And tmp <= 50621 Then
getpychar = "O"
End If
If tmp >= 50622 And tmp <= 50905 Then
getpychar = "P"
End If
If tmp >= 50906 And tmp <= 51386 Then
getpychar = "Q"
End If
If tmp >= 51387 And tmp <= 51445 Then
getpychar = "R"
End If
If tmp >= 51446 And tmp <= 52217 Then
getpychar = "S"
End If
If tmp >= 52218 And tmp <= 52697 Then
getpychar = "T"
End If
If tmp >= 52698 And tmp <= 52979 Then
getpychar = "W"
End If
If tmp >= 52980 And tmp <= 53640 Then
getpychar = "X"
End If
If tmp >= 53689 And tmp <= 54480 Then
getpychar = "Y"
End If
If tmp >= 54481 And tmp <= 55289 Then
getpychar = "Z"
End If
Return getpychar
Else
Return hz
End If
End Function 'hz2py
Public Function transpy(strhz As String) As String
Dim strtemp As String = ""
Dim strlen As Integer = strhz.Length
Dim i As Integer
For i = 0 To strlen - 1
strtemp += hz2py(strhz.Substring(i, 1))
Next i
Return strtemp
End Function 'transpy
function getpychar(str)
{
var strA="腌吖锕嗄捱锿捱霭嗳暧嗳瑷嗌嫒砹谙庵桉鹌铵揞埯黯犴嗷鏖鳌獒聱螯廒遨拗媪坳拗骜岙鏊";
var strB="粑岜茇菝魃钯灞鲅掰捭呗瘢癍阪坂钣舨浜蒡孢煲龅葆褓鸨趵陂埤萆鹎蓓悖邶孛碚褙鐾鞴呗贲锛畚坌嘣甏荸匕俾妣吡秕舭璧弼篦婢愎铋裨濞髀庳滗埤芘嬖荜贲畀萆薜筚箅哔襞跸狴砭煸蝙笾鳊匾碥窆褊苄汴忭弁缏镖骠镳杓飚飑飙瘭髟裱婊鳔蹩缤槟傧玢豳镔鬓殡膑髌槟禀邴摒饽趵礴钹孛亳鹁踣簸跛簸掰擘檗啵逋晡钸醭卟瓿钚";
var strC="嚓礤骖黪璨孱粲伧嘈漕螬艚恻岑涔噌嚓杈馇锸楂猹槎檫衩镲衩杈汊姹钗侪虿瘥觇禅潺蟾婵廛孱镡澶躔谄冁蒇骣忏羼娼伥阊菖鲳嫦徜苌氅昶惝怅鬯焯怊晁耖砗坼琛嗔抻谌宸碜谶榇龀伧瞠噌铛柽蛏丞埕枨塍铖裎酲裎哧嗤蚩笞鸱媸螭眵魑踟墀茌篪坻褫豉啻敕叱饬傺彳瘛憧忡艟舂茺铳瘳惆帱俦雠樗蜍刍蹰杵褚楮怵绌黜亍憷搋啜踹嘬膪巛氚遄舡舛钏怆陲槌棰蝽鹑莼踔啜辍龊呲祠茈鹚糍苁骢璁枞琮淙楱辏腠徂殂猝蹴蹙蔟酢撺汆镩爨隹榱璀萃悴毳啐皴忖蹉嵯矬痤瘥鹾脞厝锉";
var strD="嗒耷褡哒沓鞑怛笪靼妲疸呔黛玳岱迨骀绐埭甙眈殚箪儋瘅聃赕疸瘅啖澹萏瘅裆铛谠宕菪凼砀叨忉氘叨焘帱纛锝噔簦戥磴镫嶝嘀氐镝羝嘀荻籴觌镝诋邸砥坻柢氐骶谛睇棣娣碲绨嗲癫巅踮丶玷簟坫钿癜阽貂鲷铫铞踮喋佚牒耋蹀堞瓞揲垤鲽町酊疔仃耵玎酊铤腚碇啶铥咚岽氡鸫硐垌峒胨胴硐蔸篼蚪窦嘟渎牍黩髑椟笃芏蠹煅椴簖碓憝怼镦礅镦盹趸炖沌砘咄裰踱铎哚缍沲柁";
var strE="婀屙莪锇愕噩呃轭颚鳄谔锷萼腭垩鹗苊阏呃诶诶诶蒽摁鸸鲕迩珥铒佴";
var strF="垡砝幡蕃蕃燔蘩蹯梵畈邡枋钫鲂彷舫扉霏妃绯蜚鲱腓淝斐蜚翡悱篚榧痱狒镄芾玢棼鼢偾瀵鲼酆葑沣砜唪俸葑缶呋稃麸趺跗芙孚匐桴蜉苻茯莩菔幞怫艴郛绂绋凫祓砩黻罘稃蚨芾蝠拊滏黼驸赙馥蝮鲋鳆";
var strG="伽旮尜钆尕尬赅垓陔丐戤尴坩苷泔矸疳酐橄擀澉淦绀旰罡戆筻睾槔藁槁缟杲诰郜锆仡圪纥袼嗝骼颌搿膈镉塥鬲哿舸硌虼哏艮亘艮茛赓哽鲠绠肱蚣觥珙篝佝枸缑鞲岣枸笱觏诟媾遘彀呱轱鸪毂菰蛄酤觚汩毂鹄牯臌诂瞽罟钴嘏蛄鹘锢梏牿崮痼鲴呱栝胍鸹呱卦诖掴矜莞倌鳏莞掼盥涫鹳咣胱桄犷桄皈妫鲑匦庋宄晷簋刿桧炅鳜鲧衮绲磙聒蝈崞埚呙帼掴馘虢猓椁蜾";
var strH="铪嗨胲醢顸鼾蚶晗焓邗阚瀚颔菡撖绗珩颃沆蒿薅嚆嗥濠蚝皓昊灏颢诃嗬阖曷颌劾盍纥蚵翮壑嗨蘅珩桁薨訇泓闳蕻黉荭讧蕻瘊篌糇骺後逅堠鲎惚唿滹轷烀囫斛鹄醐猢槲鹕觳煳鹘浒琥祜扈戽笏岵怙瓠鹱冱砉骅铧桦踝獾寰鬟圜洹郇缳锾萑浣奂擐漶逭鲩肓徨璜潢蟥遑隍癀湟篁鳇诙晖麾珲咴虺隳茴洄虺彗荟喙恚浍哕缋桧蕙蟪阍馄珲诨溷劐攉锪耠夥钬藿嚯镬蠖";
var strJ="矶叽跻羁嵇唧畿齑屐剞玑赍犄墼芨丌咭笄乩岌笈瘠诘亟楫蒺殛佶戢嵴蕺戟虮掎麂骥暨霁稷偈鲫髻觊荠跽哜鲚洎芰珈迦伽浃痂笳葭镓袈跏戛郏恝铗袷蛱佼皎胛挢岬徼湫敫嘏瘕菅蒹搛湔缣戋犍鹣鲣鞯蹇謇睑锏枧戬谫囝裥笕翦趼谏僭毽锏楗腱牮踺缰茳礓豇耩犟绛洚糨姣跤鲛僬鹪蛟艽茭峤佼皎挢徼湫敫噍峤徼醮嗟疖喈拮孑诘桀碣偈颉讦婕羯鲒蚧骱矜衿瑾馑卺廑堇槿缙噤觐荩赆妗泾旌腈菁憬阱儆刭肼迳胫弪婧獍靓扃迥炅鸠赳啾阄鬏鹫僦桕柩趄掬裾苴椐锔琚雎鞫橘锔踽龃榉莒枸瞿趄飓遽倨钜犋屦榘窭讵醵苣涓镌蠲锩隽狷桊鄄嗟噘崛獗厥蹶谲矍孓橛噱珏桷劂爝镢蕨觖蹶筠皲麇隽捃";
var strK="咔咔佧胩锎铠恺蒈剀垲锴忾龛戡侃阚莰瞰阚闶伉闶钪尻栲铐犒嗑瞌轲稞疴蝌钶窠颏珂髁颏轲岢恪嗑溘骒缂氪锞蚵龈裉铿倥崆箜倥芤眍叩蔻筘骷刳堀喾绔侉蒯脍哙狯浍郐髋哐诓诳夼邝圹纩贶悝睽逵馗夔喹隗暌揆蝰跬匮喟聩篑蒉愦鲲锟醌琨髡悃阃栝蛞";
var strL="邋旯砬剌瘌徕涞崃铼睐癞籁赉濑岚斓褴镧榄漤罱啷螂锒稂阆莨蒗阆唠崂铹痨醪栳铑唠耢仂叻泐鳓羸嫘缧檑诔耒酹嘞塄愣罹藜骊蜊黧缡喱鹂嫠蠡鲡蓠俚逦娌悝澧锂蠡醴鳢笠雳莅戾俪砺郦詈枥呖唳猁溧栎轹坜苈疠疬蛎鬲篥粝跞藓裢濂臁奁蠊鲢琏蔹裣殓楝潋踉莨椋墚魉踉靓缭寮嘹獠鹩蓼钌尥钌咧咧趔冽洌捩埒躐鬣咧麟嶙辚粼遴啉瞵懔檩廪躏蔺膦聆囹苓翎棂瓴绫酃泠蛉柃鲮呤熘浏遛镏旒骝鎏绺锍遛镏鹨胧珑茏栊泷砻癃垅喽偻髅蝼蒌耧嵝镂瘘喽噜撸泸轳鲈垆胪鸬舻栌橹镥辘漉簏鹭璐辂渌蓼逯轳氇捋偻褛膂稆榈闾栾銮鸾娈脔锊囵捋猡椤脶镙倮蠃瘰摞珞泺漯荦硌雒";
var strM="呒嬷蟆犸唛杩霾荬劢颟鳗鞔螨墁幔缦熳镘邙硭蟒漭髦牦旄蝥蟊茆峁泖昴耄瑁懋袤瞀麽莓嵋湄楣猸镅鹛浼魅袂扪钔懑焖朦瞢甍礞虻艨勐懵蠓蜢艋咪麋猕祢縻蘼弭敉脒芈谧汨宓嘧糸腼渑湎沔眄黾喵鹋缈淼杪邈眇缪乜咩篾蠛珉岷缗玟苠泯闵愍黾鳘冥茗溟瞑暝酩缪麽馍谟嫫蓦茉秣镆殁瘼耱貊貘哞眸缪鍪蛑侔毪沐坶苜仫钼";
var strN="嗯唔嗯镎捺肭衲艿鼐佴萘柰囝囡楠喃腩蝻赧囔馕馕攮曩孬呶猱铙硇蛲瑙垴讷恁嗯唔嗯唔嗯坭猊怩铌鲵旎祢昵睨慝伲黏鲇鲶辇廿埝袅嬲茑脲蹑嗫乜陧颞臬蘖恁咛苎甯聍佞妞狃忸拗侬哝耨孥驽弩胬钕恧衄傩喏搦锘";
var strO="噢喔讴瓯耦怄";
var strP="葩杷钯筢俳蒎哌蹒爿蟠拚襻袢泮滂彷螃逄脬狍匏庖疱醅锫辔帔旆霈湓怦嘭堋蟛噼丕纰邳铍郫鼙裨埤陴芘枇罴铍陂蚍蜱貔癖圮擗吡庀仳疋媲淠甓睥翩犏蹁缏胼骈谝剽缥螵嫖瞟缥殍莩骠嘌氕丿苤拚姘嫔颦榀牝娉俜枰鲆陂泺攴钋鄱皤叵钷笸珀裒掊掊噗匍璞濮镤溥氆镨蹼";
var strQ="蹊嘁萋槭欹桤琪祺琦淇岐荠俟耆芪颀圻骐亓萁蕲蛴蜞綦鳍麒绮杞芑屺綮憩汔亟葺碛伽葜袷髂骞悭芊愆阡岍佥搴褰虔掮荨钤犍箝鬈缱肷倩茜芡慊椠锵跄戕戗镪蜣锖樯嫱襁镪羟跄炝戗跷缲硗劁憔樵峤谯荞鞒愀诮谯伽趄妾惬锲挈郄箧慊衾矜覃噙廑溱檎锓嗪芩螓揿吣蜻圊鲭檠黥謦苘罄磬箐綮穹茕邛蛩筇跫銎蚯鳅楸湫裘虬俅遒赇逑犰蝤巯鼽糗觑岖蛐祛麴诎黢瞿衢癯劬璩氍朐磲鸲蕖蠼蘧苣觑阒悛诠蜷荃铨辁筌鬈绻畎阙阕阙悫逡麇";
var strR="髯蚺苒禳穰禳娆桡荛娆喏稔荏饪仞葚轫衽榕嵘狨肜蝾蹂糅鞣嚅濡薷铷襦颥缛洳溽蓐朊蕤芮睿枘蚋偌箬";
var strS="仨挲卅飒脎噻毵馓糁霰搡磉颡臊缲缫鳋臊埽瘙啬铯穑挲鲨痧裟铩霎嗄歃唼酾跚姗潸膻芟埏钐舢髟禅讪嬗骟剡鄯钐疝蟮鳝殇觞熵垧绱蛸筲艄苕杓潲劭猞畲佘麝滠歙厍莘诜糁谂哂渖矧蜃葚胂椹笙渑眚嵊晟蓍酾鲺埘莳炻鲥豕轼弑谥莳贳铈螫舐筮艏狩绶倏菽摅姝纾毹殳疋塾秫澍沭丨腧唰蟀闩涮孀泷铄妁蒴槊搠厮鸶咝澌缌锶厶蛳祀驷泗俟汜兕姒耜笥忪淞崧嵩凇菘悚竦馊嗖溲飕锼螋叟薮嗾瞍稣簌夙嗉谡愫涑蔌觫狻荽睢眭濉邃燧谇荪狲飧榫隼嗦挲娑睃桫嗍羧唢";
var strT="遢溻铊趿鳎榻嗒沓闼漯邰薹骀炱跆鲐呔肽钛覃澹昙锬镡郯忐钽铴镗耥羰溏螳瑭樘镗螗饧醣傥帑叨焘韬饕啕洮鼗忑忒慝铽忒滕醍绨缇鹈荑悌倜逖绨裼阗畋钿忝殄掭佻祧鲦苕髫龆蜩笤窕粜萜餮婷霆蜓葶莛町铤梃梃嗵佟仝垌茼峒潼砼恸骰钭荼菟酴钍堍菟抟疃彖忒煺暾饨豚氽乇砣沱跎坨橐佗铊酡柁鼍庹柝箨";
var strW="娲佤腽崴蜿剜纨芄莞畹绾琬脘菀尢惘罔辋魍偎薇逶煨崴葳隈帷帏圩囗嵬闱沩涠玮炜娓猥痿韪洧隗诿艉鲔猬軎雯璺阌刎汶璺蓊蕹喔倭莴渥幄肟硪龌於兀邬圬唔浯蜈鼯妩忤鹉牾迕庑怃仵兀鹜痦寤骛芴杌焐阢婺鋈";
var strX="兮樨郗曦奚羲唏蹊淅皙嬉茜熹翕蟋歙浠僖穸蜥螅菥舾粞醯欷鼷隰觋禧徙玺屣葸蓰饩阋禊舄呷遐黠瑕狎硖瘕柙罅暹莶氙祆籼酰跹娴鹇痫跣猃藓燹蚬筅冼岘苋霰骧葙芗缃庠飨饷鲞蟓潇逍枭骁箫枵哓蛸绡魈崤筱偕撷勰颉缬亵邂榭瀣薤燮躞廨绁渫榍獬馨鑫昕歆镡囟陉荥饧硎擤悻荇芎咻馐庥鸺貅髹岫溴胥砉圩盱顼浒栩诩糈醑煦洫溆勖蓿萱暄谖揎儇煊漩璇痃炫渲铉泫碹楦镟噱踅泶鳕谑醺薰埙曛窨獯荀峋洵恂郇浔鲟巽徇蕈";
var strY="垭桠睚伢岈琊痖疋娅迓揠氩砑腌嫣胭湮阏鄢菸崦恹檐妍筵芫闫阽俨偃魇鼹兖郾琰罨厣剡鼽焱晏赝餍滟酽谳泱鞅烊徉炀蛘恙烊怏鞅夭吆幺肴铫珧轺爻徭繇鳐杳窈崾鹞曜揶铘烨谒邺靥晔漪咿噫猗欹黟怡咦贻迤痍饴圯荑诒眙嶷迤旖苡钇舣酏轶弈佚奕熠弋驿懿呓薏噫镒缢刈羿仡峄怿悒佾殪挹埸劓镱瘗癔翊蜴嗌翳喑湮氤堙洇铟垠鄞霪狺夤圻龈瘾蚓吲胤茚窨膺莺罂鹦瑛璎撄嘤萦瀛楹嬴茔滢潆荥蓥颍瘿郢媵唷邕镛墉慵壅鳙饔喁俑甬攸呦柚鱿莸尢猷疣蚰蝣蝤繇莜黝莠牖铕卣柚囿鼬宥侑蚴於纡瘀馀萸瑜揄禺谀腴竽妤臾欤觎窬蝓嵛狳舁雩圄龉伛圉庾瘐窳俣谕毓妪昱煜熨燠菀蓣饫阈鬻聿钰鹆鹬蜮眢鸢箢沅媛芫橼圜塬爰螈鼋媛掾垸瑗刖瀹栎樾龠钺氲筠芸纭昀殒狁愠熨郓韫恽";
var strZ="咂拶甾崽簪糌拶昝趱瓒錾臧驵奘缲唣啧迮帻赜笮箦舴仄昃谮缯罾缯甑锃揸楂哳吒齄喋砟吒咤痄蚱砦瘵谵旃搌璋蟑嫜鄣獐仉嶂幛钊啁诏棹笊蜇辄谪摺磔蜇褶赭鹧柘箴桢溱蓁椹榛胗祯浈缜畛轸稹圳赈朕鸩徵筝铮峥钲鲭铮诤栀卮胝祗踯摭絷跖埴徵咫芷枳祉轵黹酯栉桎帙轾贽痣豸陟忮彘膣雉鸷骘蛭踬郅觯锺忪螽舯踵冢啁妯碡胄纣绉荮籀繇酎洙铢茱邾潴槠橥侏躅竺舳瘃褚渚麈伫箸炷杼翥苎疰嘬颛沌啭馔奘僮戆隹骓惴缒肫窀涿焯倬濯斫镯诼禚擢浞谘呲龇锱辎髭赀孳粢趑觜訾缁鲻嵫梓姊秭笫耔茈訾恣眦枞腙偬粽诹陬鄹驺鲰菹镞俎躜缵攥觜蕞樽鳟撙嘬笮怍胙阼唑祚酢";
tmp=str;
window.execScript("tmp=asc(tmp)+65536",'Vbscript');
if((tmp>=45217&&tmp<=45252)||strA.indexOf(str)>=0) { return "A"}
if((tmp>=45253&&tmp<=45760)||strB.indexOf(str)>=0) { return "B"}
if((tmp>=45761&&tmp<=46317)||strC.indexOf(str)>=0) { return "C"}
if((tmp>=46318&&tmp<=46825)||strD.indexOf(str)>=0) { return "D"}
if((tmp>=46826&&tmp<=47009)||strE.indexOf(str)>=0) { return "E"}
if((tmp>=47010&&tmp<=47296)||strF.indexOf(str)>=0) { return "F"}
if((tmp>=47297&&tmp<=47613)||strG.indexOf(str)>=0) { return "G"}
if((tmp>=47614&&tmp<=48118)||strH.indexOf(str)>=0) { return "H"}
if((tmp>=48119&&tmp<=49061)||strJ.indexOf(str)>=0) { return "J"}
if((tmp>=49062&&tmp<=49323)||strK.indexOf(str)>=0) { return "K"}
if((tmp>=49324&&tmp<=49895)||strL.indexOf(str)>=0) { return "L"}
if((tmp>=49896&&tmp<=50370)||strM.indexOf(str)>=0) { return "M"}
if((tmp>=50371&&tmp<=50613)||strN.indexOf(str)>=0) { return "N"}
if((tmp>=50614&&tmp<=50621)||strO.indexOf(str)>=0) { return "O"}
if((tmp>=50622&&tmp<=50905)||strP.indexOf(str)>=0) { return "P"}
if((tmp>=50906&&tmp<=51386)||strQ.indexOf(str)>=0) { return "Q"}
if((tmp>=51387&&tmp<=51445)||strR.indexOf(str)>=0) { return "R"}
if((tmp>=51446&&tmp<=52217)||strS.indexOf(str)>=0) { return "S"}
if((tmp>=52218&&tmp<=52697)||strT.indexOf(str)>=0) { return "T"}
if((tmp>=52698&&tmp<=52979)||strW.indexOf(str)>=0) { return "W"}
if((tmp>=52980&&tmp<=53688)||strX.indexOf(str)>=0) { return "X"}
if((tmp>=53689&&tmp<=54480)||strY.indexOf(str)>=0) { return "Y"}
if((tmp>=54481&&tmp<=55289)||strZ.indexOf(str)>=0) { return "Z"}
if(tmp>=65601&&tmp<=65626) { return str}
if(tmp>=65633&&tmp<=65658) { return str}else return str;
}function getpy(str)
{
var rstr= "";
for(i=0;i<str.length;i++)
{
rstr =rstr + getpychar(str.substr(i,1))
}
return rstr.toLowerCase();
}
//-----------------------------------------------------------------//
//指定字串列表[SourceStrs]中按拼音索引字串符合[PYIndexStr]的所有字串 function SearchByPYIndex(SourceStrs: TStrings; PYIndexStr: string): string; function GetPYIndexChar(hzchar: string): char; begin case Word(hzchar[1]) shl 8 + Word(hzchar[2]) of $B0A1..$B0C4: result := 'A'; $B0C5..$B2C0: result := 'B'; $B2C1..$B4ED: result := 'C'; $B4EE..$B6E9: result := 'D'; $B6EA..$B7A1: result := 'E'; $B7A2..$B8C0: result := 'F'; $B8C1..$B9FD: result := 'G'; $B9FE..$BBF6: result := 'H'; $BBF7..$BFA5: result := 'J'; $BFA6..$C0AB: result := 'K'; $C0AC..$C2E7: result := 'L'; $C2E8..$C4C2: result := 'M'; $C4C3..$C5B5: result := 'N'; $C5B6..$C5BD: result := 'O'; $C5BE..$C6D9: result := 'P'; $C6DA..$C8BA: result := 'Q'; $C8BB..$C8F5: result := 'R'; $C8F6..$CBF9: result := 'S'; $CBFA..$CDD9: result := 'T'; $CDDA..$CEF3: result := 'W'; $CEF4..$D188: result := 'X'; $D1B9..$D4D0: result := 'Y'; $D4D1..$D7F9: result := 'Z'; else result := char(0); end; end; label NotFound; var I, J: integer; hzchar: string; begin for I := 0 to SourceStrs.Count - 1 do begin for J := 1 to Length(PYIndexStr) do begin hzchar := SourceStrs[I][2 * J - 1] + SourceStrs[I][2 * J]; if (PYIndexStr[J] <> '?') and (UpperCase(PYIndexStr[J]) <> GetPYIndexChar(hzchar)) then goto NotFound; end; if result = '' then result := SourceStrs[I] // 找到一行 else result := result + Char(13) + SourceStrs[I]; // 找到多行 NotFound: end; end; 这个程序现在只能查找拼音的索引,
Public Function py(mystr As String) As String
If Asc(mystr) < 0 Then
If Asc(Left(mystr, 1)) < Asc("啊") Then
py = "" 'mystr
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("啊") And Asc(Left(mystr, 1)) < Asc("芭") Then
py = "a"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("芭") And Asc(Left(mystr, 1)) < Asc("擦") Then
py = "b"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("擦") And Asc(Left(mystr, 1)) < Asc("搭") Then
py = "c"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("搭") And Asc(Left(mystr, 1)) < Asc("蛾") Then
py = "d"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("蛾") And Asc(Left(mystr, 1)) < Asc("发") Then
py = "e"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("发") And Asc(Left(mystr, 1)) < Asc("噶") Then
py = "f"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("噶") And Asc(Left(mystr, 1)) < Asc("哈") Then
py = "g"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("哈") And Asc(Left(mystr, 1)) < Asc("击") Then
py = "h"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("击") And Asc(Left(mystr, 1)) < Asc("喀") Then
py = "j"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("喀") And Asc(Left(mystr, 1)) < Asc("垃") Then
py = "k"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("垃") And Asc(Left(mystr, 1)) < Asc("妈") Then
py = "l"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("妈") And Asc(Left(mystr, 1)) < Asc("拿") Then
py = "m"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("拿") And Asc(Left(mystr, 1)) < Asc("哦") Then
py = "n"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("哦") And Asc(Left(mystr, 1)) < Asc("啪") Then
py = "o"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("啪") And Asc(Left(mystr, 1)) < Asc("期") Then '''qi
py = "p"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("期") And Asc(Left(mystr, 1)) < Asc("然") Then ''ra
py = "q"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("然") And Asc(Left(mystr, 1)) < Asc("撒") Then '''sa
py = "r"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("撒") And Asc(Left(mystr, 1)) < Asc("塌") Then '''ta
py = "s"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("塌") And Asc(Left(mystr, 1)) < Asc("挖") Then '''wa挖
py = "t"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("挖") And Asc(Left(mystr, 1)) < Asc("昔") Then ''''''xi昔
py = "w"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("昔") And Asc(Left(mystr, 1)) < Asc("压") Then '''''ya
py = "x"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("压") And Asc(Left(mystr, 1)) < Asc("匝") Then ''''za匝
py = "y"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("匝") Then ''''za
py = "z"
Exit Function
End If
Else
If UCase(mystr) <= "Z" And UCase(mystr) >= "A" Then
py = Left(mystr, 1)
Else
py = "" ''mystr
End If
End If
End Function
ftp://qydn.vicp.net 也有一份 汉字拼音首字母.xls 可供参考啊~~
我记得有SQL可以判断发音的,好象是?……
不好意思我是水货
提提意见而已