QB64 Sending/Receiving through COM ports

sccl8998
New Member

Posts: 1

QB64 Sending/Receiving through COM ports Dec 19, 2022 17:52:40 GMT

Quote

Post by sccl8998 on Dec 19, 2022 17:52:40 GMT

I am migrating a program from QBASIC to QB64 on windows 10. I am having trouble communicating with a device through a comport, and not confident that the signal is going out to the device. Has anyone had any issues using com ports in QB64? Or windows blocking QB64 on com ports?

9050 'serial communications with PFP

message$ = "com port to open not specified correctly!!"

opencom = 0

If stype$(sn) = "tank" Or stype$(sn) = "flask" Then

comport1$ = "Y"

Open "COM1:9600,N,8,1,ASC" For Random As #3

message$ = "serial port #1 OPEN"

opencom = 1

End If

If stype$(sn) = "tank2" Or stype$(sn) = "flask2" Then

comport2$ = "Y"

Open "COM2:9600,N,8,1,ASC" For Random As #3

message$ = "serial port #2 OPEN"

opencom = 1

End If

If Loc(3) > 0 Then 'clear buffer

TEMP$ = Input$(Loc(3), 3)

End If

Return

9055 'operate on flask package with directional flags

If pfptask$ = "pfpreply" Then GoSub 9090

If pfptask$ = "open" Then GoSub 9080

If pfptask$ = "close" Then GoSub 9085

If pfptask$ = "readpress" Then GoSub 9070: GoSub 9095

Return

9058 'looking for look$ in response buff$ from PFP

z = 1: GoSub 7700 'wait z loops (0.3 sec)

buff$ = Input$(Loc(3), 3)

j = InStr(buff$, look$)

Return

9060 ' get AS prompt

c = 0

Print #3, " "

look$ = asprmpt$: GoSub 9058 'look for AS>

9061 If j < 1 Then

Print #3, "Q": GoSub 9058

c = c + 1

If c = 4 Then message$ = "could not reach AS>": GoSub 9999

End If

If j < 1 And c < 4 Then GoTo 9061

message$ = "prompt now AS>"

Return

9090 'read reply from pfp

z = 1: GoSub 7800 'wait 1 sec, not 1 loop

If Loc(3) > 0 Then

buff$ = Input$(Loc(3), 3)

message$ = Mid$(buff$, 26, 32): GoSub 5800

If t > (postsec + 180) Then pfpopen$ = message$ 'save pre-sampling message

'problems indicated by "stalled" or "stuck"

If t < (postsec + 180) Then pfpclose$ = message$ 'save post-sampling message

'problems indicated by "stuck" or "broken"

Else message$ = "no reply from pfp": GoSub 5800

End If

Return

9095 ' read pressure in inlet of pfp package

'read during evac, save to Pevac

'read before sampling--conditional use of pneutronics possible!! save as Pinit

'read after sampling--final P in flask, save as Pfinal

' GOSUB 9070 'get unload'

z = 1: GoSub 7800 'wait 1 sec, not 1 loop...

If Loc(3) > 0 Then TEMP$ = Input$(Loc(3), 3)

Print #3, "P"

look$ = "now": GoSub 9058

pfppress$ = Mid$(buff$, j + 4, 9)

message$ = pfppress$: GoSub 5800

Return

10000 'convert pfppress$ to numeric

look$ = "."

j = InStr(pfppress$, look$)

Pval = Val(Left$(pfppress$, j + 1))

Return

Last Edit: Dec 20, 2022 16:57:59 GMT by sccl8998

tonylazuto
New Member

Tony Lazuto says hello

Posts: 25

QB64 Sending/Receiving through COM ports Dec 30, 2022 17:51:32 GMT

Quote

Post by tonylazuto on Dec 30, 2022 17:51:32 GMT

You could take a look at communication with com ports over Win32 API. I'm not sure how well it will work but it could be worth a gander. I'd need to get to my home PC to find my latest code as the UDT here is not usable, really. If I find my latest code, I'll send it your way.

Option Explicit

$NoPrefix

$Console:Only



Const GENERIC_READ = &H80000000

Const GENERIC_WRITE = &H40000000



Const OPEN_EXISTING = 3



Const CBR_110 = 110

Const CBR_300 = 300

Const CBR_600 = 600

Const CBR_1200 = 1200

Const CBR_2400 = 2400

Const CBR_4800 = 4800

Const CBR_9600 = 9600

Const CBR_14400 = 14400

Const CBR_19200 = 19200

Const CBR_38400 = 38400

