Modbus device finder

User projects written in or related to FreeBASIC.
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Modbus device finder

Postby Antoni » May 23, 2006 19:57

This is a thing I made at work, the idea is to scan the range of Modbus addresses to identify those Modbus devices someone readdressed and forgot to document.
It's an example of OPEN COM, tested with an Adam 232/485 converter. It's just a sketch, I plan to add some features and make it a minimal SCADA just for modbus, if I can make it work togheter with passerby's Win GUI wrapper.
I had to work wit ubite arrays because FB's zstrings can't hold zero characters and Modbus protocol is binary.

Code: Select all

'Modbus Device Finder Antoni Gual 5/2006
'
#include "vbcompat.bi"
option explicit
dim shared crc_table(255) as ushort
#define crc_const &hA001
#define titulo "Modbus device Finder Antoni Gual 2006"
dim shared linblanco as zstring *81=>_
{"                                                                               "}
'------------------------------------------------------------
Private sub genCRCtable
dim i as ushort, j as integer, k as ushort
'generates a lookup table for fast crc calculation
for i=0 to 255:k=i
  for j=1 to 8
    if k and 1 then k shr=1: k xor= crc_const else k shr=1           
  next j
 crc_table(i)=k
next i
end sub
'
'-------------------------------------------------------------
Public Function crcModbus_update(ByVal crc As ushort=0, _
                      byval buf As ubyte ptr, _
                      ByVal buf_len As uInteger) As ushort
  'calculates incrementally crc
  Dim r As ushort, n As Integer
  if crc_table(128)<>crc_const then gencrctable
  r = crc XOR &hffff
  For n = 0 To buf_len - 1
    'the reflected crc
    r = crc_table((buf[n] XOR r) AND 255) XOR (r shr 8)
  Next n
  return r 'XOR &hffff
End Function
'
'------------------------------------------------------------
sub transmit(byval ff,byval b as ubyte ptr,byval length)
 put #ff,,*b,length
end sub
'
'------------------------------------------------------------
function receive(byval ff,b as ubyte ptr,byval length)
 dim i
 i=loc(ff)
 get #1,,*b,i
 return i
end function
'
'------------------------------------------------------------
sub printhex (byval b as ubyte ptr,byval length)
dim i
print linblanco;
locate,1
print ">";
for i=0 to length-1: print format(b[i]," 000");:next
print "<";
end sub
'
'-------------------------------------------------------------
sub addcrc(b as ubyte ptr,length)
dim c
c=crcmodbus_update(0,b,length)
b[length]  =lobyte(c)
b[length+1] = hibyte(c)
length+=2
end sub
'
'------------------------------------------------------------
function checkcrc(b as ubyte ptr,length)
dim c
c= b[length-2] or (b[length-1] shl 8)
return iif(c=crcmodbus_update(0,b,length-2),-1,0)
end function
'
'------------------------------------------------------------
function pruebaDG(b as ubyte ptr,length,device,ff)
   static rx(255) as ubyte,lenrx
   dim rxok
   color 7

   b[0]=device
   addcrc(b,length)
   locate 23,1
   printhex(b,length)
   transmit(ff,b,length)
   
   sleep 200
 
   lenrx =receive(ff,@rx(0),0)
   rxok= iif(lenrx,checkcrc(@rx(0),lenrx),0)
   locate 24,1:color
   if rxok then
     printhex (@rx(0),lenrx)
     return b[0]
   else
     print linblanco;
     locate ,1
     ?"No answer             ";
     return 0
   end if
end function
'
'------------------------------------------------------------
#define bsize 512
dim as ubyte tx(255)={1,4,0,&hfa,0,1}
dim inilentx=6,lentx
dim b as ushort,i,j,errata,ff,lenrx,test,neq,mycom
',mycom
dim comcfg as zstring*30 =>"COM2:9600,N,8,1,dt"
dim x,y,boton
do
cls
print titulo
input "Serial port to use? ";mycom
loop until mycom>0 and mycom<10

comcfg=left(comcfg,3)+str(mycom)+mid(comcfg,5)
color 15,0:width 80,25:cls
'print comcfg
Print titulo;" Using port ";mycom

ff=freefile
open com comcfg for random as #ff
if err>0 then errata=err: ?"Error ";errata;_
 " opening port":sleep:end

do
for i=0 to 15
  for j=0 to 15
    neq=i*16+j+1
    if neq>255 then continue do
    lentx=inilentx
    test=pruebadg(@tx(0),lentx,neq,ff)
    locate i+3,j*4+8:
    if test then color 15 else color 12
    print format (neq,"###");
    if len(inkey) then exit do
  next
next
loop
close
end
Frank Dodd
Posts: 444
Joined: Mar 10, 2006 19:22

Postby Frank Dodd » May 29, 2006 21:36

It sounds like a nice little project. I am involved with SCADA work myself on a data collector that covers several protocols including ModBus.

I think that a works project like a test harness or other utility provides a great practical opportunity to enhance those FB skills in a work environment while developing a useful tool.

Return to “Projects”

Who is online

Users browsing this forum: dixiony, Google [Bot] and 3 guests