Using dbms_output.get_line in VB.NET - vb.net

I have some stored procedures to execute that use dbms_output.put_line() to put data into the output buffer.
I know I need to use dbms_output.get_line(:line, :status) to retrieve that output.
I'm using System.Data.OracleClient to avoid headaches with Oracle deployment.
So what am I doing wrong with the code below?
Dim cmdSproc As OracleCommand = cnOracle.CreateCommand()
Dim strOracle As New OracleString()
Dim opaLine As New OracleParameter("lineOut", OracleType.VarChar, 255)
opaLine.Direction = ParameterDirection.Output
Dim opaStatus As New OracleParameter("status", 0)
cmdSproc.CommandText = "begin dbms_output.get_line(:lineOut,:status); end;"
cmdSproc.Parameters.Add(opaLine)
cmdSproc.Parameters.Add(opaStatus)
Dim strOutput As String = ""
strOracle = "0"
Try
While strOracle = "0"
cmdSproc.ExecuteOracleNonQuery(strOracle)
strOutput = strOutput & strOracle.ToString() & vbNewLine
End While
Catch ex As Exception
MsgBox(ex.Message)
End Try

In vb.net the code format SKINDER friend is as follows... thnxs for sharing
Sub _showDbms()
Dim c As New OracleCommand()
c.Connection = frmMain._cnn
With c
.CommandType = CommandType.Text
.CommandText = "begin dbms_output.get_line(:line, :status); end;"
.Parameters.Add(New OracleParameter("line", OracleDbType.Varchar2)).Size = 32000
.Parameters("line").Direction = ParameterDirection.Output
.Parameters.Add(New OracleParameter("status", OracleDbType.Int32))
.Parameters("status").Direction = ParameterDirection.Output
End With
c.ExecuteNonQuery()
If c.Parameters("line").Value IsNot DBNull.Value Then
MsgBox(c.Parameters("line").Value.ToString)
End If
End Sub

Here's how I got it to work: (found it here)
Dim cmdGetOutput As New OracleCommand("declare " & _
" l_line varchar2(255); " & _
" l_done number; " & _
" l_buffer long; " & _
"begin " & _
" loop " & _
" exit when length(l_buffer)+255 > :maxbytes OR l_done =1; " & _
" dbms_output.get_line( l_line, l_done ); " & _
" l_buffer := l_buffer || l_line || chr(10); " & _
" end loop; " & _
" :done := l_done; " & _
" :buffer := l_buffer; " & _
"end;", cnOracle)
cmdGetOutput.Parameters.Add("maxbytes", OracleType.Int16)
cmdGetOutput.Parameters("maxbytes").Value = 32000
cmdGetOutput.Parameters.Add("done", OracleType.Int16)
cmdGetOutput.Parameters("done").Direction = ParameterDirection.Output
cmdGetOutput.Parameters.Add("buffer", OracleType.LongVarChar, 32000)
cmdGetOutput.Parameters("buffer").Direction = ParameterDirection.Output
Dim strOutput As String = ""
Dim intStatus As Integer = 0
Try
While True
cmdGetOutput.ExecuteNonQuery()
strOutput = strOutput & cmdGetOutput.Parameters("buffer").Value & vbNewLine
If cmdGetOutput.Parameters("done").Value = 1 Then
Exit While
End If
End While
Catch ex As Exception
MsgBox(ex.Message)
Finally
MsgBox(strOutput)
cnOracle.Close()
End Try

In C# I am using the next method:
private string GetDbmsOutputLine()
{
OracleCommand command = new OracleCommand
{
Connection = <connection>,
CommandText = "begin dbms_output.get_line(:line, :status); end;",
CommandType = CommandType.Text
};
OracleParameter lineParameter = new OracleParameter("line",
OracleType.VarChar);
lineParameter.Size = 32000;
lineParameter.Direction = ParameterDirection.Output;
command.Parameters.Add(lineParameter);
OracleParameter statusParameter = new OracleParameter("status",
OracleType.Int32);
statusParameter.Direction = ParameterDirection.Output;
command.Parameters.Add(statusParameter);
command.ExecuteNonQuery();
if (command.Parameters["line"].Value is DBNull)
return null;
string line = command.Parameters["line"].Value as string;
return line;
}

Related

OleDbDataAdapter Fill and OleDbDataReader takes 3-5 minutes to fill

