VBA QueryPerformanceCounter Not Working - vba

I am trying to test the execution time differences between data types after looping through 1 million random numbers per data type (integer, double, decimal, and variant). I took this code from the Microsoft Developer website. I am using Excel 2010.
Here is the code:
Option Explicit
Sub Function1()
Module Module1
Declare Function QueryPerformanceCounter Lib "Kernel32" (ByRef X As Long) As Short
Declare Function QueryPerformanceFrequency Lib "Kernel32" (ByRef X As Long) As Short
Dim Ctr1, Ctr2, Freq As Long
Dim Acc, I As Integer
' Times 100 increment operations by using QueryPerformanceCounter.
If QueryPerformanceCounter(Ctr1) Then ' Begin timing.
For I = 1 To 100 ' Code is being timed.
Acc += 1
Next
QueryPerformanceCounter (Ctr2) ' Finish timing.
Console.WriteLine ("Start Value: " & Ctr1)
Console.WriteLine ("End Value: " & Ctr2)
QueryPerformanceFrequency (Freq)
Console.WriteLine ("QueryPerformanceCounter minimum resolution: 1/" & Freq & " seconds.")
Console.WriteLine ("100 Increment time: " & (Ctr2 - Ctr1) / Freq & " seconds.")
Else
Console.WriteLine ("High-resolution counter not supported.")
End If
'
' Keep console window open.
'
Console.WriteLine()
Console.Write ("Press ENTER to finish ... ")
Console.Read()
End Module
End Sub
Sub Function1_Int_RandNumCounter()
Dim Int_RandNum_X As Integer
Dim Int_RandNum_Y As Integer
Dim Count As Integer
For Count = 1 To Count = 1000000
Int_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Int_RandNum_Y = Rnd(Now)
Next Count
' Call Function1_Dbl_RandNumCounter
End Sub
Sub Function1_Dbl_RandNumCounter()
Dim Dbl_RandNum_X As Double, Dbl_RandNum_Y As Double, Count As Double
For Count = 1 To Count = 1000000
Dbl_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Dbl_RandNum_Y = Rnd(Now)
Next Count
Call Function1_Var_RandNumCounter
End Sub
Sub Function1_Var_RandNumCounter()
Dim Var_RandNum_X, Var_RandNum_Y, Count As Variant
For Count = 1 To Count = 1000000
Var_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Var_RandNum_Y = Rnd(Now)
Next Count
Call Function1_Dec_RandNumCounter
End Sub
Sub Function1_Dec_RandNumCounter()
Dim Count, Var_RandNum_X, dec_RandNum_X, Var_RandNum_Y, dec_RandNum_Y
dec_RandNum_X = CDec(Var_RandNum_X)
dec_RandNum_Y = CDec(Var_RandNum_Y) ' convert these vals to decimals
For Count = 1 To Count = 1000000
dec_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
dec_RandNum_Y = Rnd(Now)
Next Count
Call Function2_BarGraph
End Sub
Sub Function2_BarGraph()
' Put all of these vals in a 2D bar graph
End Sub
This code gives me errors such as:
Compile error:
Only comments may appear after End Sub, End Function, or End Property
EDIT: Here is the improved version of the code, which has no compile errors, but I'm not sure how to integrate the timer into my functions.
Option Explicit
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Private m_CounterStart As LARGE_INTEGER
Private m_CounterEnd As LARGE_INTEGER
Private m_crFrequency As Double
Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#
Private Function LI2Double(LI As LARGE_INTEGER) As Double
Dim Low As Double
Low = LI.lowpart
If Low < 0 Then
Low = Low + TWO_32
End If
LI2Double = LI.highpart * TWO_32 + Low
End Function
Private Sub Class_Initialize()
Dim PerfFrequency As LARGE_INTEGER
QueryPerformanceFrequency PerfFrequency
m_crFrequency = LI2Double(PerfFrequency)
End Sub
Public Sub StartCounter()
QueryPerformanceCounter m_CounterStart
End Sub
Property Get TimeElapsed() As Double
Dim crStart As Double
Dim crStop As Double
QueryPerformanceCounter m_CounterEnd
crStart = LI2Double(m_CounterStart)
crStop = LI2Double(m_CounterEnd)
TimeElapsed = 1000# * (crStop - crStart) / m_crFrequency
End Property
Sub Function1_Int_RandNumCounter()
Dim Int_RandNum_X As Integer
Dim Int_RandNum_Y As Integer
Dim Count As Integer
For Count = 1 To Count = 1000000
Int_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Int_RandNum_Y = Rnd(Now)
Next Count
' Call Function1_Dbl_RandNumCounter
End Sub
Sub Function1_Dbl_RandNumCounter()
Dim Dbl_RandNum_X As Double, Dbl_RandNum_Y As Double, Count As Double
For Count = 1 To Count = 1000000
Dbl_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Dbl_RandNum_Y = Rnd(Now)
Next Count
Call Function1_Var_RandNumCounter
End Sub
Sub Function1_Var_RandNumCounter()
Dim Var_RandNum_X, Var_RandNum_Y, Count As Variant
For Count = 1 To Count = 1000000
Var_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Var_RandNum_Y = Rnd(Now)
Next Count
Call Function1_Dec_RandNumCounter
End Sub
Sub Function1_Dec_RandNumCounter()
Dim Count, Var_RandNum_X, dec_RandNum_X, Var_RandNum_Y, dec_RandNum_Y
dec_RandNum_X = CDec(Var_RandNum_X)
dec_RandNum_Y = CDec(Var_RandNum_Y) ' convert these vals to decimals
For Count = 1 To Count = 1000000
dec_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
dec_RandNum_Y = Rnd(Now)
Next Count
Call Function2_BarGraph
End Sub
Sub Function2_BarGraph()
' Put all of these vals in a 2D bar graph
End Sub
EDIT: New VBA code (did I set up this function properly?)
Sub Function1_Int_RandNumCounter()
Dim Int_RandNum_X As Integer
Dim Int_RandNum_Y As Integer
Dim Count As Integer
Dim oPM As PerformanceMonitor
Dim Time_Int As Variant
Time_Int = CDec(Time_Int)
Set oPM = New PerformanceMonitor
oPM.StartCounter
For Count = 1 To Count = 1000000
Int_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Int_RandNum_Y = Rnd(Now)
Next
Time_Int = oPM.TimeElapsed
' Call Function1_Dbl_RandNumCounter
End Sub

