簡體   English   中英

OleDbDataAdapter Fill 和 OleDbDataReader 需要 3-5 分鍾才能填充

[英]OleDbDataAdapter Fill and OleDbDataReader takes 3-5 minutes to fill

這是一個非常奇怪的問題,因為它只發生在隨機全新的 Windows 10 件上。 填充數據適配器或數據讀取器需要 1-5 分鍾。 這是從 Windows 7 舊電腦升級到全新 windows 10 電腦時發生的第三台電腦。 一年前第一次出現,問題只出現了1天。 第二次我們無法修復它,只是將它們放回舊的 Windows 7 pc 上。 現在它又發生了。 我們已經用相同的 model Nuc 10i7 計算機替換了其他 4 台運行此程序的計算機,它們運行良好,只需 1-5 秒即可完成所有例程。

我不認為它是連接字符串或 SQL 語句,因為它在其他電腦上工作正常。

我將延遲隔離到填充 OleDbDataAdapter 或 OleDbDataReader 的時間,這在下面的屏幕截圖中很明顯,在填充前后使用日志記錄 function。

這是在 Nuc10i7 pc 上,VB.Net 程序從 Access db 調用一行數據。

Public Sub PrintSwatLoad(SwatKey As String)
    didPrint = True
    Try
        Dim sBarcode As String = ""
        Dim cn As New OleDbConnection(MDBConnect)
        Dim sSql As String = "" &
          "SELECT WeightCert, [SwatLog].[SwatDate], TareDate, SaleCode, " &
                "Species, Qual, SaleDesc, Trucker, TruckNo, TruckState, " &
                "TruckLic, TrlState, TrlLic, TruckType, Comments, TareLoad, " &
                "ScaleLoad, LoadNo, Logger, LogMethod, Block, Val(Gross) as GrossWt, " &
                "Val(Tare) as TareWt, Weight, PrintAvg, Brand, Commodity, SortCode, " &
                "Deck, UserInfo1, UserInfo2, EmergencyLevel, ReprintCount, " &
                "Reason, LocationName, Addr1, Addr2, OwnerName, LoggerName," &
                "Contract, Weighmaster, TT, Reprint, TareoutBarcode, PrintTare, TruckName, " &
                "ManualWeight, DeputyName, CertStatus, ReplacedCert  " &
          "FROM Swatlog INNER JOIN tblTempCert " &
            "ON [SwatLog].[SwatDate] = [tblTempCert].[SwatDate] " &
         "WHERE [tblTempCert].[SwatDate] = #" & SwatKey & "#"


        cn.Open()
        Dim cmd As New OleDbCommand(sSql, cn)
        'Dim da As New OleDbDataAdapter(cmd)
        'Dim ds As New DataSet
        Dim dt As New DataTable

        ''''''''right here is where it hangs'''''''''''''''''''
        Dim myreader As OleDbDataReader = cmd.ExecuteReader()
        ''''''''above this is where it hangs. deleted all my logging methods for clarity''''''''''
        '''
        While myreader.Read()
            If myreader.HasRows = True Then     'ds.Tables(0).Rows.Count
                'Dim WrkRow As DataRow = dt.Rows(0)    'ds.Tables(0).Rows(0)
                If IsTareout = True Then
                    sBarcode = Trim(myreader("Trucker")) & myreader("TruckNo")
                End If

                Dim rSwatLaserCert As New XRSwatLaserCert
                rSwatLaserCert.DataSource = dt
                Dim rpt As New DevExpress.XtraReports.UI.ReportPrintTool(rSwatLaserCert)
                With rSwatLaserCert
                    .XrBCTareOut.Text = sBarcode
                    If Not (myreader("ManualWeight") = 1 Or myreader("ManualWeight") = 3) Then
                        .XrLabelManualGross1.Visible = False
                        .XrLabelManualGross2.Visible = False
                        .XrLabelManualGross3.Visible = False
                    End If

                    If Not (myreader("ManualWeight") = 2 Or myreader("ManualWeight") = 3) Then
                        .XrLabelManualTare1.Visible = False
                        .XrLabelManualTare2.Visible = False
                        .XrLabelManualTare3.Visible = False
                    End If

                    If myreader("CertStatus") = 1 Then
                    ElseIf myreader("CertStatus") = 2 Then
                        .XrLabelCertStatus1.Text = "VOID"
                        .XrLabelCertStatus2.Text = "VOID"
                        .XrLabelCertStatus3.Text = "VOID"
                    Else
                        .XrLabelCertStatus1.Visible = False
                        .XrLabelCertStatus2.Visible = False
                        .XrLabelCertStatus3.Visible = False
                    End If

                    If IsDBNull(myreader("DeputyName")) = True Then
                        .XrLabelDeputy1.Text = myreader("Weighmaster")
                        .XrLabelDeputy2.Text = myreader("Weighmaster")
                        .XrLabelDeputy3.Text = myreader("Weighmaster")
                    Else
                        .XrLabelDeputy1.Text = myreader("DeputyName")
                        .XrLabelDeputy2.Text = myreader("DeputyName")
                        .XrLabelDeputy3.Text = myreader("DeputyName")
                    End If

                    If NoNull(myreader("ReplacedCert")) = "" Then                 'Replaced this line: If IsDBNull(myreader("ReplacedCert")) = True Then
                        .XrLabelReplacesLabel1.Visible = False
                        .XrLabelReplacesLabel2.Visible = False
                        .XrLabelReplacesLabel3.Visible = False

                        .XrLabel174.Visible = False                             ' Replaces cert 1
                        .XrLabel113.Visible = False                             ' Replaces cert 2
                        .XrLabel178.Visible = False                             ' Replaces cert 3

                        .XrLabel174.BorderWidth = 0                             ' Replaces cert 1
                        .XrLabel113.BorderWidth = 0                             ' Replaces cert 2
                        .XrLabel178.BorderWidth = 0                             ' Replaces cert 3
                    Else
                        .XrLabel174.Text = myreader("ReplacedCert")               ' Replaces cert 1
                        .XrLabel113.Text = myreader("ReplacedCert")               ' Replaces cert 2
                        .XrLabel178.Text = myreader("ReplacedCert")               ' Replaces cert 3
                    End If
                End With
                rpt.Print()
            End If
        End While
        cn.Close()

