473,695 Members | 2,538 Online
Bytes | Software Development & Data Engineering Community
+ Post

Home Posts Topics Members FAQ

Cast from string "2076719" to type 'Long' is not valid

I have developed a program that sends a command through the serial port
to our business system and then reads from the buffer looking for a
number. Everything worked great on my WinXP system, but when I tried
the program on the Win98 system it will be running on, I get the
following error:

Cast from string "2076719" to type 'Long' is not valid

I am not sure why I only get this error on the Win98 system or how to go
about correcting it. Any suggestions would be appreciated.

-Thanks

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 20 '05 #1
9 7130
Could you post the Suspect section of Code?

"rsine" <an*******@devd ex.com> wrote in message
news:u%******** ********@TK2MSF TNGP10.phx.gbl. ..
I have developed a program that sends a command through the serial port
to our business system and then reads from the buffer looking for a
number. Everything worked great on my WinXP system, but when I tried
the program on the Win98 system it will be running on, I get the
following error:

Cast from string "2076719" to type 'Long' is not valid

I am not sure why I only get this error on the Win98 system or how to go
about correcting it. Any suggestions would be appreciated.

-Thanks

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Nov 20 '05 #2
Mike,

I am thinking the error my have something to do with the RS232 class
that I am using. The code is not of my own writing but met the needs of
what I am doing so I have written my code to use it. Looking at it
closer, I am wondering if I can use WIN32 API calls on a WIN98 system? I
have included the code for this class following my code which uses the
class.

'************** **********
'* Function: GetNumber()
'************** **********
Private Function GetNumber(ByVal shCnt As Short) As Long

Try

Dim sOutputCommand As String
Dim iOutputCommandI ndex As Integer

'clear commdata variable
myCommData = ""

Dim StopBits As Rs232.DataStopB it = Rs232.DataStopB it.StopBit_1
Dim Parity As Rs232.DataParit y = Rs232.DataParit y.Parity_None

'open comm port connection
myCommPort.Open (iCommPort, iBaudRate, iDataBits, Parity, StopBits,
4096)

'clear the input buffer
myCommPort.Clea rInputBuffer()

'allow system processes
System.Windows. Forms.Applicati on.DoEvents()

'build command to send
sOutputCommand = "GET.NO " & CStr(shOrderCnt ) & vbCr

'enable timer (will be disabled once commport data is retrieved)
tmrReadCommPort .Enabled = True

'output command to port and wait for response
myCommPort.Writ e(sOutputComman d)

'sleep long enough for timer to fire
System.Threadin g.Thread.Sleep( 200)

'give some time to other events
System.Windows. Forms.Applicati on.DoEvents()

'close the commport
myCommPort.Clos e()

'extract number (add 1 to account for the vbCr)
iOutputCommandI ndex = myCommData.Inde xOf("GET.NO", 0) +
sOutputCommand. Length + 1

GetNumber = Trim(myCommData .Substring(iOut putCommandIndex , 8))

Catch ex As Exception

messagebox.show (ex.message)

End Try

End Function

'************** *************** *************** **************
'* Timer Control
'*
'* This event is used to control reading from commport.
'************** *************** *************** **************
Private Sub tmrReadCommPort _Tick(ByVal sender As System.Object,B yVal e
As System.EventArg s) Handles tmrReadCommPort .Tick

Dim bDisableTimer As Boolean

Try

'timer should not be disabled until data is read
bDisableTimer = False

'retrieve data from input buffer a character at a time
'and stop when at the end.
While (myCommPort.Rea d(1) <> -1)
myCommData = myCommData & Chr(myCommPort. InputStream(0))
bDisableTimer = True
End While

Catch ex As Exception

'once data is retrieved from the comm port then disable the
'timer so it does not continue to fire.
If bDisableTimer = True Then tmrReadCommPort .Enabled = False

End Try

End Sub

=============== == RS232 code =============== =====
'This class provides all the necessary support for communicating with
the Comm Port (otherwise known as the Serial Port, or RS232 port).

Public Class Rs232

'Declare the necessary class variables, and their initial values.
Private mhRS As Integer = -1 ' Handle to Com Port
Private miPort As Integer = 1 ' Default is COM1
Private miTimeout As Integer = 70 ' Timeout in ms
Private miBaudRate As Integer = 9600
Private meParity As DataParity = 0
Private meStopBit As DataStopBit = 0
Private miDataBit As Integer = 8
Private miBufferSize As Integer = 512 ' Buffers size default to 512
bytes
Private mabtRxBuf As Byte() ' Receive buffer
Private meMode As Mode ' Class working mode
Private mbWaitOnRead As Boolean
Private mbWaitOnWrite As Boolean
Private mbWriteErr As Boolean
Private muOverlapped As OVERLAPPED
Private muOverlappedW As OVERLAPPED
Private muOverlappedE As OVERLAPPED
Private mabtTmpTxBuf As Byte() ' Temporary buffer used by Async Tx
Private moThreadTx As Thread
Private moThreadRx As Thread
Private miTmpBytes2Read As Integer
Private meMask As EventMasks

#Region "Enums"

'This enumeration provides Data Parity values.
Public Enum DataParity
Parity_None = 0
Pariti_Odd
Parity_Even
Parity_Mark
End Enum

'This enumeration provides Data Stop Bit values.
'It is set to begin with a one, so that the enumeration values
'match the actual values.
Public Enum DataStopBit
StopBit_1 = 1
StopBit_2
End Enum

'This enumeration contains values used to purge the various buffers.
Private Enum PurgeBuffers
RXAbort = &H2
RXClear = &H8
TxAbort = &H1
TxClear = &H4
End Enum

'This enumeration provides values for the lines sent to the Comm Port
Private Enum Lines
SetRts = 3
ClearRts = 4
SetDtr = 5
ClearDtr = 6
ResetDev = 7 ' Reset device if possible
SetBreak = 8 ' Set the device break line.
ClearBreak = 9 ' Clear the device break line.
End Enum

'This enumeration provides values for the Modem Status, since
'we'll be communicating primarily with a modem.
'Note that the Flags() attribute is set to allow for a bitwise
'combination of values.
<Flags()> Public Enum ModemStatusBits
ClearToSendOn = &H10
DataSetReadyOn = &H20
RingIndicatorOn = &H40
CarrierDetect = &H80
End Enum

'This enumeration provides values for the Working mode
Public Enum Mode
NonOverlapped
Overlapped
End Enum

'This enumeration provides values for the Comm Masks used.
'Note that the Flags() attribute is set to allow for a bitwise
'combination of values.
<Flags()> Public Enum EventMasks
RxChar = &H1
RXFlag = &H2
TxBufferEmpty = &H4
ClearToSend = &H8
DataSetReady = &H10
ReceiveLine = &H20
Break = &H40
StatusError = &H80
Ring = &H100
End Enum
#End Region

#Region "Structures "
' This is the DCB structure used by the calls to the Windows API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Private Structure DCB
Public DCBlength As Integer
Public BaudRate As Integer
Public Bits1 As Integer
Public wReserved As Int16
Public XonLim As Int16
Public XoffLim As Int16
Public ByteSize As Byte
Public Parity As Byte
Public StopBits As Byte
Public XonChar As Byte
Public XoffChar As Byte
Public ErrorChar As Byte
Public EofChar As Byte
Public EvtChar As Byte
Public wReserved2 As Int16
End Structure

' This is the CommTimeOuts structure used by the calls to the
Windows API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Private Structure
COMMTIMEOUTS
Public ReadIntervalTim eout As Integer
Public ReadTotalTimeou tMultiplier As Integer
Public ReadTotalTimeou tConstant As Integer
Public WriteTotalTimeo utMultiplier As Integer
Public WriteTotalTimeo utConstant As Integer
End Structure

' This is the CommConfig structure used by the calls to the Windows
API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Private Structure
COMMCONFIG
Public dwSize As Integer
Public wVersion As Int16
Public wReserved As Int16
Public dcbx As DCB
Public dwProviderSubTy pe As Integer
Public dwProviderOffse t As Integer
Public dwProviderSize As Integer
Public wcProviderData As Byte
End Structure

' This is the OverLapped structure used by the calls to the Windows
API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Public Structure
OVERLAPPED
Public Internal As Integer
Public InternalHigh As Integer
Public Offset As Integer
Public OffsetHigh As Integer
Public hEvent As Integer
End Structure
#End Region

#Region "Exceptions "

' This class defines a customized channel exception. This exception
is
' raised when a NACK is raised.
Public Class CIOChannelExcep tion : Inherits ApplicationExce ption
Sub New(ByVal Message As String)
MyBase.New(Mess age)
End Sub
Sub New(ByVal Message As String, ByVal InnerException As
Exception)
MyBase.New(Mess age, InnerException)
End Sub
End Class

' This class defines a customized timeout exception.
Public Class IOTimeoutExcept ion : Inherits CIOChannelExcep tion
Sub New(ByVal Message As String)
MyBase.New(Mess age)
End Sub
Sub New(ByVal Message As String, ByVal InnerException As
Exception)
MyBase.New(Mess age, InnerException)
End Sub
End Class

#End Region

#Region "Events"
' These events allow the program using this class to react to Comm
Port
' events.
Public Event DataReceived(By Val Source As Rs232, ByVal DataBuffer()
As Byte)
Public Event TxCompleted(ByV al Source As Rs232)
Public Event CommEvent(ByVal Source As Rs232, ByVal Mask As
EventMasks)
#End Region

#Region "Constants"
' These constants are used to make the code clearer.
Private Const PURGE_RXABORT As Integer = &H2
Private Const PURGE_RXCLEAR As Integer = &H8
Private Const PURGE_TXABORT As Integer = &H1
Private Const PURGE_TXCLEAR As Integer = &H4
Private Const GENERIC_READ As Integer = &H80000000
Private Const GENERIC_WRITE As Integer = &H40000000
Private Const OPEN_EXISTING As Integer = 3
Private Const INVALID_HANDLE_ VALUE As Integer = -1
Private Const IO_BUFFER_SIZE As Integer = 1024
Private Const FILE_FLAG_OVERL APPED As Integer = &H40000000
Private Const ERROR_IO_PENDIN G As Integer = 997
Private Const WAIT_OBJECT_0 As Integer = 0
Private Const ERROR_IO_INCOMP LETE As Integer = 996
Private Const WAIT_TIMEOUT As Integer = &H102&
Private Const INFINITE As Integer = &HFFFFFFFF
#End Region

#Region "Properties "

' This property gets or sets the BaudRate
Public Property BaudRate() As Integer
Get
Return miBaudRate
End Get
Set(ByVal Value As Integer)
miBaudRate = Value
End Set
End Property

' This property gets or sets the BufferSize
Public Property BufferSize() As Integer
Get
Return miBufferSize
End Get
Set(ByVal Value As Integer)
miBufferSize = Value
End Set
End Property

' This property gets or sets the DataBit.
Public Property DataBit() As Integer
Get
Return miDataBit
End Get
Set(ByVal Value As Integer)
miDataBit = Value
End Set
End Property

' This write-only property sets or resets the DTR line.
Public WriteOnly Property Dtr() As Boolean
Set(ByVal Value As Boolean)
If Not mhRS = -1 Then
If Value Then
EscapeCommFunct ion(mhRS, Lines.SetDtr)
Else
EscapeCommFunct ion(mhRS, Lines.ClearDtr)
End If
End If
End Set
End Property

' This read-only property returns an array of bytes that represents
' the input coming into the Comm Port.
Overridable ReadOnly Property InputStream() As Byte()
Get
Return mabtRxBuf
End Get
End Property

' This read-only property returns a string that represents
' the data coming into to the Comm Port.
Overridable ReadOnly Property InputStreamStri ng() As String
Get
Dim oEncoder As New System.Text.ASC IIEncoding()
Return oEncoder.GetStr ing(Me.InputStr eam)
End Get
End Property

' This property returns the open status of the Comm Port.
ReadOnly Property IsOpen() As Boolean
Get
Return CBool(mhRS <> -1)
End Get
End Property

