DigitalGeek
Programmer
I need to now the method to create a "UCC MOD 10" check digit...
Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Mod 10 barcode checkdigit? 1
- Thread starter DigitalGeek
- Start date
- Status
JohnYingling
Programmer
Search "MOD 10" "check digit" calculate
in Google.
Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
in Google.
Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
There's an example here:
with some VB code - but note the (c) notice
________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first
'People who live in windowed environments shouldn't cast pointers.'
with some VB code - but note the (c) notice
________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first
'People who live in windowed environments shouldn't cast pointers.'
-
1
- #4
poltergeist
Programmer
I don't know the from where i've but here is a code
Option Explicit
Private BarTextOut As String
Private BarTextIn As String
Private TempString As String
Private BarCodeOut As String
Private Sum As Long
Private II As Integer
Private WorkL As String
Private WorkR As String
Private CheckSumValue As Integer
Private CheckSum As String
Private Answer As Integer
Private BarTextOut2 As String
Private TempString2 As String
Private SupString As String
Private WorkS As String
Private SupSum As Long
Private SupCheckSumValue As Integer
'Functions in this file:
' EAN8(Text) -> convert text to EAN 8 format
' EAN13(Text) -> convert text to EAN 13 format
' Bookland(ISBN,Supplemental) -> convert text to Bookland format (EAN 13 with 5 digit
' supplemental code
'---------------------------------------------------------
Public Function EAN8(BarTextIn As String) As String
' /// Initialize input and output strings ///
BarTextOut = ""
BarTextIn = RTrim(LTrim(BarTextIn))
' /// Throw away non-numeric data ///
TempString = ""
For II = 1 To Len(BarTextIn)
If IsNumeric(Mid(BarTextIn, II, 1)) Then
TempString = TempString & Mid(BarTextIn, II, 1)
End If
Next II
' /// Better be 7 digits long, or error it ///
If Len(TempString) < 7 Then TempString = "0000000"
If Len(TempString) > 7 Then TempString = Mid(TempString, 1, 7)
' /// Now calculate checksum and character map left and right sides ///
Sum = 0
WorkL = ""
WorkR = ""
For II = 1 To 7
If (II Mod 2) = 1 Then
Sum = Sum + (3 * Mid(TempString, II, 1))
Else
Sum = Sum + Mid(TempString, II, 1)
End If
If II < 5 Then
WorkL = WorkL & Chr(Asc(Mid(TempString, II, 1)) + 17)
Else
WorkR = WorkR & Mid(TempString, II, 1)
End If
Next II
' Build actual checksum character
CheckSumValue = 10 - (Sum Mod 10)
If CheckSumValue = 10 Then CheckSumValue = 0
CheckSum = Chr(48 + CheckSumValue)
' Build working bar code string
BarCodeOut = "[" & WorkL & "|" & WorkR & CheckSum & "] "
Label1.Caption = BarCodeOut
End Function
'---------------------------------------------------------
' This function converts a string into a format compatible with Elfring
' Fonts Inc EAN bar codes. This conversion is for EAN 13 only. It removes
' non-numeric data, calculates a checksum, and converts the result to
' fit our bar code format. If the data has less than 12 digits 12 zeros
' are put in place of the data. If the data has more than 12 digits,
' the extras are truncated.
'---------------------------------------------------------
Public Function EAN13(BarTextIn As String) As String
' Initialize input and output strings
BarTextOut = ""
BarTextIn = RTrim(LTrim(BarTextIn))
' Throw away non-numeric data
TempString = ""
For II = 1 To Len(BarTextIn)
If IsNumeric(Mid(BarTextIn, II, 1)) Then
TempString = TempString & Mid(BarTextIn, II, 1)
End If
Next II
' Better be 12 digits long, or error it
If Len(TempString) < 12 Then TempString = "000000000000"
If Len(TempString) > 12 Then TempString = Mid(TempString, 1, 12)
' Now calculate checksum and character map left and right sides
Sum = 0
WorkL = ""
WorkR = ""
For II = 1 To 12
If (II Mod 2) = 0 Then
Sum = Sum + (3 * Mid(TempString, II, 1))
Else
Sum = Sum + Mid(TempString, II, 1)
End If
If (II > 2) And (II < 8) Then
WorkL = WorkL & getAB(Mid(TempString, 1, 1), Mid(TempString, II, 1), II - 2)
ElseIf II > 7 Then
WorkR = WorkR & Mid(TempString, II, 1)
End If
Next II
' Build actual checksum character
CheckSumValue = 10 - (Sum Mod 10)
If CheckSumValue = 10 Then CheckSumValue = 0
CheckSum = Chr(48 + CheckSumValue)
' Build working bar code string
BarCodeOut = Chr(Asc(Mid(TempString, 1, 1)) - 15) & Chr(Asc(Mid(TempString, 2, 1)) + 17) & WorkL & "|" & WorkR & CheckSum & "]"
EAN13 = BarCodeOut
End Function
'---------------------------------------------------------------
' Parity encoding for EAN 13
' FirstFlag = int 0-9, datachar = ASCII 0-9, position = int 1-5!
'---------------------------------------------------------------
Public Function getAB(FirstFlag As Integer, datachar As String, position As Integer) As String
Answer = 0
Select Case FirstFlag
Case 0
If Mid("AAAAA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 1
If Mid("ABABB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 2
If Mid("ABBAB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 3
If Mid("ABBBA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 4
If Mid("BAABB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 5
If Mid("BBAAB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 6
If Mid("BBBAA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 7
If Mid("BABAB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 8
If Mid("BABBA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 9
If Mid("BBABA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
End Select
getAB = Chr(Asc(Mid(datachar, 1, 1)) + Answer)
End Function
'---------------------------------------------------------
' This function converts a string into a format compatible with Elfring
' Fonts Inc Bookland bar codes. Your ISBN number is converted into an
' EAN bar code and the 5 digit supplemental code is added to the end.
' Errors in data are ignored or translated to zeros.
'---------------------------------------------------------
Public Function Bookland(ISBN As String, Supplemental As String) As String
' Initialize input and output strings
BarTextOut2 = ""
ISBN = RTrim(LTrim(ISBN))
Supplemental = RTrim(LTrim(Supplemental))
' Throw away non-numeric data in ISBN
TempString2 = ""
For II = 1 To Len(ISBN)
If IsNumeric(Mid(ISBN, II, 1)) Then
TempString2 = TempString2 & Mid(ISBN, II, 1)
End If
Next II
' Throw away non-numeric data in Supplemental
SupString = ""
For II = 1 To Len(Supplemental)
If IsNumeric(Mid(Supplemental, II, 1)) Then
SupString = SupString & Mid(Supplemental, II, 1)
End If
Next II
' ISBN better be 9 digits long, or fix it
If Len(TempString2) < 9 Then TempString2 = "000000000"
If Len(TempString2) > 9 Then TempString2 = Mid(TempString2, 1, 9)
' Supplemental better be 5 digits long, or fix it
If Len(SupString) < 5 Then SupString = "90000"
If Len(SupString) > 5 Then SupString = Mid(SupString, 1, 5)
' Convert ISBN number to Bookland
TempString2 = "978" & TempString2
BarTextOut2 = EAN13(TempString2)
' Need checksum for supplemental code
SupSum = 0
For II = 1 To Len(SupString)
If (II Mod 2) = 1 Then
SupSum = SupSum + ((Asc(Mid(SupString, II, 1)) - 48) * 3)
Else
SupSum = SupSum + ((Asc(Mid(SupString, II, 1)) - 48) * 9)
End If
Next II
SupCheckSumValue = SupSum Mod 10
' Now build supplemental string
WorkS = " /"
For II = 1 To 5
WorkS = WorkS & getAB5(SupCheckSumValue, Mid(SupString, II, 1), II)
If II < 5 Then WorkS = WorkS & "."
Next II
Bookland = BarTextOut2 & WorkS
End Function
'---------------------------------------------------------------
' Parity encoding for 5 digit supplemental
' SupChecksum = int 0-9, datachar2 = ASCII 0-9, position2 = int 1-5!
'---------------------------------------------------------------
Public Function getAB5(SupChecksum As Integer, datachar2 As String, position2 As Integer) As String
Answer2 = 0
Select Case SupChecksum
Case 0
If Mid("BBAAA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 1
If Mid("BABAA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 2
If Mid("BAABA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 3
If Mid("BAAAB", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 4
If Mid("ABBAA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 5
If Mid("AABBA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 6
If Mid("AAABB", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 7
If Mid("ABABA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 8
If Mid("ABAAB", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 9
If Mid("AABAB", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
End Select
getAB5 = Chr(Asc(Mid(datachar2, 1, 1)) + Answer2)
End Function
Private Sub Form_Load()
End Sub
Private Sub Text1_Change()
Select Case Len(Text1.Text)
Case 8
EAN8 Text1.Text
Case 12
EAN13 Text1.Text
Case Else
Label1.Caption = ""
End Select
End Sub
Option Explicit
Private BarTextOut As String
Private BarTextIn As String
Private TempString As String
Private BarCodeOut As String
Private Sum As Long
Private II As Integer
Private WorkL As String
Private WorkR As String
Private CheckSumValue As Integer
Private CheckSum As String
Private Answer As Integer
Private BarTextOut2 As String
Private TempString2 As String
Private SupString As String
Private WorkS As String
Private SupSum As Long
Private SupCheckSumValue As Integer
'Functions in this file:
' EAN8(Text) -> convert text to EAN 8 format
' EAN13(Text) -> convert text to EAN 13 format
' Bookland(ISBN,Supplemental) -> convert text to Bookland format (EAN 13 with 5 digit
' supplemental code
'---------------------------------------------------------
Public Function EAN8(BarTextIn As String) As String
' /// Initialize input and output strings ///
BarTextOut = ""
BarTextIn = RTrim(LTrim(BarTextIn))
' /// Throw away non-numeric data ///
TempString = ""
For II = 1 To Len(BarTextIn)
If IsNumeric(Mid(BarTextIn, II, 1)) Then
TempString = TempString & Mid(BarTextIn, II, 1)
End If
Next II
' /// Better be 7 digits long, or error it ///
If Len(TempString) < 7 Then TempString = "0000000"
If Len(TempString) > 7 Then TempString = Mid(TempString, 1, 7)
' /// Now calculate checksum and character map left and right sides ///
Sum = 0
WorkL = ""
WorkR = ""
For II = 1 To 7
If (II Mod 2) = 1 Then
Sum = Sum + (3 * Mid(TempString, II, 1))
Else
Sum = Sum + Mid(TempString, II, 1)
End If
If II < 5 Then
WorkL = WorkL & Chr(Asc(Mid(TempString, II, 1)) + 17)
Else
WorkR = WorkR & Mid(TempString, II, 1)
End If
Next II
' Build actual checksum character
CheckSumValue = 10 - (Sum Mod 10)
If CheckSumValue = 10 Then CheckSumValue = 0
CheckSum = Chr(48 + CheckSumValue)
' Build working bar code string
BarCodeOut = "[" & WorkL & "|" & WorkR & CheckSum & "] "
Label1.Caption = BarCodeOut
End Function
'---------------------------------------------------------
' This function converts a string into a format compatible with Elfring
' Fonts Inc EAN bar codes. This conversion is for EAN 13 only. It removes
' non-numeric data, calculates a checksum, and converts the result to
' fit our bar code format. If the data has less than 12 digits 12 zeros
' are put in place of the data. If the data has more than 12 digits,
' the extras are truncated.
'---------------------------------------------------------
Public Function EAN13(BarTextIn As String) As String
' Initialize input and output strings
BarTextOut = ""
BarTextIn = RTrim(LTrim(BarTextIn))
' Throw away non-numeric data
TempString = ""
For II = 1 To Len(BarTextIn)
If IsNumeric(Mid(BarTextIn, II, 1)) Then
TempString = TempString & Mid(BarTextIn, II, 1)
End If
Next II
' Better be 12 digits long, or error it
If Len(TempString) < 12 Then TempString = "000000000000"
If Len(TempString) > 12 Then TempString = Mid(TempString, 1, 12)
' Now calculate checksum and character map left and right sides
Sum = 0
WorkL = ""
WorkR = ""
For II = 1 To 12
If (II Mod 2) = 0 Then
Sum = Sum + (3 * Mid(TempString, II, 1))
Else
Sum = Sum + Mid(TempString, II, 1)
End If
If (II > 2) And (II < 8) Then
WorkL = WorkL & getAB(Mid(TempString, 1, 1), Mid(TempString, II, 1), II - 2)
ElseIf II > 7 Then
WorkR = WorkR & Mid(TempString, II, 1)
End If
Next II
' Build actual checksum character
CheckSumValue = 10 - (Sum Mod 10)
If CheckSumValue = 10 Then CheckSumValue = 0
CheckSum = Chr(48 + CheckSumValue)
' Build working bar code string
BarCodeOut = Chr(Asc(Mid(TempString, 1, 1)) - 15) & Chr(Asc(Mid(TempString, 2, 1)) + 17) & WorkL & "|" & WorkR & CheckSum & "]"
EAN13 = BarCodeOut
End Function
'---------------------------------------------------------------
' Parity encoding for EAN 13
' FirstFlag = int 0-9, datachar = ASCII 0-9, position = int 1-5!
'---------------------------------------------------------------
Public Function getAB(FirstFlag As Integer, datachar As String, position As Integer) As String
Answer = 0
Select Case FirstFlag
Case 0
If Mid("AAAAA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 1
If Mid("ABABB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 2
If Mid("ABBAB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 3
If Mid("ABBBA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 4
If Mid("BAABB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 5
If Mid("BBAAB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 6
If Mid("BBBAA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 7
If Mid("BABAB", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 8
If Mid("BABBA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
Case 9
If Mid("BBABA", position, 1) = "A" Then
Answer = 17
Else
Answer = 33
End If
End Select
getAB = Chr(Asc(Mid(datachar, 1, 1)) + Answer)
End Function
'---------------------------------------------------------
' This function converts a string into a format compatible with Elfring
' Fonts Inc Bookland bar codes. Your ISBN number is converted into an
' EAN bar code and the 5 digit supplemental code is added to the end.
' Errors in data are ignored or translated to zeros.
'---------------------------------------------------------
Public Function Bookland(ISBN As String, Supplemental As String) As String
' Initialize input and output strings
BarTextOut2 = ""
ISBN = RTrim(LTrim(ISBN))
Supplemental = RTrim(LTrim(Supplemental))
' Throw away non-numeric data in ISBN
TempString2 = ""
For II = 1 To Len(ISBN)
If IsNumeric(Mid(ISBN, II, 1)) Then
TempString2 = TempString2 & Mid(ISBN, II, 1)
End If
Next II
' Throw away non-numeric data in Supplemental
SupString = ""
For II = 1 To Len(Supplemental)
If IsNumeric(Mid(Supplemental, II, 1)) Then
SupString = SupString & Mid(Supplemental, II, 1)
End If
Next II
' ISBN better be 9 digits long, or fix it
If Len(TempString2) < 9 Then TempString2 = "000000000"
If Len(TempString2) > 9 Then TempString2 = Mid(TempString2, 1, 9)
' Supplemental better be 5 digits long, or fix it
If Len(SupString) < 5 Then SupString = "90000"
If Len(SupString) > 5 Then SupString = Mid(SupString, 1, 5)
' Convert ISBN number to Bookland
TempString2 = "978" & TempString2
BarTextOut2 = EAN13(TempString2)
' Need checksum for supplemental code
SupSum = 0
For II = 1 To Len(SupString)
If (II Mod 2) = 1 Then
SupSum = SupSum + ((Asc(Mid(SupString, II, 1)) - 48) * 3)
Else
SupSum = SupSum + ((Asc(Mid(SupString, II, 1)) - 48) * 9)
End If
Next II
SupCheckSumValue = SupSum Mod 10
' Now build supplemental string
WorkS = " /"
For II = 1 To 5
WorkS = WorkS & getAB5(SupCheckSumValue, Mid(SupString, II, 1), II)
If II < 5 Then WorkS = WorkS & "."
Next II
Bookland = BarTextOut2 & WorkS
End Function
'---------------------------------------------------------------
' Parity encoding for 5 digit supplemental
' SupChecksum = int 0-9, datachar2 = ASCII 0-9, position2 = int 1-5!
'---------------------------------------------------------------
Public Function getAB5(SupChecksum As Integer, datachar2 As String, position2 As Integer) As String
Answer2 = 0
Select Case SupChecksum
Case 0
If Mid("BBAAA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 1
If Mid("BABAA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 2
If Mid("BAABA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 3
If Mid("BAAAB", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 4
If Mid("ABBAA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 5
If Mid("AABBA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 6
If Mid("AAABB", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 7
If Mid("ABABA", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 8
If Mid("ABAAB", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
Case 9
If Mid("AABAB", position2, 1) = "A" Then
Answer2 = 49
Else
Answer2 = 65
End If
End Select
getAB5 = Chr(Asc(Mid(datachar2, 1, 1)) + Answer2)
End Function
Private Sub Form_Load()
End Sub
Private Sub Text1_Change()
Select Case Len(Text1.Text)
Case 8
EAN8 Text1.Text
Case 12
EAN13 Text1.Text
Case Else
Label1.Caption = ""
End Select
End Sub
- Status