This is a really strange problem as it only happens on random brand new Windows 10 pc's. It will take anywhere from 1-5 minutes to fill the data adapter or data reader. This is the 3rd pc it has happened to when upgrading from a Windows 7 old pc to a brand new windows 10 pc. The first time it happened a year ago, the problem only occurred for 1 day. The second time we could not fix it and just put them back on their old Windows 7 pc. And now it is happening again. We have replaced 4 other pc's that run this program with the same model Nuc 10i7 computer and they work just fine only taking 1-5 seconds to get through all the routines.
I don't think it is the connection string or the SQL statement since it works fine on other pc's.
I isolated the delay to when the OleDbDataAdapter or the OleDbDataReader are being filled which is evident in the screenshots below using a logging function before and after the fill.
This is on Nuc10i7 pc, VB.Net program calling one row of data from an 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()
Please note ****** this code works perfectly fine on certain PC's which is why I didn't provide the code originally. I am on a Lenovo thinkpad right now and the code runs fine with either the datareader or adapter methods. It will run fine on intel's Nuc 10 i7 sometimes and then sometimes it doesn't as I described above.*********
Here is the code using the dataAdapter and datatable method:
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
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
It's possible that your Access database is corrupt. The code below contains a variety of methods that may be useful, including CompactAccessDatabase and CompactAccessDatabaseMDBOnly - compacting also repairs the database, if needed. Since the data types weren't provided for the tables mentioned in the OP, the data types in "CreateTblSwatLog" and "CreateTblTempCert" may need to be updated.
Add references to your project:
VS 2019:
Click Project
Select Add Reference
Click COM
Check Microsoft Jet and Replication Objects 2.6 Library
Check Microsoft ADO Ext. 6.0 for DDL and Security
Check Microsoft DAO 3.6 Object Library
Check Microsoft Access xx.x Object Library
Click Assemblies
Check System.Data (if not already checked)
Create a module (name: 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
Resources
Converting Access OLE object image to show in Datagridview vb.net
Compact and Repair Access Database using C# ?
How do I compact and repair an ACCESS 2007 database by .NET code?
jro.jetengine not being recognised..
Compact and Repair Access Database using C# and Late Binding

How to edit and delete rows of a database using ASP?

I currently have a website that displays all the data within the database
Dim dcSQL As New SqlClient.SqlConnection(ConfigurationManager.ConnectionStrings("College").ConnectionString)
Dim dbAdapt As New System.Data.SqlClient.SqlDataAdapter()
Dim cmd As New SqlCommand("SELECT * FROM [College].[dbo].[Class]", dcSQL)
dbAdapt.SelectCommand = cmd
Dim ds As New DataSet
dbAdapt.Fill(ds)
If dbAdapt IsNot Nothing Then
gvStudents0.DataSource = ds.Tables(0)
gvStudents0.DataBind()
End If
Catch ex As Exception
End Try
End Sub'
But I want to create/edit and delete the database, I am aware of how to do this in EF but I am currently not aware in SQL, can someone help?
The following snippet is from SqlCommand.Parameters Property .
Updating
Dim commandText As String = _
"UPDATE Sales.Store SET Demographics = #demographics " _
& "WHERE CustomerID = #ID;"
Using connection As New SqlConnection(connectionString)
Dim command As New SqlCommand(commandText, connection)
' Add CustomerID parameter for WHERE clause.
command.Parameters.Add("#ID", SqlDbType.Int)
command.Parameters("#ID").Value = customerID
' Use AddWithValue to assign Demographics.
' SQL Server will implicitly convert strings into XML.
command.Parameters.AddWithValue("#demographics", demoXml)
Try
connection.Open()
Dim rowsAffected As Integer = command.ExecuteNonQuery()
Console.WriteLine("RowsAffected: {0}", rowsAffected)
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
End Using
Deleting
For deleting the command could be as follows.
Dim commandText As String = _
"DELETE FROM Sales.Store WHERE CustomerID = #ID;"
(...)
command.Parameters.Add("#CustomerID ", SqlDbType.Int).Value = xxx;
Inserting
For inserting the sql will be something like the following
Dim commandText As String = _
"INSERT INTO tablename(column1,column2,column3)" _
& " VALUES(#column1,#column2,#column3);"
and then
command.Parameters.Add("#column1", SqlDbType.Int).Value = x;
command.Parameters.Add("#column2", SqlDbType.Int).Value = y;
command.Parameters.Add("#column3", SqlDbType.Int).Value = z;
or
command.Parameters.AddWithValue("#column1", x);
command.Parameters.AddWithValue("#column2", y);
command.Parameters.AddWithValue("#column3", z)
Please note that this is not ASP.NET specific. A console app could use this code as well.
You can use this class that I make and don’t care about SQL (in some cases).
You can just pas lists (Of String) as parameter and the methods do the tasks.
Imports System.Data.SqlClient
Friend Class SqlDB
Friend Property _SConessione As String = ""
Private _NomeDB As String = ""
Private _SQLConnection As SqlConnection
Private _SQLCommand As SqlCommand
Private _SQLAdapter As SqlDataAdapter
Private _SQLReader As SqlDataReader
Friend Enum Version
SQL_SERV_2005 = 90
SQL_SERV_2008 = 100
SQL_SERV_2012 = 110
End Enum
Friend Structure Inputs
Const _CHAR As String = "CHAR"
Const _VARCHAR As String = "VARCHAR"
Const _TEXT As String = "TEXT"
Const _NCHAR As String = "NCHAR"
Const _NVARCHAR As String = "NVARCHAR"
Const _NTEXT As String = "NTEXT"
Const _BIT As String = "BIT"
Const _BINARY As String = "BINARY"
Const _VARBINARY As String = "VARBINARY"
Const _IMAGE As String = "IMAGE"
Const _TINYINT As String = "TINYINT"
Const _SMALLINT As String = "SMALLINT"
Const _BIGINT As String = "BIGINT"
Const _DECIMAL As String = "DECIMAL(10,2)"
Const _NUMERIC As String = "NUMERIC(10)"
Const _FLOAT As String = "FLOAT"
Const _DATE As String = "DATE"
Const _DATETIME As String = "DATETIME"
End Structure
Friend Structure NULLS
Const NULL = "NULL"
Const NOT_NULL = "NOT NULL"
End Structure
Friend Structure Cols
Dim Nome As String
Dim TInput As String
Dim Length As Integer
Dim Null As String
End Structure
Private _Versione As Version = Version.SQL_SERV_2008
Friend Function SqlDate(dateStr As String) As String
If IsDate(dateStr) Then
Dim sDate As String = ""
dateStr = CDate(dateStr).ToShortDateString
sDate = " CONVERT(DATE, '" & dateStr & "', 0) "
Return sDate
Else
Throw New Exception("Formato data non valido")
End If
Return ""
End Function
Friend Property Versione As Version
Get
Return _Versione
End Get
Set(value As Version)
_Versione = value
End Set
End Property
Friend Enum TypeIndex
CLUSTER = 0
NONCOLUSTER = 1
End Enum
Friend Sub New(ByVal ConString As String,
ByVal VersionServer As Version)
Try
Versione = VersionServer
If ConString.Length > 0 Then
_SConessione = ConString
End If
Catch ex As Exception
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
End Try
End Sub
Friend Sub New(ByVal ConString As String)
Try
Versione = _Versione
If ConString.Length > 0 Then
_SConessione = ConString
End If
Catch ex As Exception
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
End Try
End Sub
Friend Function ExecuteRestore(Optional ByVal pathBackup As String = "", Optional NameDb As String = "") As Boolean
Dim res As Boolean = False
If NameDb.Length > 0 Then _NomeDB = NameDb
If _NomeDB.Length = 0 Then
Debug.WriteLine("Set the name of DB")
Return False
End If
Dim Sql = " USE [master]; " & vbCrLf
Sql &= " RESTORE DATABASE [" & _NomeDB & "]" & vbCrLf
Sql &= " FROM DISK = '" & pathBackup & "'" & vbCrLf
Sql &= " WITH FILE = 1, NOUNLOAD, REPLACE" & vbCrLf '
Try
Using SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(Sql, SQLConnection)
res = CBool(command.ExecuteNonQuery())
res = True
End Using
Catch ex As Exception
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
End Try
Return res
End Function
Friend Function ExecuteQuery(sql As String) As Boolean
Dim res As Boolean = False
If sql.Length > 0 Then
sql = "USE [" & _NomeDB & "]; " & vbCrLf & sql
End If
Try
Using SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(sql, SQLConnection)
command.ExecuteNonQuery()
End Using
Return True
Catch ex As Exception
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
End Try
Return res
End Function
Friend Function ReadTheFirstResult(sql As String) As Object
Dim sRet As Object = ""
If sql.Length > 0 Then
sql = "USE [" & _NomeDB & "]; " & vbCrLf & sql
End If
Try
Dim SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(sql, SQLConnection)
Dim reader As SqlDataReader = command.ExecuteReader()
While reader.Read
sRet = reader(0)
Exit While
End While
Catch ex As SqlException
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
End Try
Return sRet
End Function
Friend Function GetDataAsDataReader(Sql As String, Optional ByRef RowsCount As Integer = -1) As SqlDataReader
Dim reader As SqlDataReader = Nothing
If Sql.Length > 0 Then
Sql = "USE [" & _NomeDB & "]; " & vbCrLf & Sql
End If
Try
Dim SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
If RowsCount > -1 Then
Dim DtTable As New DataTable
Dim mSqlAdapter As New SqlClient.SqlDataAdapter With {
.SelectCommand = New SqlCommand(Sql, SQLConnection)
}
mSqlAdapter.Fill(DtTable)
RowsCount = DtTable.Rows.Count
End If
Dim command As New SqlCommand(Sql, SQLConnection)
reader = command.ExecuteReader()
Catch ex As SqlException
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
End Try
Return reader
End Function
Friend Function CheckOrCreateDB(ByVal dbName As String) As Boolean
Try
Dim query As StringBuilder = New StringBuilder
query.Append(" USE [master]; ")
query.Append("IF NOT EXISTS(SELECT * FROM sys.databases Where name = '" & dbName & "') ")
query.Append(" CREATE DATABASE [" & dbName & "] ")
query.Append(" ALTER DATABASE [" & dbName & "] SET COMPATIBILITY_LEVEL = " & Versione & " ;")
query.Append(" ALTER DATABASE [" & dbName & "] SET READ_WRITE ;")
query.Append(" ALTER DATABASE [" & dbName & "] SET MULTI_USER ;")
Using SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(query.ToString, SQLConnection)
command.ExecuteNonQuery()
_NomeDB = dbName
End Using
Return True
Catch ex As Exception
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
_NomeDB = ""
Return False
End Try
End Function
Friend Function CheckOrCreateTable(ByVal tableName As String, ByVal columns As List(Of Cols)) As Boolean
Try
If _NomeDB IsNot Nothing AndAlso _NomeDB.Length > 0 Then
Dim query As StringBuilder = New StringBuilder
query.Append(" USE [" & _NomeDB & "]; ")
query.Append(" IF NOT EXISTS ( SELECT * FROM sys.tables WHERE name = '" & tableName & "' ) ")
query.Append(" CREATE TABLE " & tableName & " ")
query.Append(" ( IndexRow INT IDENTITY(1,1) NOT NULL ); ")
Using SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(query.ToString, SQLConnection)
command.ExecuteNonQuery()
End Using
query.Clear()
If columns IsNot Nothing AndAlso columns.Count > 0 Then
For i As Integer = 0 To columns.Count - 1
Dim TipoInput As String = columns(i).TInput & " "
If columns(i).Length > 0 Then
CreateColumn(tableName, columns(i).Nome, TipoInput, columns(i).Null, CStr(columns(i).Length))
Else
CreateColumn(tableName, columns(i).Nome, TipoInput, columns(i).Null)
End If
Next
End If
Return True
End If
Catch ex As Exception
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
End Try
Return False
End Function
Friend Function CreateColumn(ByVal tableName As String,
ByVal columnName As String,
ByVal TipoInput As String,
ByVal nullOrNot As String,
Optional ByVal Lunghezza As String = "-1") As Integer
Dim i As Integer = 0
Try
Dim mTipoInput As String = TipoInput
If CInt(Lunghezza) > -1 Then mTipoInput = mTipoInput & "(" & Lunghezza & ") "
Dim query As StringBuilder = New StringBuilder
query.Append(" USE [" & _NomeDB & "]; ")
query.Append(" IF NOT EXISTS (SELECT * FROM syscolumns WHERE id = OBJECT_ID('" & tableName & "') AND name = '" & columnName & "' )")
query.Append(" ALTER TABLE " & tableName)
query.Append(" ADD " & columnName & " " & mTipoInput & " " & nullOrNot)
Using SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(query.ToString, SQLConnection)
i = command.ExecuteNonQuery()
End Using
Catch ex As Exception
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
End Try
Return i
End Function
Friend Function CheckOrCreateColumn(ByVal tableName As String,
ByVal columnName As String,
Optional ByVal inputType As String = Inputs._VARCHAR,
Optional ByVal nullOrNot As String = "NULL",
Optional ByVal Lunghezza As String = "-1") As Integer
Dim i As Integer = 0
Try
Dim mTipoInput As String = inputType
If CInt(Lunghezza) > -1 Then mTipoInput = mTipoInput & "(" & Lunghezza & ") "
Dim query As StringBuilder = New StringBuilder
query.Append(" USE [" & _NomeDB & "]; ")
query.Append(" IF NOT EXISTS (SELECT * FROM syscolumns WHERE id = OBJECT_ID('" & tableName & "') AND name = '" & columnName & "' )")
query.Append(" ALTER TABLE " & tableName)
query.Append(" ADD " & columnName & " " & mTipoInput & " " & nullOrNot)
Using SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(query.ToString, SQLConnection)
i = command.ExecuteNonQuery()
End Using
Catch ex As Exception
#If DEBUG Then
Debug.WriteLine(ex.ToString)
#End If
End Try
Return i
End Function
Friend Function CheckOrCreateIndex(tipo As TypeIndex,
indexName As String,
tableName As String,
columnsIndexes() As String,
Optional includedColumns() As String = Nothing) As String
Dim res As String = ""
Try
' CREATE INDEX IX_TableName_Col1
' ON dbo.TableName
' (column_1)
If columnsIndexes.Length > 0 Then
Dim query As StringBuilder = New StringBuilder
query.Append(" USE [" & _NomeDB & "]; ")
query.Append(" IF NOT EXISTS (SELECT name FROM sys.indexes WHERE name = '" & indexName & "')")
Select Case tipo
Case TypeIndex.CLUSTER
query.Append(" CREATE CLUSTERED INDEX " & indexName)
Case TypeIndex.NONCOLUSTER
query.Append(" CREATE NONCLUSTERED INDEX " & indexName)
End Select
query.Append(" ON [" & tableName & "] (" & JoinParams(columnsIndexes, False).Trim & ")")
If includedColumns IsNot Nothing AndAlso includedColumns.Length > 0 Then
query.Append(" Include (" & JoinParams(includedColumns, False) & ")")
End If
Using SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(query.ToString, SQLConnection)
command.ExecuteNonQuery()
res = indexName
End Using
End If
Catch ex As Exception
#If DEBUG Then
Debug.WriteLine(ex.ToString)
'Debugger.Break()
#End If
End Try
Return res
End Function
Friend Function InsertInto(tableName As String, listOfCols As List(Of String), listOfValues As List(Of String)) As Boolean
Try
Dim Sql As String = " USE [" & _NomeDB & "]; "
Sql &= " INSERT INTO " & tableName
If listOfCols.Count > 0 AndAlso listOfValues.Count > 0 Then
Sql &= " (" & Join(listOfCols.ToArray, ",") & ")"
Sql &= " VALUES (" & JoinParams(listOfValues.ToArray) & ")"
Using SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(Sql, SQLConnection)
command.ExecuteNonQuery()
End Using
Return True
End If
Catch ex As Exception
#If DEBUG Then
Console.WriteLine(ex.ToString)
'Stop
#End If
End Try
Return False
End Function
Friend Function UpdateInto(tableName As String, listOfCols As List(Of String), listOfValues As List(Of String), WhereClausola As String) As Integer
Dim ret As Integer = 0
Try
Dim Sql As String = " USE [" & _NomeDB & "]; "
Sql &= " UPDATE " & tableName & " SET "
If listOfCols.Count > 0 AndAlso listOfValues.Count > 0 Then
If listOfCols.Count > 0 AndAlso listOfValues.Count > 0 Then
' UPDATE Customers
'SET
'ContactName ='Alfred Schmidt',
'City ='Hamburg'
'WHERE CustomerName ='Alfreds Futterkiste';
For i As Integer = 0 To listOfCols.Count - 1
Sql &= " " & listOfCols(i) & "=" & CStr(IIf(listOfValues(i) IsNot Nothing, listOfValues(i), "NULL")) & CStr(IIf(i < listOfCols.Count - 1, ",", ""))
Next
If WhereClausola IsNot Nothing AndAlso WhereClausola.Length > 0 Then
WhereClausola = WhereClausola.ToLower.Replace("where", " ")
Sql &= " WHERE " & WhereClausola
Using SQLConnection = New SqlConnection(_SConessione)
Open(SQLConnection)
Dim command As New SqlCommand(Sql, SQLConnection)
ret = command.ExecuteNonQuery()
End Using
End If
End If
End If
Return ret
Catch ex As Exception
#If DEBUG Then
Console.WriteLine(ex.ToString)
'Stop
#End If
End Try
Return ret
End Function
Private Function JoinParams(ByVal params() As String, Optional ByVal UseVbcrlf As Boolean = True) As String
Dim s As String = ""
Dim mVbCrlf As String = CStr(IIf(UseVbcrlf, vbCrLf, " "))
For i As Integer = 0 To params.Length - 1
If params(i) IsNot Nothing Then
If i = params.Length - 1 Then
s &= params(i) & " " & mVbCrlf
Else
s &= params(i) & ", " & mVbCrlf
End If
End If
Next
Return s
End Function
Friend Sub Open(sqlConn As SqlConnection)
Try
_SQLConnection = sqlConn
Select Case sqlConn.State
Case <> ConnectionState.Connecting
sqlConn.Close()
sqlConn.ConnectionString = _SConessione
sqlConn.Open()
End Select
Catch ex As Exception
End Try
End Sub
Friend Sub Close()
Try
If _SQLConnection IsNot Nothing Then
_SQLConnection.Close()
End If
Catch ex As Exception
Debug.WriteLine(ex.ToString)
End Try
End Sub
End Class
Module SQLUtil
Function InLIKE(s As String) As String
'%email pippo%
If s IsNot Nothing AndAlso s.Length > 0 Then
Return "%" & s & "%"
End If
Return "%%"
End Function
Function InApice(value As String) As String
If value Is Nothing Then Return "''"
If value.Length = 0 Then Return "''"
Dim appice As String = "'" '"`"
value = value.Replace("'", "''")
Return " " & appice & value & appice & " "
End Function
Function ToDate(dateStr As String) As String
If IsDate(dateStr) Then
Dim sDate As String = CDate(dateStr).ToString
Return sDate
End If
Return dateStr
End Function
Function ToDbDate(dateStr As String) As String
dateStr = New Date(dateStr)
If IsDate(dateStr) Then
Dim mDate As Date = CDate(dateStr)
Dim anno As Integer = mDate.Year
Dim mese As Integer = mDate.Month
Dim giorno As Integer = mDate.Day
Dim ora As Integer = mDate.Hour
Dim minuto As Integer = mDate.Minute
If Not IsNumeric(anno) Then anno = 0
If Not IsNumeric(mese) Then mese = 0
If Not IsNumeric(giorno) Then giorno = 0
If Not IsNumeric(ora) Then ora = 0
If Not IsNumeric(minuto) Then minuto = 0
anno = Strings.Format(anno, "0000")
mese = Strings.Format(mese, "00")
giorno = Strings.Format(giorno, "00")
ora = Strings.Format(ora, "00")
minuto = Strings.Format(minuto, "00")
Dim sDate As String = CStr(anno) & CStr(mese) & CStr(giorno) & CStr(ora) & CStr(minuto)
Return sDate
End If
Return ""
End Function
Function FromDbDate(s As String, Optional ancheOraEMinuti As Boolean = False) As String
If s Is Nothing Then Return ""
If s.Length = 0 Then Return ""
If s.Length > 12 Then
Dim data As String = ""
Dim anno As String = s.Substring(0, 4)
Dim mese As String = s.Substring(5, 2)
Dim giorno As String = s.Substring(7, 2)
Dim ora As String = s.Substring(9, 2)
Dim minuti As String = s.Substring(11, 2)
End If
Return ""
End Function
End Module

How do I track down an Unclosed reader

I've got a utility function in a much larger project that updates a backend SQL database. It's currently failing most times I use it, with the error:
There is already an open DataReader associated with this Command which must be closed first.
The code for the function is below:
Public Function Update_Data(what As String, Optional where As String = "",
Optional table As String = ThisAddIn.defaultTable) As Integer
Try
Dim cmd As New SqlCommand With {
.Connection = conn
}
cmd.CommandText = "UPDATE " & table & " SET " & what
If where <> "" Then
cmd.CommandText &= " WHERE " & where
End If
Update_Data = cmd.ExecuteNonQuery
cmd.Dispose()
Catch ex As Exception
Update_Data = 0
Debug.WriteLine("SQL Error updating data:" & vbCrLf & ex.Message)
End Try
End Function
I've gone through the rest of the code to make sure that whenever I have a SQLDataReader declared I later call reader.close(). I added the cmd.Dispose() line to this and all the other ExecuteNonQuery functions I could find - incase that helped?
Are there any other instances/types of reader that might not be being closed?
In the case of an Exception, you aren't disposing your command.
If you don't want to use Using, add a Finally
Public Function Update_Data(what As String, Optional where As String = "",
Optional table As String = ThisAddIn.defaultTable) As Integer
Dim cmd As SqlCommand
Try
cmd = New SqlCommand With {.Connection = conn}
cmd.CommandText = "UPDATE " & table & " SET " & what
If where <> "" Then
cmd.CommandText &= " WHERE " & where
End If
Update_Data = cmd.ExecuteNonQuery
Catch ex As Exception
Update_Data = 0
Debug.WriteLine("SQL Error updating data:" & vbCrLf & ex.Message)
Finally
cmd.Dispose()
End Try
End Function
but Using might be simpler
Public Function Update_Data(what As String, Optional where As String = "",
Optional table As String = ThisAddIn.defaultTable) As Integer
Using cmd As New SqlCommand With {.Connection = conn}
Try
cmd.CommandText = "UPDATE " & table & " SET " & what
If where <> "" Then
cmd.CommandText &= " WHERE " & where
End If
Update_Data = cmd.ExecuteNonQuery
Catch ex As Exception
Update_Data = 0
Debug.WriteLine("SQL Error updating data:" & vbCrLf & ex.Message)
End Try
End Using
End Function

Checking existing table rows

Can somebody tell me what I've done wrong inside my coding? I am trying to match the user login name and password with the one inside the database. If got row and matched then user will be able to login into the system but it seems like my system can only read the first row of my data table (inside database).
Here is my coding that I currently use.
Private Sub CheckLogin()
Dim lCnn As New SqlConnection
Dim lCmd As New SqlCommand
Dim lRd As SqlDataReader
Dim lsCmd As String
If TextBoxLogin.Text = "" Then
MsgBox("Enter your Username.")
Try
TextBoxLogin.Focus()
Catch ex As Exception
End Try
ElseIf TextBoxPass.Text = "" Then
MsgBox("Enter your Password.")
Try
TextBoxPass.Focus()
Catch ex As Exception
End Try
Else
lCnn.ConnectionString = GetConnString()
lCnn.Open()
lCmd.Connection = lCnn
lsCmd = "SELECT * FROM UserInfo..UserInfo "
lsCmd &= " INNER JOIN UserInfo..UserAccess ON UserLogin = UA_UserLogin "
lsCmd &= " WHERE (UserLogin = " & SQLQuote(Trim(TextBoxLogin.Text)) & " AND UserPassword = " & SQLQuote(Trim(TextBoxPass.Text))
lsCmd &= " AND UserActive = 1"
lsCmd &= " AND UA_AICode = 'MENU')"
lCmd.CommandText = lsCmd
lRd = lCmd.ExecuteReader()
If lRd.HasRows Then
lRd.Read()
lbLoginSuccess = True
gsLoginID = Trim(TextBoxLogin.Text)
gsUserPass = Trim(TextBoxPass.Text)
Me.Close()
Else
lnCurRetry += 1
Alert("Wrong Username or Password.")
End If
lRd.Close()
lCnn.Close()
End If
If Not lbLoginSuccess Then
If lnCurRetry >= 3 Then
Me.Close()
End If
End If
End Sub
I appreciate your help. Thanks.
Your code is not really bad, but can be better if utilize that sintax:
Using LCnn As New SqlConnection
LCnn.ConnectionString = GetConnString()
Try
LCnn.Open()
Using LCmd As New SqlCommand("SELECT * FROM UserInfo " & _
"INNER JOIN UserAccess ON UserLogin = UA_UserLogin " & _
"WHERE (UserLogin = '" & TextBoxLogin.Text.trim & "' " & _
"AND UserPassword = '" & TextBoxPass.Text.Trim & "' " & _
"AND UserActive = 1 AND UA_AICode = 'MENU')", LCnn)
Dim LRdr As SqlDataReader
Try
LRdr = SQL_Cmd.ExecuteReader
If Not SQL_Rdr.HasRows Then
msgbox("Empty Results...")
else
<your code>
endif
catch ex as Exception
msgbox("Error: " & ex.message)
end try
end using ' Lcmd
catch exConn as Exception
msgbox("Error: " & exConn.message)
end try
end using ' LCnn
Remember: the Using/End Using syntax can help you to manage resources. End Using always close and dispose resources.
Good luck

No Value Given For one or more parameters Vb.net Update Statement

This Is My Update Statement and when i try to update access database using it The error "No Given Value for One Or More Parameter ... etc"
Note: "There is some failed i want to keep with no change/update"
sqlupdate = "UPDATE MainData SET [Done]=#Done, [Delevered]=#Delevered, [Called]=#Called, [QussaiCheked]=#QussaiCheked,[Employee]=#Employee,[CustName]=#CustName, [CustPhone]=#CustPhone ," & _
"[NoSignal]=#NoSignal ,[NoPower]=#NoPower ,[FormatC]=#FormatC ,[FormatAll]=#FormatAll ,[WindXP]=#WindXP ,[Wind7]=#Wind7 ,[Wind8]=#Wind8 ,[DeviseType]=#DeviseType ," & _
"[Note]=#Note ,[Reciver]=#Reciver,[DateTime]=[DateTime],[Coast]=#Coast WHERE ID='" & Convert.ToInt32(IDLable.Text) & "'"
If (DoneCheckBox.Checked = True) Then
cmd.Parameters.AddWithValue("#Done", DoneCheckBox.Checked)
End If
If (DeleveredCheck.Checked = True) Then
cmd.Parameters.AddWithValue("#Delevered", DeleveredCheck.Checked)
End If
If (CalledCheck.Checked = True) Then
cmd.Parameters.AddWithValue("#Called", CalledCheck.Checked)
End If
If (QussaiChecked.Checked = True) Then
cmd.Parameters.AddWithValue("#QussaiCheked", QussaiChecked.Checked)
End If
If (Employee.Checked = True) Then
cmd.Parameters.AddWithValue("#Employee", Employee.Checked)
End If
cmd.Parameters.AddWithValue("#CustName", NameTextBox.Text)
cmd.Parameters.AddWithValue("#CustPhone", PhoneTextBox.Text)
If (RadioSignal.Checked = True) Then
cmd.Parameters.Add(New OleDbParameter("#NoSignal", RadioSignal.Checked))
End If
If (RadioPower.Checked = True) Then
cmd.Parameters.Add(New OleDbParameter("#NoPower", RadioPower.Checked))
End If
If (Fc.Checked = True) Then
cmd.Parameters.AddWithValue("#FormatC", Fc.Checked)
End If
If (Fall.Checked = True) Then
cmd.Parameters.AddWithValue("#FormatAll", Fall.Checked)
End If
If (WinXP.Checked = True) Then
cmd.Parameters.AddWithValue("#WindXP", WinXP.Checked)
End If
If (Win7.Checked = True) Then
cmd.Parameters.AddWithValue("#Wind7", Win7.Checked)
End If
If (Win8.Checked = True) Then
cmd.Parameters.AddWithValue("#Wind8", Win8.Checked)
End If
'...etc For All Parameters
'then
con1.Open()
Try
cmd.ExecuteNonQuery()
Catch ex As Exception
MessageBox.Show(ex.ToString())
' MessageBox.Show(ex.Source)
End Try
con1.Close()
RefreshDGV()
MessageBox.Show("{updated")
I try to post the exception handler message but "Still New Less than 10 Reputation "
I Solved My problem thanks for all how view or attempt to solve it and help my
:)
I Update each field one by one Using this Code:
Dim con1 As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\USER\Desktop\Test.accdb")
Public Cmd As OleDbCommand
Dim Str As String
Str = "update MainData set CustName="
Str += """" & NameTextBox.Text & """"
Str += " where ID="
Str += IDLable.Text.Trim()
con1.Open()
Cmd = New OleDbCommand(Str, con1)
Cmd.ExecuteNonQuery()
con1.Close()