請注意 ****** 此代碼在某些 PC 上運行良好,這就是我最初沒有提供代碼的原因。 我現在在聯想 thinkpad 上,代碼使用數據讀取器或適配器方法運行良好。 它有時會在英特爾的 Nuc 10 i7 上運行良好,但有時它不會像我上面描述的那樣運行。*********

下面是使用 dataAdapter 和 datatable 方法的代碼:

 Public Sub PrintSwatLoad(SwatKey As String)
    didPrint = True
    Try
        Dim sBarcode As String = ""
        Dim cn As New OleDbConnection(MDBConnect)
        Dim sSql As String = "" &
          "SELECT WeightCert, [SwatLog].[SwatDate], TareDate, SaleCode, " &
                "Species, Qual, SaleDesc, Trucker, TruckNo, TruckState, " &
                "TruckLic, TrlState, TrlLic, TruckType, Comments, TareLoad, " &
                "ScaleLoad, LoadNo, Logger, LogMethod, Block, Val(Gross) as GrossWt, " &
                "Val(Tare) as TareWt, Weight, PrintAvg, Brand, Commodity, SortCode, " &
                "Deck, UserInfo1, UserInfo2, EmergencyLevel, ReprintCount, " &
                "Reason, LocationName, Addr1, Addr2, OwnerName, LoggerName," &
                "Contract, Weighmaster, TT, Reprint, TareoutBarcode, PrintTare, TruckName, " &
                "ManualWeight, DeputyName, CertStatus, ReplacedCert  " &
          "FROM Swatlog INNER JOIN tblTempCert " &
            "ON [SwatLog].[SwatDate] = [tblTempCert].[SwatDate] " &
         "WHERE [tblTempCert].[SwatDate] = #" & SwatKey & "#"

        Dim cmd As New OleDbCommand(sSql, cn)
        Dim da As New OleDbDataAdapter(cmd)
        Dim ds As New DataSet
        Dim dt As New DataTable

        cn.Open()

        ''''''''''This is where it hangs using the dataAdapter fill'''''''''''
        da.Fill(dt)
        ''''''''''Above is where it hangs''''''''''''''''''''''''''''

        ds.Tables.Add(dt) ' added this to dataset
        dt.TableName = "dataset"
        cn.Close()


        If dt.Rows.Count > 0 Then     'ds.Tables(0).Rows.Count
            Dim WrkRow As DataRow = dt.Rows(0)    'ds.Tables(0).Rows(0)
            If IsTareout = True Then
                sBarcode = Trim(WrkRow("Trucker")) & WrkRow("TruckNo")
            End If

            Dim rSwatLaserCert As New XRSwatLaserCert
            rSwatLaserCert.DataSource = dt

            Dim rpt As New DevExpress.XtraReports.UI.ReportPrintTool(rSwatLaserCert)
            With rSwatLaserCert
                .XrBCTareOut.Text = sBarcode
                If Not (WrkRow("ManualWeight") = 1 Or WrkRow("ManualWeight") = 3) Then
                    .XrLabelManualGross1.Visible = False
                    .XrLabelManualGross2.Visible = False
                    .XrLabelManualGross3.Visible = False
                End If

                If Not (WrkRow("ManualWeight") = 2 Or WrkRow("ManualWeight") = 3) Then
                    .XrLabelManualTare1.Visible = False
                    .XrLabelManualTare2.Visible = False
                    .XrLabelManualTare3.Visible = False
                End If

                If WrkRow("CertStatus") = 1 Then
                ElseIf WrkRow("CertStatus") = 2 Then
                    .XrLabelCertStatus1.Text = "VOID"
                    .XrLabelCertStatus2.Text = "VOID"
                    .XrLabelCertStatus3.Text = "VOID"
                Else
                    .XrLabelCertStatus1.Visible = False
                    .XrLabelCertStatus2.Visible = False
                    .XrLabelCertStatus3.Visible = False
                End If

                If IsDBNull(WrkRow("DeputyName")) = True Then
                    .XrLabelDeputy1.Text = WrkRow("Weighmaster")
                    .XrLabelDeputy2.Text = WrkRow("Weighmaster")
                    .XrLabelDeputy3.Text = WrkRow("Weighmaster")
                Else
                    .XrLabelDeputy1.Text = WrkRow("DeputyName")
                    .XrLabelDeputy2.Text = WrkRow("DeputyName")
                    .XrLabelDeputy3.Text = WrkRow("DeputyName")
                End If

                If NoNull(WrkRow("ReplacedCert")) = "" Then                 'Replaced this line: If IsDBNull(WrkRow("ReplacedCert")) = True Then
                    .XrLabelReplacesLabel1.Visible = False
                    .XrLabelReplacesLabel2.Visible = False
                    .XrLabelReplacesLabel3.Visible = False

                    .XrLabel174.Visible = False                             ' Replaces cert 1
                    .XrLabel113.Visible = False                             ' Replaces cert 2
                    .XrLabel178.Visible = False                             ' Replaces cert 3

                    .XrLabel174.BorderWidth = 0                             ' Replaces cert 1
                    .XrLabel113.BorderWidth = 0                             ' Replaces cert 2
                    .XrLabel178.BorderWidth = 0                             ' Replaces cert 3
                Else
                    .XrLabel174.Text = WrkRow("ReplacedCert")               ' Replaces cert 1
                    .XrLabel113.Text = WrkRow("ReplacedCert")               ' Replaces cert 2
                    .XrLabel178.Text = WrkRow("ReplacedCert")               ' Replaces cert 3
                End If
            End With
            rpt.Print()
        End If
        ds.Tables.Remove("dataset")
        da.Dispose()
        Catch ex As Exception
        RecordEvent("Cert error:   " & SwatKey & " - " & Reason & " (" & ex.Message & ")", True)

    End Try
    didPrint = False
