!==================================================================================
! Класс для работы с COM-портом.
! Вячеслав Черников, г.Рязань, 2013 г.
!==================================================================================

                     MEMBER

   INCLUDE('fsCom.INC')

   MAP
     INCLUDE('BUILTINS.CLW'),ONCE   !функции RTL

     MODULE('win32.lib')
        APICreateFile( *CSTRING lpszName, ulong fdwAccess, ulong fdwShareMode, ulong SecurityDescriptor, ulong fewCreate, ulong fewAttrsAndFlags, ulong hTemplateFile), name( 'CREATEFILEA'), long, short, raw, pascal
        GetCommState( ulong hCommDev, *group lpdcb), short, raw, pascal
        SetCommState( ulong hCommDev, *group lpdcb), short, raw, pascal
        ClearCommBreak( ulong hCommDev ), short, raw, pascal
        BuildCommDCB( *CSTRING lpazDef, *group lpdcb ), name('BUILDCOMMDCBA'), short, raw, pascal
        EscapeCommFunction( ulong hCommDev, ulong fdwFunc), short, raw, pascal
        PurgeComm( ulong hCommDev, ulong fdwAction ), short, raw, pascal
        SetCommTimeouts( ulong hCommDev, *group lpctmo), short, raw, pascal
        ReadFile( ulong hFile, *cstring buffer, ulong nNumberOfButesToRead, *ulong lpNumberofbytesread, ulong lpoverlapped), short, raw, pascal
        WriteFile( ulong hFile, *cstring buffer, ulong nNumberOfButesToWrite, *ulong lpNumberOfBytesWritten, ulong lpOverlapped), short, raw, pascal
        CloseHandle( ulong hObject ), short, raw, pascal
        SetupComm( ulong hCommDev, ulong cbInQueue, ulong cbOutQueue), ushort, raw, pascal
        GetLastError(),LONG,RAW,PASCAL
        OutputDebugString(*cstring),pascal,raw,name('OutputDebugStringA')
     END
   END

CBR_110  EQUATE(110)
CBR_300  EQUATE(300)
CBR_600  EQUATE(600)
CBR_1200 EQUATE(1200)
CBR_2400 EQUATE(2400)
CBR_4800 EQUATE(4800)
CBR_9600 EQUATE(9600)
CBR_14400 EQUATE(14400)
CBR_19200 EQUATE(19200)
CBR_38400 EQUATE(38400)
CBR_56000 EQUATE(56000)
CBR_57600 EQUATE(57600)
CBR_115200 EQUATE(115200)
CBR_128000 EQUATE(128000)
CBR_256000 EQUATE(256000)

CE_RXOVER           EQUATE(00001h)  ! Receive Queue overflow
CE_OVERRUN          EQUATE(00002h)  ! Receive Overrun Error
CE_RXPARITY         EQUATE(00004h)  ! Receive Parity Error
CE_FRAME            EQUATE(00008h)  ! Receive Framing error
CE_BREAK            EQUATE(00010h)  ! Break Detected
CE_TXFULL           EQUATE(00100h)  ! TX Queue is full
CE_PTO              EQUATE(00200h)  ! LPTx Timeout
CE_IOE              EQUATE(00400h)  ! LPTx I/O Error
CE_DNS              EQUATE(00800h)  ! LPTx Device not selected
CE_OOP              EQUATE(01000h)  ! LPTx Out-Of-Paper
CE_MODE             EQUATE(08000h)  ! Requested mode unsupported

IE_BADID            EQUATE(-1)      ! Invalid or unsupported id
IE_OPEN             EQUATE(-2)      ! Device Already Open
IE_NOPEN            EQUATE(-3)      ! Device Not Open
IE_MEMORY           EQUATE(-4)      ! Unable to allocate queues
IE_DEFAULT          EQUATE(-5)      ! Error in default parameters
IE_HARDWARE         EQUATE(-10)     ! Hardware Not Present
IE_BYTESIZE         EQUATE(-11)     ! Illegal Byte Size
IE_BAUDRATE         EQUATE(-12)     ! Unsupported BaudRate

EV_RXCHAR           EQUATE(00001h)  ! Any Character received
EV_RXFLAG           EQUATE(00002h)  ! Received certain character
EV_TXEMPTY          EQUATE(00004h)  ! Transmitt Queue Empty
EV_CTS              EQUATE(00008h)  ! CTS changed state
EV_DSR              EQUATE(00010h)  ! DSR changed state
EV_RLSD             EQUATE(00020h)  ! RLSD changed state
EV_BREAK            EQUATE(00040h)  ! BREAK received
EV_ERR              EQUATE(00080h)  ! Line status error occurred
EV_RING             EQUATE(00100h)  ! Ring signal detected
EV_PERR             EQUATE(00200h)  ! Printer error occured
EV_RX80FULL         EQUATE(00400h)  ! Receive buffer is 80 percent full
EV_EVENT1           EQUATE(00800h)  ! Provider specific event 1
EV_EVENT2           EQUATE(01000h)  ! Provider specific event 2

