基于Excel的QR二维码生成工具——原理及算法详解（之五）

在上一篇文章中，我们讨论了QR矩阵码的数据编码问题，并尝试使用Excel的工作表函数对数据进行了编码，将数据转化成为一个“0/1”字符串，但是这种方法有一个弱点，那就是很难实现混合编码，单组编码由于规则固定，还可以通过函数编码，但是对于编码规则不固定的混合编码，就很难有一个理想的表现，因此，根据上文所讨论的思路，我们将尝试使用VBA完成编码工作，并实现数据编码。

在讨论VBA算法之前，我们必须先确定一个合适的数据结构以便存储数据编码。在前一篇文章中我们使用工作表函数将数据转化为两种形式，一种是字符串，另一个是8位二进制数（取值在0~255之间），因此我们可以借鉴这一思路。另外，根据QR规范，编码后的数据码字（计算纠错码字之前）是分段的，每一段的结构都大致相同：

字符编码段	模式指示符	字符计数指示符	数据位流	终止符
第一段	0010	000000101	00111001010000101110010
第二段	11010001	00000010	0101101010101000001011110
终止符				0000

因此，我们可以将数据码字的数据结构定义为一个数组，数组中的每个元素都是一个数据流单元，每个数据流单元包含完整的ECI（数据模式指示符），wordCount（数据计数值）以及数据码流（WordStream）。因此，这个数据结构可以用这样的自定义数据类型来定义，数据流单元简称DSU：

Type dataStreamUnit
    ECI As Byte
    wordCount As Long
    wStream() As Byte
End Type

将上面的自定义数据类型定义为数组，就可以存储多个并列的数据单元了，而且每个数据单元的数据码流都使用Byte类型的数据，范围为0~255.
接下来构造一个函数，用来将一个字符串转化为一个“0/1”字符串数据码流。自然，这个函数需要做两步工作：
1. 将输入字符串进行逐个读入，根据字符串的类型建立相应的数据流单元，并将字符串编码为Byte类型数据，存储在DSU中，直到整个字符串读取完毕
2. 从第一个DSU开始，将DSU中的数据转化为“0/1”字符串，并逐一连接到输出字符串后，直到所有的DSU都被转化完成。最后调整字符串的长度使它能被8整除

为了便于进行第一步操作还需要定义两个DSU操作函数：DUS初始化和DSU数据添加：

Private Function initDSU(dsu As dataStreamUnit, t As Byte, char As String) As dataStreamUnit
'initialize the dsu by setting ECI as 4 (Alphabet mode) or as 13 (Chinese character mode)
Dim y() As Long

With dsu
    If t = 1 Then
        .ECI = 4
        .wordCount = 1
        ReDim Preserve .wStream(1 To 1)
        .wStream(1) = Asc(char)
    Else
        .ECI = 209
        .wordCount = 1
        ReDim Preserve .wStream(1 To 2)
        y = GetURL(char)
        .wStream(1) = y(0)
        .wStream(2) = y(1)
    End If
End With
    initDSU = dsu
End Function

Private Function dsuAppend(dsu As dataStreamUnit, t As Byte, char As String) As dataStreamUnit
' append the character to the end of dsu and set correct length
Dim x As Long
Dim y() As Long

With dsu
    Select Case t
    Case Is = 1
        x = UBound(.wStream) + 1
        ReDim Preserve .wStream(1 To x)
        .wordCount = .wordCount + 1
        .wStream(x) = Asc(char)
    Case Is = 0
        x = UBound(.wStream) + 2
        ReDim Preserve .wStream(1 To x)
        .wordCount = .wordCount + 1
        y = GetURL(char)
        .wStream(x - 1) = y(0)
        .wStream(x) = y(1)
    End Select
End With
dsuAppend = dsu
End Function

上面两个函数分别用于创建一个新的DSU并向其中写入第一个字符数据，以及向一个已存在的DSU中添加一个数据。因此，建立字符串数据流的算法可以描述如下：
1. For 字符串内的所有字符，并判断字符的种类（即8位字节型字符还是中文汉字字符）
2. If 读取的字符是第一个字符或字符类型与上一个字符不同，则：
3. 创建一个DSU，并将读取的字符添加到DSU中
4. Else
5. 读取当前DSU，并将当前字符添加到当前DSU中
6. End if
7. Next 字符串内的字符
根据上述算法，可以创建一个DSU数组，在每一个DSU数组中保存着字符类型相同的字符串段，接下来，需要将这些字符串段分别编码成“0/1”字符串并连接起来，添加上中止符号“0000”后编码为完整的混合QR编码。同样，为了完成上述任务，我们也需要定义几个字符串操作函数：bitAppend(Str as string, N as long, L as long) as string. 这个函数接受三个参数，第一个参数是一个字符串，第二个参数是一个长整型数N，第三个参数也是一个长整型数。这个函数将长整型数N有十进制转化为二进制数型的字符串，这个字符串的长度为“L”，并将这个二进制字符串连接在Str字符串后。如，bitAppend(“abc”,5,5)的结果是”abc00101”。bitAppend函数是一个很简单的函数，使用And运算取出数字每个二进制位的数字，代码如下：

