[Webinar] Streamline your web hosting managementRegister Today

x
?
Solved

Help read serial data from external device

Posted on 1999-11-08
17
Medium Priority
?
403 Views
Last Modified: 2008-02-20
I have build an analog sampler and i want to conect it to the serial port vier a uart. all the hardware i can do but the software is anouther problem . I want to now if it is posible to read data in in vb or if it is not how to write a device driver in visual c++ and then read data through this in vb.
0
Comment
Question by:Marktalbot
  • 5
  • 4
  • 4
  • +4
17 Comments
 
LVL 14

Expert Comment

by:mcrider
ID: 2190958
You can use the MSComm control to read data off the serial port...


Cheers!
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2190963
To add the MSComm control to your program, right-click the toolbar and select "Components..."

Then select Microsoft Comm Control from the list.

Cheers!
0
 

Author Comment

by:Marktalbot
ID: 2191016
can you give me code on how to use cause tried this drove me mad
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
LVL 14

Expert Comment

by:mcrider
ID: 2191025
There is a complete example of using the MSCOMM control on the Visual Basic CD.

It's in \VB\SAMPLES\COMPTOOL\MSCOMM


Cheers!
0
 

Author Comment

by:Marktalbot
ID: 2191047
i dont want to use mscom control i want to acualy write the code myself it is for a a level project
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2191065
I don't understand... why would you want to create a com interface from scratch when one is already available?
0
 
LVL 2

Expert Comment

by:ryanvs
ID: 2191393
I agree with mcrider, you'll spin a lot of extra time getting the communications to work with Win32 API calls when you could just start with the MSComm control.  I've used both, and you essentially end up with the same thing.

However, if you really want to use the Win32 API, I can post some code...
0
 

Expert Comment

by:kbalaraju
ID: 2191992
ryanys
Could u please post the WIN-API code with an example.
Thanks
Raju
0
 
LVL 2

Expert Comment

by:ryanvs
ID: 2193061
kbalaraju is asking for code, but he has another question out there asking about problems with the MSComm control.  I'll wait for Marktalbot to request code before posting anything...
0
 
LVL 9

Expert Comment

by:Dalin
ID: 2193780
If you are build an Anolog Sampler, VB can't read it directly.

You will need to have some sort of AD comverter, externel or plugin AD board ( I assume you can do that since you said you can do it in the hardware).

Usually, The hardware builder provide a driver for VB to read the data. That driver is not written in VB, unless you build a hardware that receive cammand/send data via serial port which means your hardware already have everything configured for serial communication, and That part is not a VB issue either.

If you give me a little more information on your analog sampler
(how many signals to sample--number of Analog channels, signal range, resulotions, etc. ) I may be able to give you some sugguestions.

0
 

Author Comment

by:Marktalbot
ID: 2194827
It uses a 8 bit a/d converter conected to uart chip .If you send me the code on how to do the interfaceing to the serial port. The mscomm control i presume will be slow and i need to display the data as an ossiloscope and so needs to be fast to get rid of flicer
0
 
LVL 2

Expert Comment

by:ryanvs
ID: 2195108
I think that Window's response time will have more impact than the MSComm control which I don't think is slower than API methods, plus you can use the standard events MSComm provides (OnComm) for asynchronous updates.  The uart chip can provide RS-232 data, right?  If so, then you use either the MSComm control or API methods to access the data.  I can give you some code, but I won't get time to post it until tomorrow.  I don't have access to my test bed (I do serial comm regularly with VB and VC) or my code, so I'll post it when I get back to work.

However, since you need this to be fast you might be better off using VC and put the serial acquisition procedure in a thread so you don't have to use a timer.  I've used threads in VB, but the stability just isn't there and I would never rely on it.  If you want the functions in VC (Win32 or MFC, please specify), that I can actually provide now.
0
 
LVL 3

Expert Comment

by:kfrick
ID: 2195653
If you REALLY want speed, connect the 8-bit A/D to the Parallel port instead! :)

-kf
0
 

Author Comment

by:Marktalbot
ID: 2196677
The machines that this is ment to be used on are suposed to have a printer atached so the trace can be printed. Please can you post the vc code and can you give me the code or at least somware to get it from for implimeting vc code in a vb project because the display subsystem is in vb and already writen and tested.
0
 
