Option Explicit
Public Function ascii2Char(strInput As String) As String
Dim i As Integer
Dim strTemp As String
Dim nPos As Integer
Dim nValue As Integer

i = 1
nPos = InStr(i,strInput,"&#",vbTextCompare)
While (nPos > 0)
ascii2Char = ascii2Char + Left(strInput,nPos - 1)
strInput = Right(strInput,Len(strInput) - nPos + 1)
i = 3
strTemp = ""
While (i <= Len(strInput) And IsNumeric(Mid(strInput,i,1)) And Len(strTemp) < 3)
strTemp = strTemp + Mid(strInput,1)
i = i + 1
Wend
nValue = 0
If (strTemp <> "") Then nValue = Val(strTemp)
If (nValue >= 0 And nValue < 128) Then
ascii2Char = ascii2Char + Chr(nValue)
ElseIf (nValue > 127 And nValue < 256) Then
ascii2Char = ascii2Char + ChrW(nValue)
Else
ascii2Char = ascii2Char + Left(strInput,i - 1)
End If
If (i <= Len(strInput) And Mid(strInput,1) = ";") Then
i = i + 1
End If
strInput = Right(strInput,Len(strInput) - i + 1)
nPos = InStr(1,vbTextCompare)
Wend
If (Len(strInput) > 0) Then
ascii2Char = ascii2Char + strInput
End If
End Function

Public Function Code39(strToEncode As String) As String
Dim i As Integer
Dim charSet As String
Dim charToEncode As String
Dim charPos As Integer
Dim mappingSet As String

charSet = "0123456789.+-/ $%ABCDEFGHIJKLMNOPQRSTUVWXYZ"
mappingSet = "0123456789.+-/#$%ABCDEFGHIJKLMNOPQRSTUVWXYZ"

strToEncode = ascii2Char(strToEncode)
For i = 1 To Len(strToEncode)
charPos = InStr(1,charSet,Mid(strToEncode,1),0)
If charPos > 0 Then
Code39 = Code39 + Mid(mappingSet,charPos,1)
End If
Next i
Code39 = "*" + Code39 + "*"
End Function

Public Function USSCode39(strToEncode As String) As String
Dim i As Integer
Dim charSet As String
Dim charToEncode As String
Dim charPos As Integer
Dim checkDigit As String
Dim mappingSet As String

charSet = "0123456789.+-/ $%ABCDEFGHIJKLMNOPQRSTUVWXYZ"
mappingSet = "0123456789.+-/#$%ABCDEFGHIJKLMNOPQRSTUVWXYZ"

strToEncode = ascii2Char(strToEncode)
For i = 1 To Len(strToEncode)
charPos = InStr(1,0)
If charPos > 0 Then
USSCode39 = USSCode39 + Mid(mappingSet,1)
End If
Next i
checkDigit = MOD10(USSCode39)
USSCode39 = USSCode39 + checkDigit
USSCode39 = "*" + USSCode39 + "*"
End Function

Public Function UPCE(ByVal strToEncode As String) As String
Dim checkDigit As String
Dim strMod As String
Dim strUPCA As String
Dim i As Integer
Dim charSet As String
Dim strSupplement As String
Dim charPos As Integer

charSet = "0123456789|"
strToEncode = maskfilter(strToEncode,charSet)
charPos = InStr(1,strToEncode,"|",0)

If charPos > 0 Then
strSupplement = UPC25SUPP(Right(strToEncode,Len(strToEncode) - charPos))
strToEncode = Left(strToEncode,charPos - 1)
End If
If Len(strToEncode) < 6 Then
While Len(strToEncode) < 6
strToEncode = strToEncode + "0"
Wend
ElseIf Len(strToEncode) > 6 Then
strToEncode = Left(strToEncode,6)
End If
strToEncode = "0" + strToEncode

strUPCA = Upce2upca(strToEncode)
checkDigit = UPCchecksum(strUPCA)
Select Case checkDigit
Case 0: strMod = "BBBAAA"
Case 1: strMod = "BBABAA"
Case 2: strMod = "BBAABA"
Case 3: strMod = "BBAAAB"
Case 4: strMod = "BABBAA"
Case 5: strMod = "BAABBA"
Case 6: strMod = "BAAABB"
Case 7: strMod = "BABABA"
Case 8: strMod = "BABAAB"
Case 9: strMod = "BAABAB"
End Select

UPCE = "["
For i = 2 To 7
If Mid(strMod,i - 1,1) = "A" Then
UPCE = UPCE + convertSetAText(Mid(strToEncode,1))
ElseIf Mid(strMod,1) = "B" Then
UPCE = UPCE + convertSetBText(Mid(strToEncode,1))
End If
Next i
UPCE = textOnly("0") + UPCE + "'" + textOnly(checkDigit) + " " + strSupplement
End Function
Public Function EAN13(strToEncode As String) As String
Dim i As Integer
Dim checkDigit As String
Dim charToEncode As String
Dim strMod As String
Dim charSet As String
Dim strSupplement As String
Dim charPos As Integer

charSet = "0123456789|"
strToEncode = maskfilter(strToEncode,charSet)
charPos = InStr(1,0)