SETXOFF             EQUATE(1)       ! Simulate XOFF received
SETXON              EQUATE(2)       ! Simulate XON received
SETRTS              EQUATE(3)       ! Set RTS high
CLRRTS              EQUATE(4)       ! Set RTS low
SETDTR              EQUATE(5)       ! Set DTR high
CLRDTR              EQUATE(6)       ! Set DTR low
RESETDEV            EQUATE(7)       ! Reset device if possible
SETBREAK            EQUATE(8)       ! Set the device break line.
CLRBREAK            EQUATE(9)       ! Clear the device break line.

PURGE_TXABORT       EQUATE(00001h)  ! Kill the pending/current writes to the comm port.
PURGE_RXABORT       EQUATE(00002h)  ! Kill the pending/current reads to the comm port.
PURGE_TXCLEAR       EQUATE(00004h)  ! Kill the transmit queue if there.
PURGE_RXCLEAR       EQUATE(00008h)  ! Kill the typeahead buffer if there.
LPTx                EQUATE(080h)    ! Set if ID is for LPT device

MS_CTS_ON           EQUATE(00010h)
MS_DSR_ON           EQUATE(00020h)
MS_RING_ON          EQUATE(00040h)
MS_RLSD_ON          EQUATE(00080h)


!===================================================================================
! Инициализация класса
!
FsCom.Init PROCEDURE  (STRING PortName)
Ret SHORT
   CODE
   
      if SELF.Active=1
         message('Класс уже активизирован!')
      end

      SELF.Active=1

      SELF.NameCString = CLIP( PortName )
      SELF.Handle = APICreateFile( SELF.NameCString, 0C0000000h, 0, 0, 3, 0, 0 )
      if SELF.Handle = -1
         SELF.LastError = GetLastError()
         return(0)
      else
         SELF.LastError = 0
         Ret = GetCommState( SELF.Handle, SELF.DCB)
         if Ret = 0 
            SELF.LastError = GetLastError() 
            return(0)
         end
         Ret = SELF.NormalTimeouts()
         return(Ret)
      end

!===================================================================================
! Установка параметров порта
!         
FsCom.SetUp PROCEDURE
Ret SHORT
uRet USHORT
   CODE
      SELF.DCB.Length = SIZE(SELF.DCB)
      Ret = SetCommState( SELF.Handle, SELF.DCB)
      if Ret = 0
         SELF.LastError = GetLastError()
      end

      return(Ret)

!===================================================================================
! Уничтожить класс
!     
FsCom.Kill PROCEDURE()
Ret SHORT
   CODE

      if SELF.Active=0
         return
      end

      SELF.Active=0
      SELF.FlagLog=0

      Ret = CloseHandle(SELF.Handle)

!===================================================================================
! Установка параметров порта (строка)
!           
FsCom.SetUpString PROCEDURE( STRING PortString ) !baud=9600 parity=N data=8 stop=1 and so on
cS CSTRING(255)
b SHORT
   CODE

     cS = CLIP(PortString)
     b = BuildCommDCB( cS, SELF.DCB )

     if b <> 0 
        b = SetCommState( SELF.Handle, SELF.DCB) 
     end

     if b = 0 
        SELF.LastError = GetLastError() 
     end

     return(b)
     
!===================================================================================
! 
!   
FsCom.ClearIncoming PROCEDURE()
b SHORT
   CODE
      b = PurgeComm( SELF.Handle, 8 )
      if b = 0
         SELF.LastError = GetLastError()
      end

      return(b)

!===================================================================================
! 
!   
FsCom.ClearOutgoing PROCEDURE()
b SHORT
   CODE
      b = PurgeComm( SELF.Handle, 4 )
      if b = 0
         SELF.LastError = GetLastError()
      end

      return(b)

!===================================================================================
! Чтение из порта
!   
FsCom.Read PROCEDURE (*CSTRING buffer, ULONG bytes, *ULONG BytesRead)
b SHORT
   CODE
      b = ReadFile( SELF.Handle, buffer, bytes, BytesRead, 0 )
      if b <> 0
         SELF.LastError = GetLastError()
      end

      return(b)

