GB与BIG5内码转换COM原代码

'功能：GB与BIG5内码转换COM原代码
'english name: GB2BIG5
Option Explicit

Dim BIG5Data As Variant
Dim GBData As Variant

Type ChineseTypeA
    loChar As Byte
    hiChar As Byte
End Type

Private BIG5Type(&HA1 To &HFF, &H40 To &HFE) As ChineseTypeA  '对应于GB5字库
Private GBType(&HA7 To &HFF, &HA1 To &HFE) As ChineseTypeA

Function BIG5TOGB(strSource As String) As String
   Dim I As Long, Y As Long
   '定义数组，用来存放BIG5和GB内码数据
   Dim bteBIG5() As Byte
   Dim bteGB() As Byte

  If strSource = "" Then
     BIG5TOGB = ""
     Exit Function
   End If

  '将BIG5数组的类型从Unicode编友转换为系统缺省码
  bteBIG5 = StrConv(strSource, vbFormUnicode)

  Y = UBound(bteBIG5)
  ReDim bteGB(0 To Y)
  For I = 0 To Y
    If I = Y Then
       bteGB(I) = bteBIG5(I)
      Exit For
   End If
  If bteBIG5(I) < &HA1 Or bteBIG5(I + 1) < &H40 Then
      bteGB(I) = bteBIG5(I)
   Else
      bteGB(I) = BIG5Type(bteBIG5(I), bteBIG5(I + 1)).loChar
      bteGB(I) = BIG5Type(bteBIG5(I), bteBIG5(I + 1)).loChar
      I = I + 1
   End If
Next I
  '将系统缺省码转换为Unicode编码
  BIG5TOGB = StrConv(bteGB, vbUnicode)
  '重新初始化GB数据组，以释放内存
  Erase bteGB
 End Function
 
Function GBTOBIG5(strSource As String) As String
   Dim I As Long, Y As Long
   '定义数组，用来存放BIG5和GB内码数据
   Dim bteBIG5() As Byte
   Dim bteGB() As Byte

  If strSource = """" Then
     BIG5TOGB = """"
     Exit Function
   End If
   '将GB数组的类型从Unicode编友转换为系统缺省码
  bteGB = StrConv(strSource, vbFormUnicode)
 
  Y = UBound(bteGB)
  ReDim bteBIG5(0 To Y)
 
  For I = 0 To Y
     If I = Y Then
         bteBIG5(I) = bteGB(I)
         Exit For
      End If
     
  If bteGB(I) < &HA1 Or bteGB(I + 1) < &H40 Then
     bteBIG5(I) = bteGB(I)
   Else
      If bteGB(I) < &HB0 And bteGB(I + 1) >= &HA1 Then
           bteBIG5(I) = GBType(bteGB(I) + 6, bteGB(I + 1)).loChar
           bteBIG5(I) = BIG5Type(bteGB(I) + 6, bteBIG5(I + 1)).loChar
      Else
          bteBIG5(I) = GBType(bteGB(I), bteGB(I + 1)).loChar
           bteBIG5(I) = BIG5Type(bteGB(I), bteBIG5(I + 1)).loChar
      End If
      I = I + 1
   End If
Next I
  '将系统缺省码转换为Unicode编码
  GBTOBIG5 = StrConv(bteBIG5, vbUnicode)
  '重新初始化GB数据组，以释放内存
  Erase bteBIG5
 
  
End Function
    
Private Sub Class_Initialize()
  Dim I As Long, J As Long
  Dim iLen As Long
 
  '从资源文件中读取GB与BIG5的字库
  GBData = loadresdate(102, "CUSTOM") '读取GB字库
  BIG5Data = loadresdate(101, "CUSTOM") '读取BIG5字库
  For I = &HA1 To &HFE
     For J = &H40 To &HFE
        BIG5Type(I, J).loChar = BIG5Data(iLen)
        BIG5Type(I, J).hiChar = BIG5Data(iLen + 1)
        iLen = iLen + 2
     Next J
 
  Next I
  iLen = 0
 
    For I = &HA7 To &HFE
     For J = &HA1 To &HFE
        GBType(I, J).loChar = GBData(iLen)
        GBType(I, J).hiChar = GBData(iLen + 1)
        iLen = iLen + 2
     Next J
End Sub