Add a new class module to your project, call it PerformanceMonitor and paste this code from the thread I linked to in my comment into the class:
Option Explicit
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Private m_CounterStart As LARGE_INTEGER
Private m_CounterEnd As LARGE_INTEGER
Private m_crFrequency As Double
Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#
Private Function LI2Double(LI As LARGE_INTEGER) As Double
Dim Low As Double
Low = LI.lowpart
If Low < 0 Then
Low = Low + TWO_32
End If
LI2Double = LI.highpart * TWO_32 + Low
End Function
Private Sub Class_Initialize()
Dim PerfFrequency As LARGE_INTEGER
QueryPerformanceFrequency PerfFrequency
m_crFrequency = LI2Double(PerfFrequency)
End Sub
Public Sub StartCounter()
QueryPerformanceCounter m_CounterStart
End Sub
Property Get TimeElapsed() As Double
Dim crStart As Double
Dim crStop As Double
QueryPerformanceCounter m_CounterEnd
crStart = LI2Double(m_CounterStart)
crStop = LI2Double(m_CounterEnd)
TimeElapsed = 1000# * (crStop - crStart) / m_crFrequency
End Property
Now as an example of how to use it, you need to declare and create an instance of the PerformanceMonitor class, then call its StartCounter method at the start of the code you want to time, then at the end call its TimeElapsed property to see how long it took (in milliseconds). For example:
Sub foo()
Dim n As Long
Dim oPM As PerformanceMonitor
Set oPM = New PerformanceMonitor
oPM.StartCounter
For n = 1 To 100000
Debug.Print n
Next
MsgBox oPM.TimeElapsed
Set oPM = Nothing
End Sub

Related

byref argument type mismatch on microsoft word

