Member Avatar for _1_14

I make windows form application c# vs 2015 to generate 2d matrix barcodes for pharmaceutical company
manufacture medicine .
my problem when i make order to generate 2d matrix barcode for 200000 barcode and save barcodes in hard disk
take 20 minutes
How to minimize 20 minutes to 8 minutes when generate and saving 200000 barcode ?
my code under button as following

I attached serial and libarary for datamatrix encoding with message

 Class1 CLS = new Class1();
    DataTable dt = CLS.ShowalldataSerial(textBox4.Text);

     string baseText = "UserID" + dt.Rows[0][0] + "FirmName" + dt.Rows[0][1] + "OrderNo" + dt.Rows[0][2] + "BtachNo" + dt.Rows[0][3] + "Quantity" + dt.Rows[0][4] + "ProductName" + dt.Rows[0][5] + "SerialNo";
        Color foregroundColor = Color.FromName(comboBox1.SelectedItem.ToString());

        int serialsToGenerate = Convert.ToInt32(textBox1.Text);
        Parallel.For(0, serialsToGenerate, index=>
        {
            string Serial = SRL.Rnd().ToString();
            string txt = baseText + Serial;

            // WARNING HERE
            DM_Encoder dm = new DM_Encoder();
            dm.DM(txt, foregroundColor, Color.White).Save(root + "\\" + Serial + ".emf", System.Drawing.Imaging.ImageFormat.Emf);
        });