!===================================================================================
! Запись в порт
!   
FsCom.Write PROCEDURE (*CSTRING buffer, ULONG bytes)
b SHORT
Written ULONG
   CODE

      b = WriteFile(SELF.Handle, buffer, bytes, Written, 0)
      if b <> 0
         SELF.LastError = GetLastError()
      end

      return(b)

!===================================================================================
! Установка таймаута
!   
FsCom.SetTimeouts PROCEDURE (ULONG ReadInterval, ULONG ReadMultiplier, ULONG ReadConstant, ULONG WriteMultiplier, ULONG WriteConstant)

St GROUP
A ULONG
B ULONG
C ULONG
D ULONG
E ULONG
   END

   CODE
      St.A = ReadInterval
      St.B = ReadMultiplier
      St.C = ReadConstant
      St.D = WriteMultiplier
      St.E = WriteConstant
      RETURN SetCommTimeouts(SELF.Handle, St)

!===================================================================================
! Установка таймат по по умолчанию
!   
FsCom.NormalTimeouts PROCEDURE()
   CODE

      RETURN SELF.SetTimeouts( 4294967295, 0, 0, 0, 0 )

!===================================================================================
! Пауза 
!   
FsCom.Sleep PROCEDURE(ULONG Delay)
DelayTime ULONG
  CODE

  DelayTime = CLOCK() + Delay * 100
  LOOP WHILE CLOCK() <= DelayTime
    YIELD
  END

!===================================================================================
! Конвертирование байта в HEX
!   
FsCom.intToHex FUNCTION (Byte bVal)
aHex String('0123456789ABCDEF')
hexHi  Byte
hexLow Byte
hex    String(2)
   code

    hexHi = int(bVal/16)+1
    hexLow = bVal%16+1
    hex=aHex[hexHi] & aHex[hexLow]

    return (hex)

!===================================================================================
! Конвертирование строки в юникод
!   
FsCom.StrToUnicod FUNCTION (STRING StrS, LONG Dl)
loc:strT  string(4096)
loc:val   short
loc:valB  byte, dim(2), over(loc:val)
loc:dl    long
loc:s1    string(2)
loc:s2    string(2)
loc:i     long
loc:j     long
   CODE

    loc:strT=''
    loc:j=0
    if Dl=0
       loc:dl=len(clip(StrS))
    else
       loc:dl=Dl 
    end 
    loop loc:i=1 to loc:dl
       loc:val=val(StrS[loc:i]) 
       if loc:val<127 
          loc:s1=SELF.intToHex(loc:valB[1]) 
          loc:s2=SELF.intToHex(loc:valB[2]) 
       elsif loc:val=184  !ё
          loc:s1='04'
          loc:s2='51'
       elsif loc:val=168  !Ё
          loc:s1='04'
          loc:s2='01'
       else
          loc:val=val(StrS[loc:i])-192+1040
          loc:s1=SELF.intToHex(loc:valB[1]) 
          loc:s2=SELF.intToHex(loc:valB[2]) 
       end 
       loc:j+=1
       loc:strT[loc:j]=loc:s2[1]
       loc:j+=1
       loc:strT[loc:j]=loc:s2[2]
       loc:j+=1
       loc:strT[loc:j]=loc:s1[1]
       loc:j+=1
       loc:strT[loc:j]=loc:s1[2]
    end 
      
    return(loc:strT)

!===================================================================================
! Включить вывод лога
!   
FsCom.LogActive  PROCEDURE 
   CODE

     SELF.FlagLog=1

!===================================================================================
! Отключить выводо лога
!   
FsCom.LogDeActive  PROCEDURE
   CODE

      SELF.FlagLog=0

!===================================================================================
! Вывести сообщение в лог
!   
FsCom.LogAdd  PROCEDURE (STRING Mes)
loc:mess cstring(1024)
   CODE

      if SELF.FlagLog=0
         return
      end
 
      loc:mess = '[FinSoft] - ' & clip(Mes)
      OutputDebugString (loc:mess)

!===================================================================================
! Преобразовать номер телефона для отправки sms
!   
FsCom.GetPhoneForSMS  FUNCTION (STRING PhoneS)
loc:zn     string(12)
loc:phone  string(12)
loc:i      long
   CODE

      if sub(left(PhoneS),1,1)='+'
         loc:zn=sub(left(PhoneS),2,len(clip(left(PhoneS)))-1)
      else
         loc:zn=left(PhoneS) 
      end 

      if len(clip(loc:zn)) % 2 = 0
         loc:phone=loc:zn
      else
         loc:zn=clip(loc:zn) & 'F'
         loop loc:i=1 to len(clip(loc:zn))-1 by 2
            loc:phone[loc:i]=loc:zn[loc:i+1]
            loc:phone[loc:i+1]=loc:zn[loc:i]
         end
      end

      return(loc:phone)

