01-02-2026, 09:21 PM
@Rudy M
Sorry, had to finish some other stuff first. I'm on it now. Let me know if it's working or reporting any issues. We'll need to debug remotely as I have no way of testing it locally.
Code: (Select All)
' MODBUS RTU (RS-485) - PTA8D08 (8x PT100) - QB64/QB64PE
'
'
' What this program does:
' - Opens COM port (USB-RS485 adapter usually appears as COMx)
' - Periodically reads 8 temperature registers (0x0000..0x0007) via MODBUS function 03
' - Validates CRC16 (MODBUS)
' - Decodes signed 16-bit temperature values in 0.1°C units
'
' IMPORTANT NOTES (read before debugging):
' - QB64 commonly supports COM1..COM9 easily. If Windows assigns COM10+, renumber it in Device Manager.
' - RS-485 wiring: A/B must match. If you swap A/B you usually get no reply.
' - Many USB-RS485 adapters auto-handle TX enable. Some need RTS control -> harder in QB64.
' - Device might be in "auto-report" mode and spam the line. If so, your receive buffer fills with junk.
' You can force "query mode" by writing register 0x00FA = 0 (code included as optional).
Dim Shared Byte1 As String * 1 ' used by GET/PUT for serial I/O
Dim port$: port$ = "1" ' COM1..COM9 are the safest range for QB64
Dim slave%: slave% = 1 ' MODBUS slave address of your module (often 1 by default)
' ---- Tuning knobs:
Dim pollHz!: pollHz! = 2 ' how often to poll (2 = twice per second)
Dim showRawFrames%: showRawFrames% = -1 ' -1 = yes, 0 = no (raw hex dumps help debugging)
' ---- Expected response length for reading 8 registers:
' addr(1) + func(1) + bytecount(1) + data(16) + crc(2) = 21 bytes
Dim respLen%: respLen% = 21
' ---- Open COM port
Dim h%: h% = FreeFile
' NOTE: If your QB64 build rejects this OPEN string, share the error text and your QB64/QB64PE version.
Open "COM" + port$ + ":9600,N,8,1,BIN,CS0,DS0" For Random As #h%
Print "Opened COM"; port$; " at 9600,N,8,1"
Print "Polling slave address:"; slave%
Print "Press ESC to exit."
Print
' Optional: Force query mode (stop auto-report spamming).
' If the device was previously configured to auto-report, your RX buffer may contain unsolicited frames.
' Register 0x00FA:
' 0 = query mode (default)
' 1..255 = auto-report interval in seconds
'
' Uncomment to enforce query mode:
'
' DIM wr$ : wr$ = ModbusWriteSingle$(slave%, &H00FA, 0)
' SerialFlush h%
' SerialWrite h%, wr$
' DIM wrResp$ : wrResp$ = SerialReadFixed$(h%, 8, 1.0) ' write-single response is 8 bytes
' IF showRawFrames% THEN DumpHex "WRITE 00FA response", wrResp$
' IF LEN(wrResp$) <> 8 THEN PRINT "No/short reply to write 00FA. Continuing anyway."
'
Do
Dim k$: k$ = InKey$
If k$ = Chr$(27) Then Exit Do ' ESC
' Always flush any leftover bytes before issuing a request.
' This is crucial if:
' - The module is/was in auto-report mode
' - The line has noise, partial frames, or previous retries
SerialFlush h%
' Build and send MODBUS request: Read 8 temperature registers starting at 0x0000
Dim req$: req$ = ModbusReadRegs$(slave%, &H0000, 8)
If showRawFrames% Then DumpHex "TX (Read 8 temps)", req$
SerialWrite h%, req$
' Read fixed-length response
Dim resp$: resp$ = SerialReadFixed$(h%, respLen%, 1.0)
If Len(resp$) <> respLen% Then
Print "Timeout / short response. Received bytes:"; Len(resp$)
If Len(resp$) > 0 And showRawFrames% Then DumpHex "RX (partial)", resp$
Print "NOTES:"
Print "- Check A/B wiring and module power (8-30V)."
Print "- Confirm correct COM port number and slave address."
Print "- If COM is > 9, renumber it to COM1..COM9."
Print "- If you suspect auto-report mode, enforce register 00FA=0 (see optional block)."
Print
_Limit pollHz!
GoTo ContinueLoop
End If
If showRawFrames% Then DumpHex "RX (Read 8 temps)", resp$
' Basic header checks
If Asc(resp$, 1) <> (slave% And &HFF) Then
Print "Wrong slave address in response:"; Asc(resp$, 1)
Print "NOTE: Some adapters echo bytes; some devices respond on a different address."
Print
_Limit pollHz!
GoTo ContinueLoop
End If
If Asc(resp$, 2) <> &H03 Then
Print "Wrong function code in response:"; Asc(resp$, 2)
Print "NOTE: If MSB is set (e.g. 0x83) it's an exception response."
Print
_Limit pollHz!
GoTo ContinueLoop
End If
If ModbusCheckCrc%(resp$) = 0 Then
Print "CRC FAIL (response corrupted / wrong framing)."
Print "NOTES:"
Print "- Try lower baudrate if configurable (but default is 9600)."
Print "- Improve shielding/grounding, keep RS485 lines short, add termination if needed."
Print "- Ensure adapter is genuine RS485 (not TTL serial)."
Print
_Limit pollHz!
GoTo ContinueLoop
End If
' Byte count should be 16 for 8 registers (8*2)
If Asc(resp$, 3) <> 16 Then
Print "Unexpected byte count:"; Asc(resp$, 3); " (expected 16)"
Print
_Limit pollHz!
GoTo ContinueLoop
End If
' Decode temperatures
' Data starts at byte 4 (1-based string indexing):
' [4..5]=CH0, [6..7]=CH1, ... each is signed 16-bit big-endian, unit 0.1°C
Dim i As Integer, raw%, t!
For i = 0 To 7
raw% = S16FromBE%(Asc(resp$, 4 + i * 2), Asc(resp$, 5 + i * 2))
t! = raw% / 10!
Print Using "CH## = ####.# C"; i; t!
Next
Print "----------------------------"
Print
' TODO / OPTIONAL EXTENSIONS:
' 1) Read PT100 resistance registers 0x0020..0x0027 (unit 0.1 ohm, unsigned).
' 2) Implement write (06) for settings like:
' - 00FA (auto-report interval / query mode)
' - 00FE (baudrate) -> requires power cycle
' - 00FF (parity) -> requires power cycle
' 3) Add robust framing:
' - Read header first (3 bytes), then read bytecount+2 CRC dynamically
' - Handle exception frames (func|0x80 + exception code)
'
' WHAT TO SEND FOR TUNING (copy/paste into forum/chat):
' - Your exact USB-RS485 adapter model/link
' - Windows COM port number
' - Module slave address (DIP/setting)
' - RAW HEX dumps shown by DumpHex() for TX and RX
' - If you never get RX: confirm A/B wiring and whether GND is shared
'
' With those, we can fix 95% of issues quickly.
ContinueLoop:
_Limit pollHz!
Loop
Close #h%
Print "Done."
End
'===========================================================
' SUBs / FUNCTIONs (MUST BE AFTER MAIN)
'===========================================================
Function Crc16Modbus& (s$)
' MODBUS CRC16:
' - Init 0xFFFF
' - Poly 0xA001 (reflected)
Dim crc As Long, i As Integer, j As Integer
crc = &HFFFF&
For i = 1 To Len(s$)
crc = crc Xor Asc(s$, i)
For j = 1 To 8
If (crc And 1) Then
crc = (crc \ 2) Xor &HA001&
Else
crc = crc \ 2
End If
Next j%
Next i%
Crc16Modbus& = (crc And &HFFFF&)
End Function
Function U16BE$ (v&)
' Convert 0..65535 to 2 bytes, Big Endian
U16BE$ = Chr$((v& \ 256) And &HFF) + Chr$(v& And &HFF)
End Function
Sub SerialFlush (h%)
' Drain all currently buffered RX bytes.
' Important before issuing a request, especially if auto-report mode is enabled.
While Loc(h%) > 0
Get #h%, , Byte1
Wend
End Sub
Sub SerialWrite (h%, s$)
' Write raw bytes to COM via PUT.
Dim i%
For i% = 1 To Len(s$)
Byte1 = Mid$(s$, i%, 1)
Put #h%, , Byte1
Next i%
End Sub
Function SerialReadFixed$ (h%, wantLen%, timeoutSec!)
' Read exactly wantLen bytes or stop on timeout.
' This is the simplest approach when response length is known.
Dim t0!, r$
r$ = ""
t0! = Timer
Do While Len(r$) < wantLen%
If Loc(h%) > 0 Then
Get #h%, , Byte1
r$ = r$ + Byte1
Else
If (Timer - t0!) >= timeoutSec! Then Exit Do
End If
Loop
SerialReadFixed$ = r$
End Function
Function ModbusReadRegs$ (slave%, reg&, count%)
' Build MODBUS RTU frame: [slave][03][regHi][regLo][cntHi][cntLo][crcLo][crcHi]
Dim req$, crc&
req$ = Chr$(slave% And &HFF) + Chr$(&H03) + U16BE$(reg&) + U16BE$(count%)
crc& = Crc16Modbus&(req$)
req$ = req$ + Chr$(crc& And &HFF) + Chr$((crc& \ 256) And &HFF) ' CRC = low, high
ModbusReadRegs$ = req$
End Function
Function ModbusWriteSingle$ (slave%, reg&, value&)
' Build MODBUS RTU frame: [slave][06][regHi][regLo][valHi][valLo][crcLo][crcHi]
Dim req$, crc&
req$ = Chr$(slave% And &HFF) + Chr$(&H06) + U16BE$(reg&) + U16BE$(value&)
crc& = Crc16Modbus&(req$)
req$ = req$ + Chr$(crc& And &HFF) + Chr$((crc& \ 256) And &HFF)
ModbusWriteSingle$ = req$
End Function
Function ModbusCheckCrc% (frame$)
' Verify CRC for a complete MODBUS RTU frame.
' CRC is last 2 bytes: [crcLo][crcHi]
Dim n%, crcRx&, crcCalc&
n% = Len(frame$)
If n% < 4 Then
ModbusCheckCrc% = 0
Exit Function
End If
crcRx& = Asc(frame$, n% - 1) + 256& * Asc(frame$, n%)
crcCalc& = Crc16Modbus&(Left$(frame$, n% - 2))
ModbusCheckCrc% = (crcRx& = crcCalc&)
End Function
Function S16FromBE% (hi%, lo%)
' Convert 2 bytes (big-endian) to signed 16-bit integer (two's complement).
Dim v%
v% = (hi% And &HFF) * 256 + (lo% And &HFF)
If v% >= 32768 Then v% = v% - 65536
S16FromBE% = v%
End Function
Sub DumpHex (caption$, s$)
' Print a byte string as hex pairs for debugging and forum paste.
Dim i%, out$
out$ = ""
For i% = 1 To Len(s$)
out$ = out$ + Right$("0" + Hex$(Asc(s$, i%)), 2) + " "
Next i%
Print caption$; ": "; out$
End Sub
Sorry, had to finish some other stuff first. I'm on it now. Let me know if it's working or reporting any issues. We'll need to debug remotely as I have no way of testing it locally.