I have tried everything related to this ByRef error, other programmers mentioned that I have to set the value type of each variable I create, other said to remove the type of those variables.
I truly need some help since it is my first day with VB.
The Main Idea Of the Code Below is to make a small form that after clicking, the line on the word document will scroll down or up smoothly, and of course he has the capability of increase/decrease the speed of this movement.
Here is the Main Functions:
Function GoDown(ByRef Speed As Integer, ByRef CounterUp As Integer, ByRef CounterDown As Integer)
CounterUp = 0
CounterDown = 1
Dim NumberOfPages As Integer
Set NumberOfPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
Dim NumberOfLines As Range
Set NumberOfLines = ActiveDocument.BuiltInDocumentProperties(wdPropertyLines)
Dim Multiplicate As Integer
Set Multiplicate = NumberOfPages * NumberOfLines
Dim Counter As Integer
Set Counter = 0
While (Counter < Multiplicate):
ActiveWindow.SmallScroll down:=1
Counter = Counter + 1
Call Application.Wait(Now + TimeValue("0:00:'&Speed&'"))
Call ActiveWindow.Close
Call Application.Quit
End Function
Function GoUp(ByRef Speed As Integer, ByRef CounterUp As Integer, ByRef CounterDown As Integer)
Dim NumberOfLines As Range
Set NumberOfLines = ActiveDocument.BuiltInDocumentProperties(wdPropertyLines)
Set CounterUp = 1
Set CounterDown = 0
Dim Counter As Integer
Set Counter = 0
While (Counter < NumberOfLines):
ActiveWindow.SmallScroll up:=1
Counter = Counter + 1
Call Application.Wait(Now + TimeValue("0:00:'&Speed&'"))
End Function
Function GoFaster(ByRef Speed As Integer, ByRef CounterUp As Integer, ByRef CounterDown As Integer)
Speed = Speed - 1
If (CounterUp > 0 & CounterDown = 0) Then
Call Application.Run("btnUp_Click")
Else: Call Application.Run("btnDown_Click")
End Function
Function GoSlower(ByRef Speed As Integer, ByRef CounterUp As Integer, ByRef CounterDown As Integer)
Speed = Speed + 1
If (CounterDown > 0 & CounterUp = 0) Then Call Application.Run("btnDown_Click")
Else: If (CounterDown = 0 & CounterUp > 0) Then Call Application.Run("btnUp_Click")
End Function
I have tried Instead of Function to put Sub, nothing happened. I also have tried the "cint" and did not succeeded.
Here is the implementation on click events:
Sub Main()
Dim Speed As Integer
Set Speed = 3
Dim CounterUp As Integer
Set CounterUp = 0
Dim CounterDown As Integer
Set CounterDown = 0
Public Sub btnDown_Click_Click()
Call GoDown(Speed as Integer, CounterUp as Integer, CounterDown)
End Sub
Public Sub btnLeft_Click_Click()
Call GoSlower(Speed, CounterUp, CounterDown)
End Sub
Public Sub btnRight_Click_Click()
Call GoFaster(Speed, CounterUp, CounterDown)
End Sub
Public Sub btnUp_Click_Click()
Call GoUp(Speed, CounterUp, CounterDown)
End Sub
End Sub
as You see that I have tried two methods have been mentioned in MSDN and here, but none has solved my "ByRef argument type mismatch".
You can call a sub like this:
GoDown Speed, CounterUp, CounterDown
or use a function:
x = GoDown(Speed, CounterUp, CounterDown)
In attached example there are subs nested in main sub. It can't work like this, any procedure triggered by clicking will need to be separated.
Instead of Integer, always use Long or you will be encountering problems with data exceeding limitation of Integer (maximum value of 32767 and minimum of -32768).
Thank you all for who tried to help me to solve my problem , and for the unpaid philosopher .
Any way .
Any time you need to use a variable for multiple events or multiple functions .
you have to :
`Public ThisVariable As String`
in the load event of the form like this :
FormName_Initialize()
{
ThisVariable = "The Starting value you want :)"
}
Thank you

VB.NET Compare each item in collection to every other item in collection - Threading

