; CB1000DB
;
; Program for Proteus
;
; (C) 2003-2004 Simone Zanella Productions
;
; Save to READINGS.MDB the data arriving from a device connected through an Ethernet Client Bridge
; (like Symbol CB1000). For the program to work correctly, it is necessary that the device be configured
; so that it accepts connections from the PC where this program is running.
; This program can be installed as a script for Proteus Service.
;
; Communication parameters can be found at the very beginning of the program; the meaning is as follow:
; - NETADDR = CB1000 network address
; - NETPORT = CB1000 port number
;
; READINGS.MDB must have the following format:
;
; Table:   Readings
;          Fields: Text, string (50 characters), index "Text" unique
;                  DateTime, date/time
;                  Qt, long integer

#!proteus -z -j

!include "win32.prt"
!include "socket.prt"
!include "daodefs.prt"

CONST NETADDR = "172.16.0.90"
CONST NETPORT = 4000

HSock = -1

Connect()
NumBytes = 0
LastTime = W32GETTICKCOUNT()

DBHandle = RSHandle = 0
OpenDB(@DBHandle, "c:\\szp\\READINGS.MDB")
OpenTab(DBHandle, @RSHandle, "Readings")

WHILE 1
  N = W32IOCTLSOCKET(HSock, FIONREAD, @NumBytes)
  IF AND(EQ(N, 0), GT(NumBytes, 0))
    LastTime = W32GETTICKCOUNT()
    Buffer = REPLICATE(" ", NumBytes)
    N = W32RECV(HSock, @Buffer, 0)
    IF LT(N, 0)
      Connect()
    ELSE
      RTRIM(@Buffer, CHR(13))
      
      ; Select index "Text" on the table "Text"
      DAORSATTRIB(RSHandle, DAORSATTSETCURRENTINDEX, "Text")

      ; Lookup value by using index
      IF EQ(DAORSSEEK(RSHandle, "=", Buffer), 1)
        ; Found: add 1 to quantity, update reading date/time
        DAORSEDIT(RSHandle)
        DAORSSETFIELDVAL(RSHandle, "Qt", INC(DAORSGETFIELDVAL(RSHandle, "Qt")))
        DAORSSETFIELDVAL(RSHandle, "DateTime", DATE() " " TIME())
        DAORSUPDATE(RSHandle)
      ELSE
        ; Not found: save qt = 1, update date/time
        DAORSADDNEW(RSHandle)
        DAORSSETFIELDVAL(RSHandle, "Text", Buffer)
        DAORSSETFIELDVAL(RSHandle, "Qt", 1)
        DAORSSETFIELDVAL(RSHandle, "DateTime", DATE() " " TIME())
        DAORSUPDATE(RSHandle)
      FI      
    FI
  ELSE
    IF LT(N, 0)
      Connect()
    ELSE
      IF GT(SUB(W32GETTICKCOUNT(), LastTime), 4000)
        IF LT(PING(NETADDR), 0)
          Connect()
        FI
        LastTime = W32GETTICKCOUNT()
      FI
    FI
  FI
  !ifndef SERVICE  
    IF KBDHIT()
      IF EQ(GETCH(0), 27)
        W32SHUTDOWN(HSock, SD_BOTH)
        W32CLOSESOCKET(HSock)
        CloseDB(DBHandle, RSHandle)
        ABORT 0
      FI
    FI    
  !endif
LOOP

ABORT 0


FUNCTION Connect()

; Close the socket, if it's open
IF NEQ(_HSock, -1)
  W32SHUTDOWN(_HSock, _SD_BOTH)
  W32CLOSESOCKET(_HSock)
FI     
_HSock = -1
WHILE EQ(_HSock, -1)
  ; Create the socket
  WHILE EQ(_HSock, -1)
    _HSock = W32SOCKET(_AF_INET, _SOCK_STREAM, _IPPROTO_TCP)
    IF EQ(_HSock, -1)
      ; Wait one second
      SLEEP(1)
    FI
  LOOP
  
  ; Try to resolve address
  nome = netaddr = _NETADDR
  alias = ""
  type = 0
  addresses = ""
  result = W32GETHOSTBYNAME(@nome, @alias, @type, @addresses)
  IF EQ(result, 0)
    netaddr = TOKEN(addresses, 1, "\t")
  FI 
  
  ; Connect the socket to the specified address/port
  result = W32CONNECT(_HSock, _AF_INET, _NETPORT, netaddr)
  IF EQ(result, -1)
    W32SHUTDOWN(_HSock, _SD_BOTH)
    W32CLOSESOCKET(_HSock)
    _HSock = -1
    ; Wait one second
    SLEEP(1)
  FI
LOOP
RETURN


FUNCTION Ping(netaddr)

; Create socket
hsock = W32SOCKET(_AF_INET, _SOCK_RAW, _IPPROTO_ICMP)
IF EQ(hsock, -1)
  RETURN -1
FI

; Set send/receive timeout
IF EQ(W32SETSOCKOPT(hsock, _SOL_SOCKET, _SO_RCVTIMEO, 1000), -1)
  RETURN -2
FI
IF EQ(W32SETSOCKOPT(hsock, _SOL_SOCKET, _SO_SNDTIMEO, 1000), -1)
  RETURN -3
FI

; Try to resolve address
nome = netaddr
alias = ""
type = 0
addresses = ""
result = W32GETHOSTBYNAME(@nome, @alias, @type, @addresses)
IF EQ(result, 0)
  netaddr = TOKEN(addresses, 1, "\t")