!===================================================================================
! Отправить sms
!   
FsCom.SendSMS  FUNCTION (STRING PortName, STRING PhoneOut, STRING Mes) 
loc:ok     byte             !возвращаемое значение 
wbuff      Cstring(4096)    !буфер для записи
rbuff      Cstring(4096)    !буфер для чтения 
BytesRead  Ulong            !количество байт прочитано

loc:str    string(1024)      !строка для отправки
loc:dl     long              !длина сообщения  
loc:dlS    long          
loc:ident  long              !идентификатор многострочного сообщения
loc:ident2 long          
loc:phone  string(12)        !телефон
loc:p      long              !количество частей
loc:i      long              !счетчик частей

   CODE

     loc:ok=1

     loc:phone=SELF.GetPhoneForSMS(PhoneOut)  !преобразовываем номер телефона в формат для sms
 
     if SELF.Active=1
        SELF.Kill  
     end

     SELF.LogAdd('Init ' & Clip(PortName) & '...')   !инициализация порта, должен быть с одной цифрой (com1-com9)
     if ~SELF.Init(PortName)
        SELF.LogAdd('Error Init() ' & SELF.LastError)
        loc:ok=0
     else
        SELF.LogAdd('OK')
     end 

     if loc:ok=1
        SELF.DCB.BaudRate=9600   !устанавливаем настройки
        SELF.DCB.Parity=1
        SELF.DCB.StopBits=0
        SELF.LogAdd('Setup ' & Clip(PortName) & ': BaudRate=' & SELF.DCB.BaudRate & ' Parity=' & SELF.DCB.Parity & ' StopBits=' & SELF.DCB.StopBits & ' ...')
        if ~SELF.Setup()
          SELF.LogAdd('Error Setup() ' & SELF.LastError)
          loc:ok=0
        else
          SELF.LogAdd('OK')
        end
     end
     if loc:ok=1
        SELF.LogAdd('Set Timeouts: 20,10,100,10,100 ...')  !устанавливаем таймауты
        if ~SELF.SetTimeouts(20,10,100,10,100)
           SELF.LogAdd('Error SetTimeouts() ' & SELF.LastError)
           loc:ok=0
        else
           SELF.LogAdd('OK')
        end
     end

     if loc:ok=1 
        SELF.LogAdd('Writing data ...')
        wbuff='at+cmgf=0' & '<13>'          !устанавливаем тип сообщения pdu
        if ~SELF.Write(wbuff,len(wbuff)+1)
          SELF.LogAdd('Error Write() ' & SELF.LastError)
          loc:ok=0
        else
          SELF.LogAdd('Writed: ' & (len(wbuff)+1) & ' bytes ''' & wbuff & '''')
        end
    end

    if loc:ok=1
       SELF.LogAdd('Reading data ...')      !читаем ответ
       if ~SELF.Read(rbuff,4096,BytesRead)
          SELF.LogAdd('Error Read() ' & SELF.LastError)
          loc:ok=0
       else
          SELF.LogAdd('Read: ' & BytesRead &' bytes ''' & rbuff & '''')
       end
    end

    if loc:ok=1
       loc:p=int(len(clip(Mes))/67)
       if loc:p<loc:p*67 or loc:p=0
          loc:p+=1  
       end

       !сообщение в pdu-формате
       !00 - номер телефона sms-центра, через который отправляется sms; если не нужно указывать, тогда 00 (используется с sim-карты)
       !01 - тип сообщения; 01 - исходящее
       !00 - указывает, что в качестве номера телефона отправителя использоваться номер
       !0B - длина номера получателя (11 символов)
       !91 - тип номера получателя; 91 - международный формат
       !9735476474F5 - номер телефона +79537446475 без +; если количество цифр нечетное, то в
       !               конец добавляется F, слева направо цифры разбиваются на пары и меняются местами
       !00 - идентификатор протокола, всегда 00
       !08 - схема кодирования данных; 00 - латинские символы, 08 - кириллица, первый полубайт 1 (10,18), то
       !     сообщение будет типа flash
       !12 - длина сообщения в байтах; для сообщений на русском языке используется кодировка USC2 (юникод), каждая буква
       !     кодируется двумя байтами; сообщение из 9 букв "Привет!!!" будет иметь длину 18 байт, т.е. 12 в шестнадцатиричной системе исчисления
       !закодированное сообщение:
       !041F - П, 0440 - р, 0438 - и, 0432 - в, 0435 - е, 0442 - т, 0021 - !, 0021 - !, 0021 - !
       !loc:str='00' & '01' & '00' & '0B' & '91' & '9735476474F5' & '00' & '08' & '12' & '041F04400438043204350442002100210021'

       if loc:p=1   !одна часть
          loc:str=SELF.StrToUnicod(Mes,0)
          loc:str='00' & '01' & '00' & '0B' & '91' & clip(loc:phone) & '00' & '08' & SELF.intToHex(len(clip(loc:str))/2) & clip(loc:str)
          loc:dl=(len(clip(loc:str))-2)/2
          do sendStr_r
       else    !несколько частей
          !тип сообщения = 41, включает флаг сообщения с несколькими частями
          !далее вместо 00 указываем номер части сообщения
          !заголовок частей сообщения (перед текстом сообщения, после длины сообщения+заголовка):
          !05 - длина заголовка
          !00 - идентификатор содержит 1 байт (08 - для 2 байт)
          !03 - длина данных информационного элемента 3 байта (может быть 4 байта)
          !идентификатор сообщения - случайное число в диапазоне 0-255 для 1 байта и в 0-65535 для 2 байт
          !количество частей сообщения
          !номер части сообщения
          loc:ident=int(random(1,255))
          loc:ident2=int(random(1,255))
          loop loc:i=1 to loc:p
             loc:str=sub(Mes,(loc:i-1)*66+1,66)
             if loc:i=loc:p
                loc:str=SELF.StrToUnicod(clip(loc:str),0)
             else
                loc:str=SELF.StrToUnicod(sub(Mes,(loc:i-1)*66+1,66),66)
             end
             loc:dlS=len(clip(loc:str))/2+7   !7 - длина заголовка для частей
             !loc:str='00' & '41' & SELF.intToHex(loc:i-1) & '0B' & '91' & clip(loc:phone) & '00' & '08' & SELF.intToHex(loc:dlS) & '050003' & SELF.intToHex(loc:ident) & SELF.intToHex(loc:p) & SELF.intToHex(loc:i) & clip(loc:str)
             loc:str='00' & '41' & SELF.intToHex(loc:i-1) & '0B' & '91' & clip(loc:phone) & '00' & '08' & SELF.intToHex(loc:dlS) & '060804' & SELF.intToHex(loc:ident) & SELF.intToHex(loc:ident2) & SELF.intToHex(loc:p) & SELF.intToHex(loc:i) & clip(loc:str)
             loc:dl=(len(clip(loc:str))-2)/2
             do sendStr_r
             if loc:ok=0
                break
             end 
             if loc:i<>loc:p
                SELF.sleep(6)  !пауза 6 сек
             end
          end
       end 
    end

    SELF.Kill    !завершаем работу
    if SELF.LastError
       SELF.LogAdd('Error Kill ' & SELF.LastError)
       loc:ok=0       
    end

    return(loc:ok)

sendStr_r  routine   !отправить сообщение в порт
       wbuff='at+cmgs=' & loc:dl & ',' & '<13>'   !команда на отправку (в некоторых модемах без запятой - NEOWAY-M590)
       if ~SELF.Write(wbuff,len(wbuff)+1)
          SELF.LogAdd('Error Write() ' & SELF.LastError)
          loc:ok=0
          exit 
       else
          SELF.LogAdd('Writed: ' & (len(wbuff)+1) & ' bytes ''' & wbuff & '''')
       end

       SELF.LogAdd('Reading data ...')  !читаем ответ  
       if ~SELF.Read(rbuff,4096,BytesRead)
          SELF.LogAdd('Error Read() ' & SELF.LastError)
          loc:ok=0
          exit
       else
          SELF.LogAdd('Read: ' & BytesRead &' bytes ''' & rbuff & '''')
       end

       wbuff=clip(loc:str) & chr(26)   !записываем сообщение в порт
       if ~SELF.Write(wbuff,len(wbuff)+1)
          SELF.LogAdd('Error Write() ' & SELF.LastError)
          loc:ok=0
          exit
       else
          SELF.LogAdd('Writed: ' & (len(wbuff)+1) & ' bytes ''' & wbuff & '''')
       end

       SELF.LogAdd('Reading data ...')   !читаем ответ
       if ~SELF.Read(rbuff,4096,BytesRead)
          SELF.LogAdd('Error Read() ' & SELF.LastError)
          loc:ok=0          
       else
          SELF.LogAdd('Read: ' & BytesRead &' bytes ''' & rbuff & '''')
       end