how to solve system.OutOfMemoryException error in vb.net? - json

i am totally stuck with this error, please do help me..
i create a json file, user can select from start date to end date..
so button1 function as to generate the file..
the program goes well until i select a larger data to generate.. then this memory error comes out.. Here is my code:
Using writer As JsonWriter = New JsonTextWriter(sw)
writer.Formatting = Formatting.Indented
With writer
.WriteStartObject()
.WritePropertyName("LiveValue")
.WriteStartArray()
Do
liveValue.Time_Stamp = u
liveValue.Current = Generator.Next(MyMin_Current, MyMax_Current + 1)
liveValue.Voltage = Generator.Next(MyMin_Voltage, MyMax_Voltage + 1)
liveValue.Power = liveValue.Current * liveValue.Voltage
.WriteStartObject()
.WritePropertyName("ID")
.WriteValue(i)
.WritePropertyName("TimeStamp")
.WriteValue(liveValue.Time_Stamp)
.WritePropertyName("MotorID")
.WriteValue(liveValue.MotorID)
.WritePropertyName("Current")
.WriteValue(liveValue.Current)
.WritePropertyName("Voltage")
.WriteValue(liveValue.Voltage)
.WritePropertyName("Power")
.WriteValue(liveValue.Power)
.WriteEndObject()
i = i + 1
If liveValue.MotorID < 20 Then
liveValue.MotorID = liveValue.MotorID + 1
Else
liveValue.MotorID = 1
End If
'If endTime > startTime Then
' liveV.Time_Stamp = u.AddMinutes(+1)
'Else
' liveV.Time_Stamp = endTime
'End If
'(Time Stamp) Time changed every 7secs
If i = w Then
u = u.AddMinutes(+1)
w = w + 20
End If
Loop Until (liveValue.Time_Stamp = endTime)
.WriteEndArray()
.WriteEnd()
End With
file1.WriteLine(sb.ToString)
pBar.Style = ProgressBarStyle.Continuous
End Using
please do help me to solve it..Thank you

Related

Pulling data in a for loop where data sometimes does not exist