LVL 2

Accepted Solution

by:
ryanvs earned 1200 total points
ID: 2203311
Since you said that significant development has already been done in VB, I thought it would be better to use an all VB solution using the API.  If you still want C++, I'll be happy to post that as well.

A couple of notes...  I recently converted this from VC so I haven't completely debugged it, but I tested it on a couple of serial devices and it worked just fine but I can't claim it is bullet-proof.  I have had weird things happen occasionally using strings with Serial Comm...  The typical way of extracting individual characters is Asc(Mid(sData)) or AscB(Mid(sData)) but occasionally Unicode or something else will make the numbers go screwy.  So now I convert the string to a byte array before doing anything with the values (on the Read side - it doesn't matter as much with write), using the function:
  Dim ab() As Byte
  ab = StrConv(sData, vbFromUnicode)

You can create strings to Write using:
  sData = Chr$(1) + Chr$(2) + <etc.>
or
  sData = MakeCommString(Array(&H1, &H1, &H0, &H0, &H0, &H8, &H3D, &HCC)
)

The last file I have included was my test program for a simple Modbus test. Modbus is a serial protocol, nothing fancy but it is just an example.  Good luck...

Oh yeah, since they have made the margins much smaller on EE, this is probably going to look horrible with all of the line breaks.  Sorry.


' -----------------------------------------------------------------------
' File         : CommPort.bas
' Description  : Comm Port helper module for VB using Win32 API
' Author       : Ryan Van Slooten
' Date         : Sept. 11, 1999
' -----------------------------------------------------------------------
Option Explicit

' -----------------------------------------------------------------------
' File API
' -----------------------------------------------------------------------
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
     ByVal dwShareMode As Long, lpSecurityAttributes As Long, _
     ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
     ByVal hTemplateFile As Long) As Long

Public Declare Function ReadFile Lib "kernel32" _
    (ByVal hFile As Long, ByVal lpBuffer As Any, _
     ByVal nNumberOfBytesToRead As Long, _
     lpNumberOfBytesRead As Long, _
     lpOverlapped As Long) As Long