End Sub

使用 OleDbDataAdapter 填充數據表的日志文件

使用 OleDbDataReader 的日志文件

   Public Sub GetKeyAndReason(ByRef sKey As String, ByRef sReason As String)
    Dim sSql As String = "SELECT SwatDate, Reason FROM tblTempCert"
    Dim cn As New OleDbConnection(MDBConnect)
    Dim da As New OleDbDataAdapter(sSql, cn)
    Dim ds As New DataSet

    Dim dt As New DataTable
    da.Fill(dt)
    If dt.Rows.Count > 0 Then
        Dim WorkRow1 As DataRow = dt.Rows(0)
        sKey = WorkRow1("SwatDate").ToString
        sReason = WorkRow1("Reason").ToString
    End If
    dt.Dispose()
    da.Dispose()
    cn.Dispose()
End Sub

您的 Access 數據庫可能已損壞。 下面的代碼包含各種可能有用的方法,包括CompactAccessDatabaseCompactAccessDatabaseMDBOnly - 如果需要,壓縮還會修復數據庫。 由於沒有為 OP 中提到的表提供數據類型,因此可能需要更新“CreateTblSwatLog”和“CreateTblTempCert”中的數據類型。

添加對您的項目的引用

與 2019 年相比

  • 點擊項目
  • Select添加參考
  • 點擊COM
  • 檢查Microsoft Jet 和復制對象 2.6 庫
  • 檢查Microsoft ADO 分機。 6.0 用於 DDL 和安全性
  • 檢查Microsoft DAO 3.6 Object 庫
  • 檢查Microsoft Access xx.x Object 庫
  • 單擊程序集
  • 檢查System.Data (如果尚未檢查)

創建一個模塊(名稱:Helper)

Imports System.IO
Imports System.Data.OleDb