this is my first time posting so please accept my apologies if im not doing this right and please feel free to correct me for any formatting or posting guidelines. I am doing this in VB.Net with .NET Framework 4.5.2.
I have a large collection called gBoard in a class.
Private gBoard As Collection
It contains roughly 2000 instances of a class.
What i am trying to achieve is for each item in the class, i want to look at each other item in the class and then update the first item based on variables in the second.
Currently i have the following code:
In the main class:
Private gBoard As New Collection ' This is populated elsewhere in the code
Private Sub CheckSurroundings()
For i As Integer = 1 To (xBoxes)
For j As Integer = 1 To (yBoxes)
For x = 1 As Integer To (xBoxes)
For y = 1 As Integer To (yBoxes)
Tile(New Point(i, j)).CheckDistance(Tile(New Point(x, y)))
Next y
Next x
Next j
Next i
End Sub
Private Function Tile(ByVal aPoint As Point) As clsTile
Return gBoard.Item("r" & aPoint.Y & "c" & aPoint.X)
End Function
In clsTile i have the following (as well as other items):
Private Function SurroundingTerrain(ByVal aTer As String) As clsTerrain
Return mySurroundings.Item(aTer) ' a small collection (6 items of clsTerrain type)
End Function
Public Sub CheckDistance(ByRef aTile As clsTile)
SurroundingTerrain(aTile.Terrain).CheckDistance(CalcDistance(Location, aTile.Location))
End Sub
Private Function CalcDistance(ByVal myPoint As Point, ByVal aPoint As Point) As Double
Dim myReturn As Double = 0
Dim xDiff As Integer = 0
Dim yDiff As Integer = 0
Dim tDiff As Integer = 0
xDiff = Math.Abs(myPoint.X - aPoint.X)
yDiff = Math.Abs(myPoint.Y - aPoint.Y)
tDiff = xDiff + yDiff
myReturn = (MinInt(xDiff, yDiff) * 1.4) + (tDiff - MinInt(xDiff, yDiff))
Return myReturn
End Function
Private Function MinInt(ByVal a As Integer, ByVal b As Integer) As Integer
Dim myReturn As Integer = a
If b < myReturn Then
myReturn = b
End If
Return myReturn
End Function
in clsTerrain i have the following sub that is called:
Public Sub CheckDistance(ByVal aDist As Double)
If aDist < Distance Then
Distance = aDist
End If
End Sub
This runs and works file but as you can guess it runs so slow... I have been trying to work out how to make this run faster and i looked into threading/tasks but it doesnt seem to work. There are no errors but the objects don't appear to update correctly (or at all). The code i tried was:
In the main class:
Private Sub CheckSurroundings()
Dim tasks As New List(Of Task)
Dim pTile As clsTile
For Each pTile In gBoard
tasks.Add(Task.Run(Sub() TileToCheck(pTile)))
Next
Task.WaitAll(tasks.ToArray())
End Sub
Private Sub TileToCheck(ByRef aTile As clsTile)
For x As Integer = 1 To (xBoxes)
For y As Integer = 1 To (yBoxes)
aTile.CheckDistance(Tile(New Point(x, y)))
Next y
Next x
End Sub
Does anyone have any suggestions or ideas for how to get this to work?
Sorry for any headaches or facepalms caused...

DLL "'-t" gives Run-time error 424: Object Required

