Well, I'm trying to convert various data "bytes" to "long".
And it seems to be very slow ...
Code:
For X = 0 To Map.MaxX
For Y = 0 To Map.MaxY
Map.Tile(X, Y).Data1 = Buffer.ReadLong
Map.Tile(X, Y).Data2 = Buffer.ReadLong
Map.Tile(X, Y).Data3 = Buffer.ReadLong
Map.Tile(X, Y).DirBlock = Buffer.ReadLong
ReDim Map.Tile(X, Y).Layer(0 To MapLayer.Layer_Count - 1)
For i = 0 To MapLayer.Layer_Count - 1
Map.Tile(X, Y).Layer(i).tileset = Buffer.ReadLong
Map.Tile(X, Y).Layer(i).X = Buffer.ReadLong
Map.Tile(X, Y).Layer(i).Y = Buffer.ReadLong
Next
Map.Tile(X, Y).Type = Buffer.ReadLong
Next
Next
Converter:
Public Function ReadLong(Optional ByVal peek As Boolean = True) As Long
If Buff.Count > readpos Then 'check to see if this passes the byte count
Dim ret As Long = BitConverter.ToInt64(Buff.ToArray, readpos)
If peek And Buff.Count > readpos Then
readpos += 8
End If
Return ret
Else
Throw New Exception("Byte Buffer Past Limit!") 'past byte count throw a new exception
End If
End Function
Anyone have tips or a solution?
One problem I can see is that you are calling buff.ToArray each time you read a long value. The ToArray method will make a copy of the buffer each time. You should call ToArray before you start processing the map and use the array instance when calling the BitConverter.ToInt64 method.
Related
so I am creating a piece of software that in short, has a list of original byte sequences and new sequences that those bytes need to be changed into, kinda like this in text form "original location(currently irrelevant as sequence can be in different places) $ 56,69,71,73,75,77 : 56,69,71,80,50,54"
I already have code that works fine, however there can be up to 600+ of these sequences to find and change and in some cases it is taking a really really long time 15 mins +, i think it is down to how long it is taking to find the sequences to them change so i am trying to find a better way to do this as currently it is unusable due to how long it takes.
I have copied the whole code for this function below in hopes one of you kind souls can have a look and help =)
Dim originalbytes() As Byte
Dim fd As OpenFileDialog = New OpenFileDialog()
fd.Title = "Select the file"
fd.Filter = "All files (*.*)|*.*|All files (*.*)|*.*"
fd.FilterIndex = 2
If fd.ShowDialog() = DialogResult.OK Then
TextBox2.Text = fd.FileName
originalbytes = File.ReadAllBytes(fd.FileName)
End If
Dim x As Integer = 0
Dim y As Integer = 0
Dim textbox1array() = TextBox1.Lines
Dim changedbytes() = originalbytes
Dim startvalue As Integer = 0
Dim databoxarray() As String
Dim databoxarray2() As String
While x < textbox1array.Length - 1
'for each change to make
databoxarray = textbox1array(x).Replace(" $ ", vbCr).Replace(" : ", vbCr).Split
databoxarray2 = databoxarray(1).Replace(",", vbCr).Split
Dim databox2bytes() As String = databoxarray2
'copy original bytes line to databox2 lines
y = 0
While y < (originalbytes.Length - databox2bytes.Length)
'repeat for all bytes in ori file - size of data to find
If originalbytes(y) = databox2bytes(0) Then
startvalue = y
Dim z As String = 1
Dim samebytecounter As Integer = 1
While z < databox2bytes.Length
'repeat for all ori bytes
If originalbytes(y + z) = databox2bytes(z) Then
samebytecounter = samebytecounter + 1
End If
z = z + 1
End While
If samebytecounter = databox2bytes.Length Then
'same original data found, make changes
Dim bytestoinsert() As String = databoxarray(2).Replace(",", vbCr).Split
Dim t As Integer = 0
While t < bytestoinsert.Length
changedbytes(startvalue + t) = bytestoinsert(t)
t = t + 1
End While
End If
End If
y = y + 1
End While
x = x + 1
End While
File.WriteAllBytes(TextBox2.Text & " modified", changedbytes)
Let 's take a look at that inner while loop in your code, there are some things that can be optimized:
There is no need to check the total length all the time
Dim length as Integer = originalbytes.Length - databox2bytes.Length
While y < length
'repeat for all bytes in ori file - size of data to find
If originalbytes(y) = databox2bytes(0) Then
startvalue = y
z is not necessary, samebytecounter does exactly the same
Dim samebytecounter As Integer = 1
This while loop is a real bottleneck, since you always check the full length of your databox2bytes, you should rather quit the while loop when they don't match
While samebytecounter < databox2bytes.Length AndAlso originalbytes(y + samebytecounter ) = databox2bytes(samebytecounter )
samebytecounter = samebytecounter + 1
End While
This seems fine, but you already splitted the data at the top of your while loop, so, no need to create another array that does the same operation again
If samebytecounter = databox2bytes.Length Then
'same original data found, make changes
Dim t As Integer = 0
While t < databoxarray2.Length
changedbytes(startvalue + t) = databoxarray2(t)
t = t + 1
End While
End If
End If
y = y + 1
End While
For the rest I would agree that the algorithm you created is hugely inefficient, theoretically your code could have been rewritten like eg: (didn't really test this code)
Dim text = System.Text.Encoding.UTF8.GetString(originalbytes, 0, originalbytes.Length)
dim findText = System.Text.Encoding.UTF8.GetString(stringToFind, 0, stringToFind.Length)
dim replaceWith = System.Text.Encoding.UTF8.GetString(stringToSet, 0, stringToSet.Length)
text = text.Replace( findText, replaceWith )
dim outbytes = System.Text.Encoding.UTF8.GetBytes(text)
which would probably be a huge time saver.
For the rest your code seems to be created in such a way that nobody will really understand it if it's laying around for a month or so, I would say, including yourself
I am using vb.net , .NetFramework 2.0 .
My application gets live stock prices from google and updates stocks in database each 10 seconds.
I get this code for multithreading. When application starts updating stocks in database(about 200 stocks) , the update takes up to 3 seconds but it increase CPU usage from 10 % to 70 % or 80 %.
What is the best way to to update database without getting CPU increase to high level?
I observed that all threads works at the same time. how to make each thread wait until the second ends?
This is my code. The problem is in function updateThreaded2().
Please I need quick help. Thanks
Public Function Update2(ByVal l As SortableBindingList(Of NewStockList)) As Long
res = 0
UThread = New System.Threading.Thread(AddressOf UpdateThreaded2)
If Me.URunning = True Then
Else
Try
Me.URunning = True
Interlocked.Exchange(Me.UCount, 0) 'threadsafe method of assigning static value
Interlocked.Exchange(Me.UDone, 0) 'threadsafe method of assigning static value
UThread.Priority = Threading.ThreadPriority.BelowNormal
UThread.IsBackground = True
UThread.Start(l)
Return 0
Catch ex As Exception
End Try
End If
End Function
Private Sub UpdateThreaded2(ByVal l As SortableBindingList(Of NewStockList))
Dim i As Integer = 0
Dim threadcount As Integer = Math.Min(Me.MaxThreads, Me.Stocks.Count)
Dim threads(threadcount - 1) As SUTC
Try
While i < Me.Stocks.Count
For j As Integer = 0 To threadcount - 1
If threads(j) Is Nothing Then
If i < Me.Stocks.Count Then
threads(j) = New SUTC(Me.Stocks(i), Me.DefaultService, AdjustSplits, Use20Minutes, l)
threads(j).Thread.Priority = Threading.ThreadPriority.BelowNormal
threads(j).Thread.IsBackground = True
threads(j).Thread.Start()
i += 1
End If
ElseIf threads(j).UpdateState = 0 Then
If i < Me.Stocks.Count Then
SecUpd(j) = Me.Stocks(i).symbol
threads(j) = New SUTC(Me.Stocks(i), Me.DefaultService, AdjustSplits, Use20Minutes, l)
threads(j).Thread.Priority = Threading.ThreadPriority.BelowNormal
threads(j).Thread.IsBackground = True
threads(j).Thread.Start()
i += 1
End If
End If
Next
Dim running As Boolean = True
While running
For j As Integer = 0 To threadcount - 1
If threads(j).UpdateState = 0 Then
Thread.Sleep(10)
running = False
SecUpd(j) = ""
Interlocked.Increment(UDone) 'threadsafe method of incrementing a variable by 1
Interlocked.Exchange(UCount, UCount + threads(j).UpdateCount) 'Threadsafe method for assigning a value
End If
Next
End While
End While
Dim pending As Integer = threadcount
Dim tempcount As Integer = 0
Dim oldcount As Integer = UCount
While pending > 0
pending = threadcount
tempcount = 0
For i = 0 To threadcount - 1
If threads(i).UpdateState = 0 Then
SecUpd(i) = ""
pending -= 1
tempcount += threads(i).UpdateCount
Thread.Sleep(10)
End If
Next
Interlocked.Exchange(UDone, Me.Stocks.Count - pending) 'Threadsafe method for assigning a value
Interlocked.Exchange(UCount, oldcount + tempcount) 'Threadsafe method for assigning a value
End While
Me.URunning = False
Catch ex As System.Threading.ThreadAbortException 'handle abort correctly
Dim pending As Integer = threadcount
Dim tempcount As Integer = 0
Dim oldcount As Integer = UCount
While pending > 0
pending = threadcount
tempcount = 0
For i = 0 To threadcount - 1
If threads(i).UpdateState = 0 Then
SecUpd(i) = ""
pending -= 1
tempcount += threads(i).UpdateCount
End If
Next
Interlocked.Exchange(UDone, Me.Stocks.Count - pending) 'Threadsafe method for assigning a value
Interlocked.Exchange(UCount, oldcount + tempcount) 'Threadsafe method for assigning a value
End While
End Try
End Sub
This is fantastically simplified, but threads by their nature will run at the same time (if possible and depending to some extent on the whim of the OS). If you want less going on simultaneously, use fewer threads. In your case, since you want the jobs done sequentially, you really only want one thread.
The best approach, as mentioned, is to create a background worker that runs on a single background thread. There's usually a queue to which you submit jobs in a thread-safe way from the foreground thread. The thread proc typically runs in an infinite loop, processing each job in the queue, and going to sleep waiting for new jobs when there are none.
My code works on my 64-bit machine but I encounter the following error (occasionally the code works fine however) when running it on a 32-bit machine:
InvalidCastException was unhandled
The next few lines provide my code:
To write to the binary file:
Dim writeStream = New FileStream(path, FileMode.Open)
Dim BinReader As BinaryReader
next_byte = Len(CStr(time)) + Len("EndOfHeader") + 16 + 2
first_time = True
BinWriter = New BinaryWriter(writeStream)
For i = 0 To Form1.signals.Length - 1
If IsNothing(Form1.signals(i)) = False Then
'once for each test
BinWriter.Write(Int(Form1.signals(i).picodata.GetLength(0) - 1)) 'n for each signal in test
BinWriter.Write(Form1.signals(i).picodata(1, 0) - Form1.signals(i).picodata(0, 0)) 'timestep
BinWriter.Write(next_byte) 'position of start of test
BinWriter.Write(CStr(time))
Exit For
End If
Next
BinWriter.Write("EndOfHeader")
For i = 0 To Form1.signals.Length - 1
If IsNothing(Form1.signals(i)) = False Then
BinWriter.Write(i)
For j = 1 To Form1.signals(i).picodata.GetLength(0) - 1
BinWriter.Write(Form1.signals(i).picodata(j, 1))
Next
End If
Next
BinWriter.Close()
To read in:
Dim readstream As FileStream
Dim end_test As Integer
Dim Index As Integer
Dim BinReader As BinaryReader
Dim end_head as Boolean=false
Dim count as integer=0
selected_test=0
ReadStream = New FileStream(readFileName, FileMode.Open)
BinReader = New BinaryReader(ReadStream)
'read header
While end_head = False
Try
pos_old = ReadStream.Position
try_string = BinReader.ReadString
If try_string = "EndOfHeader" Then
Exit While
Else
ReadStream.Position = pos_old
End If
Catch ex As Exception
ReadStream.Position = pos_old
End Try
'this approach allows for flexibility
number_arr(count) = BinReader.ReadInt32
TimeStep_arr(count) = BinReader.ReadDouble
position_arr(count) = BinReader.ReadInt32
time_arr(count) = CDate(BinReader.ReadString)
count += 1
End While
'read in data
While readstream.Position <> read_stream.length
ReDim PicoData(number_arr(selected_test), 1)
Index = BinReader.ReadInt32
n = number_arr(selected_test)
For i = 1 To n
PicoData(i, 1) = BinReader.ReadDouble
PicoData(i, 0) = TimeStep_arr(selected_test) * i
Next
ReDim TimeShort(Int(n / 20))
ReDim FiltVoltsShort(Int(n / 20))
ReDim FiltVelShort(Int(n / 20))
ReDim RawVoltsShort(Int(n / 20))
'generate new reading here
Call FourierFilter(PicoData, 0)
signals(Index) = New reading(Index, TimeShort, RawVoltsShort, FiltVelShort, FiltVoltsShort, Points_Store(ii, 2), Points_Store(ii, 1), DataChart, VelocityChart, SelectedTimeBox, SelectedVelocityBox, True, PicoData)
End While
BinReader.Close()
readstream.Close()
The date occasionally is not read in correctly. I will get some character + the date I want. Parts of my code have been cut out (since the program is pretty huge) but hopefully what I have sent will make some sense. Thanks
Your first step should be to find a simple-as-possible reproducible test case where you can make it fail every time. Then it will be much easier to identify the source of the problem.
Code like this might help you narrow down how BinaryWriter encodes strings on different platforms.
Dim content As String = New String("!"c, 255)
Using outStream As New System.IO.MemoryStream()
Using bw As New System.IO.BinaryWriter(outStream)
bw.Write(content)
bw.Flush()
outStream.Flush()
Console.WriteLine("I am a " & If(Environment.Is64BitProcess, "64", "32") & _
"-bit process")
Console.WriteLine("I generated a string of {0} characters into a stream " & _
"of {1} bytes", content.Length, outStream.Length)
End Using
End Using
please examine my code below :
Public Class tier1
Dim rnd As New System.Random()
Function build1(ByVal dt As DataTable) As String
Try
For i = 0 To 4
For ix As Integer = 0 To till Step 4
lstrn.Add(rnd.Next(ix, ix + 4))
Next
Dim cntx As Integer = 0
For Each x As Integer In lstrn
If (i = 0) Then
If (article(x).Split(ChrW(10)).Length > 2) Then
If (article(x).Split(ChrW(10))(0).Length > 300) Then
first.Add(article(x).Split(ChrW(10))(0))
cntx = cntx + 1
If (cntx = 25) Then
Exit For
End If
End If
End If
End If
lstrn.Clear()
Next
Dim fi as String = "{"
For dx As Integer = 0 To first.Count - 2
fi = fi & w.spinl(first(dx), "light") & "|"
Next
fi = fi & "}"
Return fi
Catch ex As Exception
End Try
End Function
End Class
Now see my calling code :
Dim w As WaitCallback = New WaitCallback(AddressOf beginscn)
For var As Integer = 1 To NumericUpDown1.Value
Dim param(1) As Object
param(0) = lst
param(1) = var
ThreadPool.QueueUserWorkItem(w, param)
Next
sub
sub beginscn()
Dim scntxt As String = t1.buildtier1(dt)
end sub
Now understand what i give and what i want. Suppose i pass a datatable like this :
1,abcd,34,5
2,adfg,34,5
3,fhjrt,34,5
4,rtitk,34,5
What i want is {abcd|adfg|fhjrt|rtitk} and this sequence should be random everytime. Since i pass like 50-100 values and exit loop at 25 each output should have a different sequence of 25 strings in {|} format but it does not work like that. Everytime i get same sequence.
Can anyone explain why does it do like that and any possible solution for this problem?
Note : I have already tried shuffling datatable just before queuing it but still it does not work.
The random object is not thread safe. You could work around this by creating separate instances of the random object in each thread and use the thread ID to generate the
seed.
http://msdn.microsoft.com/en-us/library/ms683183%28VS.85%29.aspx
i make function that convert time string ("hh\:mm\:ss\,fff" - example:"00:00:00,100") to parts
strTime = "00:00:00,100" =
h int = 0
m int = 0
sec int = 0
millisec int = 100
The function:
Public Function ShowInLabel(ByVal TEXT As String, ByVal time As String, ByVal startTime As Boolean) As Boolean
On Error Resume Next
Dim sss As String
sss = time
Dim start As String = StrReverse(sss)
start = StrReverse(start.Substring(0, 3))
Dim s As Integer
s = Integer.Parse(start)
Dim secstart As String = StrReverse(sss).Substring(0, 6)
secstart = StrReverse(secstart)
Dim secs As Integer = Integer.Parse(secstart.Substring(0, 2))
Dim hurs As Integer = Integer.Parse(sss.Substring(0, 2))
Dim mins As Integer = Integer.Parse(StrReverse(StrReverse(sss.Substring(0, 5)).Substring(0, 2)))
Dim stopWatch As New Stopwatch()
stopWatch.Start()
noh:
If stopWatch.Elapsed.Hours = hurs Then
GoTo yesh
Else
GoTo noh
End If
yesh:
If stopWatch.Elapsed.Minutes = mins Then
GoTo yesm
Else
GoTo yesh
End If
yesm:
If stopWatch.Elapsed.Seconds = secs Then
GoTo yess
Else
GoTo yesm
End If
yess:
If stopWatch.Elapsed.Milliseconds > s Or stopWatch.Elapsed.Milliseconds = s Then
GoTo done
Else
GoTo yess
End If
done:
If startTime = False Then
Label1.Text = ""
Else
Label1.Text = TEXT
End If
Return True
End Function
example:
ShowInLabel("SubTitle", "00:00:00,100", True)
The Function Works ,
but when the function runing the application is Stucked Till the function return true
Why it happening?
All you need to do is something like this:
Dim time As Date = DateTime.ParseExact("00:01:02,123", "hh:mm:ss,fff", CultureInfo.InvariantCulture)
Dim h As Integer = time.Hour
Dim m As Integer = time.Minute
Dim sec As Integer = time.Second
Dim millisec As Integer = time.Millisecond
However, being all to familiar with what you're trying to accomplish :), I suspect what you really need is this:
Dim time As Date = DateTime.ParseExact("00:01:02,123", "hh:mm:ss,fff", CultureInfo.InvariantCulture)
Dim startTime As Date = DateTime.ParseExact("00:00:00,000", "hh:mm:ss,fff", CultureInfo.InvariantCulture)
Dim elapsed As TimeSpan = time - startTime
Dim totalMilliseconds As Integer = CType(elapsed.TotalMilliseconds, Integer)
You could, in the same way, convert the start and end times for each subtitle to total milliseconds and then compare them that way.
As others have pointed out, On Error Resume Next is only really available in VB.NET for backwards compatibility with VB6 code. You should use a Try/Catch block, instead. However, just putting a resume next above your entire method was never considered good practice, even in VB6, just as putting a try/catch block around the entire method would also be considered a bad idea.
Similarly, GoTo is just about the most terrible thing you could ever do by just about any programmer's sensibilities. You should consider other options such as loops, if/else blocks, breaking the code up into separate methods, etc., and avoid GoTo's at all costs.