Imports System.Drawing
Public Class DM_Encoder

    Dim _vFin_Bin, _aFin_Bin(,) As String
    Dim Wid, _vCW, _vCW_Limit, _vData_Region, _vInterLeving_Blocks, _vData_Region_Side, _aEncoded_Asc(), _vRows, _vCols, _aRep(), _vRow, _vCol, _vChr, _vErrCor, _aMatrix(), _aFactors(), _aErrCor(), _aLog(256), _aALog(256), _aEncoded_Asc_Interleaved(), _aErrCor_Interleaved() As Integer
    Dim Sqr As Rectangle
    Dim Code_Pic As New Bitmap(500, 500)
    Dim X_Dim As Integer = 2

    Private Sub Ascii_Mode(ByVal Txt As String)

        Dim i, a, ex As Integer

        Dim l As Integer = Txt.Length - 1

        'Convert to encoded Ascii
        While i <= l
            'increase _aEncoded_Asc() size by 1
            ReDim Preserve _aEncoded_Asc(i)

            ' Char Mode
            If Asc(Txt.Chars(a)) < 128 Then

                ' Dispose Extended Ascii Char Mode (if it is fired)
                ex = 0

                'Check if it is Ascii char or Ascii Digit (Digit Mode)
                If Asc(Txt.Chars(a)) <= 57 And Asc(Txt.Chars(a)) >= 48 Then

                    'Check if the digit is the last index of text
                    If Not Txt.Length - 1 = a Then

                        'Check if the next index is a digit 
                        If Asc(Txt.Chars(a + 1)) <= 57 And Asc(Txt.Chars(a + 1)) >= 48 Then

                            'Data Matrix ECC 200 Algorism for pair of digits (Digit Mode)
                            _aEncoded_Asc(i) = CInt(Txt.Substring(a, 2)) + 130

                            'Decrease target index by 1 because we have a pair of digits
                            l = l - 1

                            'Increase text index by 1 to pass pair of digits
                            a = a + 1

                        Else

                            'Data Matrix ECC 200 Algorism Chars (Char Mode)
                            _aEncoded_Asc(i) = Asc(Txt.Chars(a)) + 1

                        End If
                    Else

                        'Data Matrix ECC 200 Algorism Chars (Char Mode)
                        _aEncoded_Asc(i) = Asc(Txt.Chars(a)) + 1

                    End If

                Else

                    'Data Matrix ECC 200 Algorism Chars (Char Mode)
                    _aEncoded_Asc(i) = Asc(Txt.Chars(a)) + 1
                End If

                'Extended Ascii Char Mode
            ElseIf Asc(Txt.Chars(a)) >= 128 Then

                'Data Matrix ECC 200 Algorism Chars (Extended Ascii Char Mode)
                _aEncoded_Asc(i) = 235
                ReDim Preserve _aEncoded_Asc(i + 1)
                _aEncoded_Asc(i + 1) = Asc(Txt.Chars(a)) - 127

                'rearrange indexes
                l = l + 1
                i = i + 1

            End If

            a = a + 1
            i = i + 1
        End While

        'Number of Code Words
        _vCW = _aEncoded_Asc.Length

    End Sub

    Private Function DecToBin(ByVal DecimalNum As Long) As String
        Dim tmp As String
        Dim n As Long
        Dim i As Integer

        n = DecimalNum
        tmp = Trim(Str(n Mod 2))
        n = n \ 2

        Do While n <> 0
            tmp = Trim(Str(n Mod 2)) + tmp
            n = n \ 2
        Loop

        If tmp.Length < 8 Then
            For i = 1 To 8 - tmp.Length
                tmp = "0" + tmp
            Next

        End If

        DecToBin = tmp
    End Function

    Private Sub DM_Capacity()
        Select Case _vCW
            Case Is <= 3
                _vRows = 8
                _vCols = 8
                _vErrCor = 5
                _vCW_Limit = 3
                _vData_Region = 1
                _vInterLeving_Blocks = 1
            Case Is <= 5
                _vRows = 10
                _vCols = 10
                _vErrCor = 7
                _vCW_Limit = 5
                _vData_Region = 1
                _vInterLeving_Blocks = 1
            Case Is <= 8
                _vRows = 12
                _vCols = 12
                _vErrCor = 10
                _vCW_Limit = 8
                _vData_Region = 1
                _vInterLeving_Blocks = 1
            Case Is <= 12
                _vRows = 14
                _vCols = 14
                _vErrCor = 12
                _vCW_Limit = 12
                _vData_Region = 1
                _vInterLeving_Blocks = 1
            Case Is <= 18
                _vRows = 16
                _vCols = 16
                _vErrCor = 14
                _vCW_Limit = 18
                _vData_Region = 1
                _vInterLeving_Blocks = 1
            Case Is <= 22
                _vRows = 18
                _vCols = 18
                _vErrCor = 18
                _vCW_Limit = 22
                _vData_Region = 1
                _vInterLeving_Blocks = 1
            Case Is <= 30
                _vRows = 20
                _vCols = 20
                _vErrCor = 20
                _vCW_Limit = 30
                _vData_Region = 1
                _vInterLeving_Blocks = 1
            Case Is <= 36
                _vRows = 22
                _vCols = 22
                _vErrCor = 24
                _vCW_Limit = 36
                _vData_Region = 1
                _vInterLeving_Blocks = 1
            Case Is <= 44
                _vRows = 24
                _vCols = 24
                _vErrCor = 28
                _vCW_Limit = 44
                _vData_Region = 1
                _vInterLeving_Blocks = 1
            Case Is <= 62
                _vRows = 28
                _vCols = 28
                _vErrCor = 36
                _vCW_Limit = 62
                _vData_Region = 4
                _vInterLeving_Blocks = 1
            Case Is <= 86
                _vRows = 32
                _vCols = 32
                _vErrCor = 42
                _vCW_Limit = 86
                _vData_Region = 4
                _vInterLeving_Blocks = 1
            Case Is <= 114
                _vRows = 36
                _vCols = 36
                _vErrCor = 48
                _vCW_Limit = 114
                _vData_Region = 4
                _vInterLeving_Blocks = 1
            Case Is <= 144
                _vRows = 40
                _vCols = 40
                _vErrCor = 56
                _vCW_Limit = 144
                _vData_Region = 4
                _vInterLeving_Blocks = 1
            Case Is <= 174
                _vRows = 44
                _vCols = 44
                _vErrCor = 68
                _vCW_Limit = 174
                _vData_Region = 4
                _vInterLeving_Blocks = 1
            Case Is <= 204
                _vRows = 48
                _vCols = 48
                _vErrCor = 84
                _vCW_Limit = 204
                _vData_Region = 4
                _vInterLeving_Blocks = 2
            Case Is <= 280
                _vRows = 56
                _vCols = 56
                _vErrCor = 112
                _vCW_Limit = 280
                _vData_Region = 16
                _vInterLeving_Blocks = 2
            Case Is <= 368
                _vRows = 64
                _vCols = 64
                _vErrCor = 144
                _vCW_Limit = 368
                _vData_Region = 16
                _vInterLeving_Blocks = 4
            Case Is <= 456
                _vRows = 72
                _vCols = 72
                _vErrCor = 192
                _vCW_Limit = 456
                _vData_Region = 16
                _vInterLeving_Blocks = 4
            Case Is <= 576
                _vRows = 80
                _vCols = 80
                _vErrCor = 224
                _vCW_Limit = 576
                _vData_Region = 16
                _vInterLeving_Blocks = 4
            Case Is <= 696
                _vRows = 88
                _vCols = 88
                _vErrCor = 272
                _vCW_Limit = 696
                _vData_Region = 16
                _vInterLeving_Blocks = 4
            Case Is <= 816
                _vRows = 96
                _vCols = 96
                _vErrCor = 336
                _vCW_Limit = 816
                _vData_Region = 16
                _vInterLeving_Blocks = 6
            Case Is <= 1050
                _vRows = 108
                _vCols = 108
                _vErrCor = 408
                _vCW_Limit = 1050
                _vData_Region = 36
                _vInterLeving_Blocks = 6
            Case Is <= 1304
                _vRows = 120
                _vCols = 120
                _vErrCor = 496
                _vCW_Limit = 1304
                _vData_Region = 36
                _vInterLeving_Blocks = 8
            Case Is <= 1558
                _vRows = 132
                _vCols = 132
                _vErrCor = 620
                _vCW_Limit = 1558
                _vData_Region = 36
                _vInterLeving_Blocks = 10
        End Select

    End Sub

    Private Sub Clip_Area()
        'Set Clip_Area Size
        Sqr.Height = (_vRows * X_Dim) + (4 * X_Dim) + (((_vData_Region ^ 0.5) - 1) * 2 * X_Dim)
        Sqr.Width = (_vCols * X_Dim) + (4 * X_Dim) + (((_vData_Region ^ 0.5) - 1) * 2 * X_Dim)
    End Sub


    Private Overloads Function Draw(ByVal Clr As Color, ByVal Background As Color)

        Clip_Area()
        Dim Btmap As New Bitmap(Sqr.Width, Sqr.Height)
        Dim gr As Graphics = Graphics.FromImage(Btmap)


        If _vCW > 0 Then

            gr.Clear(background)
            'e.Graphics.FillRectangle(Brushes.White, Sqr)
            gr.FillRectangle(Brushes.White, 0, 0, Sqr.Width, Sqr.Height)
            Dim Code_Brush As New SolidBrush(Color.Coral)
            Dim i, a, b, c, d, f, g, h, j As Integer

            d = ((CInt(_vData_Region ^ 0.5)) - 1) * 2

            'draw perimeter and quite zone
            Code_Brush.Color = Clr
            'e.Graphics.FillRectangle(Code_Brush, Sqr.X + X_Dim, Sqr.Y + X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim))
            gr.FillRectangle(Code_Brush, X_Dim, X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim))