I am using a simple timer which tells me the time elapsed between performing the same calculation with different data types. When I run this I get the error:
Run-time error '424':
Object required
The troublesome line:
target_sheet.Range("A2").Value = -t
Here is all of my code:
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub Function1_Var_RandNumCounter()
Dim Var_RandNum_X, Var_RandNum_Y, Count As Variant
For Count = 1 To Count = 1000000
Var_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Var_RandNum_Y = Rnd(Now)
Next Count
target_sheet.Range("A2").Value = -t
' MsgBox GetTickCount - t, , "Milliseconds"
Call Function1_Dec_RandNumCounter
End Sub
Sub Function1_Dec_RandNumCounter()
Dim Count, Var_RandNum_X, dec_RandNum_X, Var_RandNum_Y, dec_RandNum_Y
dec_RandNum_X = CDec(Var_RandNum_X)
dec_RandNum_Y = CDec(Var_RandNum_Y) ' convert these vals to decimals
For Count = 1 To Count = 1000000
dec_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
dec_RandNum_Y = Rnd(Now)
Next Count
target_sheet.Range("B2").Value = -t
' MsgBox GetTickCount - t, , "Milliseconds"
Call Function1_Int_RandNumCounter
End Sub
Sub Function1_Int_RandNumCounter()
Dim Count, Int_RandNum_X, Int_RandNum_Y
For Count = 1 To Count = 1000000
Int_RandNum_X = Rnd(Now)
Int_RandNum_Y = Rnd(Now)
Next Count
target_sheet.Range("C2").Value = -t
' MsgBox GetTickCount - t, , "Milliseconds"
Call Function1_Double_RandNumCounter
End Sub
Sub Function1_Double_RandNumCounter()
Dim Count, Dbl_RandNum_X, Dbl_RandNum_Y
For Count = 1 To Count = 1000000
Dbl_RandNum_X = Rnd(Now)
Int_RandNum_Y = Rnd(Now)
Next Count
target_sheet.Range("D2").Value = -t
' MsgBox GetTickCount - t, , "Milliseconds"
End Sub
Sub Function2_BarGraph()
' Put all of these vals in a 2D bar graph
End Sub
The probably reason is that you haven't assigned anything to variable target_sheet, so it is empty and when it is empty you cannot call its methods (i.e. Range) since it causes 'Run-time error 424 - Object required'.
You need to assign some worksheet to variable target_sheet before you use it for the first time, i.e.:
Set target_sheet = ActiveSheet
target_sheet.Range("A2").Value = -t

VBA: Initialize object on first use in Module

I kept receiving Object Variable Not Set (Error 91) with the following code in PowerPoint 2013.
I did a step through with this, and it flagged it on the Set SlideCounter = New Counter line which is quite confusing.
Module - Module1:
Dim SlideCounter As Counter
Sub showNext()
If SlideCounter Is Nothing Then
Set SlideCounter = New Counter
End If
ActivePresentation.SlideShowWindow.View.GotoSlide (SlideCounter.GetSlideNumber)
End Sub
Class Module - Counter:
'You should config the following constants
Const kBeginSlide As Integer = 2
Const kEndSlide As Integer = 4
Const kEnddingSlide As Integer = 5
'You should NOT modify anything below
Dim slides As Collection
Private Sub Class_Initialize()
Dim x As Integer
For x = kBeginSlide To kEndSlide
slides.Add (x)
Next x
End Sub
Public Function GetSlideNumber()
If slides.Count = 0 Then
GetSlideNumber = kEnddingSlide
Else
Dim slideIndex As Integer
slideIndex = GetRandomInteger(1, slides.Count)
GetSlideNumber = slides.Item(slideIndex)
slides.Remove (slideIndex)
End If
End Function
Private Function GetRandomInteger(lowerBound As Integer, upperBound As Integer)
Randomize
GetRandomInteger = Int((upperBound - lowerBound + 1) * Rnd + lowerBound)
End Function

How can I go about adding a ProgressBar to this code which calculates CRC32 checksum in VB.NET?