Public Declare Function WriteFile Lib "kernel32" _
    (ByVal hFile As Long, ByVal lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long

' -----------------------------------------------------------------------
' Comm API
' -----------------------------------------------------------------------
Public Declare Function GetCommConfig Lib "kernel32" _
    (ByVal hCommDev As Long, lpCC As COMMCONFIG, lpdwSize As Long) As Long

Public Declare Function SetCommConfig Lib "kernel32" _
    (ByVal hCommDev As Long, lpCC As COMMCONFIG, ByVal dwSize As Long) As Long

Public Declare Function GetCommTimeouts Lib "kernel32" _
    (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long

Public Declare Function SetCommTimeouts Lib "kernel32" _
    (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long

Public Declare Function GetCommState Lib "kernel32" _
    (ByVal nCid As Long, lpDCB As DCB) As Long

Public Declare Function SetCommState Lib "kernel32" _
    (ByVal hCommDev As Long, lpDCB As DCB) As Long

Public Declare Function PurgeComm Lib "kernel32" _
    (ByVal hFile As Long, ByVal dwFlags As Long) As Long

' -----------------------------------------------------------------------
' Error API
' -----------------------------------------------------------------------
Public Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
    (ByVal dwFlags As FormatMessageEnum, ByRef lpSource As Long, _
     ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
     ByVal lpBuffer As String, ByVal nSize As Long, _
     ByRef Arguments As Any) As Long

Public Declare Function GetLastError Lib "kernel32" () As Long

' -----------------------------------------------------------------------
' Comm API Types
' -----------------------------------------------------------------------
Public Type DCB
  DCBlength         As Long
  BaudRate          As Long
  fBitFields        As Long    'See Comments in Win32API.Txt
  wReserved         As Integer
  XonLim            As Integer
  XoffLim           As Integer
  ByteSize          As Byte
  Parity            As Byte
  StopBits          As Byte
  XonChar           As Byte
  XoffChar          As Byte
  ErrorChar         As Byte
  EofChar           As Byte
  EvtChar           As Byte
  wReserved1        As Integer 'Reserved; Do Not Use
End Type

' DCB: From C Header File
'typedef struct _DCB {
'    DWORD DCBlength;           // sizeof(DCB)
'    DWORD BaudRate;            // current baud rate
'    DWORD fBinary: 1;          // binary mode, no EOF check    32-bit: 00000000 00000000 00000000 0000000?
'    DWORD fParity: 1;          // enable parity checking               00000000 00000000 00000000 000000?0
'    DWORD fOutxCtsFlow:1;      // CTS output flow control              00000000 00000000 00000000 00000?00
'    DWORD fOutxDsrFlow:1;      // DSR output flow control              00000000 00000000 00000000 0000?000
'    DWORD fDtrControl:2;       // DTR flow control type                00000000 00000000 00000000 00??0000
'    DWORD fDsrSensitivity:1;   // DSR sensitivity                      00000000 00000000 00000000 0?000000
'    DWORD fTXContinueOnXoff:1; // XOFF continues Tx                    00000000 00000000 00000000 ?0000000
'    DWORD fOutX: 1;            // XON/XOFF out flow control            00000000 00000000 0000000? 00000000
'    DWORD fInX: 1;             // XON/XOFF in flow control             00000000 00000000 000000?0 00000000
'    DWORD fErrorChar: 1;       // enable error replacement             00000000 00000000 00000?00 00000000
'    DWORD fNull: 1;            // enable null stripping                00000000 00000000 0000?000 00000000
'    DWORD fRtsControl:2;       // RTS flow control                     00000000 00000000 00??0000 00000000
'    DWORD fAbortOnError:1;     // abort on error                       00000000 00000000 0?000000 00000000
'    DWORD fDummy2:17;          // reserved                             ???????? ???????? ?0000000 00000000
'    WORD wReserved;            // not currently used
'    WORD XonLim;               // transmit XON threshold
'    WORD XoffLim;              // transmit XOFF threshold
'    BYTE ByteSize;             // number of bits/byte, 4-8
'    BYTE Parity;               // 0-4=no,odd,even,mark,space
'    BYTE StopBits;             // 0,1,2 = 1, 1.5, 2
'    char XonChar;              // Tx and Rx XON character
'    char XoffChar;             // Tx and Rx XOFF character
'    char ErrorChar;            // error replacement character
'    char EofChar;              // end of input character
'    char EvtChar;              // received event character
'    WORD wReserved1;           // reserved; do not use
'} DCB;

' Bit Fields (in C struct) Enumerated
Public Enum DCB_BitFieldEnum
  dcbBitBinary = &H1&
  dcbBitParity = &H2&
  dcbBitOutxCtsFlow = &H4&
  dcbBitfOutxDsrFlow = &H8&
  dcbBitfDtrControl = &H10&           ' Logically + &H20&
  dcbBitfDsrSensitivity = &H40&
  dcbBitfTXContinueOnXoff = &H80&
  dcbBitfOutX = &H100&
  dcbBitfInX = &H200&
  dcbBitfErrorChar = &H400&
  dcbBitfNull = &H800&
  dcbBitfRtsControl = &H1000&         ' Logically + &H2000&
  dcbBitfAbortOnError = &H4000&
  dcbBitfDummy2 = &HFFFF8000
End Enum


Public Type COMMCONFIG
  dwSize            As Long
  wVersion          As Integer
  wReserved         As Integer
  dcbx              As DCB
  dwProviderSubType As Long
  dwProviderOffset  As Long
  dwProviderSize    As Long
  wcProviderData    As Byte
End Type

Public Type COMMTIMEOUTS
  ReadIntervalTimeout         As Long
  ReadTotalTimeoutMultiplier  As Long
  ReadTotalTimeoutConstant    As Long
  WriteTotalTimeoutMultiplier As Long
  WriteTotalTimeoutConstant   As Long
End Type

' -----------------------------------------------------------------------
' File API Constants
' -----------------------------------------------------------------------
Public Const pNull                As Long = 0
Public Const INVALID_HANDLE_VALUE As Long = -1
Public Const OPEN_EXISTING        As Long = 3
Public Const GENERIC_READ         As Long = &H80000000
Public Const GENERIC_WRITE        As Long = &H40000000

' -----------------------------------------------------------------------
' Comm API Constants (Written as Enums)
' -----------------------------------------------------------------------
Public Enum CommDTREnum       ' Data Terminal Ready
  DTR_CONTROL_DISABLE = &H0
  DTR_CONTROL_ENABLE = &H1
  DTR_CONTROL_HANDSHAKE = &H2
End Enum

Public Enum CommRTSEnum       ' Request-to-Send
  RTS_CONTROL_DISABLE = &H0
  RTS_CONTROL_ENABLE = &H1
  RTS_CONTROL_TOGGLE = &H3
  RTS_CONTROL_HANDSHAKE = &H2
End Enum

Public Enum CommParityEnum
  NOPARITY = 0
  ODDPARITY = 1
  EVENPARITY = 2
End Enum

Public Enum CommBaudEnum
  CBR_110 = 110
  CBR_300 = 300
  CBR_600 = 600
  CBR_1200 = 1200
  CBR_2400 = 2400
  CBR_4800 = 4800
  CBR_9600 = 9600
  CBR_14400 = 14400
  CBR_19200 = 19200
  CBR_38400 = 38400
  CBR_56000 = 56000
  CBR_57600 = 57600
  CBR_115200 = 115200
  CBR_128000 = 128000
  CBR_256000 = 256000
End Enum

Public Enum CommStopBitEnum
  ONESTOPBIT = 0            ' 1   Stop Bit
  ONE5STOPBITS = 1          ' 1.5 Stop Bits
  TWOSTOPBITS = 2           ' 2   Stop Bits
End Enum

Public Enum CommPurgeEnum
  PURGE_TXABORT = &H1     '  Kill the pending/current writes to the comm port.
  PURGE_RXABORT = &H2     '  Kill the pending/current reads to the comm port.
  PURGE_TXCLEAR = &H4     '  Kill the transmit queue if there.
  PURGE_RXCLEAR = &H8     '  Kill the typeahead buffer if there.
End Enum

' -----------------------------------------------------------------------
' Error API Constants
' -----------------------------------------------------------------------
Public Enum FormatMessageEnum
  FORMAT_MESSAGE_NONE = 0
  FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
  FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
  FORMAT_MESSAGE_IGNORE_INSERTS = &H200
  FORMAT_MESSAGE_FROM_STRING = &H400
  FORMAT_MESSAGE_FROM_HMODULE = &H800
  FORMAT_MESSAGE_FROM_SYSTEM = &H1000
  FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
End Enum


Public Sub ApiRaiseIf(ByVal e As Long)
    If e Then
      Err.Raise vbObjectError + 29000 + e, _
                App.EXEName & ".Windows", ApiError(e)
    End If
End Sub

Public Sub ApiRaiseLastError()
  Dim e As Long
  e = GetLastError()
  If e = 0 Then e = Err.LastDllError
  ApiRaiseIf e
End Sub

Public Function ApiError(ByVal e As Long) As String
    Dim s As String, c As Long
    s = String(256, 0)
    c = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
                      FORMAT_MESSAGE_IGNORE_INSERTS, _
                      pNull, e, 0&, s, Len(s), ByVal pNull)
    If c Then ApiError = Left$(s, c)
End Function

' Debugging Function
Public Function HexDumpBytes(s As String) As String
  Dim sLine As String
  Dim iCur As Integer
  Dim sCur As String
  Dim ab() As Byte
  Dim i As Integer

  ab = StrConv(s, vbFromUnicode)
  For i = LBound(ab) To UBound(ab)
    ' Get current character
    iCur = ab(i)
    sCur = Chr$(iCur)

    ' Append its hex value
    sLine = sLine & Right$("0" & Hex$(iCur), 2) & " "
  Next i
  HexDumpBytes = sLine
End Function

' Send Parameters using Array(1, 2, 3, <etc.>)
Public Function MakeCommString(v As Variant) As String
  Dim s As String
  Dim i As Long

  If IsNull(v) Or IsEmpty(v) Then
    Exit Function
  End If
  If Not IsArray(v) Then
    Exit Function
  End If

  For i = LBound(v) To UBound(v)
    s = s + Chr$(v(i))
  Next i
  MakeCommString = s
End Function



' -----------------------------------------------------------------------
' File         : CommPort.cls
' Description  : Comm Port class for VB using Win32 API
' Author       : Ryan Van Slooten
' Date         : Sept. 11, 1999
' -----------------------------------------------------------------------
Option Explicit


' -----------------------------------------------------------------------
' Class Variables
' -----------------------------------------------------------------------
Private m_hCommDev          As Long           ' Comm Port Device Handle
Private m_dcb               As DCB
Private m_commConfig        As COMMCONFIG
Private m_commTimeouts      As COMMTIMEOUTS
Private m_lngBufferSize     As Long

' Comm DCB Members
Public CommPort             As String         ' Comm Port ("COM1", "COM2", etc.)
Public BaudRate             As CommBaudEnum
Public XonLim               As Integer
Public XoffLim              As Integer
Public ByteSize             As Byte
Public Parity               As CommParityEnum
Public StopBits             As CommStopBitEnum
Public XonChar              As Byte
Public XoffChar             As Byte
Public ErrorChar            As Byte
Public EofChar              As Byte
Public EvtChar              As Byte

' Comm DCB Bit Fields
Private fBinary             As Boolean      ' Always True (see Microsoft Documentation)
Public fParity              As Boolean
Public fOutxCtsFlow         As Boolean
Public fOutxDsrFlow         As Boolean
Public byDtrControl         As CommDTREnum
Public fDsrSensitivity      As Boolean
Public fTXContinueOnXoff    As Boolean
Public fOutX                As Boolean
Public fInX                 As Boolean
Public fUseErrorChar        As Boolean
Public fNullStripping       As Boolean
Public byRtsControl         As CommRTSEnum
Public fAbortOnError        As Boolean

' Comm Timeouts
Public ReadIntervalTimeout          As Long
Public ReadTotalTimeoutMultiplier   As Long
Public ReadTotalTimeoutConstant     As Long
Public WriteTotalTimeoutMultiplier  As Long
Public WriteTotalTimeoutConstant    As Long




' -----------------------------------------------------------------------
' Class Functions
' -----------------------------------------------------------------------
Public Property Get BufferSize() As Long
  BufferSize = m_lngBufferSize
End Property

Public Property Let BufferSize(Value As Long)
  m_lngBufferSize = Value
End Property

Public Property Get CommHandle() As Long
  CommHandle = m_hCommDev
End Property

Public Property Get IsOpen() As Boolean
  IsOpen = ((m_hCommDev <> 0) And (m_hCommDev <> INVALID_HANDLE_VALUE))
End Property

Public Function OpenPort(Optional bReopen As Boolean = False) As Boolean
  If IsOpen Then
    If Not bReopen Then
      OpenPort = True
      Exit Function
    End If
  End If
 
  m_hCommDev = CreateFile(CommPort, _
                          GENERIC_READ Or GENERIC_WRITE, _
                          0&, _
                          ByVal pNull, _
                          OPEN_EXISTING, _
                          0, _
                          ByVal pNull)

  If m_hCommDev = 0 Or m_hCommDev = INVALID_HANDLE_VALUE Then
    OpenPort = False
   
    ' Use Error Handling in Calling Function
    ApiRaiseLastError
  Else
    ' Configure Comm Port and Return Value
    Call InitializePort
    OpenPort = ConfigurePort
  End If
End Function

Public Function ClosePort() As Boolean
  If IsOpen Then
    If CloseHandle(m_hCommDev) <> 0 Then
      m_hCommDev = 0
    End If

    ' Use Error Handling in Calling Function
    ApiRaiseLastError
  End If
End Function

Public Function InitializePort() As Boolean
  Dim bSuccess As Boolean

  If Not IsOpen() Then Exit Function

  bSuccess = GetCommConfig(m_hCommDev, m_commConfig, Len(m_commConfig))
  If Not bSuccess Then
    ApiRaiseLastError
    Exit Function
  End If
 
  bSuccess = GetCommState(m_hCommDev, m_dcb)
  If Not bSuccess Then
    ApiRaiseLastError
    Exit Function
  End If
 
  bSuccess = GetCommTimeouts(m_hCommDev, m_commTimeouts)
  If Not bSuccess Then
    ApiRaiseLastError
    Exit Function
  End If
 
  InitializePort = True
End Function

' Set the Comm Properties before calling this function
Public Function ConfigurePort() As Boolean
  Dim lngBitField As Long
  Dim bSuccess As Boolean
 
  ' Build Bit Field
  If fBinary Then lngBitField = lngBitField Or dcbBitBinary
  If fParity Then lngBitField = lngBitField Or dcbBitParity
  If fOutxCtsFlow Then lngBitField = lngBitField Or dcbBitOutxCtsFlow
  If fOutxDsrFlow Then lngBitField = lngBitField Or dcbBitfOutxDsrFlow
  If byDtrControl Then lngBitField = lngBitField Or (byDtrControl * dcbBitfDtrControl)
  If fDsrSensitivity Then lngBitField = lngBitField Or dcbBitfDsrSensitivity
  If fTXContinueOnXoff Then lngBitField = lngBitField Or dcbBitfTXContinueOnXoff
  If fOutX Then lngBitField = lngBitField Or dcbBitfOutX
  If fInX Then lngBitField = lngBitField Or dcbBitfInX
  If fUseErrorChar Then lngBitField = lngBitField Or dcbBitfErrorChar
  If fNullStripping Then lngBitField = lngBitField Or dcbBitfNull
  If byRtsControl Then lngBitField = lngBitField Or dcbBitfRtsControl
  If fAbortOnError Then lngBitField = lngBitField Or (dcbBitfRtsControl * dcbBitfAbortOnError)

  With m_dcb
    .BaudRate = BaudRate
    .fBitFields = lngBitField
    .XonLim = XonLim
    .XoffLim = XoffLim
    .ByteSize = ByteSize
    .Parity = Parity
    .StopBits = StopBits
    .XonChar = XonChar
    .XoffChar = XoffChar
    If fUseErrorChar Then .ErrorChar = ErrorChar
    .EofChar = EofChar
    .EvtChar = EvtChar
  End With

  bSuccess = SetCommState(m_hCommDev, m_dcb)
  If Not bSuccess Then ApiRaiseLastError
 
  With m_commTimeouts
    .ReadIntervalTimeout = ReadIntervalTimeout
    .ReadTotalTimeoutConstant = ReadTotalTimeoutConstant
    .ReadTotalTimeoutMultiplier = ReadTotalTimeoutMultiplier
    .WriteTotalTimeoutConstant = WriteTotalTimeoutConstant
    .WriteTotalTimeoutMultiplier = WriteTotalTimeoutMultiplier
  End With
 
  bSuccess = SetCommTimeouts(m_hCommDev, m_commTimeouts)
  If Not bSuccess Then ApiRaiseLastError
 
  ConfigurePort = bSuccess
End Function

Public Sub PurgePort()
  Dim bSuccess As Boolean

  If Not IsOpen() Then
    Exit Sub
  End If

  bSuccess = PurgeComm(m_hCommDev, _
                       PURGE_RXABORT Or PURGE_RXCLEAR Or _
                       PURGE_TXABORT Or PURGE_TXCLEAR)
  If Not bSuccess Then ApiRaiseLastError
End Sub

Public Function ReadPort(ByRef sReadData As String, Optional lBytesToRead As Long, Optional lBytesRead As Long) As Boolean
  Dim bSuccess As Boolean
  Dim lBufferSize As Long
  Dim lDataLen As Long
  Dim sData As String
 
  If Not IsOpen() Then
    Exit Function
  End If
 
  lBufferSize = lBytesToRead
  If lBufferSize <= 0 Then lBufferSize = m_lngBufferSize
  sData = String$(lBufferSize, 0)
  bSuccess = ReadFile(m_hCommDev, sData, lBufferSize, lDataLen, ByVal pNull)
  If Not bSuccess Then ApiRaiseLastError
  sReadData = Left$(sData, lDataLen)
  lBytesRead = lDataLen
  'Debug.Print "Read (" + CStr(lDataLen) + " Bytes): " + sReadData
  ReadPort = bSuccess And (lDataLen > 0)    ' You might not want to use: And (lDataLen > 0)
End Function

Public Function WritePort(sWriteData As String) As Boolean
  Dim bSuccess As Boolean
  Dim lBytesWritten As Long
  Dim lDataLen As Long
  Dim ab() As Byte
 
  If Not IsOpen() Then
    Exit Function
  End If

  lDataLen = Len(sWriteData)
  'Debug.Print "Writing: " + HexDumpBytes(sWriteData)
  ab = StrConv(sWriteData, vbFromUnicode)
  bSuccess = WriteFile(m_hCommDev, sWriteData, lDataLen, lBytesWritten, ByVal pNull)
  If Not bSuccess Then ApiRaiseLastError
  WritePort = bSuccess
End Function

Private Sub Class_Initialize()
  CommPort = "COM1"
  m_commConfig.dwSize = Len(m_commConfig)
  m_dcb.DCBlength = Len(m_dcb)
  m_lngBufferSize = 128                 ' Adjust as necessary

  ' DCB Defaults
  BaudRate = CBR_9600
  XonLim = 2048
  XoffLim = 512
  ByteSize = 8
  Parity = NOPARITY
  StopBits = ONESTOPBIT
  XonChar = &H11
  XoffChar = &H13
  ErrorChar = &H0
  EofChar = &H1A
  EvtChar = &H0
 
  ' DCB Bit Field Defaults
  fBinary = True                        ' Always True
  fParity = (Parity <> NOPARITY)        ' Default No Parity
  fOutxCtsFlow = False                  ' Handshaking Off
  fOutxDsrFlow = False                  ' Handshaking Off
  byDtrControl = DTR_CONTROL_DISABLE    ' See CommDTREnum
  fTXContinueOnXoff = False             ' Disable XON/XOFF
  fOutX = False                         ' Disable XON/XOFF
  fInX = False                          ' Disable XON/XOFF
  fUseErrorChar = False                 ' Disable Error Character
  fNullStripping = False                ' Disable EOF
  byRtsControl = RTS_CONTROL_DISABLE    ' See CommRTSEnum
  fAbortOnError = False                 ' Do not Abort on Error
 
  ' Timeout Defaults
  ReadIntervalTimeout = 95              ' Max time allowed between arrival of two chars
  ReadTotalTimeoutMultiplier = 10       ' 10 msec per each char
  ReadTotalTimeoutConstant = 100        ' Read t.o. = 100 + (10 * Num. chars)
  WriteTotalTimeoutMultiplier = 10      ' 10 msec per each char
  WriteTotalTimeoutConstant = 10        ' Write t.o. = 100 + (10 * Num. chars)
End Sub

Private Sub Class_Terminate()
  If IsOpen() Then
    On Error Resume Next
    ClosePort
  End If
End Sub


' -----------------------------------------------------------------------
' File         : CommTest.frm
' Description  : Comm Port Testing file
' Author       : Ryan Van Slooten
' Date         : Sept. 11, 1999
' -----------------------------------------------------------------------
Option Explicit

Dim oComm As CCommPort

Private Sub cmdSend_Click()
  Dim v As Variant
  Dim s As String
  v = Array(&H1, &H1, &H0, &H0, &H0, &H8, &H3D, &HCC)
  s = MakeCommString(v)
  oComm.WritePort s
 
  tmrComm.Enabled = True
End Sub

Private Sub Form_Activate()
  Dim ab() As Byte
  Dim s As String
 
  ab = StrConv(s, vbFromUnicode)
 
End Sub

Private Sub Form_Load()
  Set oComm = New CCommPort
  oComm.BaudRate = CBR_19200
  oComm.Parity = NOPARITY
  oComm.StopBits = ONESTOPBIT
 
  oComm.CommPort = "COM2"
  If Not oComm.OpenPort Then
    MsgBox "Unable to Open Comm Port"
    Unload Me
    Exit Sub
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  oComm.ClosePort
  Set oComm = Nothing
End Sub

Private Sub tmrComm_Timer()
  Dim s As String
 
  tmrComm.Enabled = False
  DoEvents

  Do While oComm.ReadPort(s, 6)
    DoEvents
  Loop

  Dim ab() As Byte
  ab = StrConv(s, vbFromUnicode)
End Sub

0
 

Author Comment

by:Marktalbot
ID: 2204030
thanks this souhld help emensly.
0
 
LVL 1

Expert Comment

by:ncw
ID: 11871915
ryanvs, would you be able to help me with my question 'Read serial data using Modbus protocol on Linux' at
http://www.experts-exchange.com/Programming/Programming_Languages/Java/Q_21103884.html
please?
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

612 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question