Let's say I have four data values and one of them exists sometimes.
My For loop crashes because the path doesn't exist.
I would like to pass a "" in the cell instead of crashing.
myJSON.data[i].bank[0].money <- this part is my problem, because the bank[0].money sometimes doesn't exist.
I would like to keep the cell empty.
I tried an If but I didn't get it formatted properly, same goes for error handling.
Sub DATA()
Set RDict = CreateObject("Scripting.Dictionary")
Set dlist = CreateObject("Scripting.Dictionary")
JSON_String = Form.fromURL("exampleurl")
With CreateObject("htmlfile")
With .parentWindow
.execScript "var myJSON = " & JSON_String & ", csvstring = '';for (i = 0; i < myJSON.data.length; i++) {csvstring += myJSON.data[i].name + ',' + myJSON.data[i].bank[0].money + ',' + myJSON.data[i].location + ',' + myJSON.data[i].planneddate + ';';};"
RData = Split(.csvstring, ";")
End With
End With
For i = 0 To UBound(RData) - 1
DaData = Split(RData(i), ",")
If DaData(0) <> "null" Then RDict(DaData(0)) = DaData
Next i
Dim RSheet() As Variant
If RDict.Count > 0 Then
ReDim RSheet(2 To RDict.Count + 2, 1 To 7)
i = 0
For Each D In RDict
datalist(RDict(Da)(2)) = True
For j = 0 To 6
RSheet(i + 2, j + 1) = RDict(Da)(j)
Next j
i = i + 1
Next Da
RSData.Cells(2, 1).Resize(i, 6) = RSheet
End If
End Sub
You can handle null by using optional chaining with default nullish coalescing (#3 in example).
Something like this should work
Change myJSON.data[i]?.bank[0]?.money
To myJSON.data[i]?.bank[0]?.money ?? 'Unknown'
You can do the same with your other variables (myJSON.data[i].location and myJSON.data[i].planneddate) if they have the potential to be undefined or null as well
EDIT - Use Optional IF when optional chaining is not available
If that feature is not available in HTMLDocument's javascript maybe you can use basic conditional if?
This should work for undefined object, because undefined is == null
(myJSON.data[i].bank[0].money != null ? myJSON.data[i].bank[0].money : '-')

Comparing DATE value in Python3 MySQL (mysql-connector)

for my BOT I'm using a DB to get and store some stuff. Now I wanna only output everything in the DB that is newer/after today. Thatfor I wrote this code, but it isn't working.
ts = time.gmtime()
tsy = str(ts[0])
tsm = str(ts[1])
tsd = str(ts[2])
todaysdate = tsy + '-' + tsm + '-' + tsd
selDBcmd = "SELECT UT, SJ, HW FROM `homework` WHERE DATE(UT) >= '%s';"
cur.execute(selDBcmd, (todaysdate))
msg = 'homework:\n\n'
selDBc = cur.fetchall()
await client.send_message(message.channel, selDBc)
Does anyone has got an idea why its anyway outputting all of the DB data, and not only them where the date is after todays one?
I'm not as new to python, but to this mysql-connector thing in python
SO here is the answer I found out after some more trial and error working
ts = time.gmtime()
tsy = int(ts[0])
tsm = int(ts[1])
tsd = int(ts[2])
selDBcmd = "SELECT UT, SJ, HW FROM `homework` WHERE UT >= '%s-%s-%s';"
cur.execute(selDBcmd, (tsy, tsm, tsd))

Programaticly Limiting number of rows for mysql database using VB.net

Good day I have written a function that needs to limit the number of employees that can be added to the database.
<WebMethod()>
Public Function EmployeeSubToken()
Dim cmd As New SqlCommand("Select vchSubscriptionType FROM BillingInfo", con)
Dim subtype = "vchSubscriptionType"
Dim Token
Select Case subtype
Case subtype = "Bronze"
Token = 1
Case subtype = "Silver"
Token = 2
Case subtype = "Gold"
Token = 3
Case subtype = "Platinum"
Token = 4
End Select
Dim cmd2
Select Case Token
Case Token = 1
cmd2 = New SqlCommand("SELECT * FROM Subscribers.dtEmployment Where ROWNUM <= 5 LIMIT 5")
Case Token = 2
cmd2 = New SqlCommand("SELECT * FROM Subscribers.dtEmployment Where ROWNUM <= 5 LIMIT 10")
Case Token = 3
cmd2 = New SqlCommand("SELECT * FROM Subscribers.dtEmployment Where ROWNUM <= 5 LIMIT 25")
Case Token = 4
cmd2 = New SqlCommand("SELECT * FROM Subscribers.dtEmployment")
End Select
End Function
Does anyone know how If this is the correct way of doing it? if it is not how would I accomplish this?
if you want to limit the inserts, have a function that will query your database and return a count of rows, SELECT COUNT(*) FROM dtEmployment ; then just use a simple if,
if(dtEmploymentCount < MydesiredCount) then
'Do My Insert
else
'Return your message (Maximum amount of entries reached)
end If
maybe TOP(5) your looking for.
is there any order to the rows your returning, i.e. does it matter which 5 are returned?

Chart Edition by access VBA very Slow

I use a Chart to Display Progress of Activity on ms-access 2007 with VBA, I used to work with PivotCharts wich was fast but not really editable. I need to only display the past months and make invisibles points for the rest of the year.
My Chart is display with 2 Series of 300 points (granularity increased), but I only show Data Labels once in a month.
I wasn't able to edit point by point with Pivot Chart so I moved to a classic oldStyle Chart.
My problem is that my edit is very slow, I've read about many things about VBA optimization but nothing done the trick
I measured 20 seconds for each curve it's not "acceptable" for my hierarchy.
I was thinking about multi-threading but it's way too much work for a so small benefit (%4? or %8?)
(FYI Calculation of points and so on is done before the opening of the Form and is doing great)
Here is my code of this Slow Chart Edition :
Dim intPntCount As Integer
Dim intTmp As Integer
Dim oSeries As Object
Dim colSeries As SeriesCollection
Dim oPnt As Object
Dim intCptSeries As Byte
Dim booPreviousZero As Boolean
Dim startDate, endDate As Date
Dim lngWhite, LngBlack As Long
lngWhite = RGB(255, 255, 255)
LngBlack = RGB(0, 0, 0)
linPlanned.BorderColor = RGB(251, 140, 60)
linCompleted.BorderColor = RGB(52, 84, 136)
lblUnit.Left = 1248 'use fctgetabsciisa chProgressFixs.Axes(2).MaximumScale / 80
With Me.chProgressFixs
startDate = Now
.BackColor = lngWhite
intCptSeries = 0
'colSeries = .SeriesCollection
For Each oSeries In .SeriesCollection
intCptSeries = intCptSeries + 1
Debug.Print "Series" & intCptSeries
booPreviousZero = True
intPntCount = 1
For Each oPnt In oSeries.Points
oPnt.ApplyDataLabels
If oPnt.DataLabel.Caption = "0" Then
oPnt.Border.Weight = 1
oPnt.DataLabel.Caption = vbNullString
If booPreviousZero = False Then
oPnt.Border.Color = lngWhite
booPreviousZero = True
Else
oPnt.Border.Color = LngBlack
End If
Else
booPreviousZero = False
oPnt.Border.Weight = 4
oPnt.DataLabel.Font.Size = 14
Select Case intCptSeries
Case 1: oPnt.Border.Color = linPlanned.BorderColor
Case 2: oPnt.Border.Color = linCompleted.BorderColor
End Select
If ((intPntCount + 30) / 30 <> Int((intPntCount + 30) / 30)) Then
If (intPntCount < oSeries.Points.Count) Then
If (intPntCount <> IntLastDispDay - 1) Then
oPnt.DataLabel.Caption = vbNullString
Else
oPnt.DataLabel.Font.Size = 20
End If
End If
End If
End If
intPntCount = intPntCount + 1
Next
Debug.Print DateDiff("s", startDate, Now)
Next
Me.TimerInterval = 1
End With
Thanks all for your help
Maybe you need to avoid screen refresh with:
Application.ScreenUpdating = False
and then
Application.ScreenUpdating = true
when finished. It also be helpful if you use \ insted of / when dividing, if you don't care about working only with integers. Try it.
Maybe you should replace:
If ((intPntCount + 30) / 30 <> Int((intPntCount + 30) / 30)) Then
with something like
If (((intPntCount + 30) MOD 30) > 0 ) Then
and measure the time of execution. Another thing about your code is that:
oPnt.DataLabel.Font.Size = 14
...maybe should be inside the if's trying to avoid rewrite the property two times. Try something like:
If (((intPntCount + 30) MOD 30) > 0 ) Then
If (intPntCount < oSeries.Points.Count) Then
If (intPntCount <> IntLastDispDay - 1) Then
oPnt.DataLabel.Caption = vbNullString
oPnt.DataLabel.Font.Size = 14
Else
oPnt.DataLabel.Font.Size = 20
End If
Else
oPnt.DataLabel.Font.Size = 14
End If
Else
oPnt.DataLabel.Font.Size = 14
End If
Even it would be a very very little improvement to precalculate
(intPntCount + 30)
in a variable after
intPntCount = intPntCount + 1
...and use something like:
dim intPntCountSum= 0
(...)
End If
intPntCount = intPntCount + 1
intPntCountSum=intPntCount + 30
Next
Finally, if you don't need the debug info, it would be a good thing to delete the lines:
Debug.Print "Series" & intCptSeries
and
Debug.Print DateDiff("s", startDate, Now)
I hope it help.

Editing data grabbed from a recordset

Is it possible to edit data that is grabbed from a recordset? In my case, I am trying to add quantities together so that I can get a total. So an example of what I am trying to do would be:
<%
set rs = server.CreateObject("ADODB.recordset")
totalqty = 0
do NOT while rs.EOF
totalqty = totalqty + rs("QTY")
loop
>%
Whenever I tried to do something like this, I would always get an 'Type MisMatch' Error and I'm not sure how to resolve this problem.
As always, any and all help would be appreciated.
Try to "cast" the value in the recordset like so:
CDbl( rs.fields("QTY").value )
This will cast the value to a double. If the value is null you will get en error so you have to check that first...
Or you can write a function to always get the correct type:
public function parse(value, alternative)
dim val
val = trim(value & "")
parse = alternative
if val = "" then exit function
on error resume next
select case varType(parse)
case 2, 3 'integer, long
parse = cLng(val)
case 4, 5 'single, double
parse = cdbl(val)
case 6 'currency
parse = ccur(val)
case 7 'date
parse = cDate(val)
case 11 'bool
parse = cBool(val)
case 8 'string
parse = value & ""
case else
on error goto 0
lib.throwError("type not supported. val:" & value & " alt:" & alternative)
end select
on error goto 0
end function
dim val : val = rs("QTY")
val = parse(val, 0)
' now val is always an integer (either the value from db or 0)
ulluoink's solution will work, but this is simpler...
function ToDbl(vIn, nDefault)
'Convert a variant to an integer using default where necessary
if isnull(vIn) then
ToDbl = nDefault
else
if IsNumeric(CStr(vIn)) Then
ToDbl = CDbl(vIn)
else
ToDbl = nDefault
end if
end if
end function
Then just call:
totalqty = totalqty + ToDbl(rs("QTY"), 0)