; CB1000DB
;
; Programma per Proteus
;
; (C) 2003 Simone Zanella Productions
;
; Salva sul database CODICI.MDB i dati in arrivo da un dispositivo connesso attraverso Ethernet
; Client Bridge (tipo Symbol CB1000). Per il corretto funzionamento è necessario che il CB1000
; sia configurato in modo da accettare connessioni dal PC sul quale viene fatto girare questo 
; programma, il quale può essere installato anche come script associato al servizio Proteus.
;
; I parametri di comunicazione si trovano all'inizio del programma e sono:
; - NETADDR = indirizzo del CB1000
; - NETPORT = porta sulla quale il CB1000 attende la connessione
;
; Il database CODICI.MDB deve avere il seguente formato:
;
; Tabella: Letture
;          Campi: Lettura, tipo testo 50 caratteri, indice "Lettura" univoco
;                 DataOra, tipo Data/ora
;                 Qt, tipo numerico intero lungo

#!proteus -z -j

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

CONST NETADDR = "172.16.0.90"
CONST NETPORT = 4000

HSock = -1

Connetti()
NumBytes = 0
LastTime = W32GETTICKCOUNT()

DBHandle = RSHandle = 0
ApriDB(@DBHandle, "c:\\szp\\codici.mdb")
ApriTab(DBHandle, @RSHandle, "Letture")

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)
      Connetti()
    ELSE
      RTRIM(@Buffer, CHR(13))
      
      ; Seleziona l'indice "Lettura" sulla tabella "Letture" aperta
      DAORSATTRIB(RSHandle, DAORSATTSETCURRENTINDEX, "Lettura")

      ; Cerca attraverso l'indice il valore acquisito
      IF EQ(DAORSSEEK(RSHandle, "=", Buffer), 1)
        ; Trovato: aumenta di 1 la quantità, aggiorna data e ora di ultima lettura
        DAORSEDIT(RSHandle)
        DAORSSETFIELDVAL(RSHandle, "Qt", INC(DAORSGETFIELDVAL(RSHandle, "Qt")))
        DAORSSETFIELDVAL(RSHandle, "DataOra", DATE() " " TIME())
        DAORSUPDATE(RSHandle)
      ELSE
        ; Non trovato: salva con qt = 1, data e ora correnti
        DAORSADDNEW(RSHandle)
        DAORSSETFIELDVAL(RSHandle, "Lettura", Buffer)
        DAORSSETFIELDVAL(RSHandle, "Qt", 1)
        DAORSSETFIELDVAL(RSHandle, "DataOra", DATE() " " TIME())
        DAORSUPDATE(RSHandle)
      FI      
    FI
  ELSE
    IF LT(N, 0)
      Connetti()
    ELSE
      IF GT(SUB(W32GETTICKCOUNT(), LastTime), 4000)
        IF LT(PING(NETADDR), 0)
          Connetti()
        FI
        LastTime = W32GETTICKCOUNT()
      FI
    FI
  FI
  !ifndef SERVICE  
    IF KBDHIT()
      IF EQ(GETCH(0), 27)
        W32SHUTDOWN(HSock, SD_BOTH)
        W32CLOSESOCKET(HSock)
        ChiudiDB(DBHandle, RSHandle)
        ABORT 0
      FI
    FI    
  !endif
LOOP

ABORT 0


FUNCTION Connetti()

; Se c'era un socket precedentemente aperto, lo chiude
IF NEQ(_HSock, -1)
  W32SHUTDOWN(_HSock, _SD_BOTH)
  W32CLOSESOCKET(_HSock)