If charPos > 0 Then
strSupplement = UPC25SUPP(Right(strToEncode,charPos - 1)
End If
If Len(strToEncode) < 12 Then
While Len(strToEncode) < 12
strToEncode = strToEncode + "0"
Wend
ElseIf Len(strToEncode) > 12 Then
strToEncode = Left(strToEncode,12)
End If

Select Case Mid(strToEncode,1,1)
Case 0: strMod = "AAAAAA"
Case 1: strMod = "AABABB"
Case 2: strMod = "AABBAB"
Case 3: strMod = "AABBBA"
Case 4: strMod = "ABAABB"
Case 5: strMod = "ABBAAB"
Case 6: strMod = "ABBBAA"
Case 7: strMod = "ABABAB"
Case 8: strMod = "ABABBA"
Case 9: strMod = "ABBABA"
End Select

EAN13 = textOnly(Mid(strToEncode,1)) + "["

For i = 2 To 7
If Mid(strMod,1) = "A" Then
EAN13 = EAN13 + convertSetAText(Mid(strToEncode,1) = "B" Then
EAN13 = EAN13 + convertSetBText(Mid(strToEncode,1))
End If
Next i
EAN13 = EAN13 + "|"
For i = 8 To 12
EAN13 = EAN13 + convertSetCText(Mid(strToEncode,1))
Next i
checkDigit = UPCchecksum(strToEncode)
EAN13 = EAN13 + convertSetCText(checkDigit) + "]" + " " + strSupplement
End Function
Public Function EAN8(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charSet As String
Dim strSupplement As String
Dim charPos As Integer

charSet = "0123456789|"
strToEncode = maskfilter(strToEncode,charPos - 1)
End If
If Len(strToEncode) < 7 Then
While Len(strToEncode) < 7
strToEncode = strToEncode + "0"
Wend
ElseIf Len(strToEncode) > 7 Then
strToEncode = Left(strToEncode,7)
End If

For i = 1 To 4
EAN8 = EAN8 + convertSetAText(Mid(strToEncode,1))
Next i
EAN8 = EAN8 + "|"
For i = 5 To 7
EAN8 = EAN8 + convertSetCText(Mid(strToEncode,1))
Next i
EAN8 = "[" + EAN8 + convertSetCText(UPCchecksum(strToEncode)) + "]" + " " + strSupplement
End Function

Public Function Code39Mod43(strToEncode As String) As String
Dim charSet As String
Dim mappingSet As String
Dim i As Integer
Dim checkSum As Integer
Dim charPos As Integer

charSet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%"
mappingSet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.#$/+%"
strToEncode = ascii2Char(strToEncode)

For i = 1 To Len(strToEncode)
charPos = InStr(1,vbBinaryCompare)
checkSum = checkSum + (charPos - 1)
Code39Mod43 = Code39Mod43 + Mid(mappingSet,1)
Next i
checkSum = checkSum Mod 43
Code39Mod43 = "*" + Code39Mod43 + Mid(mappingSet,checkSum + 1,1) + "*"
End Function

Public Function UPCA(strToEncode As String) As String
Dim checkDigit As String
Dim i As Integer
Dim charSet As String
Dim strSupplement As String
Dim charPos As Integer

charSet = "0123456789|"
strToEncode = maskfilter(strToEncode,charPos - 1)
End If

If Len(strToEncode) < 11 Then
While Len(strToEncode) < 11
strToEncode = strToEncode + "0"
Wend
ElseIf Len(strToEncode) > 11 Then
strToEncode = Left(strToEncode,11)
End If

UPCA = textOnly(Mid(strToEncode,1)) + "[" + convertSetANoText(Mid(strToEncode,1))

For i = 1 To 5
UPCA = UPCA + convertSetAText(Mid(strToEncode,(1 + i),1))
Next i

UPCA = UPCA + "|"
For i = 1 To 5
UPCA = UPCA + convertSetCText(Mid(strToEncode,(6 + i),1))
Next i
checkDigit = UPCchecksum(strToEncode)
UPCA = UPCA + convertSetCNoText(checkDigit) + "]" + textOnly(checkDigit)
UPCA = UPCA + " " + strSupplement
End Function

Function textOnly(ch As String) As String
Select Case ch
Case "1": textOnly = Chr(225)
Case "2": textOnly = Chr(226)
Case "3": textOnly = Chr(227)
Case "4": textOnly = Chr(228)
Case "5": textOnly = Chr(229)
Case "6": textOnly = Chr(230)
Case "7": textOnly = Chr(231)
Case "8": textOnly = Chr(232)
Case "9": textOnly = Chr(233)
Case "0": textOnly = Chr(224)
End Select
End Function

Function convertSetAText(ch As String) As String
Select Case ch
Case "1": convertSetAText = "1"
Case "2": convertSetAText = "2"
Case "3": convertSetAText = "3"
Case "4": convertSetAText = "4"
Case "5": convertSetAText = "5"
Case "6": convertSetAText = "6"
Case "7": convertSetAText = "7"
Case "8": convertSetAText = "8"
Case "9": convertSetAText = "9"
Case "0": convertSetAText = "0"
End Select
End Function

Function convertSetANoText(ch As String) As String
Select Case ch
Case "1": convertSetANoText = "!"
Case "2": convertSetANoText = "@"
Case "3": convertSetANoText = "#"
Case "4": convertSetANoText = "$"
Case "5": convertSetANoText = "%"
Case "6": convertSetANoText = "^"
Case "7": convertSetANoText = "&"
Case "8": convertSetANoText = "*"
Case "9": convertSetANoText = "("
Case "0": convertSetANoText = ")"
End Select
End Function

Function convertSetCText(ch As String) As String
Select Case ch
Case "1": convertSetCText = "A"
Case "2": convertSetCText = "S"
Case "3": convertSetCText = "D"
Case "4": convertSetCText = "F"
Case "5": convertSetCText = "G"
Case "6": convertSetCText = "H"
Case "7": convertSetCText = "J"
Case "8": convertSetCText = "K"
Case "9": convertSetCText = "L"
Case "0": convertSetCText = ":"
End Select
End Function

Function convertSetCNoText(ch As String) As String
Select Case ch
Case "1": convertSetCNoText = "a"
Case "2": convertSetCNoText = "s"
Case "3": convertSetCNoText = "d"
Case "4": convertSetCNoText = "f"
Case "5": convertSetCNoText = "g"
Case "6": convertSetCNoText = "h"
Case "7": convertSetCNoText = "j"
Case "8": convertSetCNoText = "k"
Case "9": convertSetCNoText = "l"
Case "0": convertSetCNoText = ";"
End Select
End Function

Function convertSetBText(ch As String) As String
Select Case ch
Case "1": convertSetBText = "Q"
Case "2": convertSetBText = "W"
Case "3": convertSetBText = "E"
Case "4": convertSetBText = "R"
Case "5": convertSetBText = "T"
Case "6": convertSetBText = "Y"
Case "7": convertSetBText = "U"
Case "8": convertSetBText = "I"
Case "9": convertSetBText = "O"
Case "0": convertSetBText = "P"
End Select
End Function
Function convertSetBNoText(ch As String) As String
Select Case ch
Case "1": convertSetBNoText = "q"
Case "2": convertSetBNoText = "w"
Case "3": convertSetBNoText = "e"
Case "4": convertSetBNoText = "r"
Case "5": convertSetBNoText = "t"
Case "6": convertSetBNoText = "y"
Case "7": convertSetBNoText = "u"
Case "8": convertSetBNoText = "i"
Case "9": convertSetBNoText = "o"
Case "0": convertSetBNoText = "p"
End Select
End Function

Function UPCchecksum(digits As String) As String
Dim i As Integer
Dim checkSum As Integer
Dim strLen As Integer
strLen = Len(digits)
For i = 1 To strLen
If i Mod 2 = 1 Then
checkSum = checkSum + Val(Mid(digits,strLen - i + 1,1)) * 3
Else
checkSum = checkSum + Val(Mid(digits,1))
End If
Next i
UPCchecksum = checkSum Mod 10
If UPCchecksum <> 0 Then UPCchecksum = 10 - UPCchecksum
End Function

Public Function Upce2upca(ByVal digits As String) As String
If Mid(digits,1) <> "0" _
Or Len(digits) <> 7 _
Or Not IsNumeric(Mid(digits,2,6)) Then
Upce2upca = "00000000000"
Exit Function
End If
Select Case Mid(digits,7,1)
Case "0"
Upce2upca = Mid(digits,3) + Mid(digits,1) + "0000" + Mid(digits,4,3)
Case "1"
Upce2upca = Mid(digits,3)
Case "2"
Upce2upca = Mid(digits,3)
Case "3"
If InStr(1,"012",Mid(digits,0) Then
MsgBox ("Last digit is 3,then the forth digit can not be 0,2!")
Else
Upce2upca = Mid(digits,4) + "00000" + Mid(digits,5,2)
End If
Case "4"
Upce2upca = Mid(digits,5) + "00000" + Mid(digits,6,1)
Case "5"
Upce2upca = Mid(digits,6) + "0000" + Mid(digits,1)
Case "6"
Upce2upca = Mid(digits,1)
Case "7"
Upce2upca = Mid(digits,1)
Case "8"
Upce2upca = Mid(digits,1)
Case "9"
Upce2upca = Mid(digits,1)
Case Else
MsgBox ("The last digits of UPC-E code is not a numeric!")
Exit Function
End Select
End Function

Public Function Code11(strToEncode As String) As String
Dim CheckSumC As Integer
Dim checksumK As Integer
Dim charSet As String

charSet = "0123456789-"
Code11 = maskfilter(strToEncode,charSet)
CheckSumC = code11Checksum(Code11,10)
CheckSumC = CheckSumC Mod 11
Code11 = Code11 + Mid(charSet,CheckSumC + 1,1)

If Len(Code11) > 11 Then
checksumK = code11Checksum(Code11,9)
checksumK = checksumK Mod 11
Code11 = "*" + Code11 + Mid(charSet,checksumK + 1,1) + "*"
Else
Code11 = "*" + Code11 + "*"
End If
End Function

Function maskfilter(strToEncode As String,charSet As String) As String
Dim i As Integer
Dim charPos As Integer
Dim tempChar As String

For i = 1 To Len(strToEncode)
tempChar = Mid(strToEncode,1)
charPos = InStr(1,tempChar,0)
If charPos > 0 Then
maskfilter = maskfilter + Mid(strToEncode,1)
End If
Next i
End Function
Function code11Checksum(strToEncode As String,mode As Integer) As Integer
Dim i As Integer
Dim strLen As Integer
Dim charPos As Integer
Dim charToEncode As String
Dim charSet As String

charSet = "123456789-"
strLen = Len(strToEncode)
For i = 1 To strLen
charToEncode = Mid(strToEncode,charToEncode,0)
If charPos > 0 Then code11Checksum = (i Mod mode) * charPos + code11Checksum
Next i
End Function

Public Function Code25(strToEncode As String) As String
Dim charSet As String
charSet = "0123456789"
strToEncode = maskfilter(strToEncode,charSet)
Code25 = "(" + strToEncode + ")"
End Function

Public Function code25Check(strToEncode As String) As String
Dim i As Integer
Dim strLen As Integer
Dim checkSum As Integer
Dim checkDigit As String
Dim charSet As String

charSet = "0123456789"
strToEncode = maskfilter(strToEncode,charSet)

strLen = Len(strToEncode)
For i = 1 To strLen
If i Mod 2 = 1 Then
checkSum = checkSum + 3 * Val(Mid(strToEncode,1))
Else
checkSum = checkSum + Val(Mid(strToEncode,1))
End If
Next i
checkSum = checkSum Mod 10
If checkSum = 0 Then
checkDigit = "0"
Else
checkDigit = Chr(10 - checkSum + Asc("0"))
End If
code25Check = "(" + strToEncode + checkDigit + ")"
End Function

Public Function ITF25Check(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim checkDigit As String
Dim charVal As Integer
Dim charSet As String

charSet = "0123456789"
strToEncode = maskfilter(strToEncode,charSet)

If Len(strToEncode) Mod 2 = 0 Then strToEncode = "0" + strToEncode
checkDigit = MOD10(strToEncode)
strToEncode = strToEncode + checkDigit

For i = 1 To Len(strToEncode) Step 2
charToEncode = Mid(strToEncode,2)
charVal = Val(charToEncode)
If charVal >= 0 And charVal <= 93 Then
ITF25Check = ITF25Check + Chr(Asc("!") + charVal)
Else
ITF25Check = ITF25Check + Chr(charVal - 94 + 224)
End If
Next i
ITF25Check = Chr(230) + ITF25Check + Chr(231)
End Function

Public Function MOD10(strInput As String) As String
Dim i As Integer
Dim checkSum As Integer
Dim strLen As Integer
Dim charSet As String
Dim str As String

charSet = "0123456789"
str = maskfilter(strInput,charSet)

strLen = Len(str)
For i = 1 To strLen
If i Mod 2 = 1 Then
checkSum = checkSum + 3 * Val(Mid(str,1))
Else
checkSum = checkSum + Val(Mid(str,1))
End If
Next i
checkSum = checkSum Mod 10
If checkSum = 0 Then
MOD10 = "0"
Else
MOD10 = Chr(10 - checkSum + Asc("0"))
End If
End Function

Public Function ITF25(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charVal As Integer
Dim charSet As String

charSet = "0123456789"
strToEncode = maskfilter(strToEncode,charSet)
If Len(strToEncode) Mod 2 = 1 Then strToEncode = "0" + strToEncode

For i = 1 To Len(strToEncode) Step 2
charToEncode = Mid(strToEncode,2)
charVal = Val(charToEncode)
If charVal >= 0 And charVal <= 93 Then
ITF25 = ITF25 + Chr(Asc("!") + charVal)
Else
ITF25 = ITF25 + Chr(charVal - 94 + 224)
End If
Next i

ITF25 = Chr(230) + ITF25 + Chr(231)
End Function

Public Function MSI(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charPos As Integer
Dim checkSum As Integer
Dim checkDigit As String
Dim charVal As Integer
Dim strLen As Integer
Dim newno As String

strToEncode = maskfilter(strToEncode,"0123456789")

strLen = Len(strToEncode)
For i = 1 To strLen
charToEncode = Mid(strToEncode,1)
charVal = Val(charToEncode)
If i Mod 2 = (strLen Mod 2) Then
newno = newno + charToEncode
Else
checkSum = checkSum + charVal
End If
Next i
newno = str(2 * Val(newno))
For i = 1 To Len(newno)
checkSum = checkSum + Val(Mid(newno,1))
Next i
checkSum = checkSum Mod 10
If checkSum <> 0 Then
checkSum = 10 - checkSum
End If
MSI = "[" + strToEncode + Chr(Asc("0") + checkSum) + "]"
End Function

Function Code128aCharSet() As String
Dim i As Integer
For i = 32 To 95
Code128aCharSet = Code128aCharSet + Chr(i)
Next i
For i = 0 To 31
Code128aCharSet = Code128aCharSet + Chr(i)
Next i
For i = 241 To 247
Code128aCharSet = Code128aCharSet + ChrW(i)
Next i
End Function

Function Code128bCharSet() As String
Dim i As Integer
For i = 32 To 127
Code128bCharSet = Code128bCharSet + Chr(i)
Next i
For i = 241 To 247
Code128bCharSet = Code128bCharSet + ChrW(i)
Next i
End Function

Function Code128cCharset() As String
Dim i As Integer
For i = 0 To 9
Code128cCharset = Code128cCharset + Chr(i + Asc(0))
Next i
For i = 245 To 247
Code128cCharset = Code128cCharset + ChrW(i)
Next i
End Function

Function code128MappingSet() As String
Dim i As Integer
code128MappingSet = ChrW(252)
For i = 33 To 126
code128MappingSet = code128MappingSet + ChrW(i)
Next i
For i = 240 To 251
code128MappingSet = code128MappingSet + ChrW(i)
Next i
End Function

Function code128CSMapping(ByVal nCode As Long) As Long
Dim i As Long
If (nCode = 0) Then
code128CSMapping = 252
ElseIf (nCode >= 1 And nCode <= 38) Then
code128CSMapping = 384 + nCode - 1
ElseIf (nCode >= 39 And nCode <= 94) Then
code128CSMapping = 166 + nCode - 39
Else
code128CSMapping = 240 + nCode - 95
End If
End Function

Function code128CCSMapping(ByVal nCode As Long) As Long
Dim i As Long
If (nCode = 0) Then
code128CCSMapping = 253
ElseIf (nCode >= 1 And nCode <= 38) Then
code128CCSMapping = 384 + nCode - 1
ElseIf (nCode >= 39 And nCode <= 99) Then
code128CCSMapping = 166 + nCode - 39
Else
code128CCSMapping = 245 + nCode - 100
End If
End Function

Public Function code128Auto(ByVal strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charPos As Integer
Dim checkSum As Integer
Dim checkDigit As String
Dim AcharSet As String
Dim BcharSet As String
Dim CcharSet As String
Dim mappingSet As String
Dim curCharSet As String
Dim strLen As Integer
Dim charVal As Integer
Dim weight As Integer

If strToEncode = "" Then
code128Auto = ""
Exit Function
End If

AcharSet = Code128aCharSet
BcharSet = Code128bCharSet
CcharSet = Code128cCharset
mappingSet = code128MappingSet
strToEncode = ascii2Char(strToEncode)
strLen = Len(strToEncode)
charVal = AscW(Mid(strToEncode,1))
If charVal <= 31 Then curCharSet = AcharSet
If charVal >= 32 And charVal <= 126 Then curCharSet = BcharSet
If charVal = 242 Then curCharSet = BcharSet
If charVal = 247 Then curCharSet = CcharSet
If ((strLen > 4) And IsNumeric(Mid(strToEncode,4))) Then curCharSet = CcharSet

Select Case curCharSet
Case AcharSet
code128Auto = code128Auto + ChrW(248)
Case BcharSet
code128Auto = code128Auto + ChrW(249)
Case CcharSet
code128Auto = code128Auto + ChrW(250)
End Select

For i = 1 To strLen
charToEncode = Mid(strToEncode,1)
charVal = AscW(charToEncode)

If (charVal = 242) Then
If curCharSet = CcharSet Then
code128Auto = code128Auto + ChrW(249)
curCharSet = BcharSet
End If
code128Auto = code128Auto + ChrW(242)
i = i + 1
charToEncode = Mid(strToEncode,1)
charVal = AscW(charToEncode)
End If

If (charVal = 247) Then
code128Auto = code128Auto + ChrW(247)
ElseIf ((i < strLen - 2) And (IsNumeric(charToEncode)) And (IsNumeric(Mid(strToEncode,i + 1,1))) And (IsNumeric(Mid(strToEncode,4)))) Or _
((i < strLen) And (IsNumeric(charToEncode)) And (IsNumeric(Mid(strToEncode,1))) And (curCharSet = CcharSet)) Then
If curCharSet <> CcharSet Then
code128Auto = code128Auto + ChrW(244)
curCharSet = CcharSet
End If
charToEncode = Mid(strToEncode,2)
charVal = Val(charToEncode)
code128Auto = code128Auto + Mid(mappingSet,charVal + 1,1)
i = i + 1
ElseIf (((i <= strLen) And (charVal < 31)) Or ((curCharSet = AcharSet) And (charVal > 32 And charVal < 96))) Then
If curCharSet <> AcharSet Then
code128Auto = code128Auto + ChrW(246)
curCharSet = AcharSet
End If
charPos = InStr(1,curCharSet,0)
code128Auto = code128Auto + Mid(mappingSet,1)
ElseIf (i <= strLen) And (charVal > 31 And charVal < 127) Then
If curCharSet <> BcharSet Then
code128Auto = code128Auto + ChrW(245)
curCharSet = BcharSet
End If
charPos = InStr(1,1)
End If
Next i

strLen = Len(code128Auto)
For i = 1 To strLen
charVal = (AscW(Mid(code128Auto,1)))
If charVal = 252 Then
charVal = 0
ElseIf charVal <= 126 Then
charVal = charVal - 32
ElseIf charVal >= 240 Then
charVal = charVal - 145
End If
If i > 1 Then
weight = i - 1
Else
weight = 1
End If
checkSum = checkSum + charVal * weight
Next i
checkSum = checkSum Mod 103
checkDigit = Mid(mappingSet,1)
code128Auto = code128Auto + checkDigit + ChrW(251)
End Function

Public Function Code128A(ByVal strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charPos As Integer
Dim checkSum As Long
Dim checkDigit As Long
Dim strTemp As String
Dim AcharSet As String
Dim mappingSet As String

AcharSet = Code128aCharSet
mappingSet = code128MappingSet
strToEncode = ascii2Char(strToEncode)

For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,AcharSet,0)
If charPos > 0 Then strTemp = strTemp + charToEncode
Next i

checkSum = 103
For i = 1 To Len(strTemp)
charToEncode = Mid(strTemp,0)
If charPos > 0 Then
Code128A = Code128A + Mid(mappingSet,1)
checkSum = checkSum + i * (charPos - 1)
End If
Next i

checkSum = checkSum Mod 103
checkDigit = code128CSMapping(checkSum)
Code128A = ChrW(248) + Code128A + ChrW(checkDigit) + ChrW(251)
End Function

Public Function Code128B(ByVal strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charPos As Integer
Dim checkSum As Long
Dim strTemp As String
Dim checkDigit As Long
Dim BcharSet As String
Dim mappingSet As String

BcharSet = Code128bCharSet
mappingSet = code128MappingSet

strToEncode = ascii2Char(strToEncode)
For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,BcharSet,0)
If charPos > 0 Then strTemp = strTemp + charToEncode
Next i

checkSum = 104
For i = 1 To Len(strTemp)
charToEncode = Mid(strTemp,0)
If charPos > 0 Then
Code128B = Code128B + Mid(mappingSet,1)
checkSum = checkSum + i * (charPos - 1)
End If
Next i
checkSum = checkSum Mod 103
checkDigit = code128CSMapping(checkSum)
Code128B = ChrW(249) + Code128B + ChrW(checkDigit) + ChrW(251)
End Function

Public Function Code128C(ByVal strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charPos As Integer
Dim checkSum As Long
Dim strTemp As String
Dim checkDigit As Long
Dim charVal As Integer
Dim CcharSet As String
Dim mappingSet As String

CcharSet = Code128cCharset
mappingSet = code128MappingSet

strToEncode = ascii2Char(strToEncode)
For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,CcharSet,0)
If charPos > 0 Then strTemp = strTemp + charToEncode
Next i
If Len(strTemp) Mod 2 = 1 Then strTemp = "0" + strTemp

checkSum = 105
For i = 1 To Len(strTemp) Step 2
charToEncode = Mid(strTemp,2)
charVal = Val(charToEncode)
Code128C = Code128C + Mid(mappingSet,1)
Next i

For i = 1 To Len(Code128C)
charToEncode = Mid(Code128C,1)
charVal = AscW(charToEncode)
If charVal = 252 Then
charVal = 0
ElseIf charVal >= 33 And charVal < 127 Then
checkSum = checkSum + i * (charVal - 32)
Else
checkSum = checkSum + i * (charVal - 145)
End If
Next i
checkSum = checkSum Mod 103
checkDigit = code128CCSMapping(checkSum)
Code128C = ChrW(250) + Code128C + ChrW(checkDigit) + ChrW(251)
End Function

Public Function USPS128(ByVal strToEncode As String) As String
Dim checkDigit As String
Dim charSet As String

strToEncode = ascii2Char(strToEncode)
checkDigit = MOD10(strToEncode)
If (Mid(strToEncode,1) <> ChrW(247)) Then
strToEncode = ChrW(247) + strToEncode
End If
USPS128 = code128Auto(strToEncode + checkDigit)
End Function

Public Function UCCEAN128(ByVal strToEncode As String) As String
Dim charSet As String
Dim i As Integer
Dim charToEncode As String

strToEncode = ascii2Char(strToEncode)
strToEncode = UCase(strToEncode)

If (Mid(strToEncode,1) <> ChrW(247)) Then
strToEncode = ChrW(247) + strToEncode
End If

charSet = Mid(strToEncode,1)
For i = 2 To Len(strToEncode)
charToEncode = Mid(strToEncode,1)
If (Asc(charToEncode) >= 48 And Asc(charToEncode) <= 57) Or (Asc(charToEncode) >= 65 And Asc(charToEncode) <= 90) Or (charToEncode = ChrW(247)) Then
charSet = charSet + charToEncode
End If
Next i

UCCEAN128 = code128Auto(charSet)
End Function

Public Function Code93(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charPos As Integer
Dim weightC As Integer
Dim weightK As Integer
Dim CheckSumC As Integer
Dim checksumK As Integer
Dim charSet As String
Dim mappingSet As String

charSet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%^)&("
mappingSet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.#$/+%^)&("
strToEncode = ascii2Char(strToEncode)
For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,1)
If Asc(charToEncode) = 0 Then
Code93 = Code93 + ")" + "U"
ElseIf Asc(charToEncode) >= 1 And Asc(charToEncode) <= 26 Then
Code93 = Code93 + "^" + Chr(Asc(charToEncode) + Asc("A") - 1)
ElseIf Asc(charToEncode) >= 27 And Asc(charToEncode) <= 31 Then
Code93 = Code93 + ")" + Chr(Asc(charToEncode) - 27 + Asc("A"))
ElseIf Asc(charToEncode) = 32 Then 'space
Code93 = Code93 + "#"
ElseIf Asc(charToEncode) >= 33 And Asc(charToEncode) <= 44 Then
Code93 = Code93 + "&" + Chr(Asc(charToEncode) - 33 + Asc("A"))
ElseIf charToEncode = "-" Then
Code93 = Code93 + charToEncode
ElseIf charToEncode = "." Then
Code93 = Code93 + charToEncode
ElseIf charToEncode = "/" Then
Code93 = Code93 + "&" + "O"
ElseIf Asc(charToEncode) >= 48 And Asc(charToEncode) <= 57 Then
Code93 = Code93 + charToEncode
ElseIf charToEncode = ":" Then
Code93 = Code93 + "&" + "Z"
ElseIf Asc(charToEncode) >= 59 And Asc(charToEncode) <= 63 Then
Code93 = Code93 + ")" + Chr(Asc(charToEncode) - 59 + Asc("F"))
ElseIf Asc(charToEncode) = 64 Then
Code93 = Code93 + ")" + "V"
ElseIf Asc(charToEncode) >= 65 And Asc(charToEncode) <= 90 Then
Code93 = Code93 + charToEncode
ElseIf Asc(charToEncode) >= 91 And Asc(charToEncode) <= 95 Then
Code93 = Code93 + ")" + Chr(Asc(charToEncode) - 91 + Asc("K"))
ElseIf Asc(charToEncode) = 96 Then
Code93 = Code93 + ")" + "W"
ElseIf Asc(charToEncode) >= 97 And Asc(charToEncode) <= 122 Then
Code93 = Code93 + "(" + Chr(Asc(charToEncode) - 97 + Asc("A"))
ElseIf Asc(charToEncode) >= 123 And Asc(charToEncode) <= 127 Then
Code93 = Code93 + ")" + Chr(Asc(charToEncode) - 123 + Asc("P"))
End If
Next i

For i = 1 To Len(Code93)
weightC = ((i - 1) Mod 20) + 1
charToEncode = Mid(Code93,Len(Code93) - i + 1,mappingSet,0)
CheckSumC = CheckSumC + weightC * (charPos - 1)
Next i
Code93 = Code93 + Mid(mappingSet,(CheckSumC Mod 47) + 1,1)

For i = 1 To Len(Code93)
weightK = ((i - 1) Mod 15) + 1
charToEncode = Mid(Code93,0)
checksumK = checksumK + weightK * (charPos - 1)
Next i
Code93 = Code93 + Mid(mappingSet,(checksumK Mod 47) + 1,1)
Code93 = "*" + Code93 + "*" + "|"
End Function

Public Function Codabar(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charPos As Integer
Dim charSet As String

charSet = "0123456789-$:/.+"
strToEncode = maskfilter(strToEncode,charSet)
Codabar = "A" + strToEncode + "B"
End Function

Public Function Code39FullAscii(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charSet As String
Dim mappingSet As String
Dim strTemp As String

strToEncode = ascii2Char(strToEncode)
For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,1)
If Asc(charToEncode) = 0 Then
strTemp = strTemp + "%U"
ElseIf Asc(charToEncode) >= 1 And Asc(charToEncode) <= 26 Then
strTemp = strTemp + "$" + Chr(Asc(charToEncode) + Asc("A") - 1)
ElseIf Asc(charToEncode) >= 27 And Asc(charToEncode) <= 31 Then
strTemp = strTemp + "%" + Chr(Asc(charToEncode) - 27 + Asc("A"))
ElseIf Asc(charToEncode) = 32 Then
strTemp = strTemp + "="
ElseIf Asc(charToEncode) >= 33 And Asc(charToEncode) <= 44 Then
strTemp = strTemp + "/" + Chr(Asc(charToEncode) - 33 + Asc("A"))
ElseIf charToEncode = "-" Then
strTemp = strTemp + charToEncode
ElseIf charToEncode = "." Then
strTemp = strTemp + charToEncode
ElseIf charToEncode = "/" Then
strTemp = strTemp + "/O"
ElseIf Asc(charToEncode) >= 48 And Asc(charToEncode) <= 57 Then
strTemp = strTemp + charToEncode
ElseIf charToEncode = ":" Then
strTemp = strTemp + "/Z"
ElseIf Asc(charToEncode) >= 59 And Asc(charToEncode) <= 63 Then
strTemp = strTemp + "%" + Chr(Asc(charToEncode) - 59 + Asc("F"))
ElseIf Asc(charToEncode) = 64 Then
strTemp = strTemp + "%V"
ElseIf Asc(charToEncode) >= 65 And Asc(charToEncode) <= 90 Then
strTemp = strTemp + charToEncode
ElseIf Asc(charToEncode) >= 91 And Asc(charToEncode) <= 95 Then
strTemp = strTemp + "%" + Chr(Asc(charToEncode) - 91 + Asc("K"))
ElseIf Asc(charToEncode) = 96 Then
strTemp = strTemp + "%W"
ElseIf Asc(charToEncode) >= 97 And Asc(charToEncode) <= 122 Then
strTemp = strTemp + "+" + Chr(Asc(charToEncode) - 97 + Asc("A"))
ElseIf Asc(charToEncode) >= 123 And Asc(charToEncode) <= 127 Then
strTemp = strTemp + "%" + Chr(Asc(charToEncode) - 123 + Asc("P"))
End If
Next i
Code39FullAscii = "*" + strTemp + "*"
End Function

Public Function Code39Extended(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charVal As Integer

strToEncode = ascii2Char(strToEncode)
For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,1)
charVal = Asc(charToEncode)
If charToEncode = " " Then
Code39Extended = Code39Extended + "#"
ElseIf charToEncode = "*" Then
Code39Extended = Code39Extended + Chr(176)
ElseIf charToEncode = "#" Then
Code39Extended = Code39Extended + Chr(177)
ElseIf charVal = 127 Then
Code39Extended = Code39Extended + Chr(175)
ElseIf charVal >= 0 And charVal <= 31 Then
Code39Extended = Code39Extended + Chr(224 + charVal)
Else
Code39Extended = Code39Extended + charToEncode
End If
Next i
Code39Extended = "*" + Code39Extended + "*"
End Function

Public Function Bookland(strToEncode As String) As String
Dim i As Integer
Dim charSet As String

charSet = "0123456789"
strToEncode = maskfilter(strToEncode,charSet)
If Len(strToEncode) > 10 Then
strToEncode = Left(strToEncode,10)
ElseIf Len(strToEncode) < 10 Then
While Len(strToEncode) < 10
strToEncode = strToEncode + "0"
Wend
End If
Bookland = "978" + Left(strToEncode,9)
Bookland = EAN13(Bookland)
End Function

Public Function codeISBN(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charPos As Integer
Dim weight As Integer
Dim checkSum As Integer
Dim checkDigit As String
Dim charSet As String

charSet = "0123456789"
strToEncode = maskfilter(strToEncode,charSet)
If Len(strToEncode) > 9 Then
strToEncode = Left(strToEncode,9)
ElseIf Len(strToEncode) < 9 Then
While Len(strToEncode) < 9
strToEncode = strToEncode + "0"
Wend
End If
codeISBN = strToEncode
For i = 1 To Len(codeISBN)
weight = 11 - i
charToEncode = Mid(codeISBN,1)
checkSum = checkSum + weight * Val(charToEncode)
Next i
checkSum = 11 - (checkSum Mod 11)
checkDigit = Chr(checkSum + Asc("0"))
codeISBN = codeISBN + checkDigit
End Function

Function LeftHandEncoding(digit As Integer,parity As Integer) As String
Select Case digit
Case 0
If parity = 1 Then
LeftHandEncoding = "/"
ElseIf parity = 0 Then
LeftHandEncoding = "?"
End If
Case 1
If parity = 1 Then
LeftHandEncoding = "z"
ElseIf parity = 0 Then
LeftHandEncoding = "Z"
End If
Case 2
If parity = 1 Then
LeftHandEncoding = "x"
ElseIf parity = 0 Then
LeftHandEncoding = "X"
End If
Case 3
If parity = 1 Then
LeftHandEncoding = "c"
ElseIf parity = 0 Then
LeftHandEncoding = "C"
End If
Case 4
If parity = 1 Then
LeftHandEncoding = "v"
ElseIf parity = 0 Then
LeftHandEncoding = "V"
End If
Case 5
If parity = 1 Then
LeftHandEncoding = "b"
ElseIf parity = 0 Then
LeftHandEncoding = "B"
End If
Case 6
If parity = 1 Then
LeftHandEncoding = "n"
ElseIf parity = 0 Then
LeftHandEncoding = "N"
End If
Case 7
If parity = 1 Then
LeftHandEncoding = "m"
ElseIf parity = 0 Then
LeftHandEncoding = "M"
End If
Case 8
If parity = 1 Then
LeftHandEncoding = ","
ElseIf parity = 0 Then
LeftHandEncoding = "<"
End If
Case 9
If parity = 1 Then
LeftHandEncoding = "."
ElseIf parity = 0 Then
LeftHandEncoding = ">"
End If
End Select
End Function
Public Function UPC25SUPP(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim charPosition As Integer
Dim strLen As Integer

For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,1)
charPosition = InStr(1,"0123456789",0)
If charPosition > 0 Then
UPC25SUPP = UPC25SUPP + charToEncode
End If
Next i

strLen = Len(UPC25SUPP)
If strLen = 0 Then
UPC25SUPP = UPC2SUPP("00")
ElseIf strLen = 1 Then
UPC25SUPP = UPC2SUPP(UPC25SUPP + "0")
ElseIf strLen = 2 Then
UPC25SUPP = UPC2SUPP(UPC25SUPP)
ElseIf strLen = 3 Then
UPC25SUPP = UPC5SUPP(UPC25SUPP + "00")
ElseIf strLen = 4 Then
UPC25SUPP = UPC5SUPP(UPC25SUPP + "0")
ElseIf strLen = 5 Then
UPC25SUPP = UPC5SUPP(UPC25SUPP)
Else
UPC25SUPP = UPC5SUPP(Left(UPC25SUPP,5))
End If
End Function

Public Function UPC2SUPP(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim nTemp As Integer
Dim parity1 As Integer
Dim parity2 As Integer

nTemp = Val(strToEncode) Mod 4
If nTemp = 0 Then
parity1 = 1
parity2 = 1
ElseIf nTemp = 1 Then
parity1 = 1
parity2 = 0
ElseIf nTemp = 2 Then
parity1 = 0
parity2 = 1
ElseIf nTemp = 3 Then
parity1 = 0
parity2 = 0
End If

UPC2SUPP = "{"
charToEncode = Mid(strToEncode,1)
UPC2SUPP = UPC2SUPP + LeftHandEncoding(Val(charToEncode),parity1)
UPC2SUPP = UPC2SUPP + "/"
charToEncode = Mid(strToEncode,parity2)
End Function
Function Parity5(digit As Integer) As String
Select Case digit
Case 0
Parity5 = "00111"
Case 1
Parity5 = "01011"
Case 2
Parity5 = "01101"
Case 3
Parity5 = "01110"
Case 4
Parity5 = "10011"
Case 5
Parity5 = "11001"
Case 6
Parity5 = "11100"
Case 7
Parity5 = "10101"
Case 8
Parity5 = "10110"
Case 9
Parity5 = "11010"
End Select
End Function

Public Function UPC5SUPP(strToEncode As String) As String
Dim i As Integer
Dim strParity As String
Dim weightSum As Integer

weightSum = 3 * Val(Mid(strToEncode,1)) + 9 * Val(Mid(strToEncode,1)) + 3 * Val(Mid(strToEncode,3,1))
strParity = Parity5(weightSum Mod 10)

UPC5SUPP = "{"
For i = 1 To 5
UPC5SUPP = UPC5SUPP + LeftHandEncoding(Val(Mid(strToEncode,1)),Val(Mid(strParity,1)))
If (i < 5) Then
UPC5SUPP = UPC5SUPP + "/"
End If
Next i
End Function

Public Function telepen(ByVal strToEncode As String) As String
Dim charToEncode As String
Dim charPos As Integer
Dim checkSum As Integer
Dim checkDigit As String
Dim i As Integer

strToEncode = ascii2Char(strToEncode)

For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,1)
checkSum = checkSum + Asc(charToEncode)
Next i
checkDigit = Chr(127 - (checkSum Mod 127))
strToEncode = strToEncode + checkDigit

For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,1)
If (charToEncode = " ") Then
telepen = telepen + "#"
ElseIf (charToEncode = "#") Then
telepen = telepen + Chr(176)
ElseIf (charToEncode = "[") Then
telepen = telepen + Chr(177)
ElseIf (charToEncode = "]") Then
telepen = telepen + Chr(178)
ElseIf (Asc(charToEncode) >= 0 And Asc(charToEncode) <= 31) Then
telepen = telepen + Chr(Asc(charToEncode) + 224)
ElseIf (Asc(charToEncode) = 127) Then
telepen = telepen + Chr(179)
Else
telepen = telepen + charToEncode
End If
Next i
telepen = "[" + telepen + "]"
End Function

Public Function telepenNum(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim checkSum As Integer
Dim checkDigit As String
Dim charVal As Integer
Dim mappingSet As String
Dim charSet As String

charSet = "0123456789"
strToEncode = maskfilter(strToEncode,charSet)
If Len(strToEncode) Mod 2 = 1 Then strToEncode = "0" + strToEncode

For i = 1 To Len(strToEncode) Step 2
charToEncode = Mid(strToEncode,2)
charVal = Val(charToEncode) + 27
mappingSet = mappingSet + Chr(charVal)
Next i

For i = 1 To Len(mappingSet)
charToEncode = Mid(mappingSet,1)
charVal = Asc(charToEncode)
checkSum = checkSum + charVal
Next i
checkDigit = Chr(127 - (checkSum Mod 127))
mappingSet = mappingSet + checkDigit

For i = 1 To Len(mappingSet)
charToEncode = Mid(mappingSet,1)
If (charToEncode = " ") Then
telepenNum = telepenNum + "#"
ElseIf (charToEncode = "#") Then
telepenNum = telepenNum + Chr(176)
ElseIf (charToEncode = "[") Then
telepenNum = telepenNum + Chr(177)
ElseIf (charToEncode = "]") Then
telepenNum = telepenNum + Chr(178)
ElseIf (Asc(charToEncode) >= 0 And Asc(charToEncode) <= 31) Then
telepenNum = telepenNum + Chr(Asc(charToEncode) + 224)
ElseIf (Asc(charToEncode) = 127) Then
telepenNum = telepenNum + Chr(179)
Else
telepenNum = telepenNum + charToEncode
End If
Next i
telepenNum = "[" + telepenNum + "]"
End Function

Function Postnet(strToEncode As String) As String
Dim i As Integer
Dim charToEncode As String
Dim checkSum As Integer
Dim checkDigit As String
Dim charSet As String

charSet = "0123456789"
strToEncode = maskfilter(strToEncode,charSet)
If Len(strToEncode) >= 0 And Len(strToEncode) < 5 Then
While Len(strToEncode) < 5
strToEncode = strToEncode + "0"
Wend
ElseIf Len(strToEncode) > 5 And Len(strToEncode) < 9 Then
While Len(strToEncode) < 9
strToEncode = strToEncode + "0"
Wend
ElseIf Len(strToEncode) > 9 And Len(strToEncode) < 11 Then
While Len(strToEncode) < 11
strToEncode = strToEncode + "0"
Wend
ElseIf Len(strToEncode) > 11 Then
strToEncode = Left(strToEncode,11)
End If

For i = 1 To Len(strToEncode)
charToEncode = Mid(strToEncode,1)
If IsNumeric(charToEncode) Then
Postnet = Postnet + charToEncode
checkSum = checkSum + Val(charToEncode)
End If
Next i
checkSum = checkSum Mod 10
If checkSum <> 0 Then checkSum = 10 - checkSum
checkDigit = Chr(checkSum + Asc("0"))
Postnet = "[" + Postnet + checkDigit + "]"
End Function

Public Function pdf417(ByVal strToEncode As String) As String
Dim retval
On Error GoTo clearmem
Dim strTemp
strTemp = ascii2Char(strToEncode)
cruflBCSObj = CreateObject("cruflBCS.PDF417.1")
cruflBCSObj.MaxRows = 8
cruflBCSObj.SetCRLF (1)
retval = cruflBCSObj.EncodeCR(strTemp,"0")
pdf417 = retval
clearmem:
cruflBCSObj = Nothing
End Function

Public Function datamatrix(ByVal strToEncode As String) As String
Dim retval
On Error GoTo clearmem
Dim strTemp
strTemp = ascii2Char(strToEncode)
cruflBCSObj = CreateObject("cruflBCS.DataMatrix.1")
cruflBCSObj.SetCRLF (1)
retval = cruflBCSObj.EncodeCR(strTemp,"0")
datamatrix = retval
clearmem:
cruflBCSObj = Nothing
End Function

Public Function semidatamatrix(ByVal strToEncode As String)
Dim retval
On Error GoTo clearmem
Dim strTemp
strTemp = ascii2Char(strToEncode)
cruflBCSObj = CreateObject("BCSSEMIDataMatrix.BCSSEMIDM.1")
retval = cruflBCSObj.Encode(strTemp)
semidatamatrix = retval
clearmem:
cruflBCSObj = Nothing
End Function

Public Function qrcode(ByVal strToEncode As String) As String
Dim retval
On Error GoTo clearmem
Dim strTemp
strTemp = ascii2Char(strToEncode)
cruflBCSObj = CreateObject("cruflBCS.QRCode.1")
cruflBCSObj.SetCRLF (1)
cruflBCSObj.ECLevel = 1
retval = cruflBCSObj.EncodeCR(strTemp,"0")
qrcode = retval
clearmem:
cruflBCSObj = Nothing
End Function

Public Function code16k(ByVal strToEncode As String) As String
Dim retval
On Error GoTo clearmem
Dim strTemp
strTemp = ascii2Char(strToEncode)
cruflBCSObj = CreateObject("cruflBcS.Code16K.1")
cruflBCSObj.SetCRLF (1)
retval = cruflBCSObj.Encode(strTemp)
code16k = retval
clearmem:
cruflBCSObj = Nothing
End Function

Public Function USSCode128(strToEncode As String) As String
Dim checkDigit As String

strToEncode = ascii2Char(strToEncode)checkDigit = MOD10(strToEncode)strToEncode = strToEncode + checkDigitUSSCode128 = Code128B(strToEncode)End Function

原文链接：https://www.f2er.com/vb/262502.html