前期準備工作：

1、需要編碼的資料庫表，本例為sql 6.5資料庫，表名為aa_u_personal ，姓名標題為P_name，儲存拼音列標題為BianMa;

2、拼音表（PinYinDatebase.mdb，需要者請提供E-mail）檔案。

以下為asp檔案原始碼

<%
Response.Buffer=false
Server.ScriptTimeOut=6000

   dim conn '來源資料庫
   dim connstr
Set conn = Server.CreateObject("ADODB.Connection")
connstr="DSN=ylbx;UID=sa;PWD=sa"
conn.open connstr

   dim conn2   '拼音資料庫
   dim connstr2
   dim db2
   db2="PinYinDatebase.mdb"
   Set conn2 = Server.CreateObject("ADODB.Connection")
   connstr2="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(db2)
   conn2.open connstr2

dim piny(3),ipiny(9)

function WordToPinyin(words) '單詞分字
chars=delspace(words)
'WordToPinYin= chars & ":"
WordToPinYin= ""
charlen=len(chars)
iTurns=1
while iturns<=charlen
  Ichar=mid(chars,iTurns,1)
  piny(iTurns-1)=lcase(letters(Ichar))
  iTurns=iTurns+1
wend
i=0
for i1=1 to len(piny(0))
  piny1=mid(piny(0),i1,1)
    for i2=1 to len(piny(1))
      piny2=mid(piny(1),i2,1)
      if len(chars)>=3 then
        for i3=1 to len(piny(2))
          piny3=mid(piny(2),i3,1)
          ipiny(i)=piny1 + piny2 + piny3
          i=i+1
        next
      else
          ipiny(i)=piny1 + piny2
          i=i+1
      end if
    next
next
  WordToPinYin= WordToPinYin & ipiny(0)
i4=1
while i>1 and i4<i
  if Instr(WordToPinYin,ipiny(i4))=0 then
    WordToPinYin= WordToPinYin & "-" & ipiny(i4)
  end if
i4=i4+1
wend
end function

function letters(lett) '字轉字母
  lett=trim(lett)
if len(lett)>0 then
  Set rs6= Server.CreateObject("ADODB.Recordset")
  sql6="select * from HanZi where hanzi like '"& lett &"'"
  rs6.open sql6,conn2,1,1
  if rs6.eof then
    letters="×"
  else
    llen=rs6("pyno")
    select case llen
 case 1
   letters=left(rs6("py01"),1)
 case 2
   letters=left(rs6("py01"),1) + left(rs6("py02"),1)
 case 3
   letters=left(rs6("py01"),1) + left(rs6("py02"),1) + left(rs6("py03"),1)
 case 4
   letters=left(rs6("py01"),1) + left(rs6("py02"),1) + left(rs6("py03"),1) + left(rs6("py04"),1)
    end select
  end if
  rs6.close
  set rs6=nothing
else
  letters=""
end if
end function

function delspace(str1) '刪除漢字空格
str1=trim(str1)
for istr=1 to len(str1)
  if mid(str1,istr,1)=" " or mid(str1,istr,1)="　" then
    delspace=delspace+""
  else
    delspace=delspace+mid(str1,istr,1)
  end if
next
end function

Set rs= Server.CreateObject("ADODB.Recordset") '主要轉換部分
sql="select P_name,bianma from aa_u_personal"
rs.open sql,conn,3,2
id=1
while not rs.eof
 if isnull(rs("bianma")) then
  bianma = WordToPinyin(rs("P_name"))
  rs("bianma")=bianma
  rs.update
  response.write id & ":" & rs("P_name") & "-" & bianma & "<br>"
 else
  response.write id & ":" & rs("P_name") & "-" & rs("bianma") & "<br>"
 end if
 rs.movenext
 id=id+1
wend

rs.close  '關閉資料庫
set rs=nothing
conn.close
set conn=nothing
conn2.close
set conn2=nothing
%>