Imports System.Security.Cryptography
Imports System.Text
Public Class SerialCreator
    Function CreateSerial(ByVal CertCode As String)
        Dim _vSrl, ProdCertCode, FirmCertCode, CntryCertCode, BaseChk As String
        Dim Tmp As Integer
        'Divide Cert Code
        CntryCertCode = CertCode.Substring(0, 8)
        FirmCertCode = CertCode.Substring(8, 5)
        ProdCertCode = CertCode.Substring(13, 7)

        'Create Base Check Number
        BaseChk = ChkDigt(CntryCertCode)

        'First part of Serial Number
        _vSrl = Math.Abs(CInt(BaseChk) + CInt(FirmCertCode) - 99999)
        _vSrl = AddZeros(_vSrl)
        'Second part of Serial Number
        Tmp = Math.Abs((CInt(BaseChk) + CInt(ProdCertCode) - 9999999) / 100)
        'Tmp = AddZeros(Tmp)
        _vSrl = _vSrl + AddZeros(Tmp)


        'Third part of Serial Number -- Create Random Number
        _vSrl = "SD" + _vSrl + Rnd()

        Return _vSrl
    End Function


    Function ChkDigt(ByVal Digits As String)
        Dim _vChkNo As String
        Dim _vSum, _vDigit, _vChkSum, i, ii, x As Integer

        'Reset Variables
        _vSum = 0
        _vDigit = 0
        _vChkSum = 0

        For i = 0 To 4
            ' Calculate the Chkdigit here.
            For ii = 1 To Digits.Length
                _vDigit = CInt(Digits.Substring(Digits.Length - ii, 1))
                If ii Mod 2 = 0 Then
                    'Odd
                    _vSum = _vSum + (_vDigit * (3 + x))
                Else
                    'Even
                    _vSum = _vSum + (_vDigit * 1) + x
                End If
                x = Digits.Substring(0, 1)
            Next
            _vChkSum = (10 - (_vSum Mod 10)) Mod 10
            _vChkNo = _vChkNo + _vChkSum.ToString

            'Shift Digits by 1 to left
            Digits = Digits.Substring(1, Digits.Length - 1) + Digits.Substring(0, 1)
        Next


        Return _vChkNo

    End Function

    Function Rnd()
        Dim chars(9) As Char
        Dim a As String
        a = "1234567890"
        chars = a.ToCharArray()
        Dim size As Integer = 9
        Dim data(8) As Byte
        Dim i As Integer
        Dim Randm As String
        For i = 0 To 1
            Dim crypto As New RNGCryptoServiceProvider
            crypto.GetNonZeroBytes(data)
            Dim result As New StringBuilder(size)
            For Each b As Byte In data
                result.Append(chars(b Mod (chars.Length - 1)))
            Next b
            Randm = Randm + ChkSum((result.ToString))
        Next


        Return Randm


    End Function

    Function AddZeros(ByVal Srl As String)
        If Srl.Length = 1 Then
            Srl = "0000" + Srl
        ElseIf Srl.Length = 2 Then
            Srl = "000" + Srl
        ElseIf Srl.Length = 3 Then
            Srl = "00" + Srl
        ElseIf Srl.Length = 4 Then
            Srl = "0" + Srl
        End If
        Return Srl
    End Function


    Function ChkSum(ByVal Digits As String) As String
        Dim ii, _vDigit, _vSum, _vChkSum As Integer

        For ii = 1 To Digits.Length
            _vDigit = CInt(Digits.Substring(Digits.Length - ii, 1))
            If ii Mod 2 = 0 Then
                'Odd
                _vSum = _vSum + (_vDigit * 3)
            Else
                'Even
                _vSum = _vSum + (_vDigit * 1)
            End If
        Next
        _vChkSum = (10 - (_vSum Mod 10)) Mod 10

        Return Digits + CStr(_vChkSum)

    End Function


    Function Verify(ByVal Serial As String) As Boolean
        Dim CntryAbb, FirmID, ProductID, Ser As String
        Dim bol As Boolean
        Dim i, ii, iii, _vCheckSum, _vEven, _vOdd As Integer

        CntryAbb = Serial.Substring(0, 2)
        FirmID = Serial.Substring(2, 5)
        ProductID = Serial.Substring(7, 5)
        Ser = Serial.Substring(12, 20)

        For ii = 0 To 1
            _vCheckSum = 0
            _vEven = 0
            _vOdd = 0
            For i = 9 To 3 Step -2
                _vEven = _vEven + CInt(Val(Ser.Chars((i + iii) - 2))) * 3
                _vOdd = _vOdd + CInt(Val(Ser.Chars((i + iii) - 1)))
            Next
            _vOdd = _vOdd + CInt(Val(Ser.Chars((i + iii) - 1)))
            _vCheckSum = _vOdd + _vEven

            If CInt(Val(Ser.Chars((10 + iii) - 1))) = (10 - (_vCheckSum Mod 10)) Mod 10 Then
                bol = True
            Else
                bol = False
                Exit Function
            End If
            iii = 10
        Next

        Return bol
    End Function

End Class
Edited by happygeek because: moved
  • 4 Contributors
  • 3 Replies
  • 740 Views
  • 16 Hours Discussion Span
  • Latest Post Latest Post by tinstaafl
Member Avatar for rproffitt

Is this on bog standard hard disks? Try it on the new spiffy fast SSDs.

Member Avatar for xrjf

Watch out for strings outside the warning label. Replace strings by System.Text.StringBuilder.

Member Avatar for tinstaafl

I think youre first step should be to investigate other similar librairies. Just a quick glance at that one makes me question whether it's the most efficient.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.