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
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
