Tác giả: truongphu
Mô tả: Chuyển đổi qua lại giữa Unicode và CP-1258
Do ADODB chuyển giữa Unicode và Windows - 1258 bị sai: ADODB chỉ chuyển được các ký tự không dấu thanh như ă, â, ê, ô, ơ, ư. Còn nếu các ký tự trên kèm theo dấu thanh như ắ, ặ, ẵ ...vv thì ADODB thua.
Không lẽ mỗi lần có nhu cầu liên quan CP 1258 thì phải nhờ Unikey chuyển giùm? dzậy nên tôi viết 2 hàm góp vui...
- Function CP1258ToUni$(ByVal Chuôi1258$)
- Dim uni$, CP1258$
- uni$ = "ÁÀ" & ChrW(7842) & "Ã" & ChrW(7840) & ChrW(258) & ChrW(7854) & ChrW(7856) & ChrW(7858) & ChrW(7860) & ChrW(7862) & "Â" & ChrW(7844) & ChrW(7846) & ChrW(7848) & ChrW(7850) & ChrW(7852) & "ÉÈ" & ChrW(7866) & ChrW(7868) & ChrW(7864) & "Ê" & ChrW(7870) & ChrW(7872) & ChrW(7874) & ChrW(7876) & ChrW(7878) & "ÍÌ" & ChrW(7880) & ChrW(296) & ChrW(7882) & "ÓÒ" & ChrW(7886) & "Õ" & ChrW(7884) & "Ô" & ChrW(7888) & ChrW(7890) & ChrW(7892) & ChrW(7894) & ChrW(7896) & _
- ChrW(416) & ChrW(7898) & ChrW(7900) & ChrW(7902) & ChrW(7904) & ChrW(7906) & "ÚÙ" & ChrW(7910) & ChrW(360) & ChrW(7908) & ChrW(431) & ChrW(7912) & ChrW(7914) & ChrW(7916) & ChrW(7918) & ChrW(7920) & "Ý" & ChrW(7922) & ChrW(7926) & ChrW(7928) & ChrW(7924) & ChrW(272) & "áà" & ChrW(7843) & "ã" & ChrW(7841) & ChrW(259) & ChrW(7855) & ChrW(7857) & ChrW(7859) & ChrW(7861) & ChrW(7863) & "â" & ChrW(7845) & ChrW(7847) & ChrW(7849) & ChrW(7851) & ChrW(7853) & _
- "éè" & ChrW(7867) & ChrW(7869) & ChrW(7865) & "ê" & ChrW(7871) & ChrW(7873) & ChrW(7875) & ChrW(7877) & ChrW(7879) & "íì" & ChrW(7881) & ChrW(297) & ChrW(7883) & "óò" & ChrW(7887) & "õ" & ChrW(7885) & "ô" & ChrW(7889) & ChrW(7891) & ChrW(7893) & ChrW(7895) & ChrW(7897) & ChrW(417) & ChrW(7899) & ChrW(7901) & ChrW(7903) & ChrW(7905) & ChrW(7907) & "úù" & ChrW(7911) & ChrW(361) & ChrW(7909) & ChrW(432) & ChrW(7913) & ChrW(7915) & ChrW(7917) & ChrW(7919) & _
- ChrW(7921) & "ý" & ChrW(7923) & ChrW(7927) & ChrW(7929) & ChrW(7925) & ChrW(273)
- ' code truongphu
- CP1258$ = "AìAÌAÒAÞAòÃ@ÃìÃÌÃÒÃÞÃòÂ@ÂìÂÌÂÒÂÞÂòEìEÌEÒEÞEòÊ@ÊìÊÌÊÒÊÞÊòIìIÌIÒIÞIòOìOÌOÒOÞOòÔ@ÔìÔÌÔÒÔÞÔòÕ@ÕìÕÌÕÒÕÞÕòUìUÌUÒUÞUòÝ@ÝìÝÌÝÒÝÞÝòYìYÌYÒYÞYòÐ@aìaÌaÒaÞaòã@ãìãÌãÒãÞãòâ@âìâÌâÒâÞâòeìeÌeÒeÞeòê@êìêÌêÒêÞêòiìiÌiÒiÞiòoìoÌoÒoÞoòô@ôìôÌôÒôÞôòõ@õìõÌõÒõÞõòuìuÌuÒuÞuòý@ýìýÌýÒýÞýòyìyÌyÒyÞyòð@"
- Dim i&, S& S = Len(Chuôi1258)
- Dim M As String * 1, N As String * 1, str$
- For i = 1 To S
- M = Mid(Chuôi1258, i, 1)
- If i + 1 <= S Then N = Mid(Chuôi1258, i + 1, 1)
- Dim f& f = InStr(1, CP1258, M & N)
- If f Then
- str = str & Mid(uni, (f + 1) / 2, 1)
- i = i + 1
- Else
- f = InStr(1, CP1258, M & "@")
- If f Then
- str = str & Mid(uni, (f + 1) / 2, 1)
- Else
- str = str & M
- End If
- End If
- Next
- CP1258ToUni = str
- End Function
- Function UniTo1258$(ByVal ChuôiUni$)
- Dim uni$, CP1258$
- uni$ = "ÁÀ" & ChrW(7842) & "Ã" & ChrW(7840) & ChrW(258) & ChrW(7854) & ChrW(7856) & ChrW(7858) & ChrW(7860) & ChrW(7862) & "Â" & ChrW(7844) & ChrW(7846) & ChrW(7848) & ChrW(7850) & ChrW(7852) & "ÉÈ" & ChrW(7866) & ChrW(7868) & ChrW(7864) & "Ê" & ChrW(7870) & ChrW(7872) & ChrW(7874) & ChrW(7876) & ChrW(7878) & "ÍÌ" & ChrW(7880) & ChrW(296) & ChrW(7882) & "ÓÒ" & ChrW(7886) & "Õ" & ChrW(7884) & "Ô" & ChrW(7888) & ChrW(7890) & ChrW(7892) & ChrW(7894) & ChrW(7896) & _
- ChrW(416) & ChrW(7898) & ChrW(7900) & ChrW(7902) & ChrW(7904) & ChrW(7906) & "ÚÙ" & ChrW(7910) & ChrW(360) & ChrW(7908) & ChrW(431) & ChrW(7912) & ChrW(7914) & ChrW(7916) & ChrW(7918) & ChrW(7920) & "Ý" & ChrW(7922) & ChrW(7926) & ChrW(7928) & ChrW(7924) & ChrW(272) & "áà" & ChrW(7843) & "ã" & ChrW(7841) & ChrW(259) & ChrW(7855) & ChrW(7857) & ChrW(7859) & ChrW(7861) & ChrW(7863) & "â" & ChrW(7845) & ChrW(7847) & ChrW(7849) & ChrW(7851) & ChrW(7853) & _
- "éè" & ChrW(7867) & ChrW(7869) & ChrW(7865) & "ê" & ChrW(7871) & ChrW(7873) & ChrW(7875) & ChrW(7877) & ChrW(7879) & "íì" & ChrW(7881) & ChrW(297) & ChrW(7883) & "óò" & ChrW(7887) & "õ" & ChrW(7885) & "ô" & ChrW(7889) & ChrW(7891) & ChrW(7893) & ChrW(7895) & ChrW(7897) & ChrW(417) & ChrW(7899) & ChrW(7901) & ChrW(7903) & ChrW(7905) & ChrW(7907) & "úù" & ChrW(7911) & ChrW(361) & ChrW(7909) & ChrW(432) & ChrW(7913) & ChrW(7915) & ChrW(7917) & ChrW(7919) & _
- ChrW(7921) & "ý" & ChrW(7923) & ChrW(7927) & ChrW(7929) & ChrW(7925) & ChrW(273)
- ' code truongphu
- CP1258$ = "AìAÌAÒAÞAòÃ@ÃìÃÌÃÒÃÞÃòÂ@ÂìÂÌÂÒÂÞÂòEìEÌEÒEÞEòÊ@ÊìÊÌÊÒÊÞÊòIìIÌIÒIÞIòOìOÌOÒOÞOòÔ@ÔìÔÌÔÒÔÞÔòÕ@ÕìÕÌÕÒÕÞÕòUìUÌUÒUÞUòÝ@ÝìÝÌÝÒÝÞÝòYìYÌYÒYÞYòÐ@aìaÌaÒaÞaòã@ãìãÌãÒãÞãòâ@âìâÌâÒâÞâòeìeÌeÒeÞeòê@êìêÌêÒêÞêòiìiÌiÒiÞiòoìoÌoÒoÞoòô@ôìôÌôÒôÞôòõ@õìõÌõÒõÞõòuìuÌuÒuÞuòý@ýìýÌýÒýÞýòyìyÌyÒyÞyòð@"
- Dim i&, f&, M As String * 1, NN$
- For i = 1 To Len(ChuôiUni)
- M = Mid(ChuôiUni, i, 1)
- f = InStr(1, uni, M)
- If f Then
- NN = NN & Mid(CP1258, f * 2 - 1, 2)
- If Right(NN, 1) = "@" Then NN = Left(NN, Len(NN) - 1)
- Else
- NN = NN & M
- End If
- Next
- UniTo1258 = NN
- End Function
Bạn nào có nhu cầu về Windows CP 1258 từ nay phẻ re! ;)
