Following code causes an error at oDataObject.lastError and oDataObject.clearerror() of object ,while setting the option strict On a late binding issue persists.
Before option strict set to on the oDataObject.lastError and oDataObject.clearerror() showing as inbuild function and supports all class.
If Not trySettingValue(moProp, oDataObject, oTB.Text, sError) Then
oTB.BackColor = System.Drawing.Color.Red
bOk = False
Else
oTB.BackColor = System.Drawing.Color.White
End If
Public Shared Function trySettingValue(ByRef oProp As
System.Reflection.PropertyInfo, _
ByRef oDataObject As Object, _
ByVal oValue As Object, _
ByRef sError As String) As Boolean
Try
oDataObject.clearerror()
Select Case oProp.PropertyType.FullName
Case "System.String"
Dim str As String
str = CType(oValue, String)
oProp.SetValue(oDataObject, str, Nothing)
Case Else
End Select
' errorhandling
If oDataObject.lastError <> "" Then
sError = sError & oDataObject.lastError
Return False
Else
Return True
End If
Catch e As System.Exception
Trace.WriteLine(e.Message)
Trace.Flush()
sError = sError & "De ingevoerde waarde voor '" & oProp.Name & "' is foutief." & vbCrLf
Return False
End Try
End Function
Related
Good day,
I am trying to figure out this code from sharp-snmp samples.
https://github.com/lextudio/sharpsnmplib-samples/blob/master/Samples/VB.NET/snmpset/Program.vb
I am using the vb.net SET sample.
Public Sub New(id As Lextm.SharpSnmpLib.ObjectIdentifier, data As Lextm.SharpSnmpLib.ISnmpData)
Member of Lextm.SharpSnmpLib.Variable
Public Sub New(id As UInteger(), data As Lextm.SharpSnmpLib.ISnmpData)
Member of Lextm.SharpSnmpLib.Variable
Is my Name syntax just wrong, or is it that it must be an OID integer? When I use the OID it runs, when I use the name it dies.
System_Operation_Mode.0 'name
1.3.6.1.4.1.21703.100.1.1.0 'oid
This is the part of the SET sample where it dies at the asterix ** at the bottom of the code.
Extra(i) is filled out with the above Name instead of the OID.
ReDim args(3)
args(0) = "192.168.45.5" 'IP Address
args(1) = NetworkConfig.addrModeStringCommand 'command string name System_Operation_Mode.0
args(2) = "i" 'tell it what data type you are sending
args(3) = NetworkConfig.StaticMode 'mode you want from the IPNetwork, in this case static
Dim p As OptionSet = New OptionSet().Add("c:", "Community name, (default is public)", Sub(v As String)
If v IsNot Nothing Then
community = v
End If
End Sub) _
.Add("l:", "Security level, (default is noAuthNoPriv)", Sub(v As String)
If v.ToUpperInvariant() = "NOAUTHNOPRIV" Then
level = Levels.Reportable
ElseIf v.ToUpperInvariant() = "AUTHNOPRIV" Then
level = Levels.Authentication Or Levels.Reportable
ElseIf v.ToUpperInvariant() = "AUTHPRIV" Then
level = Levels.Authentication Or Levels.Privacy Or Levels.Reportable
Else
Throw New ArgumentException("no such security mode: " & v)
End If
End Sub) _
.Add("a:", "Authentication method (MD5 or SHA)", Sub(v As String)
authentication = v
End Sub) _
.Add("A:", "Authentication passphrase", Sub(v As String)
authPhrase = v
End Sub) _
.Add("x:", "Privacy method", Sub(v As String)
privacy = v
End Sub) _
.Add("X:", "Privacy passphrase", Sub(v As String)
privPhrase = v
End Sub) _
.Add("u:", "Security name", Sub(v As String)
user = v
End Sub) _
.Add("C:", "Context name", Sub(v As String)
contextName = v
End Sub) _
.Add("h|?|help", "Print this help information.", Sub(v As String)
showHelp__1 = v IsNot Nothing
End Sub) _
.Add("V", "Display version number of this application.", Sub(v As String)
showVersion = v IsNot Nothing
End Sub) _
.Add("d", "Display message dump", Sub(v As String)
dump = True
End Sub) _
.Add("t:", "Timeout value (unit is second).", Sub(v As String)
timeout = Integer.Parse(v) * 1000
End Sub) _
.Add("r:", "Retry count (default is 0)", Sub(v As String)
retry = Integer.Parse(v)
End Sub) _
.Add("v:", "SNMP version (1, 2, and 3 are currently supported)", Sub(v As String)
Select Case Integer.Parse(v)
Case 1
version = VersionCode.V1
Exit Select
Case 2
version = VersionCode.V2
Exit Select
Case 3
version = VersionCode.V3
Exit Select
Case Else
Throw New ArgumentException("no such version: " & v)
End Select
End Sub)
If args.Length = 0 Then
ShowHelp(p)
Return
End If
Dim extra As List(Of String)
Try
extra = p.Parse(args)
Catch ex As OptionException
Console.WriteLine(ex.Message)
Return
End Try
If showHelp__1 Then
ShowHelp(p)
Return
End If
If (extra.Count - 1) Mod 3 <> 0 Then
Console.WriteLine("invalid variable number: " & extra.Count)
Return
End If
If showVersion Then
Console.WriteLine(Reflection.Assembly.GetExecutingAssembly().GetName().Version)
Return
End If
Dim ip As IPAddress
Dim parsed As Boolean = IPAddress.TryParse(extra(0), ip)
If Not parsed Then
For Each address As IPAddress In Dns.GetHostAddresses(extra(0))
If address.AddressFamily <> AddressFamily.InterNetwork Then
Continue For
End If
ip = address
Exit For
Next
If ip Is Nothing Then
Console.WriteLine("invalid host or wrong IP address found: " & extra(0))
Return
End If
End If
Try
Dim vList As New List(Of Variable)()
Dim i As Integer = 1
While i < extra.Count
Dim type As String = extra(i + 1)
If type.Length <> 1 Then
Console.WriteLine("invalid type string: " & type)
Return
End If
Dim data As ISnmpData
Select Case type(0)
Case "i"c
data = New Integer32(Integer.Parse(extra(i + 2)))
Exit Select
Case "u"c
data = New Gauge32(UInteger.Parse(extra(i + 2)))
Exit Select
Case "t"c
data = New TimeTicks(UInteger.Parse(extra(i + 2)))
Exit Select
Case "a"c
data = New IP(IPAddress.Parse(extra(i + 2)).GetAddressBytes())
Exit Select
Case "o"c
data = New ObjectIdentifier(extra(i + 2))
Exit Select
Case "x"c
data = New OctetString(ByteTool.Convert(extra(i + 2)))
Exit Select
Case "s"c
data = New OctetString(extra(i + 2))
Exit Select
Case "d"c
data = New OctetString(ByteTool.ConvertDecimal(extra(i + 2)))
Exit Select
Case "n"c
data = New Null()
Exit Select
Case Else
Console.WriteLine("unknown type string: " & type(0))
Return
End Select
Dim test As New Variable(*New ObjectIdentifier(extra(i))*, data)
vList.Add(test)
i = i + 3
End While
I have been using using the "Name" instead of the "OID" is there a way to change so it can read either, or have them converted? Or will I have to go back use the OIDs?
Ive written a service application that listens to a port for any communication that may come through, our lab will run a certain test which will send serial data down every couple hours or so. the service is runs picks up the data fine for a few hours and then mysteriously stops. the system eventlog says the service terminated unexpectedly. and in the application event log it has a more descriptive .NET error,
Application: BondTestService.exe Framework Version: v4.0.30319
Description: The process was terminated due to an unhandled exception.
Exception Info: System.ObjectDisposedException at
System.Runtime.InteropServices.SafeHandle.DangerousAddRef(Boolean
ByRef) at
System.StubHelpers.StubHelpers.SafeHandleAddRef(System.Runtime.InteropServices.SafeHandle,
Boolean ByRef) at
Microsoft.Win32.UnsafeNativeMethods.GetOverlappedResult(Microsoft.Win32.SafeHandles.SafeFileHandle,
System.Threading.NativeOverlapped*, Int32 ByRef, Boolean) at
System.IO.Ports.SerialStream+EventLoopRunner.WaitForCommEvent() at
System.Threading.ThreadHelper.ThreadStart_Context(System.Object) at
System.Threading.ExecutionContext.RunInternal(System.Threading.ExecutionContext,
System.Threading.ContextCallback, System.Object, Boolean) at
System.Threading.ExecutionContext.Run(System.Threading.ExecutionContext,
System.Threading.ContextCallback, System.Object, Boolean) at
System.Threading.ExecutionContext.Run(System.Threading.ExecutionContext,
System.Threading.ContextCallback, System.Object) at
System.Threading.ThreadHelper.ThreadStart()
i was reading how services behave and how serial ports behave, so correct me if im wrong if the there is a 2 hour gap or so inbetween tests, the service will assume that its not running and stop itself?
I also read after reading the buffer from the serial port i append to a string builder object like below and do what i need to the string, then what happens to the serial port does it just stay open waiting for next value or do i have to close it and reopen it in order to refresh it?
Not sure how to handle this as it needs to be open waiting for the lab tester to send his data at any given time.
Imports System
Imports System.Data.SqlClient
Imports System.IO.Ports
Imports System.Net.Mime
Imports Microsoft.Win32
Imports System.IO
Imports System.Text.RegularExpressions
Imports BondTestService.PI
Imports PCA.Core.Configuration
Public Class Bond
Dim WithEvents serialPort As New IO.Ports.SerialPort
Public Delegate Sub myDelegate()
Public RawString As New System.Text.StringBuilder
Public value As String
Public BondTest As Integer = 10
#Region "Commport Traffic and Configuration Validations"
Public Sub StartListening()
If serialPort.IsOpen Then
serialPort.Close()
ErrorLog2(Now.ToString & "Port Closed because StartListening method started over")
End If
Try
With serialPort
.PortName = Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("commport")
.BaudRate = CInt(Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("baudrate"))
If Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("parity") = 0 Then
.Parity = Parity.None
End If
If Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("stopbits") = 1 Then
.StopBits = StopBits.One
End If
.DataBits = CInt(Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("bytesize"))
.Handshake = Handshake.None
If Registry.LocalMachine.OpenSubKey("SOFTWARE\Wow6432Node\AUTOLABDEVICESERVICE\bondtest", True).GetValue("RtsControl") = 1 Then
.RtsEnable = True
Else
.RtsEnable = False
End If
End With
serialPort.Open()
'debug
'ErrorLog2("Listening to COM 19, SerialPort has been Opened")
Catch ex As Exception
ErrorLog2(Now.ToString & ex.tostring)
End Try
End Sub
Public Function Filelocator() As String
' Dim filePath As String = IO.Path.Combine(Application.StartupPath, "bondtest.bat")
Dim filePath As String = IO.Path.Combine("C:\Program Files (x86)\PIPC\Interfaces\Lab", "BondTest.bat")
'Dim reader As New System.IO.StreamReader(filePath)
Dim LineNumber = 4
Using file As New StreamReader(filePath)
' Skip all preceding lines: '
For i As Integer = 1 To LineNumber - 1
If file.ReadLine() Is Nothing Then
ErrorLog2("LineNumber")
End If
Next
' Attempt to read the line you're interested in: '
Dim line As String = file.ReadLine()
If line Is Nothing Then
ErrorLog2("LineNumber")
End If
Return line
End Using
End Function
Private Sub serialPort_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort.DataReceived
Try
If GetBondInterfaceStatus = 1 Then
UPdateVariable()
Else
exit Sub
End If
Catch ex As Exception
Errorlog2(Ex.Tostring)
End Try
End Sub
#End Region
#Region "String Handling"
Public Sub UPdateVariable()
With RawString
.Append(serialPort.ReadLine())
End With
try
ErrorLog2(now.ToString & RawString.ToString)
InsertTestDataDEBUG(GetRecordID, BondTest, BondTestType.ToUpper.ToString, GetBondPosition(), StringParser(RawString.ToString()), RawString.tostring)
InsertTestData(GetRecordID, BondTest, BondTestType.ToUpper.ToString, GetBondPosition(), StringParser(RawString.ToString()))
RawString.Clear()
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
End Sub
Public Function StringParser(RawString As String)As Double ()
Dim Moisture = RawString
Dim pattern As String = "[0-9],"
Dim regex As New Regex(pattern)
Dim Counter As Integer = 0
Dim dblValues(1) As Double
Dim values As String() = Moisture.Split(New Char() {" "c})
for i = 0 to values.Count - 1
if regex.IsMatch(values(i)) Then
dblValues(Counter) = CDbl(values(i).Substring(0,1))
Counter = Counter + 1
Elseif values(i) = "" Then
continue for
else
if Double.TryParse(values(i), dblValues(Counter)) Then
Counter = Counter + 1
End If
End If
Next
Return dblValues
End Function
#End Region
#Region "SQL Statements"
Private Sub InsertTestData(RecordID As Integer, BondTest As Integer, TestType As String, TestPos As Integer, dataArray() As Double)
Dim InsertQuery As String = ""
Dim conn As New BondSQLConnection("PaperTests")
' Dim TestPos = StartingTestPos + (CInt(dataArray(0)) - 1)
conn("#RecordID") = RecordID
conn("#Test") = BondTest
conn("#TestType") = TestType
conn("#TestPos") = TestPos
conn("#TestData") = dataArray(1)
conn("#TestDateTime") = now.tostring
InsertQuery = "INSERT INTO PaperTests.dbo.PaperTestValues(ReelRecordID, Test, TestLocation, TestPosition, TestValue, TestTimeStamp) VALUES (#RecordID, #Test, #TestType, #TestPos, #TestData, #TestDateTime)"
Try
conn.ExecuteNonQuery(InsertQuery)
IncrementTestPosition
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
End Sub
Private Sub InsertTestDataDEBUG(RecordID As Integer, BondTest As Integer, TestType As String, TestPos As Integer, dataArray() As Double, rawString As String)
Dim InsertQuery As String = ""
Dim conn As New BondSQLConnection("PaperTests")
conn("#RecordID") = RecordID
conn("#Test") = BondTest
conn("#TestType") = TestType
conn("#TestPos") = TestPos
conn("#TestData") = dataArray(1)
conn("#RawString") = rawString
conn("#TestDateTime") = now.tostring
InsertQuery = "INSERT INTO PaperTests.dbo.InterfaceTesting(ReelRecordID, Test, TestLocation, TestPosition, TestValue, TestTimeStamp, RawValue) VALUES (#RecordID, #Test, #TestType, #TestPos, #TestData, #TestDateTime, #RawString)"
Try
conn.ExecuteNonQuery(InsertQuery)
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
End Sub
Private Sub IncrementTestPosition()
Dim tempPosition As Integer = GetBondPosition()
Dim FrontOriginalMax = 5
Dim CenterOriginalMax = 15
Dim BackOriginalMax = 25
Dim FrontRetestOrWinderMax = 10
Dim CenterRetestOrWinderMax = 20
Dim BackRetestOrWinderMax = 30
If tempPosition = FrontOriginalMax Then
tempPosition = 11
else if tempPosition = CenterOriginalMax Then
tempPosition = 21
else if tempPosition = BackOriginalMax Then
tempPosition = 1
Else If tempPosition = FrontRetestOrWinderMax then
tempPosition = 1
Else If tempPosition = CenterRetestOrWinderMax then
tempPosition = 1
Else If tempPosition = BackRetestOrWinderMax then
tempPosition = 1
else
tempPosition = tempPosition + 1
End If
SetBondPosition(tempPosition.tostring)
End Sub
#End Region
#Region "Get PiValues"
Private Function GetRecordID() As Int64
Dim RecordID As Int32 = 0
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
RecordID = piserver.GetCurrentValue("PAPERLAB:PaperLabReelSelected")
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return RecordID
End Function
Private Function GetBondPosition() As Int64
Dim BondPos As Int32 = 0
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
BondPos = CInt(piserver.GetCurrentValue("PAPERLAB:SBOND.POS"))
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return BondPos
End Function
Private Sub SetBondPosition(pos As String)
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
piserver.WriteValue("PAPERLAB:SBOND.POS", pos)
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
End Sub
Private Function BondTestType() As String
Dim TestType As String = ""
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
TestType = piserver.GetCurrentValue("M1:BOND.TYPE")
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return TestType
End Function
Private Function BondReelLoc() As String
Dim ReelLoc As String = ""
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
ReelLoc = piserver.GetCurrentValue("M1:BOND.ReelLoc")
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return ReelLoc
End Function
Private Function GetBondInterfaceStatus() As Integer
Dim Status As Integer = 0
Try
Dim piserver As New PIServer("valpi", "piadmin", "fatb0y",True)
Status = CInt(piserver.GetCurrentValue("PAPERLAB:BOND_INTERFACE.S"))
Catch ex As Exception
ErrorLog2(ex.ToString())
End Try
Return Status
End Function
#End Region
#Region "Debug"
Private Sub ErrorLog(RecordID As Int32, BondTest As Integer, ReelLoc As String, TestType As String, StartingTestPos As Integer, dataArray() As Double)
Dim SavePath As String = "C:\Program Files (x86)\PIPC\Interfaces\Lab"
Dim NameOfFile As String = "BondTest Debug File"
Dim TestPos = StartingTestPos + (CInt(dataArray(0)) - 1)
If System.IO.File.Exists(SavePath & "\" & NameOfFile & ".txt") Then
Using sw As StreamWriter = New StreamWriter(SavePath & "\" & NameOfFile & ".txt", True)
' For i = 0 To dataArray.Count -1
sw.WriteLine(" ")
sw.WriteLine(RecordID & " " & BondTest & " " & ReelLoc & " " & TestType & " " & TestPos & " " & dataArray(1).ToString)
' TestPos = TestPos + 1
' Next
End Using
else
File.Create(SavePath & "\" & NameOfFile & ".txt").Dispose()
Using sw As StreamWriter = File.CreateText(SavePath & "\" & NameOfFile & ".txt")
'For i = 0 To dataArray.Count -1
sw.WriteLine(" ")
sw.WriteLine(RecordID & " " & BondTest & " " & ReelLoc & " " & TestType & " " & TestPos & " " & dataArray(1).ToString)
' TestPos = TestPos + 1
'Next
End Using
End If
End Sub
Private Sub ErrorLog2(dataArray as string)
Dim SavePath As String = "C:\Program Files (x86)\PIPC\Interfaces\Lab"
Dim NameOfFile As String = "BondTest Debug File"
' Dim TestPos = StartingTestPos
If System.IO.File.Exists(SavePath & "\" & NameOfFile & ".txt") Then
Using sw As StreamWriter = New StreamWriter(SavePath & "\" & NameOfFile & ".txt", True)
sw.WriteLine(" ")
sw.WriteLine(dataArray)
End Using
else
File.Create(SavePath & "\" & NameOfFile & ".txt").Dispose()
Using sw As StreamWriter = File.CreateText(SavePath & "\" & NameOfFile & ".txt")
sw.WriteLine(" ")
sw.WriteLine(dataArray)
End Using
End If
End Sub
#End Region
This is a screenshot of the errors:
Thanks in advance
Normally, after opening the serial port in .NET it stays opened for arbitrary time. I've written several .NET applications were serial ports are used for months or years without app or computer restart and they work well.
According to the exception info you posted it looks like that serial port has been disposed. There are several possible reasons.
Using bad driver or HW, that disconnects your serial port. I've been using many USB-to-RS232 converters and some of them had bad drivers so sometimes ports were randomly disconnected and ObjectDisposedException was thrown. In earlier Windows editions (XP) the OS even 'blue-screened'. Here is more info about such situation where ObjectDisposedException is thrown.
This is a known problem with SerialPort. Device removal causes an uncatchable exception in a background thread it uses (WaitForCommEvent). The only solutions are to not use SerialPort or create a .config file that puts unhandled exception trapping mode back to .NET 1.1 behavior.
The USB cable of your RS232 converter is manually disconnected. If you do this, most drivers normally disconnect all handles to your serial port and .NET throws ObjectDisposedException.
Also check your power management settings on your USB port if USB-to-RS232 converter is used. Try to uncheck this option on USB device to which converter is connected.
SW bug in your code.
It's always advisable (especially if converter used) to try more types of converters just to be sure there is no problem in HW device/driver.
Update: So as Timmy was saying the connection was getting disposed by garbage collection. so i declared the object as a shared variable in the class
Shared Dim WithEvents serialPort as IO.Ports.SerialPort
and in the OnStart method i initiated it as a new Serial port and rocked on. has not throw any errors since garbage collection wont disposed of it. Hope this helps somebody having a similar issue.
Thought the code would catch empty records but it turns out it has not been and no error.
turns out my function always returns FALSE
Try
conn.Open()
Dim strQuery As String = "Select * FROM [UsersDataTbl] " & _
"WHERE [UserName] = """ & UserName & """"
Dim comm As New Data.OleDb.OleDbCommand(strQuery, conn)
Dim reader As Data.OleDb.OleDbDataReader = comm.ExecuteReader()
While reader.Read()
If noNull(reader("StudentID") = "") _
Or noNull(reader("LastName") = "") _
Or noNull(reader("FirstName") = "") _
Or noNull(reader("Affiliation") = "") Then
BlankFields = True
Else
BlankFields = False
End If
End While
conn.Close()
Catch ex As Exception
ADDED:
found my noNull method:
Public Function noNull(ByRef o As Object) As String
If (o Is Nothing) Then
Return ""
End If
Return o.ToString()
End Function
I process recordfield values like this:
Dim iVal As Integer = NoNull(r.Fields("someintegerfield").Value, "0", False)
Public Function NoNull(ByVal uAny As Object, Optional ByVal uFillString As String = "", Optional ByVal uTreatDecimalNullAsNothing As Boolean = False) As String
Dim sRet As String = String.Empty
If Not Convert.IsDBNull(uAny) AndAlso Not uAny Is Nothing Then
Debug.Assert(uAny.GetType.ToString <> "cField") 'checking if the argument is a "cField" helps me to check whether I passes "r.fields("somefield").value to this function, or if I forgot the ".value")
sRet = uAny
Else
sRet = String.Empty
End If
If StrLen(sRet) = 0 Then
If modStrings.StrLen(uFillString) > 0 Then
sRet = uFillString
End If
End If
If uTreatDecimalNullAsNothing Then
If sRet = "0" Then
sRet = uFillString
End If
End If
Return sRet
End Function
Public Function StrLen(ByVal uString As String) As Integer
If (Not uString Is Nothing) AndAlso (Not uString = "") Then
Return uString.Length
Else
Return 0
End If
End Function
I hope this can help you.
Dim con As New System.Data.OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=H:\yourDB.accdb;")
Dim cb As String = "SELECT * FROM Table1 "
Dim dr As System.Data.OleDb.OleDbDataReader
Dim cmd As New System.Data.OleDb.OleDbCommand
cmd.Connection = con
cmd.CommandText = cb
con.Open()
dr = cmd.ExecuteReader
While dr.Read()
If Not IsDBNull(dr("value1")) Then MessageBox.Show(dr("value1"))
End While
con.Close()
Supposing that the noNull method is something like this
Public Function noNull(dbValue As Object) as Boolean
if dbValue = DBNull.Value OrElse dbValue = "" Then
return True
else
return False
End If
End Function
Then you call it with
....
noNull(reader("LastName") = "")
....
This means that you compare the value of the LastName field to an Empty string and the result is a boolean True or False, but passing a Boolean value to noNull means that it will never be equal to an empty string or to a DBNull.Value and thus it will return always false
You need to call the method with
If noNull(reader("StudentID")) _
Or noNull(reader("LastName")) _
Or noNull(reader("FirstName")) _
Or noNull(reader("Affiliation")) Then
Or without the noNull method
If reader.IsDBNull(reader.GetOrdinal("StudentID")) _
OrElse reader("StudentID") = "" _
OrElse reader.IsDBNull(reader.GetOrdinal("LastName")) _
OrElse reader("LastName") = ""
OrElse reader.IsDBNull(reader.GetOrdinal("FirstName")) _
OrElse reader("FirstName") = "" _
OrElse reader.IsDBNull(reader.GetOrdinal("Affiliation")) _
OrElse reader("Affiliation") = "" Then
BlankFields = True
Else
BlankFields = False
End If
As you can see this is really ugly, so I suppose that a method like noNull iomplemented above could be useful in this context
EDIT Now, looking at the code of your noNull method then it is clear where is the error.
You should just change the parenthesis position.
If noNull(reader("StudentID")) = "" _
Or noNull(reader("LastName")) = "" _
Or noNull(reader("FirstName")) = "" _
Or noNull(reader("Affiliation")) = "" Then
POP Servers allow for the LIST command that returns a list of all of the emails in the mail box. Unfortunately it does not return ALL of the emails, it only returns the emails from the Inbox. So if an email lands in a junk folder it cannot find it.
Is it possible to download emails from the junk folder using POP?
This is the current class(s) that I am using:
Option Strict On
Option Explicit On
Imports System.Net, System.Text
Public Class POP3
Inherits Sockets.TcpClient
Dim Stream As Sockets.NetworkStream
Dim UsesSSL As Boolean = False
Dim SslStream As Security.SslStream
Dim SslStreamDisposed As Boolean = False
Public LastLineRead As String = vbNullString
Public Overloads Sub Connect(ByVal Server As String, ByVal Username As String, ByVal Password As String, Optional ByVal InPort As Integer = 110,Optional ByVal UseSSL As Boolean = False)
If Connected Then Disconnect()
UsesSSL = UseSSL
MyBase.Connect(Server, InPort)
Stream = MyBase.GetStream
If UsesSSL Then
SslStream = New Security.SslStream(Stream)
SslStream.AuthenticateAsClient(Server)
End If
If Not CheckResponse() Then Exit Sub
If CBool(Len(Username)) Then
Me.Submit("USER " & Username & vbCrLf)
If Not CheckResponse() Then Exit Sub
End If
If CBool(Len(Password)) Then
Me.Submit("PASS " & Password & vbCrLf)
If Not CheckResponse() Then Exit Sub
End If
End Sub
Public Function CheckResponse() As Boolean
If Not IsConnected() Then Return False
LastLineRead = Me.Response
If (Left(LastLineRead, 3) <> "+OK") Then
Throw New POP3Exception(LastLineRead)
Return False
End If
Return True
End Function
Public Function IsConnected() As Boolean
If Not Connected Then
Throw New POP3Exception("Not Connected to an POP3 Server.")
Return False
End If
Return True
End Function
Public Function Response(Optional ByVal dataSize As Integer = 1) As String
Dim enc As New ASCIIEncoding
Dim ServerBufr() As Byte
Dim Index As Integer = 0
If dataSize > 1 Then
ReDim ServerBufr(dataSize - 1)
Dim dtsz As Integer = dataSize
Dim sz As Integer
Do While Index < dataSize
If UsesSSL Then
sz = SslStream.Read(ServerBufr, Index, dtsz)
Else
sz = Stream.Read(ServerBufr, Index, dtsz)
End If
If sz = 0 Then Return vbNullString
Index += sz
dtsz -= sz
Loop
Else
ReDim ServerBufr(255)
Do
If UsesSSL Then
ServerBufr(Index) = CByte(SslStream.ReadByte)
Else
ServerBufr(Index) = CByte(Stream.ReadByte)
End If
If ServerBufr(Index) = -1 Then Exit Do
Index += 1
If ServerBufr(Index - 1) = 10 Then Exit Do
If Index > UBound(ServerBufr) Then
ReDim Preserve ServerBufr(Index + 255)
End If
Loop
End If
Return enc.GetString(ServerBufr, 0, Index)
End Function
Public Sub Submit(ByVal message As String)
Dim enc As New ASCIIEncoding
Dim WriteBuffer() As Byte = enc.GetBytes(message)
If UsesSSL Then
SslStream.Write(WriteBuffer, 0, WriteBuffer.Length)
Else
Stream.Write(WriteBuffer, 0, WriteBuffer.Length)
End If
End Sub
Public Sub Disconnect()
Me.Submit("QUIT" & vbCrLf)
CheckResponse()
If UsesSSL Then
SslStream.Dispose()
SslStreamDisposed = True
End If
End Sub
'*******************************************************************************
' Function Name : List
' Purpose : Get the drop listing from the maildrop
' :
' Returns : Any Arraylist of POP3Message objects
' :
' Typical telNet I/O:
'LIST (submit)
'+OK Mailbox scan listing follows
'1 2532 (record index and size in bytes)
'2 1610
'3 12345
'. (end of records terminator)
'*******************************************************************************
Public Function List() As ArrayList
If Not IsConnected() Then Return Nothing 'exit if not in TRANSACTION mode
Me.Submit("LIST" & vbCrLf) 'submit List request
If Not CheckResponse() Then Return Nothing 'check for a response, but if an error, return nothing
'
'get a list of emails waiting on the server for the authenticated user
'
Dim retval As New ArrayList 'set aside message list storage
Do
Dim response As String = Me.Response 'check response
If (response = "." & vbCrLf) Then 'done with list?
Exit Do 'yes
End If
Dim msg As New POP3Message 'establish a new message
Dim msgInfo() As String = Split(response, " "c) 'separate by spaces, which divide its fields
msg.MailID = Integer.Parse(msgInfo(0)) 'get the list item number
msg.ByteCount = Integer.Parse(msgInfo(1)) 'get the size of the email message
msg.Retrieved = False 'indicate its message body is not yet retreived
retval.Add(msg) 'add a new entry into the retrieval list
Loop
Return retval 'return the list
End Function
Public Function GetHeader(ByRef msg As POP3Message, Optional ByVal BodyLines As Integer = 0) As POP3Message
If Not IsConnected() Then Return Nothing
Me.Submit("TOP " & msg.MailID.ToString & " " & BodyLines.ToString & vbCrLf)
If Not CheckResponse() Then Return Nothing
msg.Message = vbNullString
Do
Dim response As String = Me.Response
If response = "." & vbCrLf Then
Exit Do
End If
msg.Message &= response
Loop
Return msg
End Function
Public Function Retrieve(ByRef msg As POP3Message) As POP3Message
If Not IsConnected() Then Return Nothing
Me.Submit("RETR " & msg.MailID.ToString & vbCrLf)
If Not CheckResponse() Then Return Nothing
msg.Message = Me.Response(msg.ByteCount)
Do
Dim S As String = Response()
If S = "." & vbCrLf Then
Exit Do
End If
msg.Message &= S
Loop
msg.ByteCount = Len(msg.Message)
Return msg
End Function
Public Sub Delete(ByVal msgHdr As POP3Message)
If Not IsConnected() Then Exit Sub
Me.Submit("DELE " & msgHdr.MailID.ToString & vbCrLf)
CheckResponse()
End Sub
Public Sub Reset()
If Not IsConnected() Then Exit Sub
Me.Submit("RSET" & vbCrLf)
CheckResponse()
End Sub
Public Function NOOP() As Boolean
If Not IsConnected() Then Return False
Me.Submit("NOOP")
Return CheckResponse()
End Function
Protected Overrides Sub Finalize()
If Not SslStreamDisposed Then
SslStream.Dispose()
End If
MyBase.Finalize()
End Sub
End Class
Public Class POP3Message
Public MailID As Integer = 0
Public ByteCount As Integer = 0
Public Retrieved As Boolean = False
Public Message As String = vbNullString
Public Overrides Function ToString() As String
Return Message
End Function
End Class
Public Class POP3Exception
Inherits ApplicationException
Public Sub New(ByVal str As String)
MyBase.New(str)
End Sub
End Class
As per the comments, the POP3 standard only allows for downloading from the "Inbox". It's not designed for anything more advanced.
The ideal solution would be to use IMAP4, if the mail server supports it.
IMAP4 allows you to save, flag, copy and delete messages, as well as allowing folders and subfolders and it does not require exclusive access.
I am hopeing someone can help me here with a recursive function I have that is not returning either true or false as I would have espected it to. The function loops through a Active Directory group for its members and then calls itself if it encounters any groups within the membership in order to gets its members as well. I am trying to return either true or false based on if any errors were encountered but not haveing any luck at all. It appears to just hang and never return back to the primary calling sub that starts the recursive function. Below is my code I am using:
Private Sub StartAnalysis(ByVal grp As String, ByVal grpdn As String, ByVal reqid As String)
Dim searchedGroups As New Hashtable
'prior work before calling sub
searchedGroups.Add(grp, 1)
Dim iserror As Boolean = GetGroupMembers(grpdn, searchedGroups, reqid)
If iserror = False Then
'do stuff
Else
'do stuff
End If
'cleanup
End Sub
Public Function GetGroupMembers(ByVal groupSearch As String, ByVal searchedGroups As Hashtable, ByVal requestID As String) As Boolean
Dim iserror As Boolean = False
Try
Dim lastQuery As Boolean = False
Dim endLoop As Boolean = False
Dim rangeStep As Integer = 999
Dim rangeLow As Integer = 0
Dim rangeHigh As Integer = rangeLow + rangeStep
Do
Dim range As String = "member"
If lastQuery = False Then
range = String.Format("member;range={0}-{1}", rangeLow, rangeHigh)
Else
range = String.Format("member;range={0}-*", rangeLow)
endLoop = True
End If
Dim group As SearchResult = QueryObject(groupSearch, range)
Dim groupCN As String = group.Properties("cn")(0).ToString
If group.Properties.Contains(range) Then
For Each member As Object In group.Properties(range)
Dim user As SearchResult = QueryObject(member.ToString, "member")
Dim userCN = user.Properties("cn")(0).ToString
If Not user.Properties.Contains("member") Then
Dim userMail = String.Empty
If user.Properties.Contains("mail") Then
userMail = user.Properties("mail")(0).ToString
End If
userCN = userCN.Replace("'", "''")
Dim qry As String = _
"INSERT INTO group_analysis_details (request_id, member_name, member_email, member_group) " & _
"values ('" & requestID & "', '" & userCN & "', '" & userMail & "', '" & groupCN & "')"
Dim sqlConn As SqlConnection = New SqlConnection(cs)
Dim sqlCmd As SqlCommand = New SqlCommand(qry, sqlConn)
sqlConn.Open()
sqlCmd.ExecuteNonQuery()
sqlConn.Close()
sqlCmd.Dispose()
sqlConn.Dispose()
Else
If Not searchedGroups.ContainsKey(userCN) Then
searchedGroups.Add(userCN, 1)
iserror = GetGroupMembers(user.Properties("distinguishedname")(0).ToString, searchedGroups, requestID)
If iserror = True Then Return iserror
Else
searchedGroups(userCN) += 1
End If
End If
Next
Else
lastQuery = True
End If
If lastQuery = False Then
rangeLow = rangeHigh + 1
rangeHigh = rangeLow + rangeStep
End If
Loop While endLoop = False
Return iserror
Catch ex As Exception
myEvents.WriteEntry("Error while analyzing the following group: " & groupSearch & vbCrLf & vbCrLf & _
"Details of the error are as follows: " & ex.Message, EventLogEntryType.Error)
Return True
End Try
End Function
Hopefully someone can point out where I might be making my error is this.
Thanks,
Ron
Generally if you're using a 'Do...Loop While' and manually setting the exit condition inside the loop it's very easy to get stuck in an infinite loop which is what causes the program to hang.
It looks like you're not setting endloop = True in all circumstances. Try changing it to an Exit Do and adding one to each of the various conditions you have. A bit of trial and error will be required to get it just right.
Also to make your life easier extract the database insert code into a seperate function and call it when needed.