Thanks for reading - I am using the class below to calculate the CRC32 checksum of a specified file.
My question is how would I go about reporting the progress of file completion (in %) to a progressbar on a different form. I have tried (i / count) * 100 under the New() sub but I am not having any luck, or setting the progress bar with it for that matter. Can anyone help?
Thanks in advance
Steve
Public Class CRC32
Private crc32Table() As Integer
Private Const BUFFER_SIZE As Integer = 1024
Public Function GetCrc32(ByRef stream As System.IO.Stream) As Integer
Dim crc32Result As Integer
crc32Result = &HFFFFFFFF
Dim buffer(BUFFER_SIZE) As Byte
Dim readSize As Integer = BUFFER_SIZE
Dim count As Integer = stream.Read(buffer, 0, readSize)
Dim i As Integer
Dim iLookup As Integer
Do While (count > 0)
For i = 0 To count - 1
iLookup = (crc32Result And &HFF) Xor buffer(i)
crc32Result = ((crc32Result And &HFFFFFF00) \ &H100) And &HFFFFFF
crc32Result = crc32Result Xor crc32Table(iLookup)
Next i
count = stream.Read(buffer, 0, readSize)
Loop
GetCrc32 = Not (crc32Result)
End Function
Public Sub New()
Dim dwPolynomial As Integer = &HEDB88320
Dim i As Integer, j As Integer
ReDim crc32Table(256)
Dim dwCrc As Integer
For i = 0 To 255
Form1.CRCWorker.ReportProgress((i / 255) * 100) 'Report Progress
dwCrc = i
For j = 8 To 1 Step -1
If (dwCrc And 1) Then
dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
dwCrc = dwCrc Xor dwPolynomial
Else
dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
End If
Next j
crc32Table(i) = dwCrc
Next i
'file complete
End Sub
End Class
'------------- END CRC32 CLASS--------------
'-------------- START FORM1 --------------------------
Private Sub CRCWorker_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles CRCWorker.DoWork
For i = CurrentInt To dgv.Rows.Count - 1
CRCWorker.ReportProgress(0, i & "/" & Total_Files)
Current_File_Num = (i + 1)
SetControlText(lblCurrentFile, Str(Current_File_Num) & "/" & Total_Files)
result = CheckFile(SFV_Parent_Directory & "\" & dgv.Rows(i).Cells(0).Value, dgv.Rows(i).Cells(1).Value)
Select Case result
Case 0 ' missing file
UpdateRow(i, 2, "MISSING")
'dgv.Rows(i).Cells(2).Value = "MISSING"
Missing_Files = Missing_Files + 1
SetControlText(lblMissingFiles, Str(Missing_Files))
Case 1 ' crc match
UpdateRow(i, 2, "OK")
' dgv.Rows(i).Cells(2).Value = "OK"
Good_Files = Good_Files + 1
SetControlText(lblGoodFiles, Str(Good_Files))
Case 2 'crc bad
UpdateRow(i, 2, "BAD")
' dgv.Rows(i).Cells(2).Value = "BAD"
Bad_Files = Bad_Files + 1
SetControlText(lblBadFiles, Str(Bad_Files))
End Select
If CRCWorker.CancellationPending = True Then
e.Cancel = True
Exit Sub
End If
Next
End Sub
Private Sub CRCWorker_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles CRCWorker.ProgressChanged
Dim val As Integer = e.ProgressPercentage
ProgressBar2.Maximum = 100
ProgressBar2.Value = e.ProgressPercentage
Debug.Print(val)
End Sub
Function CheckFile(ByVal tocheck_filepath As String, ByVal expected_crc As String) As Integer 'returns result of a file check 0 = missing 1 = good 2 = bad
If File.Exists(tocheck_filepath) = False Then
Return 0 'return file missing
End If
Dim f As FileStream = New FileStream(tocheck_filepath, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
Dim c As New CRC32()
crc = c.GetCrc32(f)
Dim crcResult As String = "00000000"
crcResult = String.Format("{0:X8}", crc)
f.Close()
End Function
It appears your .ReportProgress() call is in the New() subroutine, which is the part that makes the lookup table for the CRC calculation. The New() subroutine is called once, before the main CRC routine. The main CRC routine is the one that takes up all the time and needs the progress bar.
Shouldn't the progress bar updating be in the GetCrc32() function? Something like this:
Public Function GetCrc32(ByRef stream As System.IO.Stream, _
Optional prbr As ProgressBar = Nothing) As UInteger
Dim crc As UInteger = Not CUInt(0)
Dim buffer(BUFFER_SIZE) As Byte
Dim readSize As Integer = BUFFER_SIZE
Dim left As Long = stream.Length
If Not (prbr Is Nothing) Then ' ProgressBar setup for counting down amount left.
prbr.Maximum = 100
prbr.Minimum = 0
prbr.Value = 100
End If
Dim count As Integer : Do
count = stream.Read(buffer, 0, readSize)
For i As Integer = 0 To count - 1
crc = (crc >> 8) Xor tbl((crc And 255) Xor buffer(i))
Next
If Not (prbr Is Nothing) Then ' ProgressBar updated here
left -= count
prbr.Value = CInt(left * 100 \ stream.Length)
prbr.Refresh()
End If
Loop While count > 0
Return Not crc
End Function
In Windows Forms BackgroundWorker Class is often used to run intensive tasks in another thread and update progress bar without blocking the interface.
Example of using BackgroundWorker in VB.Net
The problem is when you use use the form in your code without instantiating it Form1.CRCWorker.ReportProgress((i / 255) * 100) there is a kind of hidden "auto-instantiation" happening and new instance of Form1 is created each time.