' This read-only property returns the status of the modem.
Public ReadOnly Property ModemStatus() As ModemStatusBits
Get
If mhRS = -1 Then
Throw New ApplicationExce ption("Please initialize and
open " + _
"port before using this method")
Else
' Retrieve modem status
Dim lpModemStatus As Integer
If Not GetCommModemSta tus(mhRS, lpModemStatus) Then
Throw New ApplicationExce ption("Unable to get modem
status")
Else
Return CType(lpModemSt atus, ModemStatusBits )
End If
End If
End Get
End Property

' This property gets or sets the Parity
Public Property Parity() As DataParity
Get
Return meParity
End Get
Set(ByVal Value As DataParity)
meParity = Value
End Set
End Property

' This property gets or sets the Port
Public Property Port() As Integer
Get
Return miPort
End Get
Set(ByVal Value As Integer)
miPort = Value
End Set
End Property

' This write-only property sets or resets the RTS line.
Public WriteOnly Property Rts() As Boolean
Set(ByVal Value As Boolean)
If Not mhRS = -1 Then
If Value Then
EscapeCommFunct ion(mhRS, Lines.SetRts)
Else
EscapeCommFunct ion(mhRS, Lines.ClearRts)
End If
End If
End Set
End Property

' This property gets or sets the StopBit
Public Property StopBit() As DataStopBit
Get
Return meStopBit
End Get
Set(ByVal Value As DataStopBit)
meStopBit = Value
End Set
End Property

' This property gets or sets the Timeout
Public Overridable Property Timeout() As Integer
Get
Return miTimeout
End Get
Set(ByVal Value As Integer)
miTimeout = CInt(IIf(Value = 0, 500, Value))
' If Port is open updates it on the fly
pSetTimeout()
End Set
End Property

' This property gets or sets the working mode to overlapped
' or non-overlapped.
Public Property WorkingMode() As Mode
Get
Return meMode
End Get
Set(ByVal Value As Mode)
meMode = Value
End Set
End Property

#End Region
#Region "Win32API"
' The following functions are the required Win32 functions needed to
' make communication with the Comm Port possible.

<DllImport("ker nel32.dll")> Private Shared Function BuildCommDCB( _
ByVal lpDef As String, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function ClearCommError(
_
ByVal hFile As Integer, ByVal lpErrors As Integer, _
ByVal l As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CloseHandle( _
ByVal hObject As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CreateEvent( _
ByVal lpEventAttribut es As Integer, ByVal bManualReset As
Integer, _
ByVal bInitialState As Integer, _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpName As String) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CreateFile( _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpFileName As String, _
ByVal dwDesiredAccess As Integer, ByVal dwShareMode As Integer,
_
ByVal lpSecurityAttri butes As Integer, _
ByVal dwCreationDispo sition As Integer, _
ByVal dwFlagsAndAttri butes As Integer, _
ByVal hTemplateFile As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
EscapeCommFunct ion( _
ByVal hFile As Integer, ByVal ifunc As Long) As Boolean
End Function

<DllImport("ker nel32.dll")> Private Shared Function FormatMessage( _
ByVal dwFlags As Integer, ByVal lpSource As Integer, _
ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpBuffer As String, _
ByVal nSize As Integer, ByVal Arguments As Integer) As Integer
End Function

Private Declare Function FormatMessage Lib "kernel32" Alias _
"FormatMessageA " (ByVal dwFlags As Integer, ByVal lpSource As
Integer, _
ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, _
ByVal lpBuffer As StringBuilder, ByVal nSize As Inteer, _
ByVal Arguments As Integer) As Integer

<DllImport("ker nel32.dll")> Public Shared Function
GetCommModemSta tus( _
ByVal hFile As Integer, ByRef lpModemStatus As Integer) As
Boolean
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetCommState( _
ByVal hCommDev As Integer, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetCommTimeouts (
_
ByVal hFile As Integer, ByRef lpCommTimeouts As COMMTIMEOUTS) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetLastError()
As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
GetOverlappedRe sult( _
ByVal hFile As Integer, ByRef lpOverlapped As OVERLAPPED, _
ByRef lpNumberOfBytes Transferred As Integer, _
ByVal bWait As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function PurgeComm( _
ByVal hFile As Integer, ByVal dwFlags As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function ReadFile( _
ByVal hFile As Integer, ByVal Buffer As Byte(), _
ByVal nNumberOfBytesT oRead As Integer, _
ByRef lpNumberOfBytes Read As Integer, _
ByRef lpOverlapped As OVERLAPPED) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommTimeouts (
_
ByVal hFile As Integer, ByRef lpCommTimeouts As COMMTIMEOUTS) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommState( _
ByVal hCommDev As Integer, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetupComm( _
ByVal hFile As Integer, ByVal dwInQueue As Integer, _
ByVal dwOutQueue As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommMask( _
ByVal hFile As Integer, ByVal lpEvtMask As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function WaitCommEvent( _
ByVal hFile As Integer, ByRef Mask As EventMasks, _
ByRef lpOverlap As OVERLAPPED) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
WaitForSingleOb ject( _
ByVal hHandle As Integer, ByVal dwMilliseconds As Integer) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function WriteFile( _
ByVal hFile As Integer, ByVal Buffer As Byte(), _
ByVal nNumberOfBytesT oWrite As Integer, _
ByRef lpNumberOfBytes Written As Integer, _
ByRef lpOverlapped As OVERLAPPED) As Integer
End Function

#End Region

#Region "Methods"

' This subroutine invokes a thread to perform an asynchronous read.
' This routine should not be called directly, but is used
' by the class.
Public Sub _R()
Dim iRet As Integer = Read(miTmpBytes 2Read)
End Sub

' This subroutine invokes a thread to perform an asynchronous write.
' This routine should not be called directly, but is used
' by the class.
Public Sub _W()
Write(mabtTmpTx Buf)
End Sub

' This subroutine uses another thread to read from the Comm Port. It
' raises RxCompleted when done. It reads an integer.
Public Overloads Sub AsyncRead(ByVal Bytes2Read As Integer)
If meMode <> Mode.Overlapped Then Throw New
ApplicationExce ption( _
"Async Methods allowed only when WorkingMode=Ove rlapped")
miTmpBytes2Read = Bytes2Read
moThreadTx = New Thread(AddressO f _R)
moThreadTx.Star t()
End Sub

' This subroutine uses another thread to write to the Comm Port. It
' raises TxCompleted when done. It writes an array of bytes.
Public Overloads Sub AsyncWrite(ByVa l Buffer() As Byte)
If meMode <> Mode.Overlapped Then Throw New
ApplicationExce ption( _
"Async Methods allowed only when WorkingMode=Ove rlapped")
If mbWaitOnWrite = True Then Throw New ApplicationExce ption( _
"Unable to send message because of pending transmission.")
mabtTmpTxBuf = Buffer
moThreadTx = New Thread(AddressO f _W)
moThreadTx.Star t()
End Sub

' This subroutine uses another thread to write to the Comm Port. It
' raises TxCompleted when done. It writes a string.
Public Overloads Sub AsyncWrite(ByVa l Buffer As String)
Dim oEncoder As New System.Text.ASC IIEncoding()
Dim aByte() As Byte = oEncoder.GetByt es(Buffer)
Me.AsyncWrite(a Byte)
End Sub

' This function takes the ModemStatusBits and returns a boolean
value
' signifying whether the Modem is active.
Public Function CheckLineStatus (ByVal Line As ModemStatusBits ) As
Boolean
Return Convert.ToBoole an(ModemStatus And Line)
End Function

' This subroutine clears the input buffer.
Public Sub ClearInputBuffe r()
If Not mhRS = -1 Then
PurgeComm(mhRS, PURGE_RXCLEAR)
End If
End Sub

' This subroutine closes the Comm Port.
Public Sub Close()
If mhRS <> -1 Then
CloseHandle(mhR S)
mhRS = -1
End If
End Sub

' This subroutine opens and initializes the Comm Port
Public Overloads Sub Open()
' Get Dcb block,Update with current data
Dim uDcb As DCB, iRc As Integer
' Set working mode
Dim iMode As Integer = Convert.ToInt32 (IIf(meMode =
Mode.Overlapped , _
FILE_FLAG_OVERL APPED, 0))
' Initializes Com Port
If miPort > 0 Then
Try
' Creates a COM Port stream handle
mhRS = CreateFile("COM " & miPort.ToString , _
GENERIC_READ Or GENERIC_WRITE, 0, 0, _
OPEN_EXISTING, iMode, 0)
If mhRS <> -1 Then
' Clear all comunication errors
Dim lpErrCode As Integer
iRc = ClearCommError( mhRS, lpErrCode, 0&)
' Clears I/O buffers
iRc = PurgeComm(mhRS, PurgeBuffers.RX Clear Or _
PurgeBuffers.Tx Clear)
' Gets COM Settings
iRc = GetCommState(mh RS, uDcb)
' Updates COM Settings
Dim sParity As String = "NOEM"
sParity = sParity.Substri ng(meParity, 1)
' Set DCB State
Dim sDCBState As String = String.Format( _
"baud={0} parity={1} data={2} stop={3}", _
miBaudRate, sParity, miDataBit, CInt(meStopBit) )
iRc = BuildCommDCB(sD CBState, uDcb)
iRc = SetCommState(mh RS, uDcb)
If iRc = 0 Then
Dim sErrTxt As String =
pErr2Text(GetLa stError())
Throw New CIOChannelExcep tion( _
"Unable to set COM state0" & sErrTxt)
End If
' Setup Buffers (Rx,Tx)
iRc = SetupComm(mhRS, miBufferSize, miBufferSize)
' Set Timeouts
pSetTimeout()
Else
' Raise Initialization problems
Throw New CIOChannelExcep tion( _
"Unable to open COM" & miPort.ToString )
End If
Catch Ex As Exception
' Generica error
Throw New CIOChannelExcep tion(Ex.Message , Ex)
End Try
Else
' Port not defined, cannot open
Throw New ApplicationExce ption("COM Port not defined, " + _
"use Port property to set it before invoking InitPort")
End If
End Sub

' This subroutine opens and initializes the Comm Port (overloaded
' to support parameters).
Public Overloads Sub Open(ByVal Port As Integer, _
ByVal BaudRate As Integer, ByVal DataBit As Integer, _
ByVal Parity As DataParity, ByVal StopBit As DataStopBit, _
ByVal BufferSize As Integer)

Me.Port = Port
Me.BaudRate = BaudRate
Me.DataBit = DataBit
Me.Parity = Parity
Me.StopBit = StopBit
Me.BufferSize = BufferSize
Open()
End Sub

' This function translates an API error code to text.
Private Function pErr2Text(ByVal lCode As Integer) As String
Dim sRtrnCode As New StringBuilder(2 56)
Dim lRet As Integer

lRet = FormatMessage(& H1000, 0, lCode, 0, sRtrnCode, 256, 0)
If lRet > 0 Then
Return sRtrnCode.ToStr ing
Else
Return "Error not found."
End If

End Function

' This subroutine handles overlapped reads.
Private Sub pHandleOverlapp edRead(ByVal Bytes2Read As Integer)
Dim iReadChars, iRc, iRes, iLastErr As Integer
muOverlapped.hE vent = CreateEvent(Not hing, 1, 0, Nothing)
If muOverlapped.hE vent = 0 Then
' Can't create event
Throw New ApplicationExce ption( _
"Error creating event for overlapped read.")
Else
' Ovellaped reading
If mbWaitOnRead = False Then
ReDim mabtRxBuf(Bytes 2Read - 1)
iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, _
iReadChars, muOverlapped)
If iRc = 0 Then
iLastErr = GetLastError()
If iLastErr <> ERROR_IO_PENDIN G Then
Throw New ArgumentExcepti on("Overlapped Read
Error: " & _
pErr2Text(iLast Err))
Else
' Set Flag
mbWaitOnRead = True
End If
Else
' Read completed successfully
RaiseEvent DataReceived(Me , mabtRxBuf)
End If
End If
End If
' Wait for operation to be completed
If mbWaitOnRead Then
iRes = WaitForSingleOb ject(muOverlapp ed.hEvent, miTimeout)
Select Case iRes
Case WAIT_OBJECT_0
' Object signaled,operat ion completed
If GetOverlappedRe sult(mhRS, muOverlapped, _
iReadChars, 0) = 0 Then

' Operation error
iLastErr = GetLastError()
If iLastErr = ERROR_IO_INCOMP LETE Then
Throw New ApplicationExce ption( _
"Read operation incomplete")
Else
Throw New ApplicationExce ption( _
"Read operation error " &
iLastErr.ToStri ng)
End If
Else
' Operation completed
RaiseEvent DataReceived(Me , mabtRxBuf)
mbWaitOnRead = False
End If
Case WAIT_TIMEOUT
Throw New IOTimeoutExcept ion("Timeout error")
Case Else
Throw New ApplicationExce ption("Overlapp ed read
error")
End Select
End If
End Sub

' This subroutine handles overlapped writes.
Private Function pHandleOverlapp edWrite(ByVal Buffer() As Byte) As
Boolean
Dim iBytesWritten, iRc, iLastErr, iRes As Integer, bErr As Boolean
muOverlappedW.h Event = CreateEvent(Not hing, 1, 0, Nothing)
If muOverlappedW.h Event = 0 Then
' Can't create event
Throw New ApplicationExce ption( _
"Error creating event for overlapped write.")
Else
' Overllaped write
PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
mbWaitOnRead = True
iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
iBytesWritten, muOverlappedW)
If iRc = 0 Then
iLastErr = GetLastError()
If iLastErr <> ERROR_IO_PENDIN G Then
Throw New ArgumentExcepti on("Overlapped Read Error: " & _
pErr2Text(iLast Err))
Else
' Write is pending
iRes = WaitForSingleOb ject(muOverlapp edW.hEvent, INFINITE)
Select Case iRes
Case WAIT_OBJECT_0
' Object signaled,operat ion completed
If GetOverlappedRe sult(mhRS, muOverlappedW, _
iBytesWritten, 0) = 0 Then

bErr = True
Else
' Notifies Async tx completion,stop s thread
mbWaitOnRead = False
RaiseEvent TxCompleted(Me)
End If
End Select
End If
Else
' Wait operation completed immediatly
bErr = False
End If
End If
CloseHandle(muO verlappedW.hEve nt)
Return bErr
End Function

' This subroutine sets the Comm Port timeouts.
Private Sub pSetTimeout()
Dim uCtm As COMMTIMEOUTS
' Set ComTimeout
If mhRS = -1 Then
Exit Sub
Else
' Changes setup on the fly
With uCtm
.ReadIntervalTi meout = 0
.ReadTotalTimeo utMultiplier = 0
.ReadTotalTimeo utConstant = miTimeout
.WriteTotalTime outMultiplier = 10
.WriteTotalTime outConstant = 100
End With
SetCommTimeouts (mhRS, uCtm)
End If
End Sub

' This function returns an integer specifying the number of bytes
' read from the Comm Port. It accepts a parameter specifying the
number
' of desired bytes to read.
Public Function Read(ByVal Bytes2Read As Integer) As Integer
Dim iReadChars, iRc As Integer

' If Bytes2Read not specified uses Buffersize
If Bytes2Read = 0 Then Bytes2Read = miBufferSize
If mhRS = -1 Then
Throw New ApplicationExce ption( _
"Please initialize and open port before using this method")
Else
' Get bytes from port
Try
' Purge buffers
'PurgeComm(mhRS , PURGE_RXCLEAR Or PURGE_TXCLEAR)
' Creates an event for overlapped operations
If meMode = Mode.Overlapped Then
pHandleOverlapp edRead(Bytes2Re ad)
Else
'Non overlapped mode
ReDim mabtRxBuf(Bytes 2Read - 1)
iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, iReadChars,
Nothing)
If iRc = 0 Then
'Read Error
Throw New ApplicationExce ption( _
"ReadFile error " & iRc.ToString)
Else
'Handles timeout or returns input chars
If iReadChars < Bytes2Read Then
Throw New IOTimeoutExcept ion("Timeout error")
Else
mbWaitOnRead = True
Return (iReadChars)
End If
End If
End If
Catch Ex As Exception
'Others generic erroes
Throw New ApplicationExce ption("Read Error: " & Ex.Message, Ex)
End Try
End If
End Function

'This subroutine writes the passed array of bytes to the
'Comm Port to be written.
Public Overloads Sub Write(ByVal Buffer As Byte())
Dim iBytesWritten, iRc As Integer

If mhRS = -1 Then
Throw New ApplicationExce ption( _
"Please initialize and open port before using this method")
Else
'Transmit data to COM Port
Try
If meMode = Mode.Overlapped Then
'Overlapped write
If pHandleOverlapp edWrite(Buffer) Then
Throw New ApplicationExce ption( _
"Error in overllapped write")
End If
Else
'Clears IO buffers
PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
iBytesWritten, Nothing)
If iRc = 0 Then
Throw New ApplicationExce ption( _
"Write Error - Bytes Written " & _
iBytesWritten.T oString & " of " & _
Buffer.Length.T oString)
End If
End If
Catch Ex As Exception
Throw
End Try
End If
End Sub

'This subroutine writes the passed string to the
'Comm Port to be written.
Public Overloads Sub Write(ByVal Buffer As String)
Dim oEncoder As New System.Text.ASC IIEncoding()
Dim aByte() As Byte = oEncoder.GetByt es(Buffer)
Me.Write(aByte)
End Sub
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 20 '05 #3
Here is more of the RS232 class code:

' This is the CommConfig structure used by the calls to the Windows API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Private Structure
COMMCONFIG
Public dwSize As Integer
Public wVersion As Int16
Public wReserved As Int16
Public dcbx As DCB
Public dwProviderSubTy pe As Integer
Public dwProviderOffse t As Integer
Public dwProviderSize As Integer
Public wcProviderData As Byte
End Structure

' This is the OverLapped structure used by the calls to the Windows
API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Public Structure
OVERLAPPED
Public Internal As Integer
Public InternalHigh As Integer
Public Offset As Integer
Public OffsetHigh As Integer
Public hEvent As Integer
End Structure
#End Region

#Region "Exceptions "

' This class defines a customized channel exception. This exception
is
' raised when a NACK is raised.
Public Class CIOChannelExcep tion : Inherits ApplicationExce ption
Sub New(ByVal Message As String)
MyBase.New(Mess age)
End Sub
Sub New(ByVal Message As String, ByVal InnerException As
Exception)
MyBase.New(Mess age, InnerException)
End Sub
End Class

' This class defines a customized timeout exception.
Public Class IOTimeoutExcept ion : Inherits CIOChannelExcep tion
Sub New(ByVal Message As String)
MyBase.New(Mess age)
End Sub
Sub New(ByVal Message As String, ByVal InnerException As
Exception)
MyBase.New(Mess age, InnerException)
End Sub
End Class

#End Region

#Region "Events"
' These events allow the program using this class to react to Comm
Port
' events.
Public Event DataReceived(By Val Source As Rs232, ByVal DataBuffer()
As Byte)
Public Event TxCompleted(ByV al Source As Rs232)
Public Event CommEvent(ByVal Source As Rs232, ByVal Mask As
EventMasks)
#End Region

#Region "Constants"
' These constants are used to make the code clearer.
Private Const PURGE_RXABORT As Integer = &H2
Private Const PURGE_RXCLEAR As Integer = &H8
Private Const PURGE_TXABORT As Integer = &H1
Private Const PURGE_TXCLEAR As Integer = &H4
Private Const GENERIC_READ As Integer = &H80000000
Private Const GENERIC_WRITE As Integer = &H40000000
Private Const OPEN_EXISTING As Integer = 3
Private Const INVALID_HANDLE_ VALUE As Integer = -1
Private Const IO_BUFFER_SIZE As Integer = 1024
Private Const FILE_FLAG_OVERL APPED As Integer = &H40000000
Private Const ERROR_IO_PENDIN G As Integer = 997
Private Const WAIT_OBJECT_0 As Integer = 0
Private Const ERROR_IO_INCOMP LETE As Integer = 996
Private Const WAIT_TIMEOUT As Integer = &H102&
Private Const INFINITE As Integer = &HFFFFFFFF
#End Region

#Region "Properties "

' This property gets or sets the BaudRate
Public Property BaudRate() As Integer
Get
Return miBaudRate
End Get
Set(ByVal Value As Integer)
miBaudRate = Value
End Set
End Property

' This property gets or sets the BufferSize
Public Property BufferSize() As Integer
Get
Return miBufferSize
End Get
Set(ByVal Value As Integer)
miBufferSize = Value
End Set
End Property

' This property gets or sets the DataBit.
Public Property DataBit() As Integer
Get
Return miDataBit
End Get
Set(ByVal Value As Integer)
miDataBit = Value
End Set
End Property

' This write-only property sets or resets the DTR line.
Public WriteOnly Property Dtr() As Boolean
Set(ByVal Value As Boolean)
If Not mhRS = -1 Then
If Value Then
EscapeCommFunct ion(mhRS, Lines.SetDtr)
Else
EscapeCommFunct ion(mhRS, Lines.ClearDtr)
End If
End If
End Set
End Property

' This read-only property returns an array of bytes that represents
' the input coming into the Comm Port.
Overridable ReadOnly Property InputStream() As Byte()
Get
Return mabtRxBuf
End Get
End Property

' This read-only property returns a string that represents
' the data coming into to the Comm Port.
Overridable ReadOnly Property InputStreamStri ng() As String
Get
Dim oEncoder As New System.Text.ASC IIEncoding()
Return oEncoder.GetStr ing(Me.InputStr eam)
End Get
End Property

' This property returns the open status of the Comm Port.
ReadOnly Property IsOpen() As Boolean
Get
Return CBool(mhRS <> -1)
End Get
End Property

' This read-only property returns the status of the modem.
Public ReadOnly Property ModemStatus() As ModemStatusBits
Get
If mhRS = -1 Then
Throw New ApplicationExce ption("Please initialize and
open " + _
"port before using this method")
Else
' Retrieve modem status
Dim lpModemStatus As Integer
If Not GetCommModemSta tus(mhRS, lpModemStatus) Then
Throw New ApplicationExce ption("Unable to get modem
status")
Else
Return CType(lpModemSt atus, ModemStatusBits )
End If
End If
End Get
End Property

' This property gets or sets the Parity
Public Property Parity() As DataParity
Get
Return meParity
End Get
Set(ByVal Value As DataParity)
meParity = Value
End Set
End Property

' This property gets or sets the Port
Public Property Port() As Integer
Get
Return miPort
End Get
Set(ByVal Value As Integer)
miPort = Value
End Set
End Property

' This write-only property sets or resets the RTS line.
Public WriteOnly Property Rts() As Boolean
Set(ByVal Value As Boolean)
If Not mhRS = -1 Then
If Value Then
EscapeCommFunct ion(mhRS, Lines.SetRts)
Else
EscapeCommFunct ion(mhRS, Lines.ClearRts)
End If
End If
End Set
End Property

' This property gets or sets the StopBit
Public Property StopBit() As DataStopBit
Get
Return meStopBit
End Get
Set(ByVal Value As DataStopBit)
meStopBit = Value
End Set
End Property

' This property gets or sets the Timeout
Public Overridable Property Timeout() As Integer
Get
Return miTimeout
End Get
Set(ByVal Value As Integer)
miTimeout = CInt(IIf(Value = 0, 500, Value))
' If Port is open updates it on the fly
pSetTimeout()
End Set
End Property

' This property gets or sets the working mode to overlapped
' or non-overlapped.
Public Property WorkingMode() As Mode
Get
Return meMode
End Get
Set(ByVal Value As Mode)
meMode = Value
End Set
End Property

#End Region
#Region "Win32API"
' The following functions are the required Win32 functions needed to
' make communication with the Comm Port possible.

<DllImport("ker nel32.dll")> Private Shared Function BuildCommDCB( _
ByVal lpDef As String, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function ClearCommError(
_
ByVal hFile As Integer, ByVal lpErrors As Integer, _
ByVal l As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CloseHandle( _
ByVal hObject As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CreateEvent( _
ByVal lpEventAttribut es As Integer, ByVal bManualReset As
Integer, _
ByVal bInitialState As Integer, _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpName As String) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CreateFile( _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpFileName As String, _
ByVal dwDesiredAccess As Integer, ByVal dwShareMode As Integer,
_
ByVal lpSecurityAttri butes As Integer, _
ByVal dwCreationDispo sition As Integer, _
ByVal dwFlagsAndAttri butes As Integer, _
ByVal hTemplateFile As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
EscapeCommFunct ion( _
ByVal hFile As Integer, ByVal ifunc As Long) As Boolean
End Function

<DllImport("ker nel32.dll")> Private Shared Function FormatMessage( _
ByVal dwFlags As Integer, ByVal lpSource As Integer, _
ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpBuffer As String, _
ByVal nSize As Integer, ByVal Arguments As Integer) As Integer
End Function

Private Declare Function FormatMessage Lib "kernel32" Alias _
"FormatMessageA " (ByVal dwFlags As Integer, ByVal lpSource As
Integer, _
ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, _
ByVal lpBuffer As StringBuilder, ByVal nSize As Integer, _
ByVal Arguments As Integer) As Integer

<DllImport("ker nel32.dll")> Public Shared Function
GetCommModemSta tus( _
ByVal hFile As Integer, ByRef lpModemStatus As Integer) As
Boolean
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetCommState( _
ByVal hCommDev As Integer, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetCommTimeouts (
_
ByVal hFile As Integer, ByRef lpCommTimeouts As COMMTIMEOUTS) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetLastError()
As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
GetOverlappedRe sult( _
ByVal hFile As Integer, ByRef lpOverlapped As OVERLAPPED, _
ByRef lpNumberOfBytes Transferred As Integer, _
ByVal bWait As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function PurgeComm( _
ByVal hFile As Integer, ByVal dwFlags As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function ReadFile( _
ByVal hFile As Integer, ByVal Buffer As Byte(), _
ByVal nNumberOfBytesT oRead As Integer, _
ByRef lpNumberOfBytes Read As Integer, _
ByRef lpOverlapped As OVERLAPPED) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommTimeouts (
_
ByVal hFile As Integer, ByRef lpCommTimeouts As COMMTIMEOUTS) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommState( _
ByVal hCommDev As Integer, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetupComm( _
ByVal hFile As Integer, ByVal dwInQueue As Integer, _
ByVal dwOutQueue As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommMask( _
ByVal hFile As Integer, ByVal lpEvtMask As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function WaitCommEvent( _
ByVal hFile As Integer, ByRef Mask As EventMasks, _
ByRef lpOverlap As OVERLAPPED) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
WaitForSingleOb ject( _
ByVal hHandle As Integer, ByVal dwMilliseconds As Integer) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function WriteFile( _
ByVal hFile As Integer, ByVal Buffer As Byte(), _
ByVal nNumberOfBytesT oWrite As Integer, _
ByRef lpNumberOfBytes Written As Integer, _
ByRef lpOverlapped As OVERLAPPED) As Integer
End Function

#End Region

#Region "Methods"

' This subroutine invokes a thread to perform an asynchronous read.
' This routine should not be called directly, but is used
' by the class.
Public Sub _R()
Dim iRet As Integer = Read(miTmpBytes 2Read)
End Sub

' This subroutine invokes a thread to perform an asynchronous write.
' This routine should not be called directly, but is used
' by the class.
Public Sub _W()
Write(mabtTmpTx Buf)
End Sub

' This subroutine uses another thread to read from the Comm Port. It
' raises RxCompleted when done. It reads an integer.
Public Overloads Sub AsyncRead(ByVal Bytes2Read As Integer)
If meMode <> Mode.Overlapped Then Throw New
ApplicationExce ption( _
"Async Methods allowed only when WorkingMode=Ove rlapped")
miTmpBytes2Read = Bytes2Read
moThreadTx = New Thread(AddressO f _R)
moThreadTx.Star t()
End Sub

' This subroutine uses another thread to write to the Comm Port. It
' raises TxCompleted when done. It writes an array of bytes.
Public Overloads Sub AsyncWrite(ByVa l Buffer() As Byte)
If meMode <> Mode.Overlapped Then Throw New
ApplicationExce ption( _
"Async Methods allwed only when WorkingMode=Ove rlapped")
If mbWaitOnWrite = True Then Throw New ApplicationExce ption( _
"Unable to send message because of pending transmission.")
mabtTmpTxBuf = Buffer
moThreadTx = New Thread(AddressO f _W)
moThreadTx.Star t()
End Sub

' This subroutine uses another thread to write to the Comm Port. It
' raises TxCompleted when done. It writes a string.
Public Overloads Sub AsyncWrite(ByVa l Buffer As String)
Dim oEncoder As New System.Text.ASC IIEncoding()
Dim aByte() As Byte = oEncoder.GetByt es(Buffer)
Me.AsyncWrite(a Byte)
End Sub

' This function takes the ModemStatusBits and returns a boolean
value
' signifying whether the Modem is active.
Public Function CheckLineStatus (ByVal Line As ModemStatusBits ) As
Boolean
Return Convert.ToBoole an(ModemStatus And Line)
End Function

' This subroutine clears the input buffer.
Public Sub ClearInputBuffe r()
If Not mhRS = -1 Then
PurgeComm(mhRS, PURGE_RXCLEAR)
End If
End Sub

' This subroutine closes the Comm Port.
Public Sub Close()
If mhRS <> -1 Then
CloseHandle(mhR S)
mhRS = -1
End If
End Sub

' This subroutine opens and initializes the Comm Port
Public Overloads Sub Open()
' Get Dcb block,Update with current data
Dim uDcb As DCB, iRc As Integer
' Set working mode
Dim iMode As Integer = Convert.ToInt32 (IIf(meMode =
Mode.Overlapped , _
FILE_FLAG_OVERL APPED, 0))
' Initializes Com Port
If miPort > 0 Then
Try
' Creates a COM Port stream handle
mhRS = CreateFile("COM " & miPort.ToString , _
GENERIC_READ Or GENERIC_WRITE, 0, 0, _
OPEN_EXISTING, iMode, 0)
If mhRS <> -1 Then
' Clear all comunication errors
Dim lpErrCode As Integer
iRc = ClearCommError( mhRS, lpErrCode, 0&)
' Clears I/O buffers
iRc = PurgeComm(mhRS, PurgeBuffers.RX Clear Or _
PurgeBuffers.Tx Clear)
' Gets COM Settings
iRc = GetCommState(mh RS, uDcb)
' Updates COM Settings
Dim sParity As String = "NOEM"
sParity = sParity.Substri ng(meParity, 1)
' Set DCB State
Dim sDCBState As String = String.Format( _
"baud={0} parity={1} data={2} stop={3}", _
miBaudRate, sParity, miDataBit, CInt(meStopBit) )
iRc = BuildCommDCB(sD CBState, uDcb)
iRc = SetCommState(mh RS, uDcb)
If iRc = 0 Then
Dim sErrTxt As String =
pErr2Text(GetLa stError())
Throw New CIOChannelExcep tion( _
"Unable to set COM state0" & sErrTxt)
End If
' Setup Buffers (Rx,Tx)
iRc = SetupComm(mhRS, miBufferSize, miBufferSize)
' Set Timeouts
pSetTimeout()
Else
' Raise Initialization problems
Throw New CIOChannelExcep tion( _
"Unable to open COM" & miPort.ToString )
End If
Catch Ex As Exception
' Generica error
Throw New CIOChannelExcep tion(Ex.Message , Ex)
End Try
Else
' Port not defined, cannot open
Throw New ApplicationExce ption("COM Port not defined, " + _
"use Port property to set it before invoking InitPort")
End If
End Sub

' This subroutine opens and initializes the Comm Port (overloaded
' to support parameters).
Public Overloads Sub Open(ByVal Port As Integer, _
ByVal BaudRate As Integer, ByVal DataBit As Integer, _
ByVal Parity As DataParity, ByVal StopBit As DataStopBit, _
ByVal BufferSize As Integer)

Me.Port = Port
Me.BaudRate = BaudRate
Me.DataBit = DataBit
Me.Parity = Parity
Me.StopBit = StopBit
Me.BufferSize = BufferSize
Open()
End Sub

' This function translates an API error code to text.
Private Function pErr2Text(ByVal lCode As Integer) As String
Dim sRtrnCode As New StringBuilder(2 56)
Dim lRet As Integer

lRet = FormatMessage(& H1000, 0, lCode, 0, sRtrnCode, 256, 0)
If lRet > 0 Then
Return sRtrnCode.ToStr ing
Else
Return "Error not found."
End If

End Function

' This subroutine handles overlapped reads.
Private Sub pHandleOverlapp edRead(ByVal Bytes2Read As Integer)
Dim iReadChars, iRc, iRes, iLastErr As Integer
muOverlapped.hE vent = CreateEvent(Not hing, 1, 0, Nothing)
If muOverlapped.hE vent = 0 Then
' Can't create event
Throw New ApplicationExce ption( _
"Error creating event for overlapped read.")
Else
' Ovellaped reading
If mbWaitOnRead = False Then
ReDim mabtRxBuf(Bytes 2Read - 1)
iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, _
iReadChars, muOverlapped)
If iRc = 0 Then
iLastErr = GetLastError()
If iLastErr <> ERROR_IO_PENDIN G Then
Throw New ArgumentExcepti on("Overlapped Read
Error: " & _
pErr2Text(iLast Err))
Else
' Set Flag
mbWaitOnRead = True
End If
Else
' Read completed successfully
RaiseEvent DataReceived(Me , mabtRxBuf)
End If
End If
End If
' Wait for operation to be completed
If mbWaitOnRead Then
iRes = WaitForSingleOb ject(muOverlapp ed.hEvent, miTimeout)
Select Case iRes
Case WAIT_OBJECT_0
' Object signaled,operat ion completed
If GetOverlappedRe sult(mhRS, muOverlapped, _
iReadChars, 0) = 0 Then

' Operation error
iLastErr = GetLastError()
If iLastErr = ERROR_IO_INCOMP LETE Then
Throw New ApplicationExce ption( _
"Read operation incomplete")
Else
Throw New ApplicationExce ption( _
"Read operation error " &
iLastErr.ToStri ng)
End If
Else
' Operation completed
RaiseEvent DataReceived(Me , mabtRxBuf)
mbWaitOnRead = False
End If
Case WAIT_TIMEOUT
Throw New IOTimeoutExcept ion("Timeout error")
Case Else
Throw New ApplicationExce ption("Overlapp ed read
error")
End Select
End If
End Sub

' This subroutine handles overlapped writes.
Private Function pHandleOverlapp edWrite(ByVal Buffer() As Byte) As
Boolean
Dim iBytesWritten, iRc, iLastErr, iRes As Integer, bErr As
Boolean
muOverlappedW.h Event = CreateEvent(Not hing, 1, 0, Nothing)
If muOverlappedW.h Event = 0 Then
' Can't create event
Throw New ApplicationExce ption( _
"Error creating event for overlapped write.")
Else
' Overllaped write
PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
mbWaitOnRead = True
iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
iBytesWritten, muOverlappedW)
If iRc = 0 Then
iLastErr = GetLastError()
If iLastErr <> ERROR_IO_PENDIN G Then
Throw New ArgumentExcepti on("Overlapped Read Error:
" & _
pErr2Text(iLast Err))
Else
' Write is pending
iRes = WaitForSingleOb ject(muOverlapp edW.hEvent,
INFINITE)
Select Case iRes
Case WAIT_OBJECT_0
' Object signaled,operat ion completed
If GetOverlappedRe sult(mhRS, muOverlappedW,
_
iBytesWritten, 0) = 0 Then

bErr = True
Else
' Notifies Async tx completion,stop s
thread
mbWaitOnRead = False
RaiseEvent TxCompleted(Me)
End If
End Select
End If
Else
' Wait operation completed immediatly
bErr = False
End If
End If
CloseHandle(muO verlappedW.hEve nt)
Return bErr
End Function

' This subroutine sets the Comm Port timeouts.
Private Sub pSetTimeout()
Dim uCtm As COMMTIMEOUTS
' Set ComTimeout
If mhRS = -1 Then
Exit Sub
Else
' Changes setup on the fly
With uCtm
.ReadIntervalTi meout = 0
.ReadTotalTimeo utMultiplier = 0
.ReadTotalTimeo utConstant = miTimeout
.WriteTotalTime outMultiplier = 10
.WriteTotalTime outConstant = 100
End With
SetCommTimeouts (mhRS, uCtm)
End If
End Sub

' This function returns an integer specifying the number of bytes
' read from the Comm Port. It accepts a parameter specifying the
number
' of desired bytes to read.
Public Function Read(ByVal Bytes2Read As Integer) As Integer
Dim iReadChars, iRc As Integer

' If Bytes2Read not specified uses Buffersize
If Bytes2Read = 0 Then Bytes2Read = miBufferSize
If mhRS = -1 Then
Throw New ApplicationExce ption( _
"Please initialize and open port before using this
method")
Else
' Get bytes from port
Try
' Purge buffers
'PurgeComm(mhRS , PURGE_RXCLEAR Or PURGE_TXCLEAR)
' Creates an event for overlapped operations
If meMode = Mode.Overlapped Then
pHandleOverlapp edRead(Bytes2Re ad)
Else
' Non overlapped mode
ReDim mabtRxBuf(Bytes 2Read - 1)
iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read,
iReadChars, Nothing)
If iRc = 0 Then
' Read Error
Throw New ApplicationExce ption( _
"ReadFile error " & iRc.ToString)
Else
' Handles timeout or returns input chars
If iReadChars < Bytes2Read Then
Throw New IOTimeoutExcept ion("Timeout
error")
Else
mbWaitOnRead = True
Return (iReadChars)
End If
End If
End If
Catch Ex As Exception
' Others generic erroes
Throw New ApplicationExce ption("Read Error: " &
Ex.Message, Ex)
End Try
End If
End Function

' This subroutine writes the passed array of bytes to the
' Comm Port to be written.
Public Overloads Sub Write(ByVal Buffer As Byte())
Dim iBytesWritten, iRc As Integer

If mhRS = -1 Then
Throw New ApplicationExce ption( _
"Please initialize and open port before using this
method")
Else
' Transmit data to COM Port
Try
If meMode = Mode.Overlapped Then
' Overlapped write
If pHandleOverlapp edWrite(Buffer) Then
Throw New ApplicationExce ption( _
"Error in overllapped write")
End If
Else
' Clears IO buffers
PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
iBytesWritten, Nothing)
If iRc = 0 Then
Throw New ApplicationExce ption( _
"Write Error - Bytes Written " & _
iBytesWritten.T oString & " of " & _
Buffer.Length.T oString)
End If
End If
Catch Ex As Exception
Throw
End Try
End If
End Sub

' This subroutine writes the passed string to the
' Comm Port to be written.
Public Overloads Sub Write(ByVal Buffer As String)
Dim oEncoder As New System.Text.ASC IIEncoding()
Dim aByte() As Byte = oEncoder.GetByt es(Buffer)
Me.Write(aByte)
End Sub

#End Region
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 20 '05 #4
Implicit datatype conversion isn't done in .Net So it can't change that
string to a Long it needs to be converted to a long first try this.

GetNumber = Ctype(Trim(myCo mmData.Substrin g(iOutputComman dIndex, 8)),Long)
"rsine" <an*******@devd ex.com> wrote in message
news:%2******** ********@TK2MSF TNGP09.phx.gbl. ..
Mike,

I am thinking the error my have something to do with the RS232 class
that I am using. The code is not of my own writing but met the needs of
what I am doing so I have written my code to use it. Looking at it
closer, I am wondering if I can use WIN32 API calls on a WIN98 system? I
have included the code for this class following my code which uses the
class.

'************** **********
'* Function: GetNumber()
'************** **********
Private Function GetNumber(ByVal shCnt As Short) As Long

Try

Dim sOutputCommand As String
Dim iOutputCommandI ndex As Integer

'clear commdata variable
myCommData = ""

Dim StopBits As Rs232.DataStopB it = Rs232.DataStopB it.StopBit_1
Dim Parity As Rs232.DataParit y = Rs232.DataParit y.Parity_None

'open comm port connection
myCommPort.Open (iCommPort, iBaudRate, iDataBits, Parity, StopBits,
4096)

'clear the input buffer
myCommPort.Clea rInputBuffer()

'allow system processes
System.Windows. Forms.Applicati on.DoEvents()

'build command to send
sOutputCommand = "GET.NO " & CStr(shOrderCnt ) & vbCr

'enable timer (will be disabled once commport data is retrieved)
tmrReadCommPort .Enabled = True

'output command to port and wait for response
myCommPort.Writ e(sOutputComman d)

'sleep long enough for timer to fire
System.Threadin g.Thread.Sleep( 200)

'give some time to other events
System.Windows. Forms.Applicati on.DoEvents()

'close the commport
myCommPort.Clos e()

'extract number (add 1 to account for the vbCr)
iOutputCommandI ndex = myCommData.Inde xOf("GET.NO", 0) +
sOutputCommand. Length + 1

GetNumber = Trim(myCommData .Substring(iOut putCommandIndex , 8))

Catch ex As Exception

messagebox.show (ex.message)

End Try

End Function

'************** *************** *************** **************
'* Timer Control
'*
'* This event is used to control reading from commport.
'************** *************** *************** **************
Private Sub tmrReadCommPort _Tick(ByVal sender As System.Object,B yVal e
As System.EventArg s) Handles tmrReadCommPort .Tick

Dim bDisableTimer As Boolean

Try

'timer should not be disabled until data is read
bDisableTimer = False

'retrieve data from input buffer a character at a time
'and stop when at the end.
While (myCommPort.Rea d(1) <> -1)
myCommData = myCommData & Chr(myCommPort. InputStream(0))
bDisableTimer = True
End While

Catch ex As Exception

'once data is retrieved from the comm port then disable the
'timer so it does not continue to fire.
If bDisableTimer = True Then tmrReadCommPort .Enabled = False

End Try

End Sub

=============== == RS232 code =============== =====
'This class provides all the necessary support for communicating with
the Comm Port (otherwise known as the Serial Port, or RS232 port).

Public Class Rs232

'Declare the necessary class variables, and their initial values.
Private mhRS As Integer = -1 ' Handle to Com Port
Private miPort As Integer = 1 ' Default is COM1
Private miTimeout As Integer = 70 ' Timeout in ms
Private miBaudRate As Integer = 9600
Private meParity As DataParity = 0
Private meStopBit As DataStopBit = 0
Private miDataBit As Integer = 8
Private miBufferSize As Integer = 512 ' Buffers size default to 512
bytes
Private mabtRxBuf As Byte() ' Receive buffer
Private meMode As Mode ' Class working mode
Private mbWaitOnRead As Boolean
Private mbWaitOnWrite As Boolean
Private mbWriteErr As Boolean
Private muOverlapped As OVERLAPPED
Private muOverlappedW As OVERLAPPED
Private muOverlappedE As OVERLAPPED
Private mabtTmpTxBuf As Byte() ' Temporary buffer used by Async Tx
Private moThreadTx As Thread
Private moThreadRx As Thread
Private miTmpBytes2Read As Integer
Private meMask As EventMasks

#Region "Enums"

'This enumeration provides Data Parity values.
Public Enum DataParity
Parity_None = 0
Pariti_Odd
Parity_Even
Parity_Mark
End Enum

'This enumeration provides Data Stop Bit values.
'It is set to begin with a one, so that the enumeration values
'match the actual values.
Public Enum DataStopBit
StopBit_1 = 1
StopBit_2
End Enum

'This enumeration contains values used to purge the various buffers.
Private Enum PurgeBuffers
RXAbort = &H2
RXClear = &H8
TxAbort = &H1
TxClear = &H4
End Enum

'This enumeration provides values for the lines sent to the Comm Port
Private Enum Lines
SetRts = 3
ClearRts = 4
SetDtr = 5
ClearDtr = 6
ResetDev = 7 ' Reset device if possible
SetBreak = 8 ' Set the device break line.
ClearBreak = 9 ' Clear the device break line.
End Enum

'This enumeration provides values for the Modem Status, since
'we'll be communicating primarily with a modem.
'Note that the Flags() attribute is set to allow for a bitwise
'combination of values.
<Flags()> Public Enum ModemStatusBits
ClearToSendOn = &H10
DataSetReadyOn = &H20
RingIndicatorOn = &H40
CarrierDetect = &H80
End Enum

'This enumeration provides values for the Working mode
Public Enum Mode
NonOverlapped
Overlapped
End Enum

'This enumeration provides values for the Comm Masks used.
'Note that the Flags() attribute is set to allow for a bitwise
'combination of values.
<Flags()> Public Enum EventMasks
RxChar = &H1
RXFlag = &H2
TxBufferEmpty = &H4
ClearToSend = &H8
DataSetReady = &H10
ReceiveLine = &H20
Break = &H40
StatusError = &H80
Ring = &H100
End Enum
#End Region

#Region "Structures "
' This is the DCB structure used by the calls to the Windows API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Private Structure DCB
Public DCBlength As Integer
Public BaudRate As Integer
Public Bits1 As Integer
Public wReserved As Int16
Public XonLim As Int16
Public XoffLim As Int16
Public ByteSize As Byte
Public Parity As Byte
Public StopBits As Byte
Public XonChar As Byte
Public XoffChar As Byte
Public ErrorChar As Byte
Public EofChar As Byte
Public EvtChar As Byte
Public wReserved2 As Int16
End Structure

' This is the CommTimeOuts structure used by the calls to the
Windows API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Private Structure
COMMTIMEOUTS
Public ReadIntervalTim eout As Integer
Public ReadTotalTimeou tMultiplier As Integer
Public ReadTotalTimeou tConstant As Integer
Public WriteTotalTimeo utMultiplier As Integer
Public WriteTotalTimeo utConstant As Integer
End Structure

' This is the CommConfig structure used by the calls to the Windows
API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Private Structure
COMMCONFIG
Public dwSize As Integer
Public wVersion As Int16
Public wReserved As Int16
Public dcbx As DCB
Public dwProviderSubTy pe As Integer
Public dwProviderOffse t As Integer
Public dwProviderSize As Integer
Public wcProviderData As Byte
End Structure

' This is the OverLapped structure used by the calls to the Windows
API.
<StructLayout(L ayoutKind.Seque ntial, Pack:=1)> Public Structure
OVERLAPPED
Public Internal As Integer
Public InternalHigh As Integer
Public Offset As Integer
Public OffsetHigh As Integer
Public hEvent As Integer
End Structure
#End Region

#Region "Exceptions "

' This class defines a customized channel exception. This exception
is
' raised when a NACK is raised.
Public Class CIOChannelExcep tion : Inherits ApplicationExce ption
Sub New(ByVal Message As String)
MyBase.New(Mess age)
End Sub
Sub New(ByVal Message As String, ByVal InnerException As
Exception)
MyBase.New(Mess age, InnerException)
End Sub
End Class

' This class defines a customized timeout exception.
Public Class IOTimeoutExcept ion : Inherits CIOChannelExcep tion
Sub New(ByVal Message As String)
MyBase.New(Mess age)
End Sub
Sub New(ByVal Message As String, ByVal InnerException As
Exception)
MyBase.New(Mess age, InnerException)
End Sub
End Class

#End Region

#Region "Events"
' These events allow the program using this class to react to Comm
Port
' events.
Public Event DataReceived(By Val Source As Rs232, ByVal DataBuffer()
As Byte)
Public Event TxCompleted(ByV al Source As Rs232)
Public Event CommEvent(ByVal Source As Rs232, ByVal Mask As
EventMasks)
#End Region

#Region "Constants"
' These constants are used to make the code clearer.
Private Const PURGE_RXABORT As Integer = &H2
Private Const PURGE_RXCLEAR As Integer = &H8
Private Const PURGE_TXABORT As Integer = &H1
Private Const PURGE_TXCLEAR As Integer = &H4
Private Const GENERIC_READ As Integer = &H80000000
Private Const GENERIC_WRITE As Integer = &H40000000
Private Const OPEN_EXISTING As Integer = 3
Private Const INVALID_HANDLE_ VALUE As Integer = -1
Private Const IO_BUFFER_SIZE As Integer = 1024
Private Const FILE_FLAG_OVERL APPED As Integer = &H40000000
Private Const ERROR_IO_PENDIN G As Integer = 997
Private Const WAIT_OBJECT_0 As Integer = 0
Private Const ERROR_IO_INCOMP LETE As Integer = 996
Private Const WAIT_TIMEOUT As Integer = &H102&
Private Const INFINITE As Integer = &HFFFFFFFF
#End Region

#Region "Properties "

' This property gets or sets the BaudRate
Public Property BaudRate() As Integer
Get
Return miBaudRate
End Get
Set(ByVal Value As Integer)
miBaudRate = Value
End Set
End Property

' This property gets or sets the BufferSize
Public Property BufferSize() As Integer
Get
Return miBufferSize
End Get
Set(ByVal Value As Integer)
miBufferSize = Value
End Set
End Property

' This property gets or sets the DataBit.
Public Property DataBit() As Integer
Get
Return miDataBit
End Get
Set(ByVal Value As Integer)
miDataBit = Value
End Set
End Property

' This write-only property sets or resets the DTR line.
Public WriteOnly Property Dtr() As Boolean
Set(ByVal Value As Boolean)
If Not mhRS = -1 Then
If Value Then
EscapeCommFunct ion(mhRS, Lines.SetDtr)
Else
EscapeCommFunct ion(mhRS, Lines.ClearDtr)
End If
End If
End Set
End Property

' This read-only property returns an array of bytes that represents
' the input coming into the Comm Port.
Overridable ReadOnly Property InputStream() As Byte()
Get
Return mabtRxBuf
End Get
End Property

' This read-only property returns a string that represents
' the data coming into to the Comm Port.
Overridable ReadOnly Property InputStreamStri ng() As String
Get
Dim oEncoder As New System.Text.ASC IIEncoding()
Return oEncoder.GetStr ing(Me.InputStr eam)
End Get
End Property

' This property returns the open status of the Comm Port.
ReadOnly Property IsOpen() As Boolean
Get
Return CBool(mhRS <> -1)
End Get
End Property

' This read-only property returns the status of the modem.
Public ReadOnly Property ModemStatus() As ModemStatusBits
Get
If mhRS = -1 Then
Throw New ApplicationExce ption("Please initialize and
open " + _
"port before using this method")
Else
' Retrieve modem status
Dim lpModemStatus As Integer
If Not GetCommModemSta tus(mhRS, lpModemStatus) Then
Throw New ApplicationExce ption("Unable to get modem
status")
Else
Return CType(lpModemSt atus, ModemStatusBits )
End If
End If
End Get
End Property

' This property gets or sets the Parity
Public Property Parity() As DataParity
Get
Return meParity
End Get
Set(ByVal Value As DataParity)
meParity = Value
End Set
End Property

' This property gets or sets the Port
Public Property Port() As Integer
Get
Return miPort
End Get
Set(ByVal Value As Integer)
miPort = Value
End Set
End Property

' This write-only property sets or resets the RTS line.
Public WriteOnly Property Rts() As Boolean
Set(ByVal Value As Boolean)
If Not mhRS = -1 Then
If Value Then
EscapeCommFunct ion(mhRS, Lines.SetRts)
Else
EscapeCommFunct ion(mhRS, Lines.ClearRts)
End If
End If
End Set
End Property

' This property gets or sets the StopBit
Public Property StopBit() As DataStopBit
Get
Return meStopBit
End Get
Set(ByVal Value As DataStopBit)
meStopBit = Value
End Set
End Property

' This property gets or sets the Timeout
Public Overridable Property Timeout() As Integer
Get
Return miTimeout
End Get
Set(ByVal Value As Integer)
miTimeout = CInt(IIf(Value = 0, 500, Value))
' If Port is open updates it on the fly
pSetTimeout()
End Set
End Property

' This property gets or sets the working mode to overlapped
' or non-overlapped.
Public Property WorkingMode() As Mode
Get
Return meMode
End Get
Set(ByVal Value As Mode)
meMode = Value
End Set
End Property

#End Region
#Region "Win32API"
' The following functions are the required Win32 functions needed to
' make communication with the Comm Port possible.

<DllImport("ker nel32.dll")> Private Shared Function BuildCommDCB( _
ByVal lpDef As String, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function ClearCommError(
_
ByVal hFile As Integer, ByVal lpErrors As Integer, _
ByVal l As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CloseHandle( _
ByVal hObject As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CreateEvent( _
ByVal lpEventAttribut es As Integer, ByVal bManualReset As
Integer, _
ByVal bInitialState As Integer, _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpName As String) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CreateFile( _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpFileName As String, _
ByVal dwDesiredAccess As Integer, ByVal dwShareMode As Integer,
_
ByVal lpSecurityAttri butes As Integer, _
ByVal dwCreationDispo sition As Integer, _
ByVal dwFlagsAndAttri butes As Integer, _
ByVal hTemplateFile As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
EscapeCommFunct ion( _
ByVal hFile As Integer, ByVal ifunc As Long) As Boolean
End Function

<DllImport("ker nel32.dll")> Private Shared Function FormatMessage( _
ByVal dwFlags As Integer, ByVal lpSource As Integer, _
ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpBuffer As String, _
ByVal nSize As Integer, ByVal Arguments As Integer) As Integer
End Function

Private Declare Function FormatMessage Lib "kernel32" Alias _
"FormatMess ageA (ByVal dwFlags As Integer, ByVal lpSource As
Integer, _
ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, _
ByVal lpBuffer As StringBuilder, ByVal nSize As Integer, _
ByVal Arguments As Integer) As Integer

<DllImport("ker nel32.dll")> Public Shared Function
GetCommModemSta tus( _
ByVal hFile As Integer, ByRef lpModemStatus As Integer) As
Boolean
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetCommState( _
ByVal hCommDev As Integer, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetCommTimeouts (
_
ByVal hFile As Integer, ByRef lpCommTimeouts As COMMTIMEOUTS) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetLastError()
As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
GetOverlappedRe sult( _
ByVal hFile As Integer, ByRef lpOverlapped As OVERLAPPED, _
ByRef lpNumberOfBytes Transferred As Integer, _
ByVal bWait As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function PurgeComm( _
ByVal hFile As Integer, ByVal dwFlags As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function ReadFile( _
ByVal hFile As Integer, ByVal Buffer As Byte(), _
ByVal nNumberOfBytesT oRead As Integer, _
ByRef lpNumberOfBytes Read As Integer, _
ByRef lpOverlapped As OVERLAPPED) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommTimeouts (
_
ByVal hFile As Integer, ByRef lpCommTimeouts As COMMTIMEOUTS) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommState( _
ByVal hCommDev As Integer, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetupComm( _
ByVal hFile As Integer, ByVal dwInQueue As Integer, _
ByVal dwOutQueue As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommMask( _
ByVal hFile As Integer, ByVal lpEvtMask As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function WaitCommEvent( _
ByVal hFile As Integer, ByRef Mask As EventMasks, _
ByRef lpOverlap As OVERLAPPED) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
WaitForSingleOb ject( _
ByVal hHandle As Integer, ByVal dwMilliseconds As Integer) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function WriteFile( _
ByVal hFile As Integer, ByVal Buffer As Byte(), _
ByVal nNumberOfBytesT oWrite As Integer, _
ByRef lpNumberOfBytes Written As Integer, _
ByRef lpOverlapped As OVERLAPPED) As Integer
End Function

#End Region

#Region "Methods"

' This subroutine invokes a thread to perform an asynchronous read.
' This routine should not be called directly, but is used
' by the class.
Public Sub _R()
Dim iRet As Integer = Read(miTmpBytes 2Read)
End Sub

' This subroutine invokes a thread to perform an asynchronous write.
' This routine should not be called directly, but is used
' by the class.
Public Sub _W()
Write(mabtTmpTx Buf)
End Sub

' This subroutine uses another thread to read from the Comm Port. It
' raises RxCompleted when done. It reads an integer.
Public Overloads Sub AsyncRead(ByVal Bytes2Read As Integer)
If meMode <> Mode.Overlapped Then Throw New
ApplicationExce ption( _
"Async Methods allowed only when WorkingMode=Ove rlapped")
miTmpBytes2Read = Bytes2Read
moThreadTx = New Thread(AddressO f _R)
moThreadTx.Star t()
End Sub

' This subroutine uses another thread to write to the Comm Port. It
' raises TxCompleted when done. It writes an array of bytes.
Public Overloads Sub AsyncWrite(ByVa l Buffer() As Byte)
If meMode <> Mode.Overlapped Then Throw New
ApplicationExce ption( _
"Async Methods allowed only when WorkingMode=Ove rlapped")
If mbWaitOnWrite = True Then Throw New ApplicationExce ption( _
"Unable to send message because of pending transmission.")
mabtTmpTxBuf = Buffer
moThreadTx = New Thread(AddressO f _W)
moThreadTx.Star t()
End Sub

' This subroutine uses another thread to write to the Comm Port. It
' raises TxCompleted when done. It writes a string.
Public Overloads Sub AsyncWrite(ByVa l Buffer As String)
Dim oEncoder As New System.Text.ASC IIEncoding()
Dim aByte() As Byte = oEncoder.GetByt es(Buffer)
Me.AsyncWrite(a Byte)
End Sub

' This function takes the ModemStatusBits and returns a boolean
value
' signifying whether the Modem is active.
Public Function CheckLineStatus (ByVal Line As ModemStatusBits ) As
Boolean
Return Convert.ToBoole an(ModemStatus And Line)
End Function

' This subroutine clears the input buffer.
Public Sub ClearInputBuffe r()
If Not mhRS = -1 Then
PurgeComm(mhRS, PURGE_RXCLEAR)
End If
End Sub

' This subroutine closes the Comm Port.
Public Sub Close()
If mhRS <> -1 Then
CloseHandle(mhR S)
mhRS = -1
End If
End Sub

' This subroutine opens and initializes the Comm Port
Public Overloads Sub Open()
' Get Dcb block,Update with current data
Dim uDcb As DCB, iRc As Integer
' Set working mode
Dim iMode As Integer = Convert.ToInt32 (IIf(meMode =
Mode.Overlapped , _
FILE_FLAG_OVERL APPED, 0))
' Initializes Com Port
If miPort > 0 Then
Try
' Creates a COM Port stream handle
mhRS = CreateFile("COM " & miPort.ToString , _
GENERIC_READ Or GENERIC_WRITE, 0, 0, _
OPEN_EXISTING, iMode, 0)
If mhRS <> -1 Then
' Clear all comunication errors
Dim lpErrCode As Integer
iRc = ClearCommError( mhRS, lpErrCode, 0&)
' Clears I/O buffers
iRc = PurgeComm(mhRS, PurgeBuffers.RX Clear Or _
PurgeBuffers.Tx Clear)
' Gets COM Settings
iRc = GetCommState(mh RS, uDcb)
' Updates COM Settings
Dim sParity As String = "NOEM"
sParity = sParity.Substri ng(meParity, 1)
' Set DCB State
Dim sDCBState As String = String.Format( _
"baud={0} parity={1} data={2} stop={3}", _
miBaudRate, sParity, miDataBit, CInt(meStopBit) )
iRc = BuildCommDCB(sD CBState, uDcb)
iRc = SetCommState(mh RS, uDcb)
If iRc = 0 Then
Dim sErrTxt As String =
pErr2Text(GetLa stError())
Throw New CIOChannelExcep tion( _
"Unable to set COM state0" & sErrTxt)
End If
' Setup Buffers (Rx,Tx)
iRc = SetupComm(mhRS, miBufferSize, miBufferSize)
' Set Timeouts
pSetTimeout()
Else
' Raise Initialization problems
Throw New CIOChannelExcep tion( _
"Unable to open COM" & miPort.ToString )
End If
Catch Ex As Exception
' Generica error
Throw New CIOChannelExcep tion(Ex.Message , Ex)
End Try
Else
' Port not defined, cannot open
Throw New ApplicationExce ption("COM Port not defined, " + _
"use Port property to set it before invoking InitPort")
End If
End Sub

' This subroutine opens and initializes the Comm Port (overloaded
' to support parameters).
Public Overloads Sub Open(ByVal Port As Integer, _
ByVal BaudRate As Integer, ByVal DataBit As Integer, _
ByVal Parity As DataParity, ByVal StopBit As DataStopBit, _
ByVal BufferSize As Integer)

Me.Port = Port
Me.BaudRate = BaudRate
Me.DataBit = DataBit
Me.Parity = Parity
Me.StopBit = StopBit
Me.BufferSize = BufferSize
Open()
End Sub

' This function translates an API error code to text.
Private Function pErr2Text(ByVal lCode As Integer) As String
Dim sRtrnCode As New StringBuilder(2 56)
Dim lRet As Integer

lRet = FormatMessage(& H1000, 0, lCode, 0, sRtrnCode, 256, 0)
If lRet > 0 Then
Return sRtrnCode.ToStr ing
Else
Return "Error not found."
End If

End Function

' This subroutine handles overlapped reads.
Private Sub pHandleOverlapp edRead(ByVal Bytes2Read As Integer)
Dim iReadChars, iRc, iRes, iLastErr As Integer
muOverlapped.hE vent = CreateEvent(Not hing, 1, 0, Nothing)
If muOverlapped.hE vent = 0 Then
' Can't create event
Throw New ApplicationExce ption( _
"Error creating event for overlapped read.")
Else
' Ovellaped reading
If mbWaitOnRead = False Then
ReDim mabtRxBuf(Bytes 2Read - 1)
iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, _
iReadChars, muOverlapped)
If iRc = 0 Then
iLastErr = GetLastError()
If iLastErr <> ERROR_IO_PENDIN G Then
Throw New ArgumentExcepti on("Overlapped Read
Error: " & _
pErr2Text(iLast Err))
Else
' Set Flag
mbWaitOnRead = True
End If
Else
' Read completed successfully
RaiseEvent DataReceived(Me , mabtRxBuf)
End If
End If
End If
' Wait for operation to be completed
If mbWaitOnRead Then
iRes = WaitForSingleOb ject(muOverlapp ed.hEvent, miTimeout)
Select Case iRes
Case WAIT_OBJECT_0
' Object signaled,operat ion completed
If GetOverlappedRe sult(mhRS, muOverlapped, _
iReadChars, 0) = 0 Then

' Operation error
iLastErr = GetLastError()
If iLastErr = ERROR_IO_INCOMP LETE Then
Throw New ApplicationExce ption( _
"Read operation incomplete")
Else
Throw New ApplicationExce ption( _
"Read operation error " &
iLastErr.ToStri ng)
End If
Else
' Operation completed
RaiseEvent DataReceived(Me , mabtRxBuf)
mbWaitOnRead = False
End If
Case WAIT_TIMEOUT
Throw New IOTimeoutExcept ion("Timeout error")
Case Else
Throw New ApplicationExce ption("Overlapp ed read
error")
End Select
End If
End Sub

' This subroutine handles overlapped writes.
Private Function pHandleOverlapp edWrite(ByVal Buffer() As Byte) As
Boolean
Dim iBytesWritten, iRc, iLastErr, iRes As Integer, bErr As Boolean
muOverlappedW.h Event = CreateEvent(Not hing, 1, 0, Nothing)
If muOverlappedW.h Event = 0 Then
' Can't create event
Throw New ApplicationExce ption( _
"Error creating event for overlapped write.")
Else
' Overllaped write
PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
mbWaitOnRead = True
iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
iBytesWritten, muOverlappedW)
If iRc = 0 Then
iLastErr = GetLastError()
If iLastErr <> ERROR_IO_PENDIN G Then
Throw New ArgumentExcepti on("Overlapped Read Error: " & _
pErr2Text(iLast Err))
Else
' Write is pending
iRes = WaitForSingleOb ject(muOverlapp edW.hEvent, INFINITE)
Select Case iRes
Case WAIT_OBJECT_0
' Object signaled,operat ion completed
If GetOverlappedRe sult(mhRS, muOverlappedW, _
iBytesWritten, 0) = 0 Then

bErr = True
Else
' Notifies Async tx completion,stop s thread
mbWaitOnRead = False
RaiseEvent TxCompleted(Me)
End If
End Select
End If
Else
' Wait operation completed immediatly
bErr = False
End If
End If
CloseHandle(muO verlappedW.hEve nt)
Return bErr
End Function

' This subroutine sets the Comm Port timeouts.
Private Sub pSetTimeout()
Dim uCtm As COMMTIMEOUTS
' Set ComTimeout
If mhRS = -1 Then
Exit Sub
Else
' Changes setup on the fly
With uCtm
.ReadIntervalTi meout = 0
.ReadTotalTimeo utMultiplier = 0
.ReadTotalTimeo utConstant = miTimeout
.WriteTotalTime outMultiplier = 10
.WriteTotalTime outConstant = 100
End With
SetCommTimeouts (mhRS, uCtm)
End If
End Sub

' This function returns an integer specifying the number of bytes
' read from the Comm Port. It accepts a parameter specifying the
number
' of desired bytes to read.
Public Function Read(ByVal Bytes2Read As Integer) As Integer
Dim iReadChars, iRc As Integer

' If Bytes2Read not specified uses Buffersize
If Bytes2Read = 0 Then Bytes2Read = miBufferSize
If mhRS = -1 Then
Throw New ApplicationExce ption( _
"Please initialize and open port before using this method")
Else
' Get bytes from port
Try
' Purge buffers
'PurgeComm(mhRS , PURGE_RXCLEAR Or PURGE_TXCLEAR)
' Creates an event for overlapped operations
If meMode = Mode.Overlapped Then
pHandleOverlapp edRead(Bytes2Re ad)
Else
'Non overlapped mode
ReDim mabtRxBuf(Bytes 2Read - 1)
iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, iReadChars,
Nothing)
If iRc = 0 Then
'Read Error
Throw New ApplicationExce ption( _
"ReadFile error " & iRc.ToString)
Else
'Handles timeout or returns input chars
If iReadChars < Bytes2Read Then
Throw New IOTimeoutExcept ion("Timeout error")
Else
mbWaitOnRead = True
Return (iReadChars)
End If
End If
End If
Catch Ex As Exception
'Others generic erroes
Throw New ApplicationExce ption("Read Error: " & Ex.Message, Ex)
End Try
End If
End Function

'This subroutine writes the passed array of bytes to the
'Comm Port to be written.
Public Overloads Sub Write(ByVal Buffer As Byte())
Dim iBytesWritten, iRc As Integer

If mhRS = -1 Then
Throw New ApplicationExce ption( _
"Please initialize and open port before using this method")
Else
'Transmit data to COM Port
Try
If meMode = Mode.Overlapped Then
'Overlapped write
If pHandleOverlapp edWrite(Buffer) Then
Throw New ApplicationExce ption( _
"Error in overllapped write")
End If
Else
'Clears IO buffers
PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
iBytesWritten, Nothing)
If iRc = 0 Then
Throw New ApplicationExce ption( _
"Write Error - Bytes Written " & _
iBytesWritten.T oString & " of " & _
Buffer.Length.T oString)
End If
End If
Catch Ex As Exception
Throw
End Try
End If
End Sub

'This subroutine writes the passed string to the
'Comm Port to be written.
Public Overloads Sub Write(ByVal Buffer As String)
Dim oEncoder As New System.Text.ASC IIEncoding()
Dim aByte() As Byte = oEncoder.GetByt es(Buffer)
Me.Write(aByte)
End Sub
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Nov 20 '05 #5
More of the RS232 class:

Public Overridable Property Timeout() As Integer
Get
Return miTimeout
End Get
Set(ByVal Value As Integer)
miTimeout = CInt(IIf(Value = 0, 500, Value))
' If Port is open updates it on the fly
pSetTimeout()
End Set
End Property

' This property gets or sets the working mode to overlapped
' or non-overlapped.
Public Property WorkingMode() As Mode
Get
Return meMode
End Get
Set(ByVal Value As Mode)
meMode = Value
End Set
End Property

#End Region
#Region "Win32API"
' The following functions are the required Win32 functions needed to
' make communication with the Comm Port possible.

<DllImport("ker nel32.dll")> Private Shared Function BuildCommDCB( _
ByVal lpDef As String, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function ClearCommError(
_
ByVal hFile As Integer, ByVal lpErrors As Integer, _
ByVal l As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CloseHandle( _
ByVal hObject As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CreateEvent( _
ByVal lpEventAttribut es As Integer, ByVal bManualReset As
Integer, _
ByVal bInitialState As Integer, _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpName As String) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function CreateFile( _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpFileName As String, _
ByVal dwDesiredAccess As Integer, ByVal dwShareMode As Integer,
_
ByVal lpSecurityAttri butes As Integer, _
ByVal dwCreationDispo sition As Integer, _
ByVal dwFlagsAndAttri butes As Integer, _
ByVal hTemplateFile As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
EscapeCommFunct ion( _
ByVal hFile As Integer, ByVal ifunc As Long) As Boolean
End Function

<DllImport("ker nel32.dll")> Private Shared Function FormatMessage( _
ByVal dwFlags As Integer, ByVal lpSource As Integer, _
ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, _
<MarshalAs(Unma nagedType.LPStr )> ByVal lpBuffer As String, _
ByVal nSize As Integer, ByVal Arguments As Integer) As Integer
End Function

Private Declare Function FormatMessage Lib "kernel32" Alias _
"FormatMessageA " (ByVal dwFlags As Integer, ByVal lpSource As
Integer, _
ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, _
ByVal lpBuffer As StringBuilder, ByVal nSize As Integer, _
ByVal Arguments As Integer) As Integer

<DllImport("ker nel32.dll")> Public Shared Function
GetCommModemSta tus( _
ByVal hFile As Integer, ByRef lpModemStatus As Integer) As
Boolean
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetCommState( _
ByVal hCommDev As Integer, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetCommTimeouts (
_
ByVal hFile As Integer, ByRef lpCommTimeouts As COMMTIMEOUTS) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function GetLastError()
As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
GetOverlappedRe sult( _
ByVal hFile As Integer, ByRef lpOverlapped As OVERLAPPED, _
ByRef lpNumberOfBytes Transferred As Integer, _
ByVal bWait As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function PurgeComm( _
ByVal hFile As Integer, ByVal dwFlags As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function ReadFile( _
ByVal hFile As Integer, ByVal Buffer As Byte(), _
ByVal nNumberOfBytesT oRead As Integer, _
ByRef lpNumberOfBytes Read As Integer, _
ByRef lpOverlapped As OVERLAPPED) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommTimeouts (
_
ByVal hFile As Integer, ByRef lpCommTimeouts As COMMTIMEOUTS) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommState( _
ByVal hCommDev As Integer, ByRef lpDCB As DCB) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetupComm( _
ByVal hFile As Integer, ByVal dwInQueue As Integer, _
ByVal dwOutQueue As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function SetCommMask( _
ByVal hFile As Integer, ByVal lpEvtMask As Integer) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function WaitCommEvent( _
ByVal hFile As Integer, ByRef Mask As EventMasks, _
ByRef lpOverlap As OVERLAPPED) As Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function
WaitForSingleOb ject( _
ByVal hHandle As Integer, ByVal dwMilliseconds As Integer) As
Integer
End Function

<DllImport("ker nel32.dll")> Private Shared Function WriteFile( _
ByVal hFile As Integer, ByVal Buffer As Byte(), _
ByVal nNumberOfBytesT oWrite As Integer, _
ByRef lpNumberOfBytes Written As Integer, _
ByRef lpOverlapped As OVERLAPPED) As Integer
End Function

#End Region

#Region "Methods"

' This subroutine invokes a thread to perform an asynchronous read.
' This routine should not be called directly, but is used
' by the class.
Public Sub _R()
Dim iRet As Integer = Read(miTmpBytes 2Read)
End Sub

' This subroutine invokes a thread to perform an asynchronous write.
' This routine should not be called directly, but is used
' by the class.
Public Sub _W()
Write(mabtTmpTx Buf)
End Sub

' This subroutine uses another thread to read from the Comm Port. It
' raises RxCompleted when done. It reads an integer.
Public Overloads Sub AsyncRead(ByVal Bytes2Read As Integer)
If meMode <> Mode.Overlapped Then Throw New
ApplicationExce ption( _
"Async Methods allowed only when WorkingMode=Ove rlapped")
miTmpBytes2Read = Bytes2Read
moThreadTx = New Thread(AddressO f _R)
moThreadTx.Star t()
End Sub

' This subroutine uses another thread to write to the Comm Port. It
' raises TxCompleted when done. It writes an array of bytes.
Public Overloads Sub AsyncWrite(ByVa l Buffer() As Byte)
If meMode <> Mode.Overlapped Then Throw New
ApplicationExce ption( _
"Async Methods allowed only when WorkingMode=Ove rlapped")
If mbWaitOnWrite = True Then Throw New ApplicationExce ption( _
"Unable to send message because of pending transmission.")
mabtTmpTxBuf = Buffer
moThreadTx = New Thread(AddressO f _W)
moThreadTx.Star t()
End Sub

' This subroutine uses another thread to write to the Comm Port. It
' raises TxCompleted when done. It writes a string.
Public Overloads Sub AsyncWrite(ByVa l Buffer As String)
Dim oEncoder As New System.Text.ASC IIEncoding()
Dim aByte() As Byte = oEncoder.GetByt es(Buffer)
Me.AsyncWrite(a Byte)
End Sub

' This function takes the ModemStatusBits and returns a boolean
value
' signifying whether the Modem is active.
Public Function CheckLineStatus (ByVal Line As ModemStatusBits ) As
Boolean
Return Convert.ToBoole an(ModemStatus And Line)
End Function

' This subroutine clears the input buffer.
Public Sub ClearInputBuffe r()
If Not mhRS = -1 Then
PurgeComm(mhRS, PURGE_RXCLEAR)
End If
End Sub

' This subroutine closes the Comm Port.
Public Sub Close()
If mhRS <> -1 Then
CloseHandle(mhR S)
mhRS = -1
End If
End Sub

' This subroutine opens and initializes the Comm Port
Public Overloads Sub Open()
' Get Dcb block,Update with current data
Dim uDcb As DCB, iRc As Integer
' Set working mode
Dim iMode As Integer = Convert.ToInt32 (IIf(meMode =
Mode.Overlapped , _
FILE_FLAG_OVERL APPED, 0))
' Initializes Com Port
If miPort > 0 Then
Try
' Creates a COM Port stream handle
mhRS = CreateFile("COM " & miPort.ToString , _
GENERIC_READ Or GENERIC_WRITE, 0, 0, _
OPEN_EXISTING, iMode, 0)
If mhRS <> -1 Then
' Clear all comunication errors
Dim lpErrCode As Integer
iRc = ClearCommError( mhRS, lpErrCode, 0&)
' Clears I/O buffers
iRc = PurgeComm(mhRS, PurgeBuffers.RX Clear Or _
PurgeBuffers.Tx Clear)
' Gets COM Settings
iRc = GetCommState(mh RS, uDcb)
' Updates COM Settings
Dim sParity As String = "NOEM"
sParity = sParity.Substri ng(meParity, 1)
' Set DCB State
Dim sDCBState As String = String.Format( _
"baud={0} parity={1} data={2} stop={3}", _
miBaudRate, sParity, miDataBit, CInt(meStopBit) )
iRc = BuildCommDCB(sD CBState, uDcb)
iRc = SetCommState(mh RS, uDcb)
If iRc = 0 Then
Dim sErrTxt As String =
pErr2Text(GetLa stError())
Throw New CIOChannelExcep tion( _
"Unable to set COM state0" & sErrTxt)
End If
' Setup Buffers (Rx,Tx)
iRc = SetupComm(mhRS, miBufferSize, miBufferSize)
' Set Timeouts
pSetTimeout()
Else
' Raise Initialization problems
Throw New CIOChannelExcep tion( _
"Unable to open COM" & miPort.ToString )
End If
Catch Ex As Exception
' Generica error
Throw New CIOChannelExcep tion(Ex.Message , Ex)
End Try
Else
' Port not defined, cannot open
Throw New ApplicationExce ption("COM Port not defined, " + _
"use Port property to set it before invoking InitPort")
End If
End Sub

' This subroutine opens and initializes the Comm Port (overloaded
' to support parameters).
Public Overloads Sub Open(ByVal Port As Integer, _
ByVal BaudRate As Integer, ByVal DataBit As Integer, _
ByVal Parity As DataParity, ByVal StopBit As DataStopBit, _
ByVal BufferSize As Integer)

Me.Port = Port
Me.BaudRate = BaudRate
Me.DataBit = DataBit
Me.Parity = Parity
Me.StopBit = StopBit
Me.BufferSize = BufferSize
Open()
End Sub

' This function translates an API error code to text.
Private Function pErr2Text(ByVal lCode As Integer) As String
Dim sRtrnCode As New StringBuilder(2 56)
Dim lRet As Integer

lRet = FormatMessage(& H1000, 0, lCode, 0, sRtrnCode, 256, 0)
If lRet > 0 Then
Return sRtrnCode.ToStr ing
Else
Return "Error not found."
End If

End Function

' This subroutine handles overlapped reads.
Private Sub pHandleOverlapp edRead(ByVal Bytes2Read As Integer)
Dim iReadChars, iRc, iRes, iLastErr As Integer
muOverlapped.hE vent = CreateEvent(Not hing, 1, 0, Nothing)
If muOverlapped.hE vent = 0 Then
' Can't create event
Throw New ApplicationExce ption( _
"Error creating event for overlapped read.")
Else
' Ovellaped reading
If mbWaitOnRead = False Then
ReDim mabtRxBuf(Bytes 2Read - 1)
iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, _
iReadChars, muOverlapped)
If iRc = 0 Then
iLastErr = GetLastError()
If iLastErr <> ERROR_IO_PENDIN G Then
Throw New ArgumentExcepti on("Overlapped Read
Error: " & _
pErr2Text(iLast Err))
Else
' Set Flag
mbWaitOnRead = True
End If
Else
' Read completed successfully
RaiseEvent DataReceived(Me , mabtRxBuf)
End If
End If
End If
' Wait for operation to be completed
If mbWaitOnRead Then
iRes = WaitForSingleOb ject(muOverlapp ed.hEvent, miTimeout)
Select Case iRes
Case WAIT_OBJECT_0
' Object signaled,operat ion completed
If GetOverlappedRe sult(mhRS, muOverlapped, _
iReadChars, 0) = 0 Then

' Operation error
iLastErr = GetLastError()
If iLastErr = ERROR_IO_INCOMP LETE Then
Throw New ApplicationExce ption( _
"Read operation incomplete")
Else
Throw New ApplicationExce ption( _
"Read operation error " &
iLastErr.ToStri ng)
End If
Else
' Operation completed
RaiseEvent DataReceived(Me , mabtRxBuf)
mbWaitOnRead = False
End If
Case WAIT_TIMEOUT
Throw New IOTimeoutExcept ion("Timeout error")
Case Else
Throw New ApplicationExce ption("Overlapp ed read
error")
End Select
End If
End Sub

' This subroutine handles overlapped writes.
Private Function pHandleOverlapp edWrite(ByVal Buffer() As Byte) As
Boolean
Dim iBytesWritten, iRc, iLastErr, iRes As Integer, bErr As
Boolean
muOverlappedW.h Event = CreateEvent(Not hing, 1, 0, Nothing)
If muOverlappedW.h Event = 0 Then
' Can't create event
Throw New ApplicationExce ption( _
"Error creating event for overlapped write.")
Else
' Overllaped write
PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
mbWaitOnRead = True
iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
iBytesWritten, muOverlappedW)
If iRc = 0 Then
iLastErr = GetLastError()
If iLastErr <> ERROR_IO_PENDIN G Then
Throw New ArgumentExcepti on("Overlapped Read Error:
" & _
pErr2Text(iLast Err))
Else
' Write is pending
iRes = WaitForSingleOb ject(muOverlapp edW.hEvent,
INFINITE)
Select Case iRes
Case WAIT_OBJECT_0
' Object signaled,operat ion completed
If GetOverlappedRe sult(mhRS, muOverlappedW,
_
iBytesWritten, 0) = 0 Then

bErr = True
Else
' Notifies Async tx completion,stop s
thread
mbWaitOnRead = False
RaiseEvent TxCompleted(Me)
End If
End Select
End If
Else
' Wait operation completed immediatly
bErr = False
End If
End If
CloseHandle(muO verlappedW.hEve nt)
Return bErr
End Function

' This subroutine sets the Comm Port timeouts.
Private Sub pSetTimeout()
Dim uCtm As COMMTIMEOUTS
' Set ComTimeout
If mhRS = -1 Then
Exit Sub
Else
' Changes setup on the fly
With uCtm
.ReadIntervalTi meout = 0
.ReadTotalTimeo utMultiplier = 0
.ReadTotalTimeo utConstant = miTimeout
.WriteTotalTime outMultiplier = 10
.WriteTotalTime outConstant = 100
End With
SetCommTimeouts (mhRS, uCtm)
End If
End Sub

' This function returns an integer specifying the number of bytes
' read from the Comm Port. It accepts a parameter specifying the
number
' of desired bytes to read.
Public Function Read(ByVal Bytes2Read As Integer) As Integer
Dim iReadChars, iRc As Integer

' If Bytes2Read not specified uses Buffersize
If Bytes2Read = 0 Then Bytes2Read = miBufferSize
If mhRS = -1 Then
Throw New ApplicationExce ption( _
"Please initialize and open port before using this
method")
Else
' Get bytes from port
Try
' Purge buffers
'PurgeComm(mhRS , PURGE_RXCLEAR Or PURGE_TXCLEAR)
' Creates an event for overlapped operations
If meMode = Mode.Overlapped Then
pHandleOverlapp edRead(Bytes2Re ad)
Else
' Non overlapped mode
ReDim mabtRxBuf(Bytes 2Read - 1)
iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read,
iReadChars, Nothing)
If iRc = 0 Then
' Read Error
Throw New ApplicationExce ption( _
"ReadFile error " & iRc.ToString)
Else
' Handles timeout or returns input chars
If iReadChars < Bytes2Read Then
Throw New IOTimeoutExcept ion("Timeout
error")
Else
mbWaitOnRead = True
Return (iReadChars)
End If
End If
End If
Catch Ex As Exception
' Others generic erroes
Throw New ApplicationExce ption("Read Error: " &
Ex.Message, Ex)
End Try
End If
End Function

' This subroutine writes the passed array of bytes to the
' Comm Port to be written.
Public Overloads Sub Write(ByVal Buffer As Byte())
Dim iBytesWritten, iRc As Integer

If mhRS = -1 Then
Throw New ApplicationExce ption( _
"Please initialize and open port before using this
method")
Else
' Transmit data to COM Port
Try
If meMode = Mode.Overlapped Then
' Overlapped write
If pHandleOverlapp edWrite(Buffer) Then
Throw New ApplicationExce ption( _
"Error in overllapped write")
End If
Else
' Clears IO buffers
PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
iBytesWritten, Nothing)
If iRc = 0 Then
Throw New ApplicationExce ption( _
"Write Error - Bytes Written " & _
iBytesWritten.T oString & " of " & _
Buffer.Length.T oString)
End If
End If
Catch Ex As Exception
Throw
End Try
End If
End Sub

' This subroutine writes the passed string to the
' Comm Port to be written.
Public Overloads Sub Write(ByVal Buffer As String)
Dim oEncoder As New System.Text.ASC IIEncoding()
Dim aByte() As Byte = oEncoder.GetByt es(Buffer)
Me.Write(aByte)
End Sub

#End Region

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 20 '05 #6
Mike,

I tried what you suggested and still get the same error. This is
getting frustrating since everything works on my XP system. Is there
anything else you can suggest? I am totally at a loss on how to resolve
this error.

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 20 '05 #7
Mike,

Thank you for your willingness to help me on this. I finally got my code
to work (see below). Still not really sure what the difference is
between Win98 and WinXP is when running VB.Net or why this works though.
Again, thank you for your help.

=========
'only necessary for older Win9.X OS
If System.Environm ent.OSVersion.P latform <> PlatformID.Win3 2Windows Then

'extract number (add 1 to account for the vbCr)
iOutputCommandI ndex = myCommData.Inde xOf("GET.NO", 0) +
sOutputCommand. Length + 1

GetNumber = CLng(Trim(myCom mData.Substring (iOutputCommand Index, 7)))

Else

'convert carriage return/linefeed to " " in data string
myCommData = myCommData.Repl ace(vbCrLf, " ")

'extract order number (add 1 to account for the vbCr)
iOutputCommandI ndex = myCommData.Inde xOf("GET.NO", 0) +
sOutputCommand. Length + 1

GetNumber = CType(Trim(myCo mmData.Substrin g(iOutputComman dIndex, 8)),
Long)

End If
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 20 '05 #8
Hi rsine
i was figuring how this codes work and where should u placed it ? do u
mind giving me some advice ? Thank u very much.

Stephen

'************** **********
'* Function: GetNumber()
'************** **********
Private Function GetNumber(ByVal shCnt As Short) As Long

Try

Dim sOutputCommand As String
Dim iOutputCommandI ndex As Integer

'clear commdata variable
myCommData = ""

Dim StopBits As Rs232.DataStopB it = Rs232.DataStopB it.StopBit_1
Dim Parity As Rs232.DataParit y = Rs232.DataParit y.Parity_None

'open comm port connection
myCommPort.Open (iCommPort, iBaudRate, iDataBits, Parity, StopBits,
4096)

'clear the input buffer
myCommPort.Clea rInputBuffer()

'allow system processes
System.Windows. Forms.Applicati on.DoEvents()

'build command to send
sOutputCommand = "GET.NO " & CStr(shOrderCnt ) & vbCr

'enable timer (will be disabled once commport data is retrieved)
tmrReadCommPort .Enabled = True

'output command to port and wait for response
myCommPort.Writ e(sOutputComman d)

'sleep long enough for timer to fire
System.Threadin g.Thread.Sleep( 200)

'give some time to other events
System.Windows. Forms.Applicati on.DoEvents()

'close the commport
myCommPort.Clos e()

'extract number (add 1 to account for the vbCr)
iOutputCommandI ndex = myCommData.Inde xOf("GET.NO", 0) +
sOutputCommand. Length + 1

GetNumber = Trim(myCommData .Substring(iOut putCommandIndex , )

Catch ex As Exception

messagebox.show (ex.message)

End Try

End Function

*-----------------------*
Posted at:
www.GroupSrv.com
*-----------------------*
Nov 21 '05 #9
Stephen,

Probably are you asking this to Rinze (a very original Frysian name) in a
question accoording to another question.

Better is too connect that question to the original thread (answer from
Rinze), than the information is more complete to know what you are asking.

Cor
Hi rsine
i was figuring how this codes work and where should u placed it ? do u
mind giving me some advice ? Thank u very much.

Stephen

'************** **********
'* Function: GetNumber()
'************** **********
Private Function GetNumber(ByVal shCnt As Short) As Long

Try

Dim sOutputCommand As String
Dim iOutputCommandI ndex As Integer

'clear commdata variable
myCommData = ""

Dim StopBits As Rs232.DataStopB it = Rs232.DataStopB it.StopBit_1
Dim Parity As Rs232.DataParit y = Rs232.DataParit y.Parity_None

'open comm port connection
myCommPort.Open (iCommPort, iBaudRate, iDataBits, Parity, StopBits,
4096)

'clear the input buffer
myCommPort.Clea rInputBuffer()

'allow system processes
System.Windows. Forms.Applicati on.DoEvents()

'build command to send
sOutputCommand = "GET.NO " & CStr(shOrderCnt ) & vbCr

'enable timer (will be disabled once commport data is retrieved)
tmrReadCommPort .Enabled = True

'output command to port and wait for response
myCommPort.Writ e(sOutputComman d)

'sleep long enough for timer to fire
System.Threadin g.Thread.Sleep( 200)

'give some time to other events
System.Windows. Forms.Applicati on.DoEvents()

'close the commport
myCommPort.Clos e()

'extract number (add 1 to account for the vbCr)
iOutputCommandI ndex = myCommData.Inde xOf("GET.NO", 0) +
sOutputCommand. Length + 1

GetNumber = Trim(myCommData .Substring(iOut putCommandIndex , )

Catch ex As Exception

messagebox.show (ex.message)

End Try

End Function

*-----------------------*
Posted at:
www.GroupSrv.com
*-----------------------*

Nov 21 '05 #10

This thread has been closed and replies have been disabled. Please start a new discussion.

Similar topics

0
7380
by: Pankaj Jain | last post by:
Hi All, I have a class A which is derived from ServicesComponent to participate in automatic transaction with falg Transaction.Required. Class A is exposed to client through remoting on Http channal hosting into IIS. There is a class B which is also available through remoting hosted on IIS on the same URI. B creates new of A inside a function. It succeed and able to create instance of A inside B first time. But it failes in 2nd attempt when...
3
12990
by: Imran Aziz | last post by:
Hello All, I am getting the following error on our production server, and I dont get the same error on the development box. Unable to cast object of type 'System.Byte' to type 'System.String'. here is the code that I used to create a table and then add columns to it later, later I populate the rows in the table.
3
6037
by: dbuchanan | last post by:
How do I explicitly cast a string to Byte? Here are my circumstances; The string is from a textbox and could be empty. The Byte is a tinyint in SQL Server 2000 I am using the AddRow method as shown below and get an InvalidCastException. "Cast from string "" to type integer is not valid" Me.DataSet.tblCustomer.AddtblCustomerRow(txtCustomerName.Text.ToString,
3
4102
by: Steve | last post by:
I'm trying to call some unmanaged methods from a DLL. I did this awhile ago, a couple years ago... I'm a little rusty. I will show you what I'm dealing with: <unmanaged function signature> STATUS_T WINAPI MSP430_Initialize(CHAR* port, LONG* version); </unmanaged function signature> STATUS_T is a long (typedef long STATUS_T)
3
10251
by: keithb | last post by:
What could be causing this? this code: String Com = ""; if (Com != (String)rw.ItemArray) fails at runtime with the error message: Unable to cast object of type 'System.Int32' to type 'System.String'.
4
2458
by: JackBlack | last post by:
Hi, all! Need a little help tracking down a runtime error problem. I'm getting this error: "Unable to cast object of type 'myStruct' to type 'myStruct'... but the two types are identical! I have a class method that's building an array of user-defined structures (see below), and returning that array to the calling routine. I'm getting the error on that calling line. The structure in both the webform and class are defined like this:
3
1444
by: NorseMN | last post by:
I suppose my problem really started when I decided to implement a top-down design, because management always wants to see the frosting before they let you bake a cake. In any case, I now seem to have the proverbial design that is simple, elegant... and wrong. Before I give up, I'd like to see if anyone in this forum has a solution. I seems that I need to perform a run-time cast to a type that is specified by an integer. Ideally, the...
1
1719
by: carl34 | last post by:
Hi Can someone tell me why am i getting this error? Cast from string "" to type 'Long' is not valid. Location: at Microsoft.VisualBasic.CompilerServices.LongType.FromString(String Value) at ItemExchange.WorkerX9Process.CreateAdministrativeReturnReport(CJOB& objJob, CExchangeItemDatas& objExchangeItemDatas, CDelimitedExportFile& objAdministrativeReturnReport, ExportFileTypeEnum enmReportType Kind regards, Carl
1
2339
by: =?Utf-8?B?U2NvdHQ=?= | last post by:
Hello, Using VS2008 in a C# web service application, a class has been created that inherits from the ConfigurationSelection. This class file has been placed in the App_Code folder. The web.config has been updated with the necessary section. Using System.Web.Configuration.WebConfiguration.GetSection(), the config information is returned without any issues when the GetSection is set to an object. When the object is casted explicitly...
0
8585
by: Hystou | last post by:
Most computers default to English, but sometimes we require a different language, especially when relocating. Forgot to request a specific language before your computer shipped? No problem! You can effortlessly switch the default language on Windows 10 without reinstalling. I'll walk you through it. First, let's disable language synchronization. With a Microsoft account, language settings sync across devices. To prevent any complications,...
0
9132
Oralloy
by: Oralloy | last post by:
Hello folks, I am unable to find appropriate documentation on the type promotion of bit-fields when using the generalised comparison operator "<=>". The problem is that using the GNU compilers, it seems that the internal comparison operator "<=>" tries to promote arguments from unsigned to signed. This is as boiled down as I can make it. Here is my compilation command: g++-12 -std=c++20 -Wnarrowing bit_field.cpp Here is the code in...
0
9004
jinu1996
by: jinu1996 | last post by:
In today's digital age, having a compelling online presence is paramount for businesses aiming to thrive in a competitive landscape. At the heart of this digital strategy lies an intricately woven tapestry of website design and digital marketing. It's not merely about having a website; it's about crafting an immersive digital experience that captivates audiences and drives business growth. The Art of Business Website Design Your website is...
0
8838
tracyyun
by: tracyyun | last post by:
Dear forum friends, With the development of smart home technology, a variety of wireless communication protocols have appeared on the market, such as Zigbee, Z-Wave, Wi-Fi, Bluetooth, etc. Each protocol has its own unique characteristics and advantages, but as a user who is planning to build a smart home system, I am a bit confused by the choice of these technologies. I'm particularly interested in Zigbee because I've heard it does some...
0
7682
agi2029
by: agi2029 | last post by:
Let's talk about the concept of autonomous AI software engineers and no-code agents. These AIs are designed to manage the entire lifecycle of a software development project—planning, coding, testing, and deployment—without human intervention. Imagine an AI that can take a project description, break it down, write the code, debug it, and then launch it, all on its own.... Now, this would greatly impact the work of software developers. The idea...
1
6506
isladogs
by: isladogs | last post by:
The next Access Europe User Group meeting will be on Wednesday 1 May 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM). In this session, we are pleased to welcome a new presenter, Adolph Dupré who will be discussing some powerful techniques for using class modules. He will explain when you may want to use classes instead of User Defined Types (UDT). For example, to manage the data in unbound forms. Adolph will...
0
4351
by: TSSRALBI | last post by:
Hello I'm a network technician in training and I need your help. I am currently learning how to create and manage the different types of VPNs and I have a question about LAN-to-LAN VPNs. The last exercise I practiced was to create a LAN-to-LAN VPN between two Pfsense firewalls, by using IPSEC protocols. I succeeded, with both firewalls in the same network. But I'm wondering if it's possible to do the same thing, with 2 Pfsense firewalls...
1
3024
by: 6302768590 | last post by:
Hai team i want code for transfer the data from one system to another through IP address by using C# our system has to for every 5mins then we have to update the data what the data is updated we have to send another system
2
2288
muto222
by: muto222 | last post by:
How can i add a mobile payment intergratation into php mysql website.

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.