求一简体和繁体互相转换的程序

Question

急急急急急急急
求一简体和繁体互相转换的程序

Answer 1

'*****************************************************
'//
'//  basBIG2GB.bas  1999/08/19
'//
'//  作者:陈国强  [email protected]
'//  原子数据工作室  http://www.quanqiu.com/vb
'//
'//  您可以自由的拷贝并使用本程序
'//  您有义务把程序中的BUG告诉我
'//
'*****************************************************
'
'
'
'函数说明'Sub InitDATA
'初始化内码数据
'首次调用GB2BIG或BIG2GB函数之前最好先Call InitDATA
'数组BIG5Order()中存放所有BIG5码汉字对应的GB2312码的的 ANSI 字符代码。
'数组GBOrder()中存放所有GB2312码汉字对应的BIG5码的的 ANSI 字符代码。
'使用Chr(ANSI 字符代码)即可得到对应的汉字
'
'Function GB2BIG(strGB As String) As String
'GB2312码 -> BIG5码
'
'Function BIG2GB(strBIG As String) As String
'BIG5码 -> GB2312码'Function CheckBIG(strSource As String) As Boolean
'判断一段文字中是否含有BIG5码汉字 , 可用做内码的自动识别
'返回True表示包含BIG5码
'返回False表示不含BIG5码 , 这段文字一般可认为是GB码
'
'
'资源文件的生成方法祥见Resource目录下的BuildDATA.vbp项目
Option ExplicitPrivate GBOrder(8177) As Integer
Private BIG5Order(14757) As Integer
Private InitOK As Boolean
Private ByteDataGB() As Byte
Private ByteDataBIG() As BytePublic Sub InitDATA()
On Error GoTo ERROR_HANDLE
Dim h As Long
Dim i, j As Integer
InitOK = TrueByteDataGB = LoadResData(101, "INS")
ByteDataBIG = LoadResData(102, "INS")For i = LBound(ByteDataGB) To UBound(ByteDataGB) / 2
    GBOrder(i) = Val("&H" & Hex(ByteDataGB(2 * i + 1)) & Hex(ByteDataGB(2 * i)))
Next i
For i = LBound(ByteDataBIG) To UBound(ByteDataBIG) / 2
    BIG5Order(i) = Val("&H" & Hex(ByteDataBIG(2 * i + 1)) & Hex(ByteDataBIG(2 * i)))
Next i
Exit Sub
ERROR_HANDLE:
    InitOK = False
End SubPublic Function GB2BIG(strGB As String) As String
On Error Resume Next
Dim ByteGB() As Byte
Dim ByteTemp(1) As Byte
Dim leng As Long, idx As Long
Dim strOut As String
Dim Offset As LongIf Not InitOK Then Call InitDATA
If Not InitOK Then
    GB2BIG = strGB
    Exit Function
End IfByteGB = StrConv(strGB, vbFromUnicode)
leng = UBound(ByteGB)
idx = 0Do While idx <= leng
    ByteTemp(0) = ByteGB(idx)
    ByteTemp(1) = ByteGB(idx + 1)
    Offset = GBOffset(ByteTemp)
    If isGB(ByteTemp) And (Offset >= 0) And (Offset <= 8177) Then
        strOut = strOut & Chr(GBOrder(Offset))
        idx = idx + 2
    Else
        strOut = strOut & Chr(ByteTemp(0))
        idx = idx + 1
    End If
    LoopGB2BIG = strOut
End FunctionPublic Function BIG2GB(strBIG As String) As String
On Error Resume Next
Dim ByteBIG() As Byte
Dim ByteTemp(1) As Byte
Dim leng As Long, idx As Long
Dim strOut As String
Dim Offset As LongIf Not InitOK Then Call InitDATA
If Not InitOK Then
    BIG2GB = strBIG
    Exit Function
End IfByteBIG = StrConv(strBIG, vbFromUnicode)
leng = UBound(ByteBIG)
idx = 0
Do While idx <= leng
    ByteTemp(0) = ByteBIG(idx)
    ByteTemp(1) = ByteBIG(idx + 1)
    Offset = BIG5Offset(ByteTemp)
    If isBIG(ByteTemp) And (Offset >= 0) And (Offset <= 14757) Then
        strOut = strOut & Chr(BIG5Order(Offset))
        idx = idx + 1
    Else
        strOut = strOut & Chr(ByteTemp(0))
    End If
    idx = idx + 1
Loop
BIG2GB = strOut
End FunctionPublic Function CheckBIG(strSource As String) As Boolean
Dim idx As Long
Dim ByteTemp() As Byte
CheckBIG = False
For idx = 1 To Len(strSource)
    ByteTemp = StrConv(Mid(strSource, idx, 1), vbFromUnicode)
    If UBound(ByteTemp) > 0 Then
        If (ByteTemp(1) >= 64) And (ByteTemp(1) <= 126) Then
            CheckBIG = True
            Exit For
        End If
    End If
Next idx
End FunctionPrivate Function GBOffset(ChrString() As Byte) As Long
'On Error GoTo ERROR_HANDLE
Dim Dl, Dh
    Dl = ChrString(0)
    Dh = ChrString(1)
    GBOffset = (Dl - 161) * 94 + (Dh - 161)
'    Exit Function
'ERROR_HANDLE:
'    GBOffset = -1
End FunctionPrivate Function BIG5Offset(ChrString() As Byte) As Long
'On Error GoTo ERROR_HANDLE
Dim Dl, Dh
    Dl = ChrString(0)
    Dh = ChrString(1)
    If (Dh >= 64) And (Dh <= 126) Then _
        BIG5Offset = (Dl - 161) * 157 + (Dh - 64)
    If (Dh >= 161) And (Dh <= 254) Then _
        BIG5Offset = (Dl - 161) * 157 + 63 + (Dh - 161)
'    Exit Function
'ERROR_HANDLE:
'    BIG5Offset = -1
End FunctionPrivate Function isGB(ChrString() As Byte) As Boolean
'On Error GoTo ERRORHANDLE
If UBound(ChrString) >= 1 Then
    If (ChrString(0) <= 161) And (ChrString(0) >= 247) Then
        isGB = False
    Else
        If (ChrString(1) <= 161) And (ChrString(1) >= 254) Then
            isGB = False
        Else
            isGB = True
        End If
    End If
Else
    isGB = False
End If
'Exit Function
'ERRORHANDLE:
'    isGB = False
End FunctionPrivate Function isBIG(ChrString() As Byte) As Boolean
'On Error GoTo ERRORHANDLE
If UBound(ChrString) >= 1 Then
    If ChrString(0) < 161 Then
        isBIG = False
    Else
        If ((ChrString(1) >= 64) And (ChrString(1) <= 126)) Or ((ChrString(1) >= 161) And (ChrString(1) <= 254)) Then
            isBIG = True
        Else
            isBIG = False
        End If
    End If
Else
    isBIG = False
End If
'Exit Function
'ERRORHANDLE:
'    isBIG = False
End Function

Answer 2

调用
Private Sub Command1_Click()
    Text1.Text = GB2BIG(Text1.Text)
End SubPrivate Sub Command2_Click()
    Text1.Text = BIG2GB(Text1.Text)
End SubPrivate Sub Command3_Click()
    MsgBox IIf(CheckBIG(Text1.Text), "BIG5", "GB"), , "内码"
End SubPrivate Sub Form_Load()
    Call InitDATA
End Sub