'   ,      ,     .
'   
' ComPort = InitCom(2)  '   "2" (   )
' ScanCode = ReadCom	'        ( = Enter (chr(13)))
' '...     
' mErr = ClearComInBuf  '    -       "" 
' ScanCode = ReadCom	'        ( = Enter (chr(13)))
' close_com_port   	'    .
' 
Option Compare Database
Option Explicit

Public ScanFlg As Boolean  '          false   ESC
Public ComPort As Long   '  ,        Sveta     .                    


Const INVALID_HANDLE_VALUE = -1
Const GENERIC_READ = &H80000000
Const OPEN_EXISTING = 3
Const FILE_ATTRIBUTE_NORMAL = &H80
Const NOPARITY = 0
Const ONESTOPBIT = 0
Const TWOSTOPBITS = 2


Type OVERLAPPED
  Internal As Long
  InternalHigh As Long
  offset As Long
  OffsetHigh As Long
  hEvent As Long
End Type

Type COMMTIMEOUTS
  ReadIntervalTimeout As Long
  ReadTotalTimeoutMultiplier As Long
  ReadTotalTimeoutConstant As Long
  WriteTotalTimeoutMultiplier As Long
  WriteTotalTimeoutConstant As Long
End Type

Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type

Type DCB
  DCBlength As Long
  BaudRate As Long
  fBitFields As Long 'See Comments in Win32API.Txt
  wReserved As Integer
  XonLim As Integer
  XoffLim As Integer
  ByteSize As Byte
  Parity As Byte
  StopBits As Byte
  XonChar As Byte
  XoffChar As Byte
  ErrorChar As Byte
  EofChar As Byte
  EvtChar As Byte
  wReserved1 As Integer 'Reserved; Do Not Use
End Type

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Private Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long

Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long

Public Const PURGE_TXABORT = &H1 '        ,       .
Public Const PURGE_RXABORT = &H2 '        ,       .
Public Const PURGE_TXCLEAR = &H4 '    (    ).
Public Const PURGE_RXCLEAR = &H8 '    (    ).


'*****************************************************************************
'     
Public Function InitCom(port As Byte) As Long

Dim hcom As Long, tt As String, r As SECURITY_ATTRIBUTES, h2 As Boolean
Dim r1 As DCB, h4 As Boolean, h5 As Boolean, t1 As COMMTIMEOUTS
Dim h6 As Boolean


  tt = "COM" + CStr(port)

  r.lpSecurityDescriptor = 0
  r.lpSecurityDescriptor = 0
  r.nLength = 12

  hcom = CreateFile(tt, GENERIC_READ, 0, r, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  If hcom = INVALID_HANDLE_VALUE Then
    InitCom = INVALID_HANDLE_VALUE
    Exit Function
  End If
  h5 = SetupComm(hcom, 3000, 3000)
  If (Not h5) Then
    InitCom = INVALID_HANDLE_VALUE
    Exit Function
  End If
  h2 = GetCommState(hcom, r1)
  If (Not h2) Then
    InitCom = INVALID_HANDLE_VALUE
    Exit Function
  End If
  r1.BaudRate = 10472  ' 10472     115200
  r1.ByteSize = 8
  r1.Parity = NOPARITY
  r1.StopBits = ONESTOPBIT
  r1.fBitFields = 12305

  h4 = SetCommState(hcom, r1)
  If (Not h4) Then
    InitCom = INVALID_HANDLE_VALUE
    Exit Function
  End If

  t1.ReadIntervalTimeout = 10
  t1.ReadTotalTimeoutConstant = 100
  t1.ReadTotalTimeoutMultiplier = 20
  t1.WriteTotalTimeoutConstant = 0
  t1.WriteTotalTimeoutMultiplier = 0
  h6 = SetCommTimeouts(hcom, t1)
  If (Not h6) Then
    InitCom = INVALID_HANDLE_VALUE
    Exit Function
  End If

  InitCom = hcom

End Function


'****************************************************************************
'     
Public Function ClearComInBuf() As Long
  ClearComInBuf = PurgeComm(ComPort, PURGE_RXCLEAR)
End Function

'****************************************************************************
'  
Public Function ReadCom() As String

Dim mErr As Boolean, n2 As Long
Dim buf As Byte '  
'   ,  
  ReadCom = ""
  DoEvents
  mErr = ReadFile(ComPort, buf, 1, n2, ByVal 0&)
  While Not ((buf = 13) Or Len(ReadCom) > 13 Or ScanFlg = False Or n2 = 0)
    DoEvents
    ReadCom = ReadCom + Chr(buf - 64)
    mErr = ReadFile(ComPort, buf, 1, n2, ByVal 0&)
  Wend

End Function


'******************************************************************************
'  
Public Function close_com_port() As Long

  close_com_port = 0
  If (Not CloseHandle(ComPort)) Then
    close_com_port = GetLastError()
  End If

End Function
