'----取得区位码的函数---------------------
Function CharToQWM(byVal str)
    dim sHex,sHigh,sLow,iLow,iHigh,sResult
    
    sHex=Hex(Asc(str)) '取得字符的内码的编码，如B0A1，此编码是正确的顺序，不必交换高低位。
    sHigh=Left(sHex,2) '取得编码的高位，如B0。
    sLow=Right(sHex,2) '取得编码的低位，如A1。
    
    'GB2312内码范围为&HA1A1--&HFEFE，每个字节都在A1-FE之间。
    if NOT (sHigh>="A1" AND sHigh<="FE") then
        CharToQWM=""
        Exit Function
    end if
    if NOT (sLow>="A1" AND sLow<="FE") then
        CharToQWM=""
        Exit Function
    end if

    'GB交换码仅使用了7位，高位置1，即为内码。反过来就是将高位置0，可得到交换码。
    iLow=Clng("&H" & sLow)-128 
    iHigh=Clng("&H" & sHigh)-128

    '区位码与控制码0-31冲突，所以加上32之后，即是交换码。反过来减去32即可。
    iLow=iLow-32
    iHigh=iHigh-32
    
    'OK，区位码已经得到。
    sResult=""
    if iHigh<10 then
        sResult = sResult & "0" & Cstr(iHigh)
    else
        sResult = sResult & Cstr(iHigh)
    end if
    if iLow<10 then
        sResult = sResult & "0" & Cstr(iLow)
    else
        sResult = sResult & Cstr(iLow)
    end if

    CharToQWM=sResult
End Function

'----根据区位码得到字符的函数---------------------
Function QWMToChar(byVal str,byVal doCheckFlg)
    dim sHex,sHigh,sLow,iLow,iHigh,sResult
    
    '-------------检查输入格式--------------
    if doCheckFlg then
        if Len(str)<>4 then
            QWMToChar=""
            Exit Function
        end if
        '--4位必须都是数字
        dim i,iAsc
        for i=1 to 4
            iAsc=Asc(mid(str,i,1))
            if NOT (iAsc>=&H30 AND iAsc<=&H39) then
                QWMToChar=""
                Exit Function
            end if
        next
        '--区号，位号都要在01-94之间
        iHigh=Clng(Left(str,2))
        iLow=Clng(Right(str,2))
        if NOT (iHigh>=1 AND iHigh<=94) then
            QWMToChar=""
            Exit Function
        end if
        if NOT (iLow>=1 AND iLow<=94) then
            QWMToChar=""
            Exit Function
        end if
    end if
    '-------------检查完毕------------------
    iHigh=Clng(Left(str,2))
    iLow=Clng(Right(str,2))
    
    iHigh=iHigh + 32 + 128
    iLow=iLow + 32 + 128
    
    sHex=Hex(iHigh) & Hex(iLow)
    QWMToChar=Chr("&H" & sHex)
End Function