FI     
_HSock = -1
WHILE EQ(_HSock, -1)
  ; Crea il socket
  WHILE EQ(_HSock, -1)
    _HSock = W32SOCKET(_AF_INET, _SOCK_STREAM, _IPPROTO_TCP)
    IF EQ(_HSock, -1)
      ; Attende un secondo
      SLEEP(1)
    FI
  LOOP
  
  ; Prova a risolvere l'indirizzo
  nome = netaddr = _NETADDR
  alias = ""
  tipo = 0
  indirizzi = ""
  result = W32GETHOSTBYNAME(@nome, @alias, @tipo, @indirizzi)
  IF EQ(result, 0)
    netaddr = TOKEN(indirizzi, 1, "\t")
  FI 
  
  ; Connette il socket all'indirizzo/porta specificati
  result = W32CONNECT(_HSock, _AF_INET, _NETPORT, netaddr)
  IF EQ(result, -1)
    W32SHUTDOWN(_HSock, _SD_BOTH)
    W32CLOSESOCKET(_HSock)
    _HSock = -1
    ; Attende un secondo
    SLEEP(1)
  FI
LOOP
RETURN


FUNCTION Ping(netaddr)

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

; Imposta i timeout in invio e ricezione
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

; Prova a risolvere l'indirizzo
nome = netaddr
alias = ""
tipo = 0
indirizzi = ""
result = W32GETHOSTBYNAME(@nome, @alias, @tipo, @indirizzi)
IF EQ(result, 0)
  netaddr = TOKEN(indirizzi, 1, "\t")
FI

; IcmpHeader:
; BYTE i_type  (ECHO = 8)
; BYTE i_code  (= 0)
; WORD i_cksum (= 0)
; WORD i_id    (= ID del processo corrente)
; 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)

; Invia il pacchetto di ping  
result = W32SENDTO(hsock, buffer, 0, _AF_INET, 0, netaddr)
IF EQ(result, -1)
  RETURN -4
FI
  
; Riceve la risposta, con 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)

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

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

; Tempo di round-trip in millisecondi
diff = SUB(W32GETTICKCOUNT(), String2LongWord(SUBSTR(NEWBUF, 9, 4)))

; Chiude il socket e ritorna il tempo di round-trip
W32SHUTDOWN(hsock, _SD_BOTH)
W32CLOSESOCKET(hsock)
RETURN diff


FUNCTION CheckSum(s)

; Calcola il checksum sul pacchetto
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)

; Converte da binario a word
RETURN NOR( ASC(LEFT(s, 1)), SHIFTLT(ASC(SUBSTR(s, 2, 1)), 8) )


FUNCTION Word2String(n)

; Converte da word a binario
RETURN CHR(NAND(n, 0xFF)) CHR(NAND(SHIFTRT(n, 8), 0xFF))


FUNCTION String2LongWord(s)

; Converte da binario a 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)

; Converte da long word a binario
RETURN CHR(NAND(n, 0xFF)) CHR(NAND(SHIFTRT(n, 8), 0xFF)) CHR(NAND(SHIFTRT(n, 16), 0xFF)) \
       CHR(NAND(SHIFTRT(n, 24), 0xFF))


FUNCTION ApriDB(dbhandle, S)

; Apre il database e segnala eventuali errori
dbhandle = DAODBNEW()
res = DAODBOPEN(dbhandle, S, 0, 0, "") 

; Esempio di apertura database con password:
; res = DAODBOPEN(dbhandle2, "c:\\szp\\letture_protetto.mdb", 0, 0, \
;                 ";PWD=Wg3Tha912;UID=Admin") 

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

FUNCTION ApriTab(dbhandle, rshandle, T)

; Apre la tabella del database; segnala eventuali errori
rshandle = DAORSNEW(dbhandle)
res = DAORSOPEN(rshandle, _DAOCOpenTable, T, 0)
IF EQ(res, -1)
  ; Errore
  PrintErr(dbhandle)
  ABORT 1
FI
RETURN

FUNCTION PrintErr(dbhandle)

numerr = DAOERRCOUNT(dbhandle)
FOR x = 1 TO numerr
  CONSOLELN "Errore " x ": " 
  CONSOLELN "Codice     : " DAOGETERRORNUM(dbhandle, x)
  CONSOLELN "Descrizione: " DAOGETERRORDESC(dbhandle, x)
  CONSOLELN "Sorgente   : " DAOGETERRORSRC(dbhandle, x)
  CONSOLELN ""
NEXT
RETURN

FUNCTION ChiudiDB(dbhandle, rshandle)

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