BEGIN:VCARD
VERSION:2.1
N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E9=98=BF=E9=87=8C=E5=B7=B4=E5=B7=B4;=E9=A2=9D;;;
FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E9=98=BF=E9=87=8C=E5=B7=B4=E5=B7=B4=E9=A2=9D
TEL;CELL:16845869
EMAIL;HOME:lh@bbb.com

再看原来手机的名片文件格式：

BEGIN:VCARD
VERSION:2.1
N:要善发发发;
TEL;CELL:138888888888
END:VCARD

     这才明白，原来是编码不同所致。赶紧上网拜读了一下UTF-8编码，恶补一下，学了点儿新知识，但咋解决自己手机的问题还是不得要领。曾经想找个字库去一一搞定，但总还是觉得太麻烦太累。昨天上午，带着这个问题继续嗖嗖地拜读，终于有幸找到了一个VB编的小程序，里面就有如何读取汉字的国标码和UTF8编码，感谢作者！！！赶紧抄下来学习下。。。

    

 

 

 

Private Sub convert1(filenm, name$, familyname$, Tel_num, E_mail_address)
Open filenm For Output As #1
    Print #1, "BEGIN: VCARD"
    Print #1, "VERSION:2.1"
    Print #1, "N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:"; UTF8Encode_eq(name$) & ";;;"                  
    Print #1, "FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:"; UTF8Encode_eq(familyname$)             
    Print #1, Tel_num                                                                
    Print #1, E_mail_address;                                                        

    Print #1, "End: VCARD"
Close #1
End Sub
Function UTF8Encode_eq(szInput)
        Dim wch, uch, szRet
        Dim x
        Dim nAsc, nAsc2, nAsc3

        If szInput = "" Then
            UTF8Encode_eq = szInput
            Exit Function
        End If

        For x = 1 To Len(szInput)
            wch = Mid(szInput, x, 1)
            nAsc = AscW(wch)

            If nAsc < 0 Then nAsc = nAsc + 65536

            If (nAsc And &HFF80) = 0 Then
                szRet = szRet & wch
            Else
                If (nAsc And &HF000) = 0 Then
                    uch = "=" & Hex(((nAsc 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                    szRet = szRet & uch
                Else
                    uch = "=" & Hex((nAsc 2 ^ 12) Or &HE0) & "=" & _
                    Hex((nAsc 2 ^ 6) And &H3F Or &H80) & "=" & _
                    Hex(nAsc And &H3F Or &H80)
                    szRet = szRet & uch
                End If
            End If
        Next

        UTF8Encode_eq = szRet
    End Function
    Function GBKEncodeURI(szInput)
        Dim i As Long
        Dim x() As Byte
        Dim szRet As String

        szRet = ""
        x = StrConv(szInput, vbFromUnicode)
        For i = LBound(x) To UBound(x)
            szRet = szRet & "%" & Hex(x(i))
        Next
        GBKEncodeURI = szRet
    End Function

Private Sub Command2_Click()
    Text2 = UTF8Encode_eq(Text1)
    Text3 = GBKEncodeURI(Text1)
End Sub

Private Sub Command3_Click()
    path_utf8 = "c:UTF_8_phone_book"
    filenm_old = File1.Path & "" & Text4
    Open filenm_old For Input As #2
        Line Input #2, begin_card$          'BEGIN:     VCARD
        Line Input #2, ver_num$             'VERSION:2.1
        Line Input #2, name_old$                'N:

        Line Input #2, Tel_num$             'TEL;CELL:
        Line Input #2, End_card$            'End: VCARD
       
    Close #2
    l1 = Len(name_old$)
    name_1$ = Right$(name_old$, l1 - 2)
    new_filenm = path_utf8 & Text4
    Call convert1(new_filenm, name_1$, name_1$, Tel_num$, E_mail_address)
End Sub

Private Sub Command4_Click()
    For i = 0 To File1.ListCount - 1
        Text4 = File1.List(i)
        Command3.Value = True
    Next i
End Sub

Private Sub Dir1_Change()
    File1.Path = Dir1
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
    Text4 = File1.FileName
End Sub

Private Sub Form_Load()
    File1.Path = "c:phone book"
End Sub