I built a desktop application using VB.NET on Visual Studio 2012. I use Crystal Report to show the report. But when user generated the report and try to export into another file (excel,etc), it always cause my application "Not responding" and closing the application.
Is this memory problem or I have to install something else?
my code to load report in reportviewer controller
Thread.CurrentThread.CurrentCulture = New CultureInfo("id-ID")
Thread.CurrentThread.CurrentCulture.NumberFormat.CurrencySymbol = "Rp "
Thread.CurrentThread.CurrentCulture.DateTimeFormat.DateSeparator = "-"
Thread.CurrentThread.CurrentCulture.DateTimeFormat.FullDateTimePattern = "dd/MM/yyyy hh:mm:ss"
Dim PeriodeAwal As DateTime
Dim PeriodeAkhir As DateTime
If lblTodayOrMonth.Text.ToLower = "custom" Then
PeriodeAwal = New DateTime(frmJenisLaporan.dtpAwal.Value.Year, frmJenisLaporan.dtpAwal.Value.Month, frmJenisLaporan.dtpAwal.Value.Day)
PeriodeAkhir = New DateTime(frmJenisLaporan.dtpAkhir.Value.Year, frmJenisLaporan.dtpAkhir.Value.Month, frmJenisLaporan.dtpAkhir.Value.Day)
End If
If conn.State = ConnectionState.Closed Then
conn.Open()
End If
Dim ds As DataSet = New DataSet
Dim t As DataTable = ds.Tables.Add("Transaksi")
Dim r As DataRow
t.Columns.Add("IDHORDER", Type.GetType("System.Int32"))
t.Columns.Add("TANGGAL", Type.GetType("System.DateTime"))
t.Columns.Add("NOINVOICE", Type.GetType("System.String"))
t.Columns.Add("MEJA", Type.GetType("System.String"))
t.Columns.Add("Total", Type.GetType("System.Decimal"))
t.Columns.Add("Diskon", Type.GetType("System.Decimal"))
t.Columns.Add("TotalBersih", Type.GetType("System.Decimal"))
t.Columns.Add("PEMBAYARAN", Type.GetType("System.Decimal"))
t.Columns.Add("KEMBALIAN", Type.GetType("System.Decimal"))
t.Columns.Add("JENISORDER", Type.GetType("System.String"))
t.Columns.Add("CREATEDBY", Type.GetType("System.String"))
t.Columns.Add("PAX", Type.GetType("System.String"))
t.Columns.Add("NAMA", Type.GetType("System.String"))
t.Columns.Add("IDDORDER", Type.GetType("System.Int32"))
t.Columns.Add("IDMENU", Type.GetType("System.Int32"))
t.Columns.Add("QTY", Type.GetType("System.Int32"))
t.Columns.Add("HARGASAATORDER", Type.GetType("System.Decimal"))
t.Columns.Add("SUBTOTAL", Type.GetType("System.Decimal"))
t.Columns.Add("NAMAMENU", Type.GetType("System.String"))
t.Columns.Add("NAMARESTORAN", Type.GetType("System.String"))
t.Columns.Add("REVISIORNOT", Type.GetType("System.String"))
t.Columns.Add("SERVICECHARGE", Type.GetType("System.Decimal"))
t.Columns.Add("LOGOLOCATION", Type.GetType("System.String"))
t.Columns.Add("PAJAK", Type.GetType("System.Decimal"))
t.Columns.Add("ALASANDISKON", Type.GetType("System.String"))
t.Columns.Add("DISKONBY", Type.GetType("System.String"))
t.Columns.Add("CUSTOMERNAME", Type.GetType("System.String"))
t.Columns.Add("GETPOIN", Type.GetType("System.Int32"))
t.Columns.Add("CUSTOMERTOTALPOIN", Type.GetType("System.Int32"))
t.Columns.Add("DISKONEXTRA", Type.GetType("System.Decimal"))
Dim counterJumlahPorsi As Integer = 0
Dim TotalNominal As Decimal = 0
'ambil data transaksi
'cmdtxt = "SELECT H.IDHORDER, H.TANGGAL, H.NOINVOICE, H.MEJA, H.TOTAL, H.DISKON, H.TOTALBERSIH, H.PEMBAYARAN, H.KEMBALIAN, H.JENISORDER, H.CREATEDBY, H.PAX, H.NAMA, D.IDDORDER, D.IDMENU, D.QTY, D.HARGASAATORDER, D.SUBTOTAL, M.NAMAMENU, H.SERVICECHARGE,H.PAJAK,H.ALASANDISKON,H.DISKONBY FROM HORDER AS H, DORDER AS D, MENU AS M WHERE (((M.IDMENU)=[D].[IDMENU]) AND ((D.IDHORDER)=[H].[IDHORDER])) AND COMPLETED=True AND KEEPRECORD=True"
cmdtxt = "SELECT H.IDHORDER, H.TANGGAL, H.NOINVOICE, H.MEJA, H.TOTAL, H.DISKON, H.TOTALBERSIH, H.PEMBAYARAN, H.KEMBALIAN, H.JENISORDER, H.CREATEDBY, H.PAX, H.NAMA, D.IDDORDER, D.IDMENU, D.QTY, D.HARGASAATORDER, D.SUBTOTAL, M.NAMAMENU, H.SERVICECHARGE,H.PAJAK,H.ALASANDISKON,H.DISKONBY, H.GETPOIN, IIF(H.IDCUSTOMER=0,'Non Member',C.NAMACUSTOMER) AS NAMACUSTOMER,H.DISKONEXTRA FROM ((HORDER AS H INNER JOIN DORDER AS D ON D.IDHORDER=H.IDHORDER) INNER JOIN MENU AS M ON M.IDMENU=D.IDMENU) LEFT JOIN CUSTOMER AS C ON C.IDCUSTOMER=H.IDCUSTOMER WHERE H.COMPLETED=TRUE AND H.KEEPRECORD=TRUE"
If lblTodayOrMonth.Text.ToLower = "today" Then
cmdtxt &= " AND DAY(H.TANGGAL)=" & Date.Now.Day & " AND MONTH(H.TANGGAL)=" & Date.Now.Month & " AND YEAR(H.TANGGAL)=" & Date.Now.Year
ElseIf lblTodayOrMonth.Text.ToLower = "month" Then
cmdtxt &= " AND MONTH(H.TANGGAL)=" & Date.Now.Month & " AND YEAR(H.TANGGAL)=" & Date.Now.Year
ElseIf lblTodayOrMonth.Text.ToLower = "custom" Then
'cmdtxt &= " AND DATEVALUE('" & PeriodeAwal & "')<=H.TANGGAL AND H.TANGGAL<=DATEVALUE('" & PeriodeAkhir.AddDays(1) & "')"
cmdtxt &= " AND DATEVALUE('" & PeriodeAwal.Month & "-" & PeriodeAwal.Day & "-" & PeriodeAwal.Year & "')<=H.TANGGAL AND H.TANGGAL<=DATEVALUE('" & PeriodeAkhir.AddDays(1).Month & "-" & PeriodeAkhir.AddDays(1).Day & "-" & PeriodeAkhir.AddDays(1).Year & "')"
End If
cmd = New OleDbCommand(cmdtxt, conn)
reader = cmd.ExecuteReader
If reader.HasRows Then
While reader.Read
r = t.NewRow()
r("IDHORDER") = reader.GetValue(0)
r("TANGGAL") = reader.GetValue(1)
r("NOINVOICE") = reader.GetValue(2)
Dim totalMeja() As String = reader.GetValue(3).ToString.Split(",")
r("MEJA") = totalMeja(0)
r("Total") = reader.GetValue(4)
r("Diskon") = reader.GetValue(5)
r("TotalBersih") = reader.GetValue(6)
r("PEMBAYARAN") = reader.GetValue(7)
r("KEMBALIAN") = reader.GetValue(8)
r("JENISORDER") = reader.GetValue(9)
r("CREATEDBY") = reader.GetValue(10)
r("PAX") = reader.GetValue(11)
r("NAMA") = reader.GetValue(12)
r("IDDORDER") = reader.GetValue(13)
r("IDMENU") = reader.GetValue(14)
r("QTY") = reader.GetValue(15)
r("HARGASAATORDER") = reader.GetValue(16)
r("SUBTOTAL") = reader.GetValue(17)
r("NAMAMENU") = reader.GetValue(18)
r("NAMARESTORAN") = NamaRestoran
r("SERVICECHARGE") = reader.GetValue(19)
r("LOGOLOCATION") = LogoRestoran
r("PAJAK") = reader.GetValue(20)
r("ALASANDISKON") = reader.GetValue(21)
r("DISKONBY") = reader.GetValue(22)
r("GETPOIN") = reader.GetValue(23)
r("CUSTOMERNAME") = reader.GetValue(24)
r("CUSTOMERTOTALPOIN") = 0
r("DISKONEXTRA") = reader.GetValue(25)
t.Rows.Add(r)
counterJumlahPorsi += reader.GetValue(15)
End While
End If
reader.Close()
'hitung total Nominal Penjualan
cmdtxt = "SELECT H.TOTALBERSIH FROM HORDER AS H WHERE COMPLETED=True AND KEEPRECORD=True"
If lblTodayOrMonth.Text.ToLower = "today" Then
cmdtxt &= " AND DAY(H.TANGGAL)=" & Date.Now.Day & " AND MONTH(H.TANGGAL)=" & Date.Now.Month & " AND YEAR(H.TANGGAL)=" & Date.Now.Year
ElseIf lblTodayOrMonth.Text.ToLower = "month" Then
cmdtxt &= " AND MONTH(H.TANGGAL)=" & Date.Now.Month & " AND YEAR(H.TANGGAL)=" & Date.Now.Year
ElseIf lblTodayOrMonth.Text.ToLower = "custom" Then
cmdtxt &= " AND DATEVALUE('" & PeriodeAwal.Month & "-" & PeriodeAwal.Day & "-" & PeriodeAwal.Year & "')<=H.TANGGAL AND H.TANGGAL<=DATEVALUE('" & PeriodeAkhir.AddDays(1).Month & "-" & PeriodeAkhir.AddDays(1).Day & "-" & PeriodeAkhir.AddDays(1).Year & "')"
End If
cmd = New OleDbCommand(cmdtxt, conn)
reader = cmd.ExecuteReader
While reader.Read
TotalNominal += reader.GetValue(0)
End While
reader.Close()
Dim trptTotal As DataTable = ds.Tables.Add("TotalMenuSold")
Dim rrptTotal As DataRow
trptTotal.Columns.Add("IDHORDER", Type.GetType("System.Int32"))
trptTotal.Columns.Add("IDMENU", Type.GetType("System.Int32"))
trptTotal.Columns.Add("NAMAMENU", Type.GetType("System.String"))
trptTotal.Columns.Add("HARGAJUAL", Type.GetType("System.Decimal"))
trptTotal.Columns.Add("TANGGAL", Type.GetType("System.String"))
trptTotal.Columns.Add("QTY", Type.GetType("System.Int32"))
trptTotal.Columns.Add("SUBTOTAL", Type.GetType("System.Decimal"))
trptTotal.Columns.Add("TOTALDISKONMEMBER", Type.GetType("System.Decimal"))
trptTotal.Columns.Add("TOTALDISKONEXTRA", Type.GetType("System.Decimal"))
trptTotal.Columns.Add("TOTALPAJAK", Type.GetType("System.Decimal"))
'ambil total diskon
Dim varTotalDiskonMember As Decimal = 0
Dim vartotalDiskonExtra As Decimal = 0
Dim vartotalPajak As Decimal = 0
cmdtxt = "SELECT SUM(DISKON) AS 'TOTALDISKONMEMBER',SUM(DISKONEXTRA) AS 'TOTALDISKONEXTRA',SUM(PAJAK) AS 'TOTALPAJAK' FROM HORDER H WHERE h.COMPLETED=True AND h.KEEPRECORD=True "
If lblTodayOrMonth.Text.ToLower = "today" Then
cmdtxt &= " AND DAY(H.TANGGAL)=" & Date.Now.Day & " AND MONTH(H.TANGGAL)=" & Date.Now.Month & " AND YEAR(H.TANGGAL)=" & Date.Now.Year
ElseIf lblTodayOrMonth.Text.ToLower = "month" Then
cmdtxt &= " AND MONTH(H.TANGGAL)=" & Date.Now.Month & " AND YEAR(H.TANGGAL)=" & Date.Now.Year
ElseIf lblTodayOrMonth.Text.ToLower = "custom" Then
cmdtxt &= " AND DATEVALUE('" & PeriodeAwal.Month & "-" & PeriodeAwal.Day & "-" & PeriodeAwal.Year & "')<=H.TANGGAL AND H.TANGGAL<=DATEVALUE('" & PeriodeAkhir.AddDays(1).Month & "-" & PeriodeAkhir.AddDays(1).Day & "-" & PeriodeAkhir.AddDays(1).Year & "')"
End If
cmd = New OleDbCommand(cmdtxt, conn)
reader = cmd.ExecuteReader
If reader.HasRows Then
reader.Read()
varTotalDiskonMember = reader.GetValue(0)
vartotalDiskonExtra = reader.GetValue(1)
vartotalPajak = reader.GetValue(2)
End If
reader.Close()
'ambil total menu terjual
cmdtxt = "SELECT m.IDMENU, m.NAMAMENU, m.HARGAJUAL, SUM(d.QTY) as 'SOLD' FROM MENU M, HORDER H, DORDER D WHERE h.COMPLETED=True AND h.KEEPRECORD=True AND M.IDMENU=D.IDMENU AND H.IDHORDER=D.IDHORDER "
If lblTodayOrMonth.Text.ToLower = "today" Then
cmdtxt &= " AND DAY(H.TANGGAL)=" & Date.Now.Day & " AND MONTH(H.TANGGAL)=" & Date.Now.Month & " AND YEAR(H.TANGGAL)=" & Date.Now.Year
ElseIf lblTodayOrMonth.Text.ToLower = "month" Then
cmdtxt &= " AND MONTH(H.TANGGAL)=" & Date.Now.Month & " AND YEAR(H.TANGGAL)=" & Date.Now.Year
ElseIf lblTodayOrMonth.Text.ToLower = "custom" Then
cmdtxt &= " AND DATEVALUE('" & PeriodeAwal.Month & "-" & PeriodeAwal.Day & "-" & PeriodeAwal.Year & "')<=H.TANGGAL AND H.TANGGAL<=DATEVALUE('" & PeriodeAkhir.AddDays(1).Month & "-" & PeriodeAkhir.AddDays(1).Day & "-" & PeriodeAkhir.AddDays(1).Year & "')"
End If
cmdtxt &= " GROUP BY M.IDMENU,M.NAMAMENU, M.HARGAJUAL"
cmd = New OleDbCommand(cmdtxt, conn)
reader = cmd.ExecuteReader
If reader.HasRows Then
While reader.Read
rrptTotal = trptTotal.NewRow()
rrptTotal("IDHORDER") = -1
rrptTotal("IDMENU") = reader.GetValue(0)
rrptTotal("NAMAMENU") = reader.GetValue(1)
rrptTotal("HARGAJUAL") = reader.GetValue(2)
rrptTotal("QTY") = reader.GetValue(3)
rrptTotal("SUBTOTAL") = reader.GetValue(2) * reader.GetValue(3)
rrptTotal("TOTALDISKONMEMBER") = varTotalDiskonMember
rrptTotal("TOTALDISKONEXTRA") = vartotalDiskonExtra
rrptTotal("TOTALPAJAK") = vartotalPajak
trptTotal.Rows.Add(rrptTotal)
End While
End If
reader.Close()
Dim rptTotal As New crTotalMenuSold
rptTotal.Subreports(0).SetDataSource(ds.Tables(0)) ' define table data for sub report
rptTotal.SetDataSource(ds.Tables(1))
'Isi total porsi terjual per periode laporan
Dim crParamDefinitions As ParameterFieldDefinitions
Dim paramDefinition As ParameterFieldDefinition
Dim crParamValues As New ParameterValues
Dim paramFieldValue As New ParameterDiscreteValue
paramFieldValue.Value = counterJumlahPorsi
crParamDefinitions = rptTotal.Subreports(0).DataDefinition.ParameterFields
paramDefinition = crParamDefinitions.Item("TotalPorsi")
crParamValues = paramDefinition.CurrentValues
crParamValues.Clear()
crParamValues.Add(paramFieldValue)
paramDefinition.ApplyCurrentValues(crParamValues)
paramDefinition = crParamDefinitions.Item("PeriodeLaporan")
crParamValues = New ParameterValues
crParamValues = paramDefinition.CurrentValues
crParamValues.Clear()
paramFieldValue = New ParameterDiscreteValue
If lblTodayOrMonth.Text.ToLower = "today" Then
paramFieldValue.Value = "HARI INI"
ElseIf lblTodayOrMonth.Text.ToLower = "month" Then
paramFieldValue.Value = "BULAN INI"
ElseIf lblTodayOrMonth.Text.ToLower = "custom" Then
paramFieldValue.Value = PeriodeAwal.ToString("dd MMM yyyy") & " - " & PeriodeAkhir.ToString("dd MMM yyyy")
End If
crParamValues.Add(paramFieldValue)
paramDefinition.ApplyCurrentValues(crParamValues)
paramDefinition = crParamDefinitions.Item("TotalDalamRupiah")
crParamValues = New ParameterValues
crParamValues = paramDefinition.CurrentValues
crParamValues.Clear()
paramFieldValue = New ParameterDiscreteValue
paramFieldValue.Value = TotalNominal
crParamValues.Add(paramFieldValue)
paramDefinition.ApplyCurrentValues(crParamValues)
'===========================================================
'Isi total porsi terjual per periode laporan
Dim crParamDefinitionsrptTotal As ParameterFieldDefinitions
Dim paramDefinitionrptTotal As ParameterFieldDefinition
Dim crParamValuesrptTotal As ParameterValues
Dim paramFieldValuerptTotal As ParameterDiscreteValue
crParamDefinitionsrptTotal = rptTotal.DataDefinition.ParameterFields
paramDefinitionrptTotal = crParamDefinitionsrptTotal.Item("PeriodeLaporan")
crParamValuesrptTotal = New ParameterValues
crParamValuesrptTotal = paramDefinitionrptTotal.CurrentValues
crParamValuesrptTotal.Clear()
paramFieldValuerptTotal = New ParameterDiscreteValue
If lblTodayOrMonth.Text.ToLower = "today" Then
paramFieldValuerptTotal.Value = "HARI INI"
ElseIf lblTodayOrMonth.Text.ToLower = "month" Then
paramFieldValuerptTotal.Value = "BULAN INI"
ElseIf lblTodayOrMonth.Text.ToLower = "custom" Then
paramFieldValuerptTotal.Value = PeriodeAwal.ToString("dd MMM yyyy") & " - " & PeriodeAkhir.ToString("dd MMM yyyy")
End If
crParamValuesrptTotal.Add(paramFieldValuerptTotal)
paramDefinitionrptTotal.ApplyCurrentValues(crParamValuesrptTotal)
'===========================================================
rptViewer.ReportSource = rptTotal
rptViewer.Refresh()
If conn.State = ConnectionState.Open Then
conn.Close()
End If
Related
Attempted to read or write protected memory. This is often an indication that other memory is corrupt.
I got this error when I filter my datagridview by date and save it as .dat file.
Dim sv As New SaveFileDialog()
sv.FilterIndex = 2
sv.RestoreDirectory = True
sv.FileName = ""
sv.Filter = "Text Document |*.dat"
sv.Title = "Save as"
Dim mm As String = DateTimePicker1.Value.Month
Dim yy As String = DateTimePicker1.Value.Year
Dim dd As String = mm & yy
sv.FileName = "123456789" & "P" & dd
If sv.ShowDialog = DialogResult.OK Then
Dim writer As TextWriter = New System.IO.StreamWriter(sv.FileName)
writer.Write("H,P," & "123456789" & "," & "ABC CORP" & "," & "DELA CRUZ" & "," & "JUAN POGI" & "," & "MADLANGTUTA" & "," & "ABC CORP TRADENAME" & "," & "BATANGAS CITY" & "," & "BATANGAS PROVINCE" & " " & "4200" & "," & totalExempt & "," & totalZeroRated & "," & totalServices & "," & totalCapitalGoods & "," & totalGoodsOther & "," & totalInputTax & "," & Creditable & "," & totalNonCreditable & "," & "058" & "," & DateTimePicker1.Text & "," & "12")
writer.WriteLine("")
For i As Integer = 0 To DataGridView1.Rows.Count - 1 Step +1
writer.Write("D,P" & ",")
For j As Integer = 0 To 12
writer.Write(DataGridView1.Rows(i).Cells(j).Value.ToString() & ",")
Next
writer.Write("123456789" & "," & DateTimePicker1.Text)
writer.WriteLine("")
Next
writer.Close()
MsgBox("Generated Successfully", MsgBoxStyle.Information, "Transaction Complete")
End If
https://drive.google.com/file/d/18lODhowILSuyl7zKZyJ55cH9U9DvL393/view
here is the screen recording of my project
enter code here
'' this is my code for filter
Call connectDB()
Try
con.Open()
cmd = New OleDbCommand("select colDate, colSupplierTin, ColSupplierName, colLastName, colFirstName, colMiddleName, colAddress1, colAddress2, colExempt, colZeroRated,colDomesticServices,colCapitalGood, colDomesticGoods, colInputTax,colNetofvat from tblPurchases where colDate like '%" + DateTimePicker1.Text + "%'", con)
adp = New OleDbDataAdapter(cmd)
Dim table As New DataTable()
adp.Fill(table)
DataGridView1.DataSource = table
Dim src As New BindingSource
src.DataSource = DataGridView1.DataSource
DataGridView1.Columns(0).HeaderText = "DATE"
DataGridView1.Columns(0).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleCenter
DataGridView1.Columns(0).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(1).HeaderText = "SUPPLIER TIN"
DataGridView1.Columns(1).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(1).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleCenter
DataGridView1.Columns(1).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(2).HeaderText = "SUPPLIER NAME"
DataGridView1.Columns(2).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(2).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(3).HeaderCell.Value = "LAST NAME"
DataGridView1.Columns(3).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(3).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(3).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleCenter
DataGridView1.Columns(4).HeaderCell.Value = "FIRST NAME"
DataGridView1.Columns(4).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(4).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(4).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleLeft
DataGridView1.Columns(5).HeaderCell.Value = "MIDDLE NAME"
DataGridView1.Columns(5).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(5).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(5).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleLeft
DataGridView1.Columns(6).HeaderCell.Value = "BARANGAY / SUBSTREET"
DataGridView1.Columns(6).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(6).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(6).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleLeft
DataGridView1.Columns(7).HeaderCell.Value = "CITY / PROVINCE"
DataGridView1.Columns(7).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(7).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(8).HeaderCell.Value = "EXEMPT PURCHASES"
DataGridView1.Columns(8).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(8).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(9).HeaderCell.Value = "ZERO-RATED PURCHASES"
DataGridView1.Columns(9).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(9).DefaultCellStyle.Alignment = DataGridViewContentAlignment.BottomCenter
DataGridView1.Columns(9).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(10).HeaderCell.Value = "DOMESTIC SERVICES"
DataGridView1.Columns(10).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(10).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
DataGridView1.Columns(10).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(11).HeaderCell.Value = "CAPITAL GOODS"
DataGridView1.Columns(11).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(11).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
DataGridView1.Columns(11).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(12).HeaderCell.Value = "GOODS OTHER THAN CAPITAL GOODS"
DataGridView1.Columns(12).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(12).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
DataGridView1.Columns(12).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(13).HeaderCell.Value = "TOTAL INPUT TAX"
DataGridView1.Columns(13).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(13).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
DataGridView1.Columns(13).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(14).HeaderCell.Value = "TAXABLE NET OF VAT"
DataGridView1.Columns(14).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
DataGridView1.Columns(14).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
DataGridView1.Columns(14).SortMode = DataGridViewColumnSortMode.Programmatic
DataGridView1.Columns(14).DefaultCellStyle.Format = "c"
Catch ex As Exception
MsgBox(ex.Message)
End Try
Call Computation()
con.Close()
I'm currently writing a GUI for xmr-stak (www.xmrgui.com)
Having some trouble getting the output from the program and basically want to grab the last 30 lines from the output text file and append them to the RichTextBox if they don't already exist. Storing the text file in memory isn't a big issue because it will be deleted every 20 min or so...at least so I think. Maybe my function is taking up too much memory or time as it is.
My only requirement is that the Sub TimerOutput_tick can process each of the 30 last lines of text from the file to run a regex on each line and that the RichTextBox does not repeat old information.
Heres my code:
Private Function getlastlines(filename As String, numberOfLines As Integer) As Dictionary(Of Integer, String)
Try
Dim fs = File.Open(filename, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim reader As StreamReader = New StreamReader(fs)
Dim everything As New Dictionary(Of Integer, String)
Dim n As Integer = 1
While reader.Peek > -1
Dim line = reader.ReadLine()
If everything.ContainsKey(n) Then
everything(n) = line
n += 1
Else
everything.Add(n, line)
n += 1
End If
End While
Dim results As New Dictionary(Of Integer, String)
Dim z As Integer = 1
If n - numberOfLines > 0 Then
For x As Integer = n - numberOfLines To n - 1
'MsgBox(everything.Count - numberOfLines)
If results.ContainsKey(z) Then
results(z) = everything(x)
z += 1
Else
results.Add(z, everything(x))
z += 1
End If
Next
End If
Return results
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Function
' GRABS XMR-STAK OUTPUT FROM ReadLastLinesFromFile AND RUNS A REGEX ON THE HASHRATE TO PROVIDE VALUES TO THE CHART
And here is the Sub that calls the previous function:
Private Sub timeroutput_Tick(sender As Object, e As EventArgs) Handles timeroutput.Tick
'Try
Dim lateststring = getlastlines(xmroutput, 30)
Try
If lateststring IsNot rtlateststring Then
Dim kvp As KeyValuePair(Of Integer, String)
For Each kvp In lateststring
If lateststring.ContainsKey(kvp.Key) Then
Dim line = kvp.Value
RichTextBox1.AppendText(line & vbCrLf)
If line.Contains("Totals") Then ' Should be "Totals"
'Dim regex As Regex = New Regex("\d+?.\d+")
Dim regex As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim ret = regex.Match(line).Value
If ret <> "" Then
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " " & ret & " H/s"
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & ret & " H/s"
Else
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & "Initializing..."
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " Initializing..."
ret = "0.0"
End If
'Dim match As Match = regex.Match(lastline)
newhashrate = Convert.ToDouble(ret)
ElseIf line.Contains("NVIDIA") Then
Dim regexnv As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retnv = regexnv.Match(line).Value
newNVhashRate = Convert.ToDouble(retnv)
If firstNV = False Then
newser.Add(nvidiacard1)
nvidiacard1.Title = "NIVIDIA Hashrate(H/s)"
nvidiacard1.Values = nvidiavalues
nvidiavalues.add(0)
nvidiavalues.add(4)
nvidiavalues.add(2)
nvidiavalues.add(5)
firstNV = True
End If
ElseIf line.Contains("AMD") Then
Dim regexAMD As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retAMD = regexAMD.Match(line).Value
newAMDhashrate = Convert.ToDouble(retAMD)
If firstAMD = False Then
newser.Add(AMDCard1)
AMDCard1.Title = "AMD Hashrate(H/s)"
AMDCard1.Values = AMDValues
AMDValues.add(0)
AMDValues.add(4)
AMDValues.add(2)
AMDValues.add(5)
firstAMD = True
End If
End If
' Now if a GPU exists, add a new lineseries for CPU
If firstAMD = True Or firstNV = True Then
If firstCPU = False Then
newser.Add(CPU1)
CPU1.Title = "CPU Hashrate(H/s)"
CPU1.Values = CPUValues
CPUValues.add(0)
CPUValues.add(4)
CPUValues.add(2)
CPUValues.add(5)
firstCPU = True
End If
newCPUhashrate = newhashrate - newNVhashRate - newAMDhashrate
End If
rtlateststring = lateststring
End If
Next
RichTextBox1.SelectionStart = RichTextBox1.Text.Length
End If
Catch
End Try
End Sub
I've found a much easier solution, running the code within one function and then loading the entire text file into the richtextbox. From there its much easier to read the last ten lines individually:
Private Sub timeroutput_Tick(sender As Object, e As EventArgs) Handles timeroutput.Tick
Try
'Dim lateststring = getlastlines(xmroutput, 30)
' START NEW TEST
Dim fs = File.Open(xmroutput, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim reader As StreamReader = New StreamReader(fs)
Dim wholefile = reader.ReadToEnd
RichTextBox1.Text = wholefile
RichTextBox1.SelectionStart = RichTextBox1.Text.Length
For x As Integer = 1 To 10
Dim line As String = RichTextBox1.Lines(RichTextBox1.Lines.Length - x)
If line.Contains("Totals") Then ' Should be "Totals"
'Dim regex As Regex = New Regex("\d+?.\d+")
Dim regex As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim ret = regex.Match(line).Value
If ret <> "" Then
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " " & ret & " H/s"
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & ret & " H/s"
Else
Dim iSpan As TimeSpan = TimeSpan.FromSeconds(upseconds)
NotifyIcon1.Text = "Uptime - Hours: " & iSpan.Hours & vbCrLf & " Minutes: " & iSpan.Minutes & vbCrLf & " Seconds: " & iSpan.Seconds & vbCrLf & "Initializing..."
Label8.Text = "Uptime - Hours: " & iSpan.Hours & " Minutes: " & iSpan.Minutes & " Seconds: " & iSpan.Seconds & " Initializing..."
ret = "0.0"
End If
'Dim match As Match = regex.Match(lastline)
newhashrate = Convert.ToDouble(ret)
ElseIf line.Contains("NVIDIA") Then
Dim regexnv As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retnv = regexnv.Match(line).Value
newNVhashRate = Convert.ToDouble(retnv)
If firstNV = False Then
newser.Add(nvidiacard1)
nvidiacard1.Title = "NIVIDIA Hashrate(H/s)"
nvidiacard1.Values = nvidiavalues
For Each z In Chartvalues
Chartvalues.remove(z)
Next
nvidiavalues.add(0)
firstNV = True
End If
ElseIf line.Contains("AMD") Then
Dim regexAMD As Regex = New Regex("\d{1,5}\.\d{1,1}") ' match a double
Dim retAMD = regexAMD.Match(line).Value
newAMDhashrate = Convert.ToDouble(retAMD)
If firstAMD = False Then
newser.Add(AMDCard1)
AMDCard1.Title = "AMD Hashrate(H/s)"
AMDCard1.Values = AMDValues
For Each z In Chartvalues
Chartvalues.remove(z)
Next
AMDValues.add(0)
firstAMD = True
End If
End If
' Now if a GPU exists, add a new lineseries for CPU
If firstAMD = True Or firstNV = True Then
If firstCPU = False Then
newser.Add(CPU1)
CPU1.Title = "CPU Hashrate(H/s)"
CPU1.Values = CPUValues
For Each z In Chartvalues
Chartvalues.remove(z)
Next
CPUValues.add(0)
Chartvalues.add(0)
firstCPU = True
End If
newCPUhashrate = newhashrate - newNVhashRate - newAMDhashrate
End If
Next
Catch
End Try
' END NEW TEST
End Sub
When I try to run the program, an error shows " ERROR[07002][Microsoft][ODBC MICROSOFT ACCESS DRIVER] TOO FEW PARAMETERS.EXPECTED 1" USING THIS CONNECTION.
Public Sub open_connection ()
Try
con = New OdbcConnection("dsn = LocalDB")
con.Open()
End try
Catch ex As Exception
MsgBox(ex.message)
End sub
Problems occurs when inserting and reading..
sSql = "select * from Faculty where RFID='" & txtrfid.Text & "'"
Dim cmd As New OdbcCommand(sSql, con)
Dim dr As OdbcDataReader = cmd.ExecuteReader()
If dr.HasRows Then
dr.Read()
txtfname.Text = dr("fname").ToString()
txtlname.Text = dr("lname").ToString()
txtid.Text = dr("STID").ToString()
txtposition.Text = dr("Pstion").ToString()
txtsubject.Text = dr("Subject").ToString()
Dim bits As Byte() = CType(dr("Pfile"), Byte())
Dim memo As New MemoryStream(bits)
Dim myimg As New Bitmap(memo)
imgRetrieve.Image = myimg
dr.Close()
sSql = " SELECT TOP 1 flag_inout FROM Attendance where faculty_id = #StId ORDER BY Attendance_id DESC"
Dim pcmd As New OdbcCommand(sSql, con)
pcmd.Parameters.AddWithValue("#StId", txtid.Text)
Dim pdr As OdbcDataReader = pcmd.ExecuteReader()
While pdr.Read()
TextBox1.Text = pdr("flag_inout").ToString()
End While
If TextBox1.Text = "IN" Then
TextBox1.Text = "OUT"
ElseIf TextBox1.Text = "OUT" Then
TextBox1.Text = "IN"
ElseIf TextBox1.Text = Nothing Then
TextBox1.Text = "IN"
End If
pdr.Close()
'Check Duplicate
'If txtfname.Text.Length = 0 Then
' Return
'End If
'If Not CheckDateDuplicate() Then
' MessageBox.Show("Already Saved on this Date")
' Return
'End If
sSql = "insert into Attendance (faculty_id, faculty_Fname,faculty_Lname,[Position],Subject, attendance_date, attendance_time, flag_inout) values('" & txtid.Text & "','" & txtfname.Text & "','" & txtlname.Text & "','" & txtposition.Text & "','" & txtsubject.Text & "','" & DateTimePicker1.Value.Date & "','" & TimeOfDay.ToShortTimeString & "','" & TextBox1.Text & "')"
Dim xcmd As New OdbcCommand(sSql, con)
If xcmd.ExecuteNonQuery() > 0 Then
'MessageBox.Show("ATTENDANCE SAVED")
txtrfid.Text = ""
'txtid.Text = ""
'txtfname.Text = ""
'txtlname.Text = ""
'txtposition.Text = ""
'txtsubject.Text = ""
txtrfid.Focus()
Dtagrid()
End If
If TextBox1.Text = "IN" Then
lblinuse.Visible = True
lblvacant.Visible = False
lbllstuser.Visible = False
lblcrrntuser.Visible = True
ElseIf TextBox1.Text = "OUT" Then
lblinuse.Visible = False
lblvacant.Visible = True
lbllstuser.Visible = True
lblcrrntuser.Visible = False
'txtid.Text = ""
'txtfname.Text = ""
'txtlname.Text = ""
'txtposition.Text = ""
'txtsubject.Text = ""
'imgRetrieve.Image = Nothing
End If
End If
Dtagrid()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
CAUSE
This error occurs only with Microsoft Access when one of the column
names specified in a select statement does not exist in the table
being queried.
Resolution
Remove any invalid column names from the select statement.
Make sure that Column Name RFID exist in Faculty table and also check txtrfid has value or not
Dim cmd As OdbcCommand = New OdbcCommand("SELECT distinct checktime,format(CHECKTIME,'Short Date') as adlaws, format(CHECKTIME,'ampm') as formatz,checktype " & _
"from CHECKINOUT where userid=" & Label6.Text & " and checktime between #" & FormatDateTime(DateTimePicker1.Value, DateFormat.ShortDate) & _
"# and #" & FormatDateTime(DateTimePicker2.Value, DateFormat.ShortDate) & "#", con)
Try
Dim dr As OdbcDataReader
ListView1.Items.Clear()
dr = cmd.ExecuteReader
MsgBox(i & " " & adlawan)
Do While dr.Read()
Dim Str1 As String = dr.Item("adlaws").ToString
Dim Str2 As String = dr.Item("formatz").ToString
Dim Str3 As String = dr.Item("checktype").ToString
sLog = FormatDateTime(dr.Item("CHECKTIME").ToString, DateFormat.ShortDate)
sTime = FormatDateTime(dr.Item("CHECKTIME").ToString, DateFormat.ShortTime)
adlawan = Val(Mid(sLog, 3, 2))
' MsgBox(i & " " & adlawan)
' If adlawan = i Then
'lv = ListView1.Items.Add(adlawan)
Select Case Str3
Case "I"
If Val(Mid(sTime, 1, 2)) > 3 And Val(Mid(sTime, 1, 2)) < 10 Then
lv = ListView1.Items.Add(adlawan)
a = FormatDateTime(dr.Item("CHECKTIME").ToString, DateFormat.ShortTime)
lv.SubItems.Add(a)
Else
d = FormatDateTime(dr.Item("CHECKTIME").ToString, DateFormat.ShortTime)
lv.SubItems.Add(d)
End If
Case "O"
If Val(Mid(sTime, 1, 2)) > 10 And Val(Mid(sTime, 1, 2)) < 17 Then
b = FormatDateTime(dr.Item("CHECKTIME").ToString, DateFormat.ShortTime)
lv.SubItems.Add(b)
Else
c = FormatDateTime(dr.Item("CHECKTIME").ToString, DateFormat.ShortTime)
lv.SubItems.Add(c)
End If
End Select
adlawan = adlawan + 1
Loop
con.Close()
Catch oe As OdbcException
MsgBox(oe.Message)
End Try
i have the following code to fill two comboboxes using one dataset:
Private Sub sub_cbo_type_load()
Dim ds As New DataSet
ds = cls.cbo_type()
If ds IsNot Nothing _
AndAlso ds.Tables.Count > 0 _
AndAlso ds.Tables(0).Rows.Count > 0 Then
Me.r_cbo_type.DataSource = ds.Tables(0)
Me.r_cbo_type.DisplayMember = "desc"
Me.r_cbo_type.ValueMember = "code"
Me.r_cbo_type.SelectedIndex = -1
Me.m_cbo_type.DataSource = ds.Tables(0)
Me.m_cbo_type.DisplayMember = "desc"
Me.m_cbo_type.ValueMember = "code"
Me.m_cbo_type.SelectedIndex = -1
End If
End Sub
the problems is: whenever the index is changed in one combobox, it's automatically changed in the other one too.
does anyone know how can i solve this?
thanks for your time.
Try cloning the tables:
Private Function CopyTable(ByVal sourceTable As DataTable) As DataTable
Dim newTable As DataTable = sourceTable.Clone
For Each row As DataRow In sourceTable.Rows
newTable.ImportRow(row)
Next
Return newTable
End Function
Then your data sources would be referencing different sources:
Me.r_cbo_type.DataSource = CopyTable(ds.Tables(0))
Me.m_cbo_type.DataSource = CopyTable(ds.Tables(0))
do like this
Private Sub btn_update1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btn_update1.Click
If MsgBox("Are you sure to update?" & "", MsgBoxStyle.YesNo, "Confirmation") = MsgBoxResult.Yes = True Then
Dim transmode As String = vbNullString
Dim byair As String = vbNullString
Dim bysea As String = vbNullString
If rb_air.Checked = True Then
transmode = "A"
byair = txt_mserial.Text '.Substring(txt_mserial.TextLength - 4, 4)
bysea = vbNullString
ElseIf rb_sea.Checked = True Then
transmode = "B"
byair = vbNullString
bysea = txt_mserial.Text '.Substring(txt_mserial.TextLength - 4, 4)
End If
Try
If con.State = ConnectionState.Closed Then con.Open()
global_command = New SqlCommand("update ytmi_finished_products set rev_ctrl_no = '" & txt_mrev.Text & "', by_air = '" & byair & "', by_sea = '" & bysea & "', transport_mode = '" & transmode & "' where REPLACE(prod_no, '-', '') +'-'+ ISNULL(CONVERT(varchar(50), prod_sx), '') + prod_lvl = '" & txt_mpart.Text & "' and cast(serial_no as numeric) = '" & txt_mserial.Text & "' and req_box_qty = '" & txt_mqty.Text & "' and remarks is null", con)
global_command.ExecuteNonQuery()
global_command.Dispose()
MsgBox("Successfully Updated!", MsgBoxStyle.Information, "Message")
mclear()
Catch ex As Exception
MsgBox("Trace No 20: System Error or Data Error!" + Chr(13) + ex.Message + Chr(13) + "Please Contact Your System Administrator!", vbInformation, "Message")
End Try
End If
End Sub