Const CBR_57600 = 57600

Const CBR_115200 = 115200

Const CBR_128000 = 128000

Const CBR_256000 = 256000



Const EVENPARITY = 2

Const MARKPARITY = 3

Const NOPARITY = 0

Const ODDPARITY = 1

Const SPACEPARITY = 4



Const DTR_CONTROL_DISABLE = &H00

Const DTR_CONTROL_ENABLE = &H01

Const DTR_CONTROL_HANDSHAKE = &H02



Const RTS_CONTROL_DISABLE = &H00

Const RTS_CONTROL_ENABLE = &H01

Const RTS_CONTROL_HANDSHAKE = &H02

Const RTS_CONTROL_TOGGLE = &H03



Const ONESTOPBIT = 0

Const ONE5STOPBITS = 1

Const TWOSTOPBITS = 2



Type DCB

    As Unsigned Long DCBlength, BaudRate

    As Bit fBinary, fParity, fOutxCtsFlow, fOutxDsrFlow

    As _Bit * 2 fdtrControl

    As Bit fDsrSensitivity, fTXContinueOnXoff, fOutX, fInX, fErrorChar, fNull

    As _Bit * 2 fRtsControl

    As Bit fAbortOnError

    As _Bit * 17 fDummy2

    As Unsigned Integer wReserved, XonLim, XoffLim

    As Byte ByteSize, Parity, StopBits

    As Unsigned Byte XonChar, XoffChar, ErrorChar, EofChar, EvtChar

    As Unsigned Integer wReserved1

End Type



Declare CustomType Library

    Function CreateFile%& (ByVal lpFileName As Offset, Byval dwDesiredAccess As Unsigned Long, Byval dwShareMode As Unsigned Long, Byval lpSecurityAttributes As Offset, Byval dwCreationDisposition As Unsigned Long, Byval dwFlagsAndAttributes As Unsigned Long, Byval hTemplateFile As Offset)

    Function GetCommState& (ByVal hFile As Offset, Byval lpDCB As Offset)

    Function SetCommState& (ByVal hFile As Offset, Byval lpDCB As Offset)

End Declare



Dim As DCB dcb

Dim As Offset hCom

Dim As Long fSuccess

Dim As String pcCommPort: pcCommPort = "COM1" + Chr$(0)



hCom = CreateFile(Offset(pcCommPort), GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)

If hCom = -1 Then End



fSuccess = GetCommState(hCom, Offset(dcb))

If fSuccess Then

    PrintCommState dcb



    dcb.BaudRate = CBR_57600

    dcb.ByteSize = 8

    dcb.Parity = NOPARITY

    dcb.StopBits = ONESTOPBIT



    fSuccess = SetCommState(hCom, Offset(dcb))

    If fSuccess Then

        fSuccess = GetCommState(hCom, Offset(dcb))

        If fSuccess Then

            PrintCommState dcb

            Print "Serial port "; pcCommPort; " successfully reconfigured"

        Else

            End

        End If

    Else

        End

    End If

Else

    End

End If



Sub PrintCommState (dcb As DCB)

    Print "BaudRate ="; dcb.BaudRate; ", ByteSize ="; dcb.ByteSize; ", Parity ="; dcb.Parity; ", StopBits ="; dcb.StopBits

End Sub

Last Edit: Dec 30, 2022 17:52:54 GMT by tonylazuto

mdijkens
New Member

Posts: 4

QB64 Sending/Receiving through COM ports Dec 31, 2022 9:21:18 GMT dualbrain likes this

Quote

Post by mdijkens on Dec 31, 2022 9:21:18 GMT

Yes there are some issues with serial comms.
I implemented below functions that turn out quite reliable:

Function ser.open% (ser$)
  On Error GoTo Errhandler
  Open ser$ + ",N,8,1,BIN,CS0,DS0,RB8192" For Random As #88
  If errorNum = 0 Then serBytes$ = ser.read$
  On Error GoTo 0
  ser.open% = errorNum
End Function

Function ser.close$ ()
  ser.close$ = ser.read$
  Close #88
End Function

Sub ser.send (bytes$)
  Dim b As String * 1
  For i% = 1 To Len(bytes$)
    b = Mid$(bytes$, i%, 1)
    Put #88, , b
  Next i%
End Sub

Function ser.read$ ()
  Dim b As String * 1: resp$ = ""
  Do While Loc(88)
    Get #88, , b: resp$ = resp$ + b
  Loop
  ser.read$ = resp$
End Function

Last Edit: Dec 31, 2022 9:21:49 GMT by mdijkens