Module HelperAccess

    Private didPrint As Boolean = False
    'Private MDBConnect As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\SWAT\Pclogs.mdb;User Id=admin;Password=;"
    Private MDBConnect As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\SWAT\Pclogs.mdb;Mode=Share Exclusive;User Id=admin;Password=;"
    'Private MDBConnect As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\SWAT\Pclogs.mdb;Persist Security Info=False;"

    Public Property IsTareOut As Boolean = True

    Public Sub CompactAccessDatabase(filename As String)
        'Add reference
        'Project => Add Reference => COM => Microsoft Access xx.x Object Library

        'compacts Access database by copying the database to a new file and replacing the original file
        'Note: this method works with both .mdb and .accdb files

        Try
            If String.IsNullOrEmpty(filename) OrElse Not System.IO.File.Exists(filename) Then
                Throw New Exception("Error: Access database '" & filename & "' doesn't exist.")
            End If

            Dim fileExt As String = Path.GetExtension(filename).ToLower()

            Dim tempFilename As String = Path.Combine(Path.GetDirectoryName(filename), Path.GetFileNameWithoutExtension(filename) & "_temp" & Path.GetExtension(filename))

            Debug.WriteLine("Info: Compacting '" & filename & "'...")

            Dim dbe As New Microsoft.Office.Interop.Access.Dao.DBEngine

            'invoke CompactDatabase - compacts database to temp file
            dbe.CompactDatabase(filename, tempFilename)

            'delete original database file
            System.IO.File.Delete(filename)

            System.IO.File.Move(tempFilename, filename)

            'release COM object
            System.Runtime.InteropServices.Marshal.FinalReleaseComObject(dbe)

            Debug.WriteLine("Info: Database compacted: '" & filename & "'")
        Catch ex As Exception
            Throw ex
        End Try
    End Sub

    Public Sub CompactAccessDatabaseMDBOnly(filename As String)
        'Add reference
        'Project => Add Reference => COM => Microsoft DAO 3.6 Object Library

        'compacts Access database by copying the database to a new file and replacing the original file
        'Note: this method works with only .mdb files

        Try
            If String.IsNullOrEmpty(filename) OrElse Not System.IO.File.Exists(filename) Then
                Throw New Exception("Error: Access database '" & filename & "' doesn't exist.")
            End If

            Dim fileExt As String = Path.GetExtension(filename).ToLower()

            Dim tempFilename As String = Path.Combine(Path.GetDirectoryName(filename), Path.GetFileNameWithoutExtension(filename) & "_temp" & Path.GetExtension(filename))

            Debug.WriteLine("Info: Compacting '" & filename & "'...")

            Dim dbe As New DAO.DBEngine

            'invoke CompactDatabase - compacts database to temp file
            dbe.CompactDatabase(filename, tempFilename)

            'delete original database file
            System.IO.File.Delete(filename)

            System.IO.File.Move(tempFilename, filename)

            'release COM object
            System.Runtime.InteropServices.Marshal.FinalReleaseComObject(dbe)

            Debug.WriteLine("Info: Database compacted: '" & filename & "'")
        Catch ex As Exception
            Throw ex
        End Try
    End Sub

    Public Sub CompactAccessDatabaseMDBOnly2(filename As String)
        'Add reference
        'Project => Add Reference => COM => Microsoft Jet and Replication Objects 2.6 Library

        'compacts Access database by copying the database to a new file and replacing the original file
        'Note: this method is only for .mdb files

        Try
            If String.IsNullOrEmpty(filename) OrElse Not System.IO.File.Exists(filename) Then
                Throw New Exception("Error: Access database '" & filename & "' doesn't exist.")
            End If

            Dim fileExt As String = Path.GetExtension(filename).ToLower()

            'must be .mdb to compact
            If fileExt <> ".mdb" Then
                Throw New Exception("Error: Compacting database with '" & fileExt & "' isn't supported.")
            End If

            Dim connectionString As String = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Mode=Share Exclusive;User Id=admin;Password=;", filename)
            Dim tempFilename As String = Path.Combine(Path.GetDirectoryName(filename), Path.GetFileNameWithoutExtension(filename) & "_temp" & Path.GetExtension(filename))
            'Dim connectionStringTemp As String = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};", tempFilename)
            Dim connectionStringTemp As String = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Jet OLEDB:Engine Type=5", tempFilename)

            'Debug.WriteLine("connectionString: " & connectionString)
            'Debug.WriteLine("tempFilename: " & tempFilename)
            'Debug.WriteLine("connectionStringTemp: " & connectionStringTemp)

            'create instance of Jet Replication Object
            Dim objJRO = Activator.CreateInstance(Type.GetTypeFromProgID("JRO.JetEngine"))

            'Engine Type: 
            '1: JET10
            '2: JET11
            '3: JET2x
            '4: JET3x
            '5: JET4x
            'Dim oParams = {connectionString, String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Jet OLEDB:Engine Type=5", tempFilename)}
            Dim oParams = {connectionString, connectionStringTemp}

            Debug.WriteLine("Info: Compacting '" & filename & "'...")

            'invoke CompactDatabase - compacts database to temp file
            objJRO.GetType().InvokeMember("CompactDatabase", System.Reflection.BindingFlags.InvokeMethod, Nothing, objJRO, oParams)

            'delete original database file
            System.IO.File.Delete(filename)

            System.IO.File.Move(tempFilename, filename)

            'release COM object
            'System.Runtime.InteropServices.Marshal.ReleaseComObject(objJRO)
            System.Runtime.InteropServices.Marshal.FinalReleaseComObject(objJRO)

            Debug.WriteLine("Info: Database compacted: '" & filename & "'")
        Catch ex As Exception
            Throw ex
        End Try
    End Sub

    Public Function CreateDatabase() As String
        'Add reference
        'Project => Add Reference => COM => Microsoft ADO Ext. 6.0 for DDL and Security

        Dim result As String = String.Empty

        Dim cat As ADOX.Catalog = Nothing

        Try
            'create New instance
            cat = New ADOX.Catalog()

            'create Access database
            cat.Create(MDBConnect)

            'set value
            result = String.Format("Status: Database created.")

            Return result
        Catch ex As Exception
            'set value
            result = String.Format("Error (CreateDatabase): {0}(Connection String: {1})", ex.Message, MDBConnect)
            Return result
        Finally
            If cat IsNot Nothing Then
                'close connection
                cat.ActiveConnection.Close()

                'release COM object
                System.Runtime.InteropServices.Marshal.ReleaseComObject(cat)

                cat = Nothing
            End If
        End Try
    End Function

    Public Function CreateTblSwatLog() As String
        Dim result As String = String.Empty

        Dim tableName As String = "SwatLog"

        Dim sqlText = String.Empty
        sqlText = "CREATE TABLE SwatLog "
        sqlText += "(ID AUTOINCREMENT not null primary key,"
        sqlText += " [WeightCert] varchar(50),"
        sqlText += " [SwatDate] DateTime,"
        sqlText += " [TareDate] DateTime,"
        sqlText += " [SaleCode] varchar(50),"
        sqlText += " [Species] varchar(50),"
        sqlText += " [Qual] varchar(50),"
        sqlText += " [SaleDesc] varchar(50),"
        sqlText += " [Trucker] varchar(50),"
        sqlText += " [TruckNo] varchar(50),"
        sqlText += " [TruckState] varchar(50),"
        sqlText += " [TruckLic] varchar(50),"
        sqlText += " [TrlState] varchar(50),"
        sqlText += " [TrlLic] varchar(50),"
        sqlText += " [TruckType] varchar(50),"
        sqlText += " [Comments] varchar(150),"
        sqlText += " [TareLoad] varchar(50),"
        sqlText += " [ScaleLoad] varchar(50),"
        sqlText += " [LoadNo] integer,"
        sqlText += " [Logger] varchar(50),"
        sqlText += " [LogMethod] varchar(50),"
        sqlText += " [Block] varchar(50),"
        sqlText += " [Gross] varchar(25),"
        sqlText += " [Tare] varchar(25),"
        sqlText += " [Weight] numeric(18,2),"
        sqlText += " [PrintAvg] numeric(18,2),"
        sqlText += " [Brand] varchar(50),"
        sqlText += " [Commodity] varchar(50),"
        sqlText += " [SortCode] varchar(50),"
        sqlText += " [Deck] varchar(50),"
        sqlText += " [UserInfo1] varchar(50),"
        sqlText += " [UserInfo2] varchar(50),"
        sqlText += " [EmergencyLevel] integer,"
        sqlText += " [ReprintCount] integer,"
        sqlText += " [Reason] varchar(75),"
        sqlText += " [LocationName] varchar(50),"
        sqlText += " [Addr1] varchar(50),"
        sqlText += " [Addr2] varchar(50),"
        sqlText += " [OwnerName] varchar(50),"
        sqlText += " [LoggerName] varchar(75),"
        sqlText += " [Contract] varchar(50),"
        sqlText += " [Weighmaster] varchar(50),"
        sqlText += " [TT] varchar(50),"
        sqlText += " [Reprint] bit,"
        sqlText += " [TareoutBarcode] Longbinary,"
        sqlText += " [PrintTare] bit,"
        sqlText += " [TruckName] varchar(50),"
        sqlText += " [ManualWeight] varchar(50),"
        sqlText += " [DeputyName] varchar(50),"
        sqlText += " [CertStatus] varchar(50),"
        sqlText += " [ReplacedCert] varchar(50));"

        Try
            Debug.WriteLine(sqlText)

            'create database table
            ExecuteNonQuery(sqlText)

            result = String.Format("Table created: '{0}'", tableName)

        Catch ex As OleDbException
            'result = String.Format("Error (CreateTblSwatLog - OleDbException): Table creation failed: '{0}'; {1}", tableName, ex.Message)
            Throw ex
        Catch ex As Exception
            'result = String.Format("Error (CreateTblSwatLog): Table creation failed: '{0}'; {1}", tableName, ex.Message)
            Throw ex
        End Try

        Return result
    End Function

    Public Function CreateTblSwatLog2() As String
        Dim result As String = String.Empty

        Dim tableName As String = "SwatLog"

        Dim sqlText = String.Empty
        sqlText = "CREATE TABLE SwatLog "
        sqlText += "(ID AUTOINCREMENT not null primary key,"
        sqlText += " [WeightCert] varchar(50),"
        sqlText += " [SwatDate] DateTime,"
        sqlText += " [TareDate] DateTime,"
        sqlText += " [SaleCode] varchar(50),"
        sqlText += " [Species] varchar(50),"
        sqlText += " [Qual] varchar(50),"
        sqlText += " [SaleDesc] varchar(50),"
        sqlText += " [Trucker] varchar(50),"
        sqlText += " [TruckNo] varchar(50),"
        sqlText += " [TruckState] varchar(50),"
        sqlText += " [TruckLic] varchar(50),"
        sqlText += " [TrlState] varchar(50),"
        sqlText += " [TrlLic] varchar(50),"
        sqlText += " [TruckType] varchar(50),"
        sqlText += " [Comments] varchar(150),"
        sqlText += " [TareLoad] varchar(50),"
        sqlText += " [ScaleLoad] varchar(50),"
        sqlText += " [LoadNo] integer,"
        sqlText += " [Logger] varchar(50),"
        sqlText += " [LogMethod] varchar(50),"
        sqlText += " [Block] varchar(50),"
        sqlText += " [Gross] numeric(18,2),"
        sqlText += " [Tare] numeric(18,2),"
        sqlText += " [Weight] numeric(18,2),"
        sqlText += " [PrintAvg] numeric(18,2),"
        sqlText += " [Brand] varchar(50),"
        sqlText += " [Commodity] varchar(50),"
        sqlText += " [SortCode] varchar(50),"
        sqlText += " [Deck] varchar(50),"
        sqlText += " [UserInfo1] varchar(50),"
        sqlText += " [UserInfo2] varchar(50),"
        sqlText += " [EmergencyLevel] integer,"
        sqlText += " [ReprintCount] integer,"
        sqlText += " [Reason] varchar(75),"
        sqlText += " [LocationName] varchar(50),"
        sqlText += " [Addr1] varchar(50),"
        sqlText += " [Addr2] varchar(50),"
        sqlText += " [OwnerName] varchar(50),"
        sqlText += " [LoggerName] varchar(75),"
        sqlText += " [Contract] varchar(50),"
        sqlText += " [Weighmaster] varchar(50),"
        sqlText += " [TT] varchar(50),"
        sqlText += " [Reprint] bit,"
        sqlText += " [TareoutBarcode] Longbinary,"
        sqlText += " [PrintTare] bit,"
        sqlText += " [TruckName] varchar(50),"
        sqlText += " [ManualWeight] varchar(50),"
        sqlText += " [DeputyName] varchar(50),"
        sqlText += " [CertStatus] varchar(50),"
        sqlText += " [ReplacedCert] varchar(50));"

        Try
            Debug.WriteLine(sqlText)

            'create database table
            ExecuteNonQuery(sqlText)

            result = String.Format("Table created: '{0}'", tableName)

        Catch ex As OleDbException
            'result = String.Format("Error (CreateTblSwatLog - OleDbException): Table creation failed: '{0}'; {1}", tableName, ex.Message)
            Throw ex
        Catch ex As Exception
            'result = String.Format("Error (CreateTblSwatLog): Table creation failed: '{0}'; {1}", tableName, ex.Message)
            Throw ex
        End Try

        Return result
    End Function

    Public Function CreateTblTempCert() As String
        Dim result As String = String.Empty

        Dim tableName As String = "tblTempCert"

        Dim sqlText = String.Empty
        sqlText = "CREATE TABLE tblTempCert "
        sqlText += "(ID AUTOINCREMENT not null primary key,"
        sqlText += " [SwatDate] DateTime);"

        Try
            'create database table
            ExecuteNonQuery(sqlText)

            result = String.Format("Table created: '{0}'", tableName)

        Catch ex As OleDbException
            'result = String.Format("Error (CreateTblSwatLog - OleDbException): Table creation failed: '{0}'; {1}", tableName, ex.Message)
            Throw ex
        Catch ex As Exception
            'result = String.Format("Error (CreateTblSwatLog): Table creation failed: '{0}'; {1}", tableName, ex.Message)
            Throw ex
        End Try

        Return result
    End Function

    Private Function ExecuteNonQuery(sqlText As String) As Integer
        Dim rowsAffected As Integer = 0

        'used for insert/update

        'create new connection
        Using cn As OleDbConnection = New OleDbConnection(MDBConnect)
            'open
            cn.Open()

            'create new instance
            Using cmd As OleDbCommand = New OleDbCommand(sqlText, cn)
                'execute
                rowsAffected = cmd.ExecuteNonQuery()
            End Using
        End Using

        Return rowsAffected
    End Function



    Public Sub PrintSwatLoad(SwatKey As String)
        'set value
        didPrint = True

        'create new instance
        Dim dt As New DataTable

        'create new instance
        Dim ds As New DataSet

        Try
            Dim sBarcode As String = ""

            Dim sSql As String = String.Empty

            'sSql = "SELECT WeightCert, [SwatLog].[SwatDate], TareDate, SaleCode, " &
            '        "Species, Qual, SaleDesc, Trucker, TruckNo, TruckState, " &
            '        "TruckLic, TrlState, TrlLic, TruckType, Comments, TareLoad, " &
            '        "ScaleLoad, LoadNo, Logger, LogMethod, Block, Val(Gross) as GrossWt, " &
            '        "Val(Tare) as TareWt, Weight, PrintAvg, Brand, Commodity, SortCode, " &
            '        "Deck, UserInfo1, UserInfo2, EmergencyLevel, ReprintCount, " &
            '        "Reason, LocationName, Addr1, Addr2, OwnerName, LoggerName," &
            '        "Contract, Weighmaster, TT, Reprint, TareoutBarcode, PrintTare, TruckName, " &
            '        "ManualWeight, DeputyName, CertStatus, ReplacedCert  " &
            '        "FROM Swatlog INNER JOIN tblTempCert " &
            '        "ON [SwatLog].[SwatDate] = [tblTempCert].[SwatDate] " &
            '        "WHERE [tblTempCert].[SwatDate] = ?;"

            sSql = "SELECT WeightCert, [SwatLog].[SwatDate], TareDate, SaleCode, " &
                    "Species, Qual, SaleDesc, Trucker, TruckNo, TruckState, " &
                    "TruckLic, TrlState, TrlLic, TruckType, Comments, TareLoad, " &
                    "ScaleLoad, LoadNo, Logger, LogMethod, Block, Gross as GrossWt, " &
                    "Tare as TareWt, Weight, PrintAvg, Brand, Commodity, SortCode, " &
                    "Deck, UserInfo1, UserInfo2, EmergencyLevel, ReprintCount, " &
                    "Reason, LocationName, Addr1, Addr2, OwnerName, LoggerName," &
                    "Contract, Weighmaster, TT, Reprint, TareoutBarcode, PrintTare, TruckName, " &
                    "ManualWeight, DeputyName, CertStatus, ReplacedCert  " &
                    "FROM Swatlog INNER JOIN tblTempCert " &
                    "ON [SwatLog].[SwatDate] = [tblTempCert].[SwatDate] " &
                    "WHERE [tblTempCert].[SwatDate] = ?;"

            Using cn As New OleDbConnection(MDBConnect)
                'open
                cn.Open()

                Dim swatDate As DateTime = DateTime.MaxValue

                'try to convert to DateTime
                DateTime.TryParse(SwatKey, swatDate)

                Using cmd As New OleDbCommand(sSql, cn)
                    'add parameters
                    cmd.Parameters.Add("!swatDate", OleDbType.DBDate).Value = swatDate

                    'ToDo: remove the following code that is for debugging
                    For Each p As OleDbParameter In cmd.Parameters
                        Debug.WriteLine(p.ParameterName & ": " & p.Value.ToString())
                    Next

                    Debug.WriteLine(cmd.CommandText)

                    Using da As New OleDbDataAdapter(cmd)

                        'fill DataTable
                        da.Fill(dt)

                        'add to DataSet
                        ds.Tables.Add(dt) ' added this to dataset
                        dt.TableName = "dataset"

                        'Debug.WriteLine("table count: " & ds.Tables.Count)

                        'For i As Integer = 0 To ds.Tables.Count - 1 Step 1
                        'Debug.WriteLine("table: " & ds.Tables(i).TableName)
                        'Next
                    End Using
                End Using
            End Using

            If dt.Rows.Count > 0 Then     'ds.Tables(0).Rows.Count
                Dim WrkRow As DataRow = dt.Rows(0)    'ds.Tables(0).Rows(0)
                If IsTareOut = True Then
                    'sBarcode = Trim(WrkRow("Trucker")) & WrkRow("TruckNo")
                    sBarcode = Trim(WrkRow("Trucker")) & " - " & WrkRow("TruckNo")

                    Debug.WriteLine("sBarcode: " & sBarcode)
                End If

                'ToDo: add desired code

            End If
        Catch ex As OleDbException
            'ToDo: add desired code
            'RecordEvent("Cert error:   " & SwatKey & " - " & Reason & " (" & ex.Message & ")", True)
            Throw ex
        Catch ex As Exception
            'ToDo: add desired code
            'RecordEvent("Cert error:   " & SwatKey & " - " & Reason & " (" & ex.Message & ")", True)
            Throw ex
        End Try

        'set value
        didPrint = False
    End Sub

    Public Function TblSwatLogInsert(swatDate As DateTime, trucker As String, truckNo As String, weight As String, tare As String, comments As String) As Integer
        Dim rowsAffected As Integer = 0

        Dim sqlText As String = String.Empty
        sqlText = "INSERT INTO SwatLog ([SwatDate], [Trucker], [TruckNo], [Weight], [Tare], [Comments]) VALUES (?, ?, ?, ?, ?, ?);"

        Try
            'insert data to database
            'create new connection
            Using cn As OleDbConnection = New OleDbConnection(MDBConnect)
                'open
                cn.Open()

                'create new instance
                Using cmd As OleDbCommand = New OleDbCommand(sqlText, cn)

                    'OLEDB doesn't use named parameters in SQL. Any names specified will be discarded and replaced with '?'
                    'However, specifying names in the parameter 'Add' statement can be useful for debugging
                    'Since OLEDB uses anonymous names, the order which the parameters are added is important
                    'if a column is referenced more than once in the SQL, then it must be added as a parameter more than once
                    'parameters must be added in the order that they are specified in the SQL
                    'if a value is null, the value must be assigned as: DBNull.Value

                    'add parameters
                    With cmd.Parameters
                        .Add("!swatDate", OleDbType.DBDate).Value = swatDate
                        .Add("!trucker", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(trucker), DBNull.Value, trucker)
                        .Add("!truckNo", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(truckNo), DBNull.Value, truckNo)
                        .Add("!weight", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(weight), 0, weight)
                        .Add("!tare", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(tare), 0, tare)
                        .Add("!comments", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(comments), DBNull.Value, comments)
                    End With

                    'ToDo: remove the following code that is for debugging
                    'For Each p As OleDbParameter In cmd.Parameters
                    'Debug.WriteLine(p.ParameterName & ": " & p.Value.ToString())
                    'Next

                    'execute
                    rowsAffected = cmd.ExecuteNonQuery()
                End Using
            End Using
        Catch ex As OleDbException
            Debug.WriteLine("Error (TblSwatLogInsert - OleDbException) - " & ex.Message & "(" & sqlText & ")")
            Throw ex
        Catch ex As Exception
            Debug.WriteLine("Error (TblSwatLogInsert) - " & ex.Message & "(" & sqlText & ")")
            Throw ex

        End Try

        Return rowsAffected
    End Function

    Public Function TblTempCertInsert(swatDate As DateTime) As Integer
        Dim rowsAffected As Integer = 0

        Dim sqlText As String = String.Empty
        sqlText = "INSERT INTO tblTempCert ([SwatDate]) VALUES (?);"

        Try
            'insert data to database
            'create new connection
            Using cn As OleDbConnection = New OleDbConnection(MDBConnect)
                'open
                cn.Open()

                'create new instance
                Using cmd As OleDbCommand = New OleDbCommand(sqlText, cn)

                    'OLEDB doesn't use named parameters in SQL. Any names specified will be discarded and replaced with '?'
                    'However, specifying names in the parameter 'Add' statement can be useful for debugging
                    'Since OLEDB uses anonymous names, the order which the parameters are added is important
                    'if a column is referenced more than once in the SQL, then it must be added as a parameter more than once
                    'parameters must be added in the order that they are specified in the SQL
                    'if a value is null, the value must be assigned as: DBNull.Value

                    'add parameters
                    With cmd.Parameters
                        .Add("!swatDate", OleDbType.DBDate).Value = swatDate
                    End With

                    'ToDo: remove the following code that is for debugging
                    'For Each p As OleDbParameter In cmd.Parameters
                    'Debug.WriteLine(p.ParameterName & ": " & p.Value.ToString())
                    'Next

                    'execute
                    rowsAffected = cmd.ExecuteNonQuery()
                End Using
            End Using
        Catch ex As OleDbException
            Debug.WriteLine("Error (TblTempCertInsert - OleDbException) - " & ex.Message & "(" & sqlText & ")")
            Throw ex
        Catch ex As Exception
            Debug.WriteLine("Error (TblTempCertInsert) - " & ex.Message & "(" & sqlText & ")")
            Throw ex

        End Try

        Return rowsAffected
    End Function
End Module

資源

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM