Greetings from Michigan,
I have a program that runs continuously (logging data) where it runs inside a While loop within one Sub ("logging data" Sub), then when the log file becomes "full", it jumps to another Sub to create a new file, then jumps back to the "logging data" Sub to continue on. Anyway, it keeps doing this and can run for hours like this, creating 100+ files or more of data. The problem is that the program crashes at some point and it always crashes within this part of the program (one of these two subs, although I haven't pinpointed which one. When I run the debugger on the machine in which the program is deployed, the Call Stack is rather large. I'm wondering if that is a problem, and how is that managed. Could that be the reason for the program crashing (Call stack getting too large?). I have gotten some sort of memory exception error on at least one of the crashes. I made some edits to the code yesterday to try and alleviate this. This last crash (this morning when I got into the office) that I experienced was a nullreference exception error, although I can't pinpoint where unless I run the program from my development machine in debug mode, which I plan to do next to catch exactly what line of code the crash is happening within either of these two Subs. I'll need to run it overnight as like I said, the program can run for hours before a crash occurs. Anyway, the question is in regards to the Call Stack. Is the large Call Stack a problem? How is that managed/cleared?
Thanks,
D
Public Sub dataAcquiring()
'Receive the collection of channels in this sub and append data to each of the channels
'Set up the channel group
Dim message1 As String = "The data file may have been deleted or moved prior to a new data file and directory being created. Check the main 'Data' directory and be sure the file exists, or simply create a new data file."
Dim testBool As Boolean = False
'Set the global variable to True if running the application from the development machine in debug mode. Otherwise, initialize it to false for deployment.
If Connectlocal = True Then
statsFile = "C:\Users\dmckin01\Desktop\Data\" & folderName & "\" & dataFileName & "_stats.csv"
Else : statsFile = "D:\Data\" & folderName & "\" & dataFileName & "_stats.csv"
End If
Try
logFile.Open()
Catch ex As Exception
MessageBox.Show(Me, ex.Message & message1, "File not found", MessageBoxButtons.OK, MessageBoxIcon.Error)
cbRecord.Checked = False
Return
End Try
Dim i As Integer = 0, n As Integer = 0, hvar As Integer, value As Single, count As Integer = 0, maxValue As Single
Dim b As Boolean = False, returnValue As Type, stringVar As String, lastValidNumber As Integer
Dim dtype As System.Type
Dim channelGroupName As String = "Main Group"
Dim channelGroup As TdmsChannelGroup = New TdmsChannelGroup(channelGroupName)
Dim channelGroups As TdmsChannelGroupCollection = logFile.GetChannelGroups()
If (channelGroups.Contains(channelGroupName)) Then
channelGroup = channelGroups(channelGroupName)
Else
channelGroups.Add(channelGroup)
End If
'Set up the TDMS channels
Dim Names As String() = New String(13) {" Spindle Speed (rpm) ", " Oil Flow (ccm) ", " Torque (Nm) ", " LVDT Displacement (mm) ", " Linear Pot Displacement (mm) ", _
" Pneu. Actuator (0=OFF, 1=ON) ", " Elec. Actuator (0=OFF, 1=ON) ", " Hydr. Actuator (0=OFF, 1=ON) ", _
" Upper Tank Oil Temp. (°F) ", " Lower Tank Oil Temp. (°F) ", " Exit Oil Temp. (°F) ", _
" Inlet Oil Temp. (°F) ", " Part Temp. (°F) ", " Time Stamp "}
Dim dataArrayNames As String() = New String(13) {"arrSpeed", "arrFlow", "arrTorque", "arrLVDT", "arrLinPot", "arrActPneu", "arrActElec", "arrActHydr", _
"arrUpperOil", "arrLowerOil", "arrExitOil", "arrInletOil", "arrTestPart", "arrTimeStamp"}
Dim OPCTagNames As String() = New String(13) {"peakTorque", "peakTorqueSpeed", "peakTorquePlatePos", "timeToPeakTorque", "firstPeakTorque", "firstPeakTorqueSpeed", _
"firstPeakTorquePlatePos", "timeToFirstPeakTorque", "peakDecel", "peakJerk", "engagementSpeed", "slidePlateSpeed", _
"timeOfEngagement", "totalEnergy"}
Dim bools As Boolean() = New Boolean(13) {recSpeed, recOilFlow, recTorque, recLVDT, recLinPot, recActPneu, recActElec, recActHydr, recUpperOil, recLowerOil, _
recExitOil, recInletOil, recTestPart, recTimeStamp}
'Instantiate the TDMS channels to be used. We have to do this each and every time this Sub is executed because National Instruments
'does not have a method to 'clear' the channel group.
Dim ch0 As TdmsChannel = New TdmsChannel(Names(0), TdmsDataType.Float) 'spindle speed
Dim ch1 As TdmsChannel = New TdmsChannel(Names(1), TdmsDataType.Float) 'oil flow
Dim ch2 As TdmsChannel = New TdmsChannel(Names(2), TdmsDataType.Float) 'torque
Dim ch3 As TdmsChannel = New TdmsChannel(Names(3), TdmsDataType.Float) 'actuator position (LVDT)
Dim ch4 As TdmsChannel = New TdmsChannel(Names(4), TdmsDataType.Float) 'actuator position (LINEAR POT)
Dim ch5 As TdmsChannel = New TdmsChannel(Names(5), TdmsDataType.Float) 'actuator state (pneu)
Dim ch6 As TdmsChannel = New TdmsChannel(Names(6), TdmsDataType.Float) 'actuator state (elec)
Dim ch7 As TdmsChannel = New TdmsChannel(Names(7), TdmsDataType.Float) 'actuator state (hydr)
Dim ch8 As TdmsChannel = New TdmsChannel(Names(8), TdmsDataType.Float) 'upper oil tank temp
Dim ch9 As TdmsChannel = New TdmsChannel(Names(9), TdmsDataType.Float) 'lower oil tank temp
Dim ch10 As TdmsChannel = New TdmsChannel(Names(10), TdmsDataType.Float) 'Exit oil tank temp
Dim ch11 As TdmsChannel = New TdmsChannel(Names(11), TdmsDataType.Float) 'Inlet oil temp
Dim ch12 As TdmsChannel = New TdmsChannel(Names(12), TdmsDataType.Float) 'Part temp
Dim ch13 As TdmsChannel = New TdmsChannel(Names(13), TdmsDataType.String) 'Time stamp
Dim Channels As TdmsChannelCollection
Dim chans As TdmsChannel() = New TdmsChannel(13) {ch0, ch1, ch2, ch3, ch4, ch5, ch6, ch7, ch8, ch9, ch10, ch11, ch12, ch13}
Channels = channelGroup.GetChannels()
ch0.UnitString = "RPM" : ch0.Description = "Rotational speed of the spindle shaft."
ch1.UnitString = "CCM" : ch1.Description = "Oil flow from the specimen pump."
ch2.UnitString = "Nm" : ch2.Description = "Torque from the torque cell."
ch3.UnitString = "mm" : ch3.Description = "Linear displacement of the linear velocity displacement transducer."
ch4.UnitString = "mm" : ch4.Description = "Linear displacement of the linear potentiometer."
ch5.UnitString = "BIT" : ch5.Description = "Binary state of the pneumatic actuator (0=OFF, 1=ON)."
ch6.UnitString = "BIT" : ch6.Description = "Binary state of the electric actuator (0=OFF, 1=ON)."
ch7.UnitString = "BIT" : ch7.Description = "Binary state of the hydraulic actuator (0=OFF, 1=ON)."
ch8.UnitString = "°F" : ch8.Description = "Upper tubular tank oil temperature."
ch9.UnitString = "°F" : ch9.Description = "Lower (main) tank oil temperature."
ch10.UnitString = "°F" : ch10.Description = "Thermocouple (Location: Remote rack, EL3318, Ch.2)."
ch11.UnitString = "°F" : ch11.Description = "Thermocouple (Location: Remote rack, EL3318, Ch.3)."
ch12.UnitString = "°F" : ch12.Description = "Thermocouple (Location: Remote rack, EL3318, Ch.1)"
ch13.UnitString = "nS" : ch13.Description = "Time when the data was captured."
'The only TDMS channels that get added to the collection are the ones that the user selects on the 'Configure Data File' form.
'That is what this If-Then block is for.
If Channels.Count = 0 Then
jArray.Clear()
plcArrayNames.Clear()
For Each [boolean] In bools
If [boolean] = True Then
Channels.Add(chans(i))
Channels = channelGroup.GetChannels 'new
jArray.Add(jaggedarray(i))
plcArrayNames.Add(dataArrayNames(i))
End If
i += 1
Next
End If
'At this point, we are ready to write data to the TDMS file.
'Establish the line of communication to the PLC so we can read the data arrays.
Dim tcClient As New TwinCAT.Ads.TcAdsClient()
Dim dataStreamRead As TwinCAT.Ads.AdsStream = New AdsStream
Dim binaryReader As System.IO.BinaryReader = New BinaryReader(dataStreamRead)
If Connectlocal = True Then
tcClient.Connect(851) 'local
Else : tcClient.Connect(AMSNetID, 851)
End If
While cbRecord.Checked = True
b = tcClient2.ReadAny(DRHvar, GetType(Boolean)) 'read the handshaking variable from the PLC
If b = False Then
'This For loop reads the appropriate arrays in the PLC and then writes that data to the appropriate arrays here.
'The arrays in here will eventually get written to the TDMS file.
i = 0
n = 0
writingData = True
For Each [string] In dataArrayNames
If dataArrayNames(n) = plcArrayNames(i) Then
hvar = tcClient.CreateVariableHandle("IO_HS.Data." & dataArrayNames(n))
value = 0
returnValue = jArray(i).GetType
If returnValue.Name = "Single[]" Then
dataStreamRead.SetLength(jArray(0).Length * 4)
dataStreamRead.Position = 0
tcClient.Read(hvar, dataStreamRead)
For Each [element] In jArray(0)
jArray(i)(value) = binaryReader.ReadSingle()
value += 1
Next
ElseIf returnValue.Name = "Int64[]" Then
dataStreamRead.SetLength(jArray(0).Length * 8)
dataStreamRead.Position = 0
tcClient.Read(hvar, dataStreamRead)
For Each [element] In jArray(0)
jArray(i)(value) = binaryReader.ReadInt64()
value += 1
Next
ElseIf returnValue.Name = "String[]" Then
dataStreamRead.SetLength(jArray(0).Length * 32)
dataStreamRead.Position = 0
tcClient.Read(hvar, dataStreamRead)
For Each [element] In jArray(0)
stringVar = binaryReader.ReadChars(32)
lastValidNumber = Math.Max(Math.Max(Math.Max(Math.Max(Math.Max(Math.Max(Math.Max(Math.Max(Math.Max(stringVar.LastIndexOf("0"), stringVar.LastIndexOf("1")), stringVar.LastIndexOf("2")), stringVar.LastIndexOf("3")), stringVar.LastIndexOf("4")), stringVar.LastIndexOf("5")), stringVar.LastIndexOf("6")), stringVar.LastIndexOf("7")), stringVar.LastIndexOf("8")), stringVar.LastIndexOf("9"))
If lastValidNumber > 0 Then
jArray(i)(value) = stringVar.Substring(0, lastValidNumber + 1)
Else
jArray(i)(value) = "Invalid Timestamp"
End If
value += 1
Next
End If
tcClient.DeleteVariableHandle(hvar)
i += 1
If i = plcArrayNames.Count Then
Exit For
End If
End If
n += 1
Next
'This For loop appends/writes the data from each array to the actual TDMS file.
i = 0
For Each [array] In jArray
dtype = Channels(i).GetDataType
If dtype.Name = "Int32" Then
Channels(i).AppendData(Of Integer)(jArray(i))
ElseIf dtype.Name = "Single" Then
Channels(i).AppendData(Of Single)(jArray(i))
ElseIf dtype.Name = "Boolean" Then
Channels(i).AppendData(Of Boolean)(jArray(i))
ElseIf dtype.Name = "String" Then
Channels(i).AppendData(Of String)(jArray(i))
End If
i += 1
Next
Try
'Call the DataAnalyzer dll to write stats of the cycle to stats CSV file. Also plot the data of the cycle on the chart on the UI
Invoke(Sub() DataAnalyzer.Analyze(arrSpeed, arrTorque, arrLinPot))
Invoke(Sub() plotData())
Invoke(Sub() DataAnalyzer.WriteData(statsFile, logFile.Path, arrTimeStamp(0), plcData.cyclesCompleted))
Catch ex As Exception
testBool = True
End Try
'Populate the datagridview cells with the data values
dgvStats.Item(1, 0).Value = DataAnalyzer.peakTorque
dgvStats.Item(1, 1).Value = DataAnalyzer.engagementSpeed
dgvStats.Item(1, 2).Value = DataAnalyzer.slidePlateSpeed
dgvStats.Item(1, 3).Value = plcData.bimbaTravSpeed
dgvStats.Item(1, 4).Value = plcData.lastCycleTime
dgvStats.Item(1, 5).Value = plcData.currentCycleTime
dgvStats.Item(1, 6).Value = plcData.meanCycleTime
dgvStats.Item(1, 7).Value = plcData.cyclesPerHr
'NEW CODE to Evalute the elements in the arrTorque array to get the Max value recorded
maxValue = 0
For Each [element] In arrTorque
maxValue = Math.Max(maxValue, element)
Next
If maxValue <= plcData.torqueAlrmSP And plcData.cycleStarted Then
torqueLowCount += 1
Else : torqueLowCount = 0
End If
'Let the PLC know that we received the data and are now ready for the next set (handshaking variable).
tcClient2.WriteAny(DRHvar, True)
End If
'If the data count in the first column of the TDMS file exceeds the number here, then
'close the file and create a new one, then continue to append/write data
If Channels(0).DataCount >= 1020000 Then
For Each channel As TdmsChannel In chans
channel.Dispose() : channel = Nothing
Next
chans = Nothing
channelGroup.Dispose() : channelGroup = Nothing
If tcClient.IsConnected Then
dataStreamRead.Dispose() : dataStreamRead = Nothing
tcClient.Disconnect() : tcClient.Dispose() : tcClient = Nothing
End If
'Jump to the CreateNewFile Sub to create the next TDMS file
CreateNewFile()
End If
End While
If logFile.IsOpen = True Then
logFile.Close()
End If
If tcClient.IsConnected Then
dataStreamRead.Dispose() : dataStreamRead = Nothing
tcClient.Disconnect() : tcClient.Dispose() : tcClient = Nothing
End If
writingData = False
End Sub
Private Sub CreateNewFile()
'Create the new folder where the data file/s will reside
Dim newFilename As String = dataFileName & "_" & fileNum
Dim customFilePropertyNames() As String = {"Date"}
Dim customFilePropertyVals() As String = {""}
Dim newAuthor As String = logFile.Author
Dim newDescription As String = logFile.Description
Dim newTitle As String = logFile.Title
Dim newPath1 As String = "C:\Users\dmckin01\Desktop\Data\" & folderName
Dim newPath2 As String = "D:\Data\" & folderName
fileNum += 1
'Create the TDMS file and save it to the user specified directory
customFilePropertyVals(0) = Date.Today.ToShortDateString()
logFile.Close() 'Close the old logfile after we've gotten values/properties from it
logFile.Dispose() : logFile = Nothing
Try
If Connectlocal = True Then
logFile = New TdmsFile(newPath1 & "\" & newFilename & ".tdms", New TdmsFileOptions())
Else : logFile = New TdmsFile(newPath2 & "\" & newFilename & ".tdms", New TdmsFileOptions())
End If
Catch ex As Exception
MessageBox.Show("Directory not created. Make sure the TDMS file and/or directory that you are referencing are not already currently opened.", "Directory Creation Failed", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End Try
logFile.Author = newAuthor
logFile.Description = newDescription
logFile.Title = newTitle
logFile.AddProperty(customFilePropertyNames(0), TdmsPropertyDataType.String, customFilePropertyVals(0))
logFile.AutoSave = True
dataAcquiring()
End Sub
Stack errors are always caused by loops in your code that call back on themselves. Often caused by property setting handlers that set other properties that, in their turn, try to set the initial property. They can be difficult to pinpoint sometimes.
In your case, you have called the logging function
dataAcquiring()
End Sub
At then end of the file creation routine... this is a SERIOUS bug.
Each time you start a new file you start a new instance of the log loop and the old one remains on the stack... it's just a matter of time till it runs out of room
In this instance... the create routine should just exit..
However, if it were me I would make that code a function that returns true or false. Have it return false if the file could not be created for some reason and handle it gracefully in the main loop.
I have this VB code which is giving the above error in the code below
Try
'Job Ticket Section
StatusText = "Reading Job Ticket Data."
FileName = System.IO.Path.Combine(SoftSavePath, "cfgjt.sys")
If Not System.IO.File.Exists(FileName) Then
CopyDefaultSoftJobTicketItems(FileName, ErrorFlag)
End If
filenumber = FreeFile()
FileOpen(filenumber, FileName, OpenMode.Binary)
.ConvexJobTicketItems = GetConfigConvexJobTicketItems(filenumber)
.ConcaveJobTicketItems = GetConfigConcaveJobTicketItems(filenumber)
FileClose(filenumber)
Catch ex As Exception
ErrorFlag.NumErrors = ErrorFlag.NumErrors + 1
ReDim Preserve ErrorFlag.ErrorDef(ErrorFlag.NumErrors - 1)
With ErrorFlag.ErrorDef(ErrorFlag.NumErrors - 1)
.Number = ErrorFlag.NumErrors - 1
.Description = "Open Config job ticket File Error: " & StatusText + ex.Message
End With
FileClose(filenumber)
End Try
On debugging , I found out that when the cursor hits this statement .ConcaveJobTicketItems , it jumps to the catch block .
The function GetConfigConcaveJobTicketItems(filenumber) where I stepped into has other function calls inside it .
Public Function GetConfigConcaveJobTicketItems(ByRef InFileNumber As Short) As JobTicketConcaveDesignItemsType
With GetConfigConcaveJobTicketItems
.ComfortConic = GetConfigConcaveSphereToricJobTicket(InFileNumber, "ConfortConic")
.Multicurve = GetConfigConcaveSphereToricJobTicket(InFileNumber, "Multicurve")
End With
End Function
When the debug cursor Hits the statement .ComfortConic = GetConfigConcaveSphereToricJobTicket(InFileNumber, "ConfortConic"), I step into the function and see that everything is fine and the cursor moves to the next line.
.Multicurve = GetConfigConcaveSphereToricJobTicket(InFileNumber, "Multicurve")
The GetConfigConcaveSphereToricJobTicket() is defined as
Public Function GetConfigConcaveSphereToricJobTicket(ByRef InFileNumber As Short, ByRef InString As String) As JobTicketSphereToricConcaveItemsType
With GetConfigConcaveSphereToricJobTicket
.Sphere = GetConfigConcaveDesignJobTicket(InFileNumber, InString & "Sphere")
.Toric = GetConfigConcaveDesignJobTicket(InFileNumber, InString & "Toric")
End With
End Function
I'm writing some software to import a CSV file into Active Directory (to create user accounts). At some point I know it was working perfectly importing multiple accounts. I'm not sure what I've changed as it's been a while since I last worked on it. But it now imports 2 accounts successfully and then crashes on the line below during the third loop iteration (however the third account is still created):
newUser.Save()
When it crashes I get the error "vshost32.exe has stopped working". I then enabled native code debugging and now get this error: "0xC0000374: A heap has been corrupted" and InvalidCastException (see immediate window at end of post for full error). For testing I've been deleting and recreating the same accounts. If I don't delete the first three accounts, the principal exists exception is handled and then the program crashes on the 4th iteration, and then the 5th and so on. But it never crashes on the first two. (The data I'm importing is identical except for numbers - E.g. sAMAccountNames: Test1, Test2, Test3 etc)
My Code
Private Sub bwImport_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles bwImport.DoWork
Dim _worker As BackgroundWorker = CType(sender, BackgroundWorker)
Dim beginImport As New StartImport(AddressOf progressForm.StartImport)
Me.Invoke(beginImport, New Object() {dtUsers.Rows.Count})
Dim log As New UpdateLog(AddressOf progressForm.UpdateLog)
'### TO DO: Check that all mandatory columns/attributes are in the DataTable
'### TO DO: Check for duplicate sAMAccountNames, userPrincipalNames and Cononical Names
#If Not Debug Then
Try
#End If
Dim rowNum As Integer = 0 'Keep track of how many accounts have been created
For Each row As DataRow In dtUsers.Rows
Dim newUser As UserPrincipalEx = New UserPrincipalEx(adCtx)
newUser.SamAccountName = row("sAMAccountName")
newUser.SetPassword(row("Password"))
'General Tab (of Template Exporter)
If row.Table.Columns.Contains("initials") Then
newUser.Initials = row("initials")
End If
If row.Table.Columns.Contains("givenName") Then
newUser.GivenName = row("givenName")
End If
If row.Table.Columns.Contains("sn") Then
newUser.Surname = row("sn")
End If
If row.Table.Columns.Contains("displayName") Then
newUser.DisplayName = row("displayName")
End If
If row.Table.Columns.Contains("description") Then
newUser.Description = row("description")
End If
If row.Table.Columns.Contains("physicalDeliveryOfficeName") Then
newUser.Office = row("physicalDeliveryOfficeName")
End If
If row.Table.Columns.Contains("telephoneNumber") Then
newUser.TelephoneNumber = row("telephoneNumber")
End If
If row.Table.Columns.Contains("wWWHomePage") Then
newUser.WebPage = row("wWWHomePage")
End If
'Address Tab (of Template Exporter)
If row.Table.Columns.Contains("streetAddress") Then
newUser.Street = row("streetAddress")
End If
If row.Table.Columns.Contains("postOfficeBox") Then
newUser.POBox = row("postOfficeBox")
End If
If row.Table.Columns.Contains("l") Then 'City
newUser.City = row("l")
End If
If row.Table.Columns.Contains("st") Then 'State/Province
newUser.State = row("st")
End If
If row.Table.Columns.Contains("postalCode") Then
newUser.PostCode = row("postalCode")
End If
'### TO DO: Add country fields
'Account Tab (of Template Exporter)
If row.Table.Columns.Contains("userPrincipalName") Then
newUser.UserPrincipalName = row("userPrincipalName")
End If
If row.Table.Columns.Contains("ResetPassword") Then
If row("ResetPassword").ToString.ToLower = "yes" Then
newUser.ExpirePasswordNow() 'Force the user to change their password at next logon
End If
End If
If row.Table.Columns.Contains("PreventPasswordChange") Then
If row("PreventPasswordChange").ToString.ToLower = "yes" Then
newUser.UserCannotChangePassword = True
End If
End If
If row.Table.Columns.Contains("PasswordNeverExpires") Then
If row("PasswordNeverExpires").ToString.ToLower = "yes" Then
newUser.PasswordNeverExpires = True
End If
End If
If row.Table.Columns.Contains("AccountDisabled") Then
If row("AccountDisabled").ToString.ToLower = "yes" Then
newUser.Enabled = False
Else
newUser.Enabled = True
End If
Else 'Enable the account by default if not specified
newUser.Enabled = True
End If
If row.Table.Columns.Contains("accountExpires") Then
Dim expireyDate As Date
Date.TryParse(row("accountExpires"), expireyDate) 'Try to convert the data from row("accountExpires") into a date
newUser.AccountExpirationDate = expireyDate
End If
'Profile Tab (of Template Exporter)
If row.Table.Columns.Contains("profilePath") Then
newUser.ProfilePath = row("profilePath")
End If
If row.Table.Columns.Contains("scriptPath") Then
newUser.ScriptPath = row("scriptPath")
End If
If row.Table.Columns.Contains("homeDrive") Then
newUser.HomeDrive = row("homeDrive")
End If
If row.Table.Columns.Contains("homeDirectory") Then
newUser.HomeDirectory = row("homeDirectory")
End If
'Telephones Tab (of Template Exporter)
If row.Table.Columns.Contains("homePhone") Then
newUser.HomePhone = row("homePhone")
End If
If row.Table.Columns.Contains("pager") Then
newUser.Pager = row("pager")
End If
If row.Table.Columns.Contains("mobile") Then
newUser.Mobile = row("mobile")
End If
If row.Table.Columns.Contains("facsimileTelephoneNumber") Then
newUser.Fax = row("facsimileTelephoneNumber")
End If
If row.Table.Columns.Contains("ipPhone") Then
newUser.IPPhone = row("ipPhone")
End If
'Organization Tab
If row.Table.Columns.Contains("title") Then
newUser.Title = row("title")
End If
If row.Table.Columns.Contains("department") Then
newUser.Department = row("department")
End If
If row.Table.Columns.Contains("company") Then
newUser.Company = row("company")
End If
rowNum += 1
_worker.ReportProgress(rowNum) 'Update progress dialog
Try
newUser.Save() 'Save the user to Active Directory
Me.Invoke(log, New Object() {"Successfully created " + row("sAMAccountName") + " (" + row("displayName") + ")", frmProgress.LogType.Success})
Catch ex As PrincipalExistsException
Me.Invoke(log, New Object() {"Error creating " + row("sAMAccountName") + " (" + row("displayName") + "). " + ex.Message, frmProgress.LogType.Failure})
Continue For
End Try
'Member Of Tab
If row.Table.Columns.Contains("MemberOf") Then
Dim groups() As String = row("MemberOf").ToString.Split(";")
'Add the user to any specified groups
Dim groupPrincipal As GroupPrincipal
Try 'Try adding group(s)
For Each group As String In groups
groupPrincipal = groupPrincipal.FindByIdentity(adCtx, group) 'Search for the group name, sid, sAMAccountName or display name
If groupPrincipal IsNot Nothing Then
groupPrincipal.Members.Add(newUser) 'Add the user to the group
groupPrincipal.Save()
Else
Me.Invoke(log, New Object() {"Unable to add " + row("sAMAccountName") + " to group: " + group + ". Group not found.", frmProgress.LogType.Failure})
End If
Next
Catch ex As PrincipalExistsException
'### TO DO: Try to get group name in exception
Me.Invoke(log, New Object() {"Error adding " + row("sAMAccountName") + " (" + row("displayName") + ") to " + "group(s). " + ex.Message, frmProgress.LogType.Failure})
End Try
End If
newUser.Dispose() 'Dispose of the newUser object
Next
#If Not Debug Then
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical)
End Try
#End If
End Sub
Immediate Window (When Native Debugging is enabled)
Critical error detected c0000374
First-chance exception at 0x76fbf996 in AD User Importer.exe: 0xC0000374: A heap has been corrupted.
A first chance exception of type 'System.InvalidCastException' occured in System.DirectoryServices.AccountManagement.dll
I think your issue lies in this block:
Try
newUser.Save() 'Save the user to Active Directory
Me.Invoke(log, New Object() {"Successfully created " + row("sAMAccountName") + " (" + row("displayName") + ")", frmProgress.LogType.Success})
Catch ex As PrincipalExistsException
Me.Invoke(log, New Object() {"Error creating " + row("sAMAccountName") + " (" + row("displayName") + "). " + ex.Message, frmProgress.LogType.Failure})
Continue For
End Try
This code handles exceptions but does not dispose newUser before continuing with the next loop iteration.
I recently began to receive similar heap exceptions and after a close examination I realized that I was not disposing my UserPrincipal object. Once I correctly disposed of the object the issue seems to have stopped.
You should wrap your newUser object in a Using block:
For Each row As DataRow In dtUsers.Rows
Using newUser As UserPrincipalEx = New UserPrincipalEx(adCtx)
newUser.SamAccountName = row("sAMAccountName")
newUser.SetPassword(row("Password"))
' ... the remainder of the code
' ... now wrapped in a Using block
End Using
Next
The newUser object will be automatically disposed no matter how the Using block is exited. Because the Using block disposes for you, you can remove the explicit call to newUser.Dispose().
If the Using block is not available in your version of VB.Net then you should wrap the loop in a Try...Finally block and explicitly dispose the newUser in the Finally block.
I am designing a blackjack game for a school project, and when the first hand is dealt, i would like the first card to appear for the player, then the dealers first card, then player card, dealer card.
I am using system.threading.thread.sleep(1000) to pause in between the cards being dealt, so they dont all appear at once. for some reason, the sleeps all execute at once, before any cards appear. so it will pause for 3 seconds, then deal all cards instead of executing at the line where i coded it:
Private Sub dealHand()
Dim playerScore As Integer = 0,
playerScoreA As Integer = 0,
dealerScore As Integer = 0,
dealerScoreA As Integer = 0
Dim card1 As Integer = newCard(True),
card2 As Integer = newCard(False),
card3 As Integer = newCard(False),
card4 As Integer = newCard(False)
playerCardPic1.Image = cardImgList.Images(card1)
playerScore = cardValue(card1)
playerScoreA = checkAce(card1, playerScore, True)
System.Threading.Thread.Sleep(1000)
dealerCardPic1.Image = My.Resources.ImpsBackDesign
dealerScore = cardValue(card2)
dealerScoreA = checkAce(card2, dealerScore, False)
System.Threading.Thread.Sleep(1000)
playerCardPic2.Image = cardImgList.Images(card3)
playerCardPic2.Visible = True
playerScore += cardValue(card3)
playerScoreA += checkAce(card3, playerScore, True)
System.Threading.Thread.Sleep(1000)
dealerCardPic2.Image = cardImgList.Images(card4)
dealerCardPic2.Visible = True
dealerScore += cardValue(card4)
dealerScoreA += checkAce(card4, dealerScore, False)
pScoreLbl.Text = playerScore.ToString
pAceLbl.Text = "or " & playerScoreA.ToString
dScoreLbl.Text = dealerScore.ToString
dAceLbl.Text = "or " & dealerScoreA.ToString
If playerScore <> playerScoreA Then
aceLabel(playerScoreA, True)
End If
If dealerScore <> dealerScoreA Then
aceLabel(dealerScoreA, False)
End If
checkPScore(playerScore, playerScoreA)
hitBtn.Enabled = True
standBtn.Enabled = True
End Sub
I fixed it by refreshing the GUI with me.refresh() before the sleep pauses. Much thanks!
I have written code to read and write to a serial port. I need it to indefinitely loop, I have been unable to figure a way to place a button to stop the loop, it will stop if there are errors.
I have searched the internet and have tried people's suggestions, but yet to get one actually work for me.
I am also unsure if the display data is updating frequently enough. This is my first time to use shapes.
I am still new to all this.
'this code has no provision to stop voluntarily, apart from quitting the program.
Imports System.IO.Ports
Class form1
'==CONTROL CHARACTERS- as per spec==
'==start and stop values==
Dim STX As Byte = &H2
Dim ETX As Byte = &H3
'==Read==
Dim read As String = "R"
'==Acknowledgment==
Dim ACK As Byte = &H6
'==class and address==
Dim DeviceClass As String = "E"
Dim DeviceAddress As String = "1"
'==Host Commane==
Dim hostCommand As String
'==STX E 1 R REG1 REG0 ETX==
'==Command to read==
Dim readSlave As String
'==STX E 1 ACK REG1 REG0 D1 D0 ETX==
'==array of register values==
Dim REG = New String() {"22", "23", "2F", "30"}
'==set and open port==NB not using get portname- COM1 to be used as dedicated port as spec==
Private Sub btnStartReset_Click(sender As Object, e As EventArgs) Handles btnStartReset.Click
If SerialPort1.IsOpen = False Then
'==Open and set COM1 as host==
Try
'==Set COM1 as portname==
SerialPort1.PortName = "COM1"
'==Port settings==
SerialPort1.BaudRate = 9600
SerialPort1.Parity = Parity.None
SerialPort1.StopBits = StopBits.One
SerialPort1.DataBits = 8
SerialPort1.ReadTimeout = 100
'==Open port==
SerialPort1.Open()
rtbCom1.Text = "COM1 Ready"
tmrPoll.Start()
Catch ex As Exception
rtbCom1.Text = "open error " & ex.Message
End Try
End If
End Sub
Private Sub tmrPoll_Tick(sender As Object, e As EventArgs) Handles tmrPoll.Tick
'==timeout error counter==
Dim i As Integer = 0
'==Prevent unnecessary timeout errors/allow time lag for port to open==
Do While SerialPort1.IsOpen = True
'==Loop through Register==
For Each register In REG
'==STX E 1 R REG1 REG0 ETX==
hostCommand = (STX & DeviceClass & DeviceAddress & read & register & ETX)
Try
'==Loop Host Commands for Register==
SerialPort1.WriteLine(hostCommand)
Catch ex As Exception
rtbCom1.Text = "Write Error: " & ex.Message
End Try
Try
'==readline to separate data==
readSlave = SerialPort1.ReadLine()
'==display data in GUI==
lst1.Items.Add(readSlave)
'==Get Register Value==
'==STX E 1 ACK REG1 REG0 D1 D0 ETX==
'==2-E-1-6-R-R-D-D-3==
'==Get the Data Value for Individual Register==
Dim reg = readSlave.Substring(4, 2)
'==convert data to integer, so data can be displayed graphically==
Dim D1 = CInt(readSlave.Substring(6, 1))
Dim D0 = CInt(readSlave.Substring(7, 1))
'==Display received substring values==
Select Case reg
Case Is = "22"
'list box until advised.
lst1.Items.Add(reg & D1 & D0)
Case Is = "23"
'==display data as shape==
'==0-100==
shpTemp.Width = (D1 + D0)
Case Is = "2F"
'==0-5==
shpAmp.Width = (D1 + D0) * 20
Case Is = "30"
'==0-40==
shpVolt.Width = (D1 + D0) * 2.5
End Select
Catch ex As Exception
rtbCom1.Text = "Read error: " & ex.Message
i += 1
End Try
If i > 2 Then
rtbCom1.Text = "Operation Aborted: 3 timeout errors."
'==Stop program if 3 timeout errors- as spec/closed port==
SerialPort1.Close()
rtbCom1.Text = "port closed - Operation Aborted: 3 timeout errors."
shpAmp.Width = 1
shpTemp.Width = 1
shpVolt.Width = 1
tmrPoll.Stop()
Exit Do
End If
Next
Loop
End Sub
End Class
With WinForm projects, the UI is single-threaded. The message loop (which processes incoming messages from the OS, such as button clicks) runs on the same thread as the UI event handlers, such as your tmrPoll_Tick event handler method. Therefore, until your event handler from one UI event exits, the message loop will not process the next OS message. Since that is the case, if you sit in an infinite loop in tmrPoll_Tick, it will completely lock up the UI because it will block the message loop from processing any more messages.
For that reason, as a rule, in WinForm projects, you should never create an infinite or long-running loop which runs in a UI event handler. You need to either redesign your code so it is more event-driven (doing one piece of work at a time in a recurring event), or you need to run the loop in a separate thread so that it doesn't block the UI thread. If you want to do it with a separate thread, a popular option is to use the BackgroundWorker component, which you will find in your form-designer tool box.