FI

; IcmpHeader:
; BYTE i_type  (ECHO = 8)
; BYTE i_code  (= 0)
; WORD i_cksum (= 0)
; WORD i_id    (= current process ID)
; WORD i_seq   (= 0)
; DWORD timestamp (= Tick Count)

seq = 0
buffer = CHR(8) CHR(0) CHR(0) CHR(0) Word2String(W32GETPROCESSID()) Word2String(seq) LongWord2String(W32GETTICKCOUNT()) \
         REPLICATE("E", SUB(44, 12))
buffer = LEFT(buffer, 2) Word2String(CHECKSUM(buffer)) RESTFROM(buffer, 5)

; Send ping packet
result = W32SENDTO(hsock, buffer, 0, _AF_INET, 0, netaddr)
IF EQ(result, -1)
  RETURN -4
FI
  
; Receive answer, with timeout
buffer = REPLICATE(" ", 1024)
indirizzo = ""
porta = 0
famiglia = 0
result = W32RECVFROM(hsock, @buffer, 0, @famiglia, @porta, @indirizzo)
IF EQ(result, -1)
  RETURN -5
FI
  
l = MUL(NAND(ASC(LEFT(buffer,1)), 0xF), 4)

; Non-echo type
NEWBUF = RESTFROM(buffer, INC(l))
IF NEQ(ASC(SUBSTR(NEWBUF, 1, 1)), 0)
  RETURN -6
FI

; Wrong destination
IF NEQ(String2Word(SUBSTR(NEWBUF, 5, 2)), W32GETPROCESSID())
  RETURN -7
FI

; Round-trip time in milliseconds
diff = SUB(W32GETTICKCOUNT(), String2LongWord(SUBSTR(NEWBUF, 9, 4)))

; Close socket and return round-trip time
W32SHUTDOWN(hsock, _SD_BOTH)
W32CLOSESOCKET(hsock)
RETURN diff


FUNCTION CheckSum(s)

; Calculate checksum for the packet
l = STRLEN(s)
chk = 0
x = 1
WHILE GT(l, 1)
  ADD(@chk, ASC(SUBSTR(s, x, 1)), MUL(ASC(SUBSTR(s, INC(x), 1)), 256))
  SUB(@l, 2)
  ADD(@x, 2)
LOOP
IF l
  ADD(@chk, ASC(SUBSTR(s, x, 1)))
FI
chk = ADD(SHIFTRT(chk, 16), NAND(chk, 0xFFFF))
ADD(@chk, SHIFTRT(chk, 16))
RETURN NAND(NNOT(chk), 0xFFFF)


FUNCTION String2Word(s)

; Convert from binary to word
RETURN NOR( ASC(LEFT(s, 1)), SHIFTLT(ASC(SUBSTR(s, 2, 1)), 8) )


FUNCTION Word2String(n)

; Convert from word to binary
RETURN CHR(NAND(n, 0xFF)) CHR(NAND(SHIFTRT(n, 8), 0xFF))


FUNCTION String2LongWord(s)

; Convert from binary to long word
RETURN NOR(ASC(LEFT(s, 1)), \
           SHIFTLT(ASC(SUBSTR(s, 2, 1)), 8), \
           SHIFTLT(ASC(SUBSTR(s, 3, 1)), 16), \
           SHIFTLT(ASC(SUBSTR(s, 4, 1)), 24))


FUNCTION LongWord2String(n)

; Convert from long word to binary
RETURN CHR(NAND(n, 0xFF)) CHR(NAND(SHIFTRT(n, 8), 0xFF)) CHR(NAND(SHIFTRT(n, 16), 0xFF)) \
       CHR(NAND(SHIFTRT(n, 24), 0xFF))


FUNCTION OpenDB(dbhandle, S)

; Open database and warn the user in case of trouble
dbhandle = DAODBNEW()
res = DAODBOPEN(dbhandle, S, 0, 0, "") 

; Example for opening a database with password:
; res = DAODBOPEN(dbhandle2, "c:\\szp\\letture_protetto.mdb", 0, 0, \
;                 ";PWD=Wg3Tha912;UID=Admin") 

IF EQ(res, -1)
  ; Error
  PrintErr(dbhandle)
  ABORT 1
FI
RETURN

FUNCTION OpenTab(dbhandle, rshandle, T)

; Open database table; warn user in case of trouble
rshandle = DAORSNEW(dbhandle)
res = DAORSOPEN(rshandle, _DAOCOpenTable, T, 0)
IF EQ(res, -1)
  ; Error
  PrintErr(dbhandle)
  ABORT 1
FI
RETURN

FUNCTION PrintErr(dbhandle)

numerr = DAOERRCOUNT(dbhandle)
FOR x = 1 TO numerr
  CONSOLELN "Error " x ": " 
  CONSOLELN "Code       : " DAOGETERRORNUM(dbhandle, x)
  CONSOLELN "Description: " DAOGETERRORDESC(dbhandle, x)
  CONSOLELN "Source     : " DAOGETERRORSRC(dbhandle, x)
  CONSOLELN ""
NEXT
RETURN

FUNCTION CloseDB(dbhandle, rshandle)

DAORSCLOSE(rshandle)
DAORSFREE(rshandle)
DAODBCLOSE(dbhandle)
DAODBFREE(dbhandle)
RETURN