Private Function bitAppend(S As String, N As Variant, l As Long) As String
' transfers the number N into a binary type l-lenth string, and appends the string to the end of string S
Dim i As Long
Dim bit As Byte
Dim str As String

    str = ""
    For i = l - 1 To 0 Step -1
        bit = IIf((N And 2 ^ i) > 0, 1, 0)
        str = str + CStr(bit)
    Next
    bitAppend = S + str
End Function

因此，编码算法的第二部分就只需要逐个读取所有的DSU，将DSU的模式指示符、字符长度指示符、数据编码等数字按照规定的码长连接到一个字符串中即可，最后别忘了加上“0000”。各种不同模式下的码长分别为：

QR版本	8位字节模式指示符	8位字节长度指示符	8位字节数据码长	中文字符模式指示符	中文字符长度指示符	中文字符数据码长
版本1～版本9	4位	8位	8位	8位	8位	5+8位
版本10～版本26	4位	16位	8位	8位	10位	5+8位
版本27～版本40	4位	16位	8位	8位	12位	5+8位

由上表可以查出不同版本QR码的编码所需要的二进制位长度，然后根据所需的长度循环使用bitAppend函数将数据码子写入到字符串中即可，具体的代码如下：

Private Function buildDataStream(str As String, Optional v As Long = 1) As String
' convert the input text strings into QR standard data stream, begin with ECI and end with ending bits
' output data are stored in a byte type one dimensional array with lower bound 1 representing first bit
' each bit of the code stream is stored in each item of the byte type array

Dim DS() As dataStreamUnit
Dim dType As Byte
Dim curType As Byte, nextType As Byte
Dim tempStr As String * 1
Dim curDSU As Long, length As Long
Dim i As Long, j As Long
Dim y(1 To 2) As Long
Dim msg As String, dataStream As String

    'build the first data stream unit
    curDSU = 1
    tempStr = Mid(str, 1, 1)
    curType = strType(tempStr)
    curDSU = 1
    ReDim DS(1 To 1)

    DS(1) = initDSU(DS(1), curType, tempStr)

    For i = 2 To Len(str)
        tempStr = Mid(str, i, 1)
        nextType = strType(tempStr)
        If nextType = curType Then
            DS(curDSU) = dsuAppend(DS(curDSU), curType, tempStr)
        Else
            curDSU = curDSU + 1
            curType = nextType
            ReDim Preserve DS(1 To curDSU)
            DS(curDSU) = initDSU(DS(curDSU), nextType, tempStr)
        End If
    Next
    msg = curDSU & " data stream units are built" & vbNewLine & vbNewLine
    dataStream = ""
    For i = 1 To curDSU
        'msg = msg + vbNewLine & "DSU " & i & ":  Type: " & DS(i).ECI & " , count: " & DS(i).wordCount & vbNewLine & "      Char: "
        With DS(i)
            ' get ECI
            length = IIf(.ECI = 4, 4, 8)
            dataStream = bitAppend(dataStream, .ECI, length)
            ' get wordcount
            If .ECI = 4 Then
                length = IIf(v < 10, 8, 16)
                dataStream = bitAppend(dataStream, .wordCount, length)
            Else
                If v < 10 Then length = 8
                If v >= 10 And v < 27 Then length = 10
                If v >= 27 Then length = 12
                dataStream = bitAppend(dataStream, .wordCount, length)
            End If
            ' get data word stream
            If .ECI = 4 Then
                For j = 1 To UBound(.wStream)
                'msg = msg + CStr(DS(i).wStream(j)) & " , "
                    dataStream = bitAppend(dataStream, .wStream(j), 8)
                Next
            Else
                For j = 1 To UBound(.wStream) - 1 Step 2
                    dataStream = bitAppend(dataStream, .wStream(j), 5)
                    dataStream = bitAppend(dataStream, .wStream(j + 1), 8)
                Next
            End If
        End With
    Next
    buildDataStream = bitAppend(dataStream, 0, 4)
    'MsgBox msg
End Function

至此，我们就可以完整地将任意中英文混合字符串编码为一个QR数据码流了，这个QR数据码流是一串“0/1”字符串，编码完成后可以写入

一个单元格，并利用本文上一节介绍的方法将字符串补全后每8个字符分组，并将每一组字符串转化为一个0～255之间的数字，这样就可以进一步计算RS纠错码了。
接下来的几篇文章中，我们将讨论二维码生成的最后几个步骤，填充及掩码。不过，在讨论最后步骤之前，我们还需要解决一个问题：格式信息以及版本信息的编码和BCH纠错码计算，这将在本文的第六节中讨论。