Next k
Next l
Next i
Next j
For i = m - 7 - s To 18 Step -s
For l = -2 To 2
For k = -2 To 2
j = 2 + (k = 2 Or k = -2 Or l = 2 Or l = -2 Or (k Or l) = 0)
b(i + k, 6 + l) = j
b(6 + l, i + k) = j
Next k
Next l
Next i
End If
End Select
End Sub
Friend Function pAlphaNumericToNumber(ByVal b As Byte) As Long
Select Case b
Case &H30& To &H39&
pAlphaNumericToNumber = b - 48
Case &H41& To &H5A&
pAlphaNumericToNumber = b - 55
Case &H20
pAlphaNumericToNumber = 36
Case &H24
pAlphaNumericToNumber = 37
Case &H25
pAlphaNumericToNumber = 38
Case &H2A
pAlphaNumericToNumber = 39
Case &H2B
pAlphaNumericToNumber = 40
Case &H2D
pAlphaNumericToNumber = 41
Case &H2E
pAlphaNumericToNumber = 42
Case &H2F
pAlphaNumericToNumber = 43
Case &H3A
pAlphaNumericToNumber = 44
End Select
End Function
Friend Function pCheckExclusiveSubset(ByVal b As Byte) As Long
Select Case b
Case &H30& To &H39&
pCheckExclusiveSubset = 1
Case &H41& To &H5A&, &H20, &H24, &H25, &H2A, &H2B, &H2D, &H2E&, &H2F, &H3A
pCheckExclusiveSubset = 2
End Select
End Function
Friend Function pCheckKanji(ByVal b1 As Byte, ByVal b2 As Byte) As Boolean
If b2 >= &H40& Then
Select Case b1
Case &H81& To &H9F&, &HE0& To &HEA&
pCheckKanji = True
Case &HEB&
pCheckKanji = b2 <= &HBF&
End Select
End If
End Function
Friend Function pEncodeToBitArray(ByRef bOutput() As Byte, ByRef bInput() As Byte, ByVal nSize As Long, ByVal nVersion As Long, Optional ByVal bCheckSizeOnly As Boolean) As Long
Dim nEncodingMode() As Byte
Dim tNode() As typeDynamicProgrammingNode
Dim nMaxSize(3) As Long
Dim i As Long, j As Long, k As Long, m As Long
Dim nCost As Long, nCount As Long
Dim lp As Long, lp2 As Long
If nSize <= 0 Then
bOutput(0) = 0
bOutput(1) = 0
bOutput(2) = 0
bOutput(3) = 0
pEncodeToBitArray = 4
Exit Function
End If
Select Case nVersion
Case Is < 10
nVersion = 2
nMaxSize(0) = 255
nMaxSize(1) = 1023
nMaxSize(2) = 511
nMaxSize(3) = 255
Case Is < 27
nVersion = 4
nMaxSize(0) = 65535
nMaxSize(1) = 4095
nMaxSize(2) = 2047
nMaxSize(3) = 1023
Case Else
nVersion = 6
nMaxSize(0) = 65535
nMaxSize(1) = 16383
nMaxSize(2) = 8191
nMaxSize(3) = 4095
End Select
ReDim tNode(3, nSize - 1)
For lp = 0 To nSize - 1
If lp > 0 Then
nCost = &H7FFFFFFF
For i = 0 To 3
k = tNode(i, lp - 1).nCost + 8
If i <> 0 Or tNode(i, lp - 1).nCount >= nMaxSize(0) Then k = k + 12 + (nVersion And 4) * 2
If k < nCost Then
j = i
nCost = k
nCount = tNode(i, lp - 1).nCount And i = 0 And tNode(i, lp - 1).nCount < nMaxSize(0)
End If
Next i
Else
j = -1
nCost = 20 + (nVersion And 4) * 2
nCount = 0
End If
tNode(0, lp).nPrevMode = j
tNode(0, lp).nCost = nCost
tNode(0, lp).nCount = nCount + 1
lp2 = pCheckExclusiveSubset(bInput(lp))
If lp2 = 1 Then
If lp > 0 Then
nCost = &H7FFFFFFF
For i = 0 To 3
k = tNode(i, lp - 1).nCost
If i <> 1 Or tNode(i, lp - 1).nCount >= nMaxSize(1) Then
k = k + 16 + nVersion
Else
k = k + 3
If (tNode(i, lp - 1).nCount Mod 3) = 0 Then k = k + 1
End If
If k < nCost Then
j = i
nCost = k
nCount = tNode(i, lp - 1).nCount And i = 1 And tNode(i, lp - 1).nCount < nMaxSize(1)
End If
Next i
Else
j = -1
nCost = 16 + nVersion
nCount = 0
End If
tNode(1, lp).nPrevMode = j
tNode(1, lp).nCost = nCost
tNode(1, lp).nCount = nCount + 1
Else
tNode(1, lp).nCost = &H70000000
End If
If lp2 > 0 Then
If lp > 0 Then
nCost = &H7FFFFFFF
For i = 0 To 3
k = tNode(i, lp - 1).nCost
If i <> 2 Or tNode(i, lp - 1).nCount >= nMaxSize(2) Then
k = k + 17 + nVersion
Else
k = k + 5
If (tNode(i, lp - 1).nCount And 1) = 0 Then k = k + 1
End If
If k < nCost Then
j = i
nCost = k
nCount = tNode(i, lp - 1).nCount And i = 2 And tNode(i, lp - 1).nCount < nMaxSize(2)
End If
Next i
Else
j = -1
nCost = 17 + nVersion
nCount = 0
End If
tNode(2, lp).nPrevMode = j
tNode(2, lp).nCost = nCost
tNode(2, lp).nCount = nCount + 1
Else
tNode(2, lp).nCost = &H70000000
End If
If lp = 0 Then
tNode(3, lp).nCost = &H70000000
ElseIf Not pCheckKanji(bInput(lp - 1), bInput(lp)) Then
tNode(3, lp).nCost = &H70000000
Else
If lp > 1 Then
nCost = &H7FFFFFFF
For i = 0 To 3
k = tNode(i, lp - 2).nCost + 13
If i <> 3 Or tNode(i, lp - 2).nCount >= nMaxSize(3) Then k = k + 10 + nVersion
If k < nCost Then
j = i
nCost = k
nCount = tNode(i, lp - 2).nCount And i = 3 And tNode(i, lp - 2).nCount < nMaxSize(3)
End If
Next i
Else
j = -1
nCost = 23 + nVersion
nCount = 0
End If
tNode(3, lp).nPrevMode = j
tNode(3, lp).nCost = nCost
tNode(3, lp).nCount = nCount + 1
End If
Next lp
nCost = &H7FFFFFFF
For i = 0 To 3
k = tNode(i, nSize - 1).nCost
If k < nCost Then
j = i
nCost = k
End If
Next i
If bCheckSizeOnly Then
pEncodeToBitArray = nCost + 4
Exit Function
End If
ReDim nEncodingMode(nSize - 1)
lp = nSize - 1
Do
k = tNode(j, lp).nPrevMode
nEncodingMode(lp) = j
lp = lp - 1
If j = 3 Then
If lp < 0 Then
Debug.Assert False
Exit Function
End If
nEncodingMode(lp) = j
lp = lp - 1
End If
j = k
Loop While lp >= 0
Erase tNode
nMaxSize(3) = nMaxSize(3) * 2
lp = 0
lp2 = 0
Do
j = nEncodingMode(lp)
For nCount = 1 To nSize - 1 - lp
If nEncodingMode(lp + nCount) <> j Then Exit For
If nCount >= nMaxSize(j) Then Exit For
Next nCount
Select Case j
Case 0 'byte
bOutput(lp2) = 0
bOutput(lp2 + 1) = 1
bOutput(lp2 + 2) = 0
bOutput(lp2 + 3) = 0
lp2 = lp2 + 4
m = 8 + (nVersion And 4) * 2
For i = 0 To m - 1
bOutput(lp2 + i) = (nCount And m_nPowerOfTwo(m - 1 - i)) <> 0 And 1
Next i
lp2 = lp2 + m
For j = 0 To nCount - 1
k = bInput(lp + j)
For i = 0 To 7
bOutput(lp2 + i) = (k And m_nPowerOfTwo(7 - i)) <> 0 And 1
Next i
lp2 = lp2 + 8
Next j
Case 1 'number
bOutput(lp2) = 0
bOutput(lp2 + 1) = 0
bOutput(lp2 + 2) = 0
bOutput(lp2 + 3) = 1
lp2 = lp2 + 4
m = 8 + nVersion
For i = 0 To m - 1
bOutput(lp2 + i) = (nCount And m_nPowerOfTwo(m - 1 - i)) <> 0 And 1
Next i
lp2 = lp2 + m
For j = 0 To nCount - 3 Step 3
k = (bInput(lp + j) And &HF&) * 100& + (bInput(lp + j + 1) And &HF&) * 10& + (bInput(lp + j + 2) And &HF&)
For i = 0 To 9
bOutput(lp2 + i) = (k And m_nPowerOfTwo(9 - i)) <> 0 And 1
Next i
lp2 = lp2 + 10
Next j
Select Case nCount Mod 3
Case 1
k = (bInput(lp + nCount - 1) And &HF&)
For i = 0 To 3
bOutput(lp2 + i) = (k And m_nPowerOfTwo(3 - i)) <> 0 And 1
Next i
lp2 = lp2 + 4
Case 2
k = (bInput(lp + nCount - 2) And &HF&) * 10& + (bInput(lp + nCount - 1) And &HF&)
For i = 0 To 6
bOutput(lp2 + i) = (k And m_nPowerOfTwo(6 - i)) <> 0 And 1
Next i
lp2 = lp2 + 7
End Select
Case 2 'alphanumeric
bOutput(lp2) = 0
bOutput(lp2 + 1) = 0
bOutput(lp2 + 2) = 1
bOutput(lp2 + 3) = 0
lp2 = lp2 + 4
m = 7 + nVersion
For i = 0 To m - 1
bOutput(lp2 + i) = (nCount And m_nPowerOfTwo(m - 1 - i)) <> 0 And 1
Next i
lp2 = lp2 + m
For j = 0 To nCount - 2 Step 2
k = pAlphaNumericToNumber(bInput(lp + j)) * 45& + pAlphaNumericToNumber(bInput(lp + j + 1))
For i = 0 To 10
bOutput(lp2 + i) = (k And m_nPowerOfTwo(10 - i)) <> 0 And 1
Next i
lp2 = lp2 + 11
Next j
If nCount And 1& Then
k = pAlphaNumericToNumber(bInput(lp + nCount - 1))
For i = 0 To 5
bOutput(lp2 + i) = (k And m_nPowerOfTwo(5 - i)) <> 0 And 1
Next i
lp2 = lp2 + 6
End If
Case 3 'kanji
bOutput(lp2) = 1
bOutput(lp2 + 1) = 0
bOutput(lp2 + 2) = 0
bOutput(lp2 + 3) = 0
lp2 = lp2 + 4
Debug.Assert (nCount And 1&) = 0
m = 6 + nVersion
For i = 0 To m - 1
bOutput(lp2 + i) = (nCount And m_nPowerOfTwo(m - i)) <> 0 And 1
Next i
lp2 = lp2 + m
For j = 0 To nCount - 2 Step 2
i = bInput(lp + j)
Select Case i
Case &H81& To &H9F&
i = i - &H81&
Case &HE0& To &HEB&
i = i - &HC1&
Case Else
Debug.Assert False
Exit Function
End Select
k = bInput(lp + j + 1) - &H40&
Debug.Assert k >= 0
k = k + i * &HC0&
Debug.Assert k < &H2000&
For i = 0 To 12
bOutput(lp2 + i) = (k And m_nPowerOfTwo(12 - i)) <> 0 And 1
Next i
lp2 = lp2 + 13
Next j
End Select
lp = lp + nCount
Loop While lp < nSize
bOutput(lp2) = 0
bOutput(lp2 + 1) = 0
bOutput(lp2 + 2) = 0
bOutput(lp2 + 3) = 0
pEncodeToBitArray = lp2 + 4
End Function
‘=========类模块二结束=========================================