Sorry your browser is not supported!

Option Explicit
'глобальные переменные
Global ComNum As Long 'хэндл открытого порта; >0, если порт открыт.
Global BarDCB As DCB 'таблица параметров порта
Global CtimeOut As COMMTIMEOUTS 'таймауты порта
Global bRead(2047) As Byte 'буфер принятых символов
'Структуры для параметров настройки порта
Type COMMTIMEOUTS
        ReadIntervalTimeout As Long
        ReadTotalTimeoutMultiplier As Long
        ReadTotalTimeoutConstant As Long
        WriteTotalTimeoutMultiplier As Long
        WriteTotalTimeoutConstant As Long
End Type
Type DCB
        DCBlength As Long
        BaudRate As Long
        fBitFields As Long
        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
End Type
'структура для операций файлового чтения-записи
Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type
'объявления функций API
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Public Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Sub OpenCOM(ByVal com As Integer) 'Открытие COM-порта
    Dim retval As Long
    ComNum = CreateFile(("COM" + Trim(Str$(com))), &HC0000000, 0, 0&, &H3, 0, 0)
    If ComNum = -1 Then
        MsgBox "Ошибка открытия порта COM" + Trim(Str$(com)), vbCritical
      Else
         retval = PurgeComm(ComNum, 0) 'очистка порта, очередей
    End If
    
    ' Начальное заполнение таблицы параметров приемопередачи
    BarDCB.DCBlength = 28  'длина блока DCB
    BarDCB.BaudRate = 2400  'скорость приемопередачи в бодах
    BarDCB.fBitFields = &H83 'Битовое поле, биты которого означают следующее:
            '1 fBinary вкл двоичный режим. Всегда 1 (кроме Windows 3.x :))
            '2 fParity          1 -проверять четность, возвращать код ошибки.
            '3 fOutxCtsFlow     1 -задействовать сигнал CTS: при сброшенном CTS приостанавливает передачу до появления CTS.
            '4 OutxDsrFlow      1 -точно так же задействовать сигнал DSR
            '5,6 fDtrControl    режим управления DTR. Три значения, не выяснил, каких.
            '7 fDsrSensitivity  чувствительность драйвера к DSR. При 1 драйвер устройства будет игнорировать данные, принятые без DSR.
            '8 fTXContinueOnXoff 0 - прием будет приостанавливаться принятым символом Xoff и возобновляться Xon.
            '9 fOutX            1 -передача будет приостанавливаться принятым символом Xoff и возобновляться Xon.
            '10 fInX            1 -драйвер будет передавать управляющие символы Xon\Xoff
            '11 fErrorChar      1 -при ошибке по четности заменить ошибочный символ на заданный в поле ErrorChar
            '12 fNull           1 -отбрасывать при передаче нулевые байты
            '13,14 fRtsControl  0 -выдавать сигнал RTS. Возможны три значения для выбора режима управления, какая кодировка - не выяснил.
            '15 fAbortOnError   1 -при возникновении ошибки драйвер остановится до вызова функции ClearCommError.
            '16 fDummy2         =0 зарезервировано, не используется.
    BarDCB.wReserved = 0 'не используется, должен быть 0
    BarDCB.XonLim = 128 'Задает минимальное число символов в приемном буфере перед посылкой символа XON
    BarDCB.XoffLim = 64 'Определяет макс кол-во байт в приемном буфере перед посылкой символа XOFF. Оно вычисляется вычитанием данного значения из размера применого буфера (в байтах)
    BarDCB.ByteSize = 8      'разрядность данных (кол-во бит)
    BarDCB.parity = 0      '1-проверять нечетность, 2-проверять четность, 0-не проверять ничего
    BarDCB.StopBits = 0     'количество стоповых бит: 0 -один, 1 -полтора, 2 -два
    BarDCB.XonChar = 17 'символ, используемый в качестве Xon
    BarDCB.XoffChar = 19 'символ, используемый в качестве Xoff
    BarDCB.ErrorChar = 35 'символ, заменяющий принятый с ошибкой
    BarDCB.EofChar = 26 'символ "конец данных"
    BarDCB.EvtChar = 0  'символ для сигнализации о событии
    BarDCB.wReserved1 = 0 'зарезервировано. Не используется.
    'Времена ожидания (Time Outs) в миллисекундах
    CtimeOut.ReadIntervalTimeout = 1 'максимальное время между двумя принимаемыми символами.
    CtimeOut.ReadTotalTimeoutConstant = 1 'постоянная часть таймаута на прием
    CtimeOut.ReadTotalTimeoutMultiplier = 1 'время на прием одного символа (для вычисления переменной части таймаута)
    CtimeOut.WriteTotalTimeoutConstant = 20 'постоянная часть таймаута на передачу
    CtimeOut.WriteTotalTimeoutMultiplier = 5 'время на передачу одного символа (для вычисления переменной части таймаута)
                                                         'нулевые времена означают, что таймауты не используются.
End Sub
    
Public Sub SetCommParam(baud As Long, parity As Byte, bits As Byte, stops As Byte)
'подпрограмма установки параметров порту
'все аргументы- числа:
' baud -скорость обмена в бодах, из принятой шкалы скоростей.
' parity -четность. 1=проверять нечетность, 2=проверять четность, 0=не проверять ничего
' bits -битность данных. Число: 5, 6, 7 или 8 бит.
' stops 0=один стоповый бит, 1=полтора стоповых бита, 2=два стоповых бита.
    Dim retval As Long
    'установка таймаутов
 '   CtimeOut.ReadIntervalTimeout = 1 + Int(12000 / baud)
 '   CtimeOut.ReadTotalTimeoutConstant = 1
 '   CtimeOut.ReadTotalTimeoutMultiplier = 1 + Int(12000 / baud)
    CtimeOut.WriteTotalTimeoutMultiplier = 1 + Int(12000 / baud)
    retval = SetCommTimeouts(ComNum, CtimeOut)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "Ошибка при установке таймаутов, Error: " & retval
    End If
    
    BarDCB.BaudRate = baud  'скорость приемопередачи в бодах
    BarDCB.ByteSize = bits  'разрядность данных (кол-во бит)
    BarDCB.parity = parity  '1-проверять нечетность, 2-проверять четность, 0-не проверять ничего
    BarDCB.StopBits = stops 'количество стоповых бит: 0 -один, 1 -полтора, 2 -два
    retval = SetCommState(ComNum, BarDCB)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "Не удается настроить порт на заданные параметры Error: " & retval
    End If
         
End Sub
Public Function ReadCOM(ByVal numChar As Integer) As String
'функция приема через COM
'параметр - число принимаемых за раз символов, до 2047
'(при циклическом вызове его можно уменьшить для ускорения работы)
    Dim RetBytes As Long, i As Integer, ReadStr As String, retval As Long
    Dim lpOverlapped As OVERLAPPED
    'чтение с порта
    retval = ReadFile(ComNum, bRead(0), numChar, RetBytes, lpOverlapped)
    If retval = 0 Then
        retval = GetLastError()
        MsgBox "Ошибка работы с портом Error: " & retval
    End If
    ReadStr = ""
    If (RetBytes > 0) Then
        For i = 0 To RetBytes - 1
            ReadStr = ReadStr + Chr(bRead(i))
        Next i
    End If
    ReadCOM = ReadStr
End Function
Public Sub WriteCOM(COMString As String)
'Подпрограмма передачи в порт.
'Параметр - передаваемая строка символов
    Dim RetBytes As Long, LenVal As Long, retval As Long
    Dim lpOverlapped As OVERLAPPED
    If COMString = "" Then Exit Sub
    'Рекурсивный вызов: передача длинных строк
    'частями по 2048 знаков (потому что буфер приемопередачи- 2048 знаков)
    If Len(COMString) > 2047 Then
        Call WriteCOM(Left$(COMString, 2047))
        Call WriteCOM(Right$(COMString, Len(COMString) - 2047))
        Exit Sub
    End If
    'передача знаков в буфер
    For LenVal = 0 To Len(COMString) - 1
        bRead(LenVal) = Asc(Mid$(COMString, LenVal + 1, 1))
    Next LenVal
    'передачa через COM
    retval = WriteFile(ComNum, bRead(0), Len(COMString), RetBytes, lpOverlapped)
    If retval = 0 Then
        retval = GetLastError()
        MsgBox "Ошибка передачи Error: " & retval & vbCrLf & "Передано " & RetBytes & " байт"
    End If
End Sub

load dll "c:\windows\system32\kernel32.dll", 1
global g_hPort as dword : `The state of the serial port, setup or not setup, -1 means that the port could not be setup
global g_SERIALPORT_Port_Output_String$ as string : ` Used to capture the data received on the serial port as a string
#constant g_Read_Port_Timer_Max 2000
global g_Read_Port_Timer as integer : g_Read_Port_Timer = timer()
global g_TEMPINT1 as integer : g_TEMPINT1 = -1
g_hPort = SERIAL_PORT_Setup("COM2")
print g_hPort
wait key //this var. = 224.
Main_Program()
end

function Main_Program()
  exit_condition = -1
  repeat

    
    SERIAL_PORT_Read(g_hPort)
    
    cls
    print "Read Port Timer : " + str$(g_Read_Port_Timer)
    print "System Timer : " + str$(timer())
    print "Read Port Counter : " + str$(g_TEMPINT1)
    print g_SERIALPORT_Port_Output_String$
    
    if scancode() = 32
      end
    endif  
  
  until exit_condition = 1

endfunction

function SERIAL_PORT_Setup(r_CommPort$)

  local l_comm_handle as integer

  `g_hPort = CreateFile(r_CommPort$, GENERIC_READ || GENERIC_WRITE, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  `2. Open the Port
  l_comm_handle = call dll(1, "CreateFileA", r_CommPort$, 0x80000000, 0, 0, 3, 0x80, 0)
  if l_comm_handle = -1
    cls
    print "Error: Could not retrieve handle for COM port. (Port in use or invalid?)"
    wait key
    end
  endif
  
  `3. Set up the Port
  `Build comm port parameters and apply them. See: http://msdn.microsoft.com/en-us/library/aa363143%28v=VS.85%29.aspx
  //COMx[:][baud=b][parity=p][data=d][stop=s][to={on|off}][xon={on|off}][odsr={on|off}][octs={on|off}][dtr={on|off|hs}][rts={on|off|hs|tg}][idsr={on|off}]
  
  dcb_buf = alloc zeroed(80)                                            `Allocate memory to create DCB structure (com port parameters)
  result=call dll(1,"BuildCommDCBA","baud=9600 parity=O data=8 stop=1", dcb_buf) `Build structure with selected options
  free dcb_buf

endfunction l_comm_handle

function SERIAL_PORT_Read(r_hPort)

  local l_ReadPort$ as string

  char_buf = alloc zeroed(4+255)                                          `dword for returned num of characters read, 255 bytes max space for character data
  
  if timer() > g_Read_Port_Timer + g_Read_Port_Timer_Max
    result = call dll(1, "ReadFile", r_hPort, char_buf+4, 255, char_buf, 0)  `Call readfile to get up to 255 characters from serial port
    g_Read_Port_Timer = timer()
    inc g_TEMPINT1, 1
  endif
  
  if peek dword(char_buf)>0                                                   `If returned some characters
    l_ReadPort$ = g_SERIALPORT_Port_Output_String$ + peek string(char_buf+4, peek dword(char_buf))  `then add them to the serial chunk data
    if l_ReadPort$ <> ""
      g_SERIALPORT_Port_Output_String$ = l_ReadPort$
    endif
  endif
  
  free char_buf
  
endfunction

load dll "DBP_SerialPortMulti_exp.dll",1

call dll 1,"SPM_AddPort","COM1",9600,128,1,1

wait key

sync on : sync rate 60
set display mode 640, 480, 32, 1

load dll "F:\DBpro\Includes\DBP_SerialPortMulti_exp.dll", 1

call dll 1,"SPM_AddPort","COM8",9600,8,1,1

wait key

#constant dll_num=1
#constant stop_bit=1

SMP_LoadDll()
SMP_AddPort("COM8",9600,8,1,1)

	if (SMP_OpenPort("COM8")=0)
		print "Error with open port!"
		wait key
		end
	endif

	do
	
		cls
		center text screen width()*0.5,screen height()*0.5,ReadBuffer("COM8")

		sync
	loop
	
function ReadBuffer(PortID as string)
local res as string
local buff as integer

	repeat

		buff = SPM_DQNext(buff,PortID)  ` read integer
		
		res = res + chr$(buff) ` join in string
		
	until (buff=stop_bit or buff=0)

endfunction res ` return result string
	

function SMP_LoadDll()

	load dll "DBP_SerialPortMulti_exp.dll",dll_num
	
endfunction
	
function SMP_AddPort(PortID as string, Baud as integer, DataBits as integer, Parity as integer, StopBits as integer)

	call dll 1,"SPM_AddPort",PortID,Baud,DataBits,Parity,StopBits
	
endfunction

function SMP_OpenPort(PortID as string)

	call dll dll_num,"SPM_OpenPort",PortID
	
endfunction SNMP_PortIsOpen(PortID)

function SNMP_PortIsOpen(PortID as string)
local result as integer

	result = call dll (dll_num, "SNMP_PortIsOpen", PortID)
	
endfunction result

function SPM_DQNext(oldStr As integer, PortID As String) As integer
local result as integer

	result= call dll (dll_num,"SPM_DQNext", oldStr, PortID)
	
endfunction result

//http://forum.thegamecreators.com/?m=forum_view&t=210938&b=1
//VisualProg
set display mode 640, 480, 32, 1
#constant dll_num=1
#constant stop_bit=1

SMP_LoadDll()
SMP_AddPort("COM8",9600,8,1,1)

if (SMP_OpenPort("COM8")=0)
   print "Error with open port!"
   wait key
   end
endif

do
      center text screen width()*0.5,screen height()*0.5,ReadBuffer("COM8")
      
loop
   
function ReadBuffer(PortID as string)
local res as string
local buff as integer
   repeat
      buff = SPM_DQNext(buff,PortID)  ` read integer
      res = res + chr$(buff) ` join in string
         print chr$(buff)
   until (buff=stop_bit or buff=0)

endfunction res ` return result string

function SMP_LoadDll()
   load dll "DBP_SerialPortMulti_exp.dll",dll_num
endfunction
   
function SMP_AddPort(PortID as string, Baud as integer, DataBits as integer, Parity as integer, StopBits as integer)
   call dll 1,"SPM_AddPort",PortID,Baud,DataBits,Parity,StopBits
endfunction

function SMP_OpenPort(PortID as string)
   local OpenPort AS INTEGER
   call dll dll_num,"SPM_OpenPort",PortID
   OpenPort=SNMP_PortIsOpen(PortID) 
endfunction OpenPort

function SNMP_PortIsOpen(PortID as string)
   local result as integer
   result = call dll (dll_num, "SPM_PortIsOpen", PortID)
endfunction result

function SPM_DQNext(oldStr As integer, PortID As String)
   local result as integer
   result= call dll (dll_num,"SPM_DQNext", oldStr, PortID)
endfunction result

function _DQNext(oldStr As integer, PortID As String)
   local result AS INTEGER
   result= call dll (dll_num,"SPM_DQNext", oldStr, PortID)
   print result
endfunction result

//http://forum.thegamecreators.com/?m=forum_view&t=210938&b=1
//VisualProg
set display mode 640, 480, 32, 1
#constant dll_num=1
#constant stop_bit=1
Answer AS STRING

load dll "DBP_SerialPortMulti_exp.dll",dll_num

_AddPort("COM8",9600,8,1,1)
CALL DLL 1,"SPM_ConfigurePort","COM8",1,2048,2048,1,60,60,32,1
if (_OpenPort("COM8")=0)
   print "Error with open port!"
   wait key
   end
endif

do

      Answer = ReadBuffer("COM8")
      //print Answer
loop
   
function ReadBuffer(PortID as string)
   local res as string
   local buff as integer
   repeat
      buff = _DQNext(buff,PortID)  ` read integer
      res = res + chr$(buff) ` join in string
   until (buff=stop_bit or buff=0)
endfunction res ` return result string

function _AddPort(PortID as string, Baud as integer, DataBits as integer, Parity as integer, StopBits as integer)
   call dll dll_num,"SPM_AddPort",PortID,Baud,DataBits,Parity,StopBits
endfunction

function _OpenPort(PortID as string)
   local OpenPort AS INTEGER
   call dll dll_num,"SPM_OpenPort",PortID
   OpenPort=_PortIsOpen(PortID) 
endfunction OpenPort

function _PortIsOpen(PortID as string)
   local result as integer
   result = call dll (dll_num, "SPM_PortIsOpen", PortID)
endfunction result

function _DQNext(oldStr AS INTEGER, PortID As String)
   local result AS INTEGER
   result = call dll (dll_num,"SPM_DQNext", oldStr, PortID)
   print result
wait 1000
endfunction result

function ReadBuffer(PortID as string)
   local res as string
      res = _DQNext(PortID)  ` read data
endfunction res ` return result string

function _DQNext(PortID As String)
   local result AS INTEGER
   result = call dll (dll_num,"SPM_DQNext", PortID) ` send only PortID, get chr$-summ
   print result
wait 1000
endfunction result

function ReadBuffer(PortID as string)
   local res as string
      res = _DQNext(PortID)  ` read data
endfunction res ` return result string

function _DQNext(PortID As String)
   local result AS string
   result = call dll (dll_num,"SPM_DQNext", PortID) ` send only PortID, get chr$-summ
   print result
wait 1000
endfunction result

//http://forum.thegamecreators.com/?m=forum_view&t=210938&b=1
//VisualProg
set display mode 640, 480, 32, 1
#constant dll_num=1
#constant stop_bit=1
Answer AS STRING

load dll "DBP_SerialPortMulti_exp.dll",dll_num

_AddPort("COM8",9600,8,1,1)
CALL DLL 1,"SPM_ConfigurePort","COM8",1,4096,2048,1,60,60,1,1
if (_OpenPort("COM8")=0)
   print "Error with open port!"
   wait key
   end
endif

do

   Answer = ReadBuffer("COM8")
   print Answer
   print
   wait 1000
   
loop
   
function ReadBuffer(PortID as string)
   local res as string
      res = _DQNext(PortID)  ` read data
endfunction res ` return result string

function _AddPort(PortID as string, Baud as integer, DataBits as integer, Parity as integer, StopBits as integer)
   call dll dll_num,"SPM_AddPort",PortID,Baud,DataBits,Parity,StopBits
endfunction

function _OpenPort(PortID as string)
   local OpenPort AS INTEGER
   call dll dll_num,"SPM_OpenPort",PortID
   OpenPort=_PortIsOpen(PortID) 
endfunction OpenPort

function _PortIsOpen(PortID as string)
   local result as integer
   result = call dll (dll_num, "SPM_PortIsOpen", PortID)
endfunction result

function _DQNext(PortID As String)
   local result AS STRING
   result = call dll (dll_num,"SPM_DQNext",0, PortID)` send only PortID, get chr$-summ == this crashed because dqnext needs 2 arguments.
endfunction result

Rem Project: newser
Rem Created: 20/01/2005 22:06:50

Rem ***** Main Source File *****

#CONSTANT GENERIC_READ = 0x80000000
#CONSTANT GENERIC_WRITE = 0x40000000
#CONSTANT OPEN_EXISTING = 3
#CONSTANT FILE_ATTRIBUTE_NORMAL = 0x80
#CONSTANT NOPARITY = 0
#CONSTANT ONESTOPBIT = 0
#CONSTANT MAXDWORD = 4294967295
#CONSTANT SETXOFF =            1
` Simulate XOFF received
#CONSTANT SETXON  =            2
` Simulate XON received
#CONSTANT SETRTS  =            3
` Set RTS high
#CONSTANT CLRRTS  =            4
` Set RTS low
#CONSTANT SETDTR  =            5
` Set DTR high
#CONSTANT CLRDTR  =            6
` Set DTR low
#CONSTANT RESETDEV =           7
` Reset device if possible
#CONSTANT SETBREAK =           8
` Set the device break line.
#CONSTANT CLRBREAK =           9
` Clear the device break line.

#CONSTANT BUFFER_SIZE = 256

#CONSTANT KERNEL_DLL_ID = 1
#CONSTANT DCB_MEMBLOCK_ID = 1
#CONSTANT TIMEOUTS_MEMBLOCK_ID = 2
#CONSTANT IO_BUFFER_MEMBLOCK_ID = 3
#CONSTANT BYTES_READ_WRITE_ID = 4

Type T_DCB
   DCBlength as dword
   BaudRate as dword
   fBinary as dword
   fParity as dword
   fOutxCtsFlow as dword
   fOutcDsrFlow as dword
   fDtrControl as dword
   fDsrSensitivity as dword
   fTXContinueONXoff as dword
   fOutX as dword
   fInX as dword
   fErrorChar as dword
   fNull as dword
   fRtsControl as dword
   fAbortOnError as dword
   fDummy as dword
   XonLim as word
   XoffLim as word
   ByteSize as byte
   Parity as byte
   StopBits as byte
   XonChar as byte
   XoffChar as byte
   ErrorChar as byte
   EofChar as byte
   EvtChar as byte
   wReservedl as word
endtype

type T_COMMTIMEOUTS
   ReadIntervalTimeout as dword
   ReadTotalTimeoutMultiplier as dword
   ReadTotalTimeOutConstant as dword
   WriteTotalTimeoutMultiplier as dword
   WriteTotalTimeoutConstant as dword
endtype


`These Global variables will have to be inserted into you main source file
global hPort as dword
global DCB as T_DCB
global CommTimeouts as T_COMMTIMEOUTS
global Buffer as string
global Success as dword

`##########################################################################################################################
`  Initialization Driver
`##########################################################################################################################
Initialize_Serial_Driver()
`##########################################################################################################################
`  Initialize port
`##########################################################################################################################
hPort = CreateFile("COM1", GENERIC_READ || GENERIC_WRITE, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
` Can use "COM2", "LPT1", etc...
print "Successfully open COM1!(Press any key to continue)"
wait key
print

`##########################################################################################################################
`  Get Current COM port Settings
`##########################################################################################################################
Success = GetCommState(hPort)
print "Successfully retrieved COM Settings!(Press any key to continue)"
print "Baud Rate :" ;DCB.BaudRate
print "ByteSize :";DCB.ByteSize
print "Parity :"; DCB.Parity
print "StopBits :";DCB.StopBits
wait key
print

`##########################################################################################################################
`  Change Com Port Settings
`##########################################################################################################################
DCB.BaudRate = 2400
DCB.ByteSize = 8
DCB.Parity = NOPARITY
DCB.StopBits = 1
Success = SetCommState(hPort)
print "Successfully Set COM port values!(Press any key to continue)"
wait key
print

`#########################################################################################################################
`  Get COM port Settings (again)
`#########################################################################################################################
Success = GetCommState(hPort)
print "Successfully retrieved COM Settings!(Press any key to continue)"
print "Baud Rate :" ;DCB.BaudRate
print "ByteSize :";DCB.ByteSize
print "Parity :"; DCB.Parity
print "StopBits :";DCB.StopBits
wait key
print

`########################################################################################################################
`  Get COM port Timeouts
`########################################################################################################################
Success = GetCommTimeouts(hPort)
print "Successfully retrieved COM Timeouts!(Press any key to continue)"
print "ReadIntervalTimeout = "; CommTimeouts.ReadIntervalTimeout
print "ReadTotalTimeoutConstant = "; CommTimeouts.ReadTotalTimeoutConstant
print "ReadTotalTimeoutMultiplier = "; CommTimeouts.ReadTotalTimeoutMultiplier
print "WriteTotalTimeoutConstant = "; CommTimeouts.WriteTotalTimeoutConstant
print "WriteTotalTimeoutMultiplier = ";CommTimeouts.WriteTotalTimeoutMultiplier
wait key
print

`########################################################################################################################
`  Set COM port Timeouts
`########################################################################################################################
CommTimeouts.ReadIntervalTimeout = 100
CommTimeouts.ReadTotalTimeoutConstant = 3000 :`In Milliseconds
CommTimeouts.ReadTotalTimeoutMultiplier = 0
CommTimeouts.WriteTotalTimeoutConstant = 1000
CommTimeouts.WriteTotalTimeoutMultiplier = 0
Success = SetCommTimeouts(hPort)
print "Successfully set COM Timeouts!(Press any key to continue)"
wait key
print

`########################################################################################################################
`  Get COM port Timeouts
`########################################################################################################################
Success = GetCommTimeouts(hPort)
print "Successfully retrieved COM Timeouts!(Press any key to continue)"
print "ReadIntervalTimeout = "; CommTimeouts.ReadIntervalTimeout
print "ReadTotalTimeoutConstant = "; CommTimeouts.ReadTotalTimeoutConstant
print "ReadTotalTimeoutMultiplier = "; CommTimeouts.ReadTotalTimeoutMultiplier
print "WriteTotalTimeoutConstant = "; CommTimeouts.WriteTotalTimeoutConstant
print "WriteTotalTimeoutMultiplier = ";CommTimeouts.WriteTotalTimeoutMultiplier
wait key
print

`########################################################################################################################
`  Clear DTR
`########################################################################################################################
Success = EscapeCommFunction(hPort,CLRDTR)
print "Successfully cleared DTR!(Press any key to continue)"
wait key
print

`#######################################################################################################################
`  Read From Serial Port
`#######################################################################################################################
print "Reading from Serial Port...Please wait."
repeat
success = ReadFile(hPort, BUFFER_SIZE - 1)
print "Serial in Data (Press ENTER to continue): "; buffer
until returnkey()
print

`######################################################################################################################
`  Write To Serial Port
`######################################################################################################################
buffer = "Hello!"
repeat
success = WriteFile(hPort, len(buffer))
print "Serial out Data (Press space to continue): ";buffer
until spacekey()
print

`#######################################################################################################################
`  Close the COM port
`#######################################################################################################################
Success = CloseHandle(hPort)
print "Done!"
wait key

Cleanup_Memory()
end


`#######################################################################################################################
`  Internal Functions
`#######################################################################################################################
function Initialize_Serial_Driver()

load dll "c:\windows\system32\kernel32.dll", KERNEL_DLL_ID

if dll exist(KERNEL_DLL_ID) = 0
   Print "Could not find kernel32.dll"
   wait key
   end
endif

if dll call exist(KERNEL_DLL_ID, "CreateFileA") = 0
   Print "Could not find CreateFile command in kernel32.dll"
   wait key
   end
endif

if dll call exist(KERNEL_DLL_ID, "GetCommState") = 0
   Print "Could not find GetCommState command in kernel32.dll"
   wait key
   end
endif

if dll call exist(KERNEL_DLL_ID, "SetCommState") = 0
   Print "Could not find SetCommState command in kernel32.dll"
   wait key
   end
endif

if dll call exist(KERNEL_DLL_ID, "GetCommTimeouts") = 0
   Print "Could not find GetCommTimeouts command in kernel32.dll"
   wait key
   end
endif

if dll call exist(KERNEL_DLL_ID, "SetCommTimeouts") = 0
   Print "Could not find SetCommTimeouts command in kernel32.dll"
   wait key
   end
endif

if dll call exist(KERNEL_DLL_ID, "ReadFile") = 0
   Print "Could not find ReadFile command in kernel32.dll"
   wait key
   end
endif

if dll call exist(KERNEL_DLL_ID, "WriteFile") = 0
   Print "Could not find WriteFile command in kernel32.dll"
   wait key
   end
endif

if dll call exist(KERNEL_DLL_ID, "CloseHandle") = 0
   Print "Could not find CloseHandle command in kernel32.dll"
   wait key
   end
endif

if dll call exist(KERNEL_DLL_ID, "EscapeCommFunction") = 0
   Print "Could not find EscapeCommFunction command in kernel32.dll"
   wait key
   end
endif

Make memblock DCB_MEMBLOCK_ID, 80 : ` For DCB
Make memblock TIMEOUTS_MEMBLOCK_ID, 20 : ` For TimeOuts
Make memblock IO_BUFFER_MEMBLOCK_ID, BUFFER_SIZE : `I/O buffer
Make memblock BYTES_READ_WRITE_ID, 4 : `Bytes Written or Read
endfunction

function CreateFile(lpFileName as String, dwDesiredAccess as Dword, dwShareMode as dword, lpSecurityAttributes as dword, dwCreationDisposition as Dword, dwFlagsAndAttributes as dword, hTemplateFile as Dword)
ret = call dll (KERNEL_DLL_ID, "CreateFileA",lpFilename, dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
if ret = -1
   Print "Could not retrieve handle for COM port.(Is something else using the Port?)"
   wait key
   end
endif
endfunction ret

function GetCommState(nCid as dword)
ret = call dll (KERNEL_DLL_ID, "GetCommState", nCid, get memblock ptr(DCB_MEMBLOCK_ID))
if ret = 0
   print "Could not get Com port state"
   wait key
   end
endif
   DCB.DCBlength  = memblock dword(DCB_MEMBLOCK_ID,0)
   DCB.BaudRate  = memblock dword(DCB_MEMBLOCK_ID,4)
   DCB.fBinary  = memblock dword(DCB_MEMBLOCK_ID,8)
   DCB.fParity  = memblock dword(DCB_MEMBLOCK_ID,12)
   DCB.fOutxCtsFlow  = memblock dword(DCB_MEMBLOCK_ID,16)
   DCB.fOutcDsrFlow  = memblock dword(DCB_MEMBLOCK_ID,20)
   DCB.fDtrControl  = memblock dword(DCB_MEMBLOCK_ID,24)
   DCB.fDsrSensitivity  = memblock dword(DCB_MEMBLOCK_ID,28)
   DCB.fTXContinueONXoff  = memblock dword(DCB_MEMBLOCK_ID,32)
   DCB.fOutX  = memblock dword(DCB_MEMBLOCK_ID,36)
   DCB.fInX  = memblock dword(DCB_MEMBLOCK_ID,40)
   DCB.fErrorChar  = memblock dword(DCB_MEMBLOCK_ID,44)
   DCB.fNull  = memblock dword(DCB_MEMBLOCK_ID,48)
   DCB.fRtsControl  = memblock dword(DCB_MEMBLOCK_ID,52)
   DCB.fAbortOnError  = memblock dword(DCB_MEMBLOCK_ID,56)
   DCB.fDummy  = memblock dword(DCB_MEMBLOCK_ID,60)
   DCB.XonLim  = memblock word(DCB_MEMBLOCK_ID,64)
   DCB.XoffLim  = memblock word(DCB_MEMBLOCK_ID,66)
   DCB.ByteSize  = memblock byte(DCB_MEMBLOCK_ID,68)
   DCB.Parity  = memblock byte(DCB_MEMBLOCK_ID,69)
   DCB.StopBits  = memblock byte(DCB_MEMBLOCK_ID,70)
   DCB.XonChar  = memblock byte(DCB_MEMBLOCK_ID,71)
   DCB.XoffChar  = memblock byte(DCB_MEMBLOCK_ID,72)
   DCB.ErrorChar  = memblock byte(DCB_MEMBLOCK_ID,73)
   DCB.EofChar  = memblock byte(DCB_MEMBLOCK_ID,74)
   DCB.EvtChar  = memblock byte(DCB_MEMBLOCK_ID,75)
   DCB.wReservedl  = memblock word(DCB_MEMBLOCK_ID,76)
endfunction ret

function SetCommState(nCid as dword)
   Write memblock dword DCB_MEMBLOCK_ID,0,DCB.DCBlength
   Write memblock dword DCB_MEMBLOCK_ID,4,DCB.BaudRate
   Write memblock dword DCB_MEMBLOCK_ID,8,DCB.fBinary
   Write memblock dword DCB_MEMBLOCK_ID,12,DCB.fParity
   Write memblock dword DCB_MEMBLOCK_ID,16,DCB.fOutxCtsFlow
   Write memblock dword DCB_MEMBLOCK_ID,20,DCB.fOutcDsrFlow
   Write memblock dword DCB_MEMBLOCK_ID,24,DCB.fDtrControl
   Write memblock dword DCB_MEMBLOCK_ID,28,DCB.fDsrSensitivity
   Write memblock dword DCB_MEMBLOCK_ID,32,DCB.fTXContinueONXoff
   Write memblock dword DCB_MEMBLOCK_ID,36,DCB.fOutX
   Write memblock dword DCB_MEMBLOCK_ID,40,DCB.fInX
   Write memblock dword DCB_MEMBLOCK_ID,44,DCB.fErrorChar
   Write memblock dword DCB_MEMBLOCK_ID,48,DCB.fNull
   Write memblock dword DCB_MEMBLOCK_ID,52,DCB.fRtsControl
   Write memblock dword DCB_MEMBLOCK_ID,56,DCB.fAbortOnError
   Write memblock dword DCB_MEMBLOCK_ID,60,DCB.fDummy
   Write memblock word DCB_MEMBLOCK_ID,64,DCB.XonLim
   Write memblock word DCB_MEMBLOCK_ID,66,DCB.XoffLim
   Write memblock byte DCB_MEMBLOCK_ID,68,DCB.ByteSize
   Write memblock byte DCB_MEMBLOCK_ID,69,DCB.Parity
   Write memblock byte DCB_MEMBLOCK_ID,70,DCB.StopBits
   Write memblock byte DCB_MEMBLOCK_ID,71,DCB.XonChar
   Write memblock byte DCB_MEMBLOCK_ID,72,DCB.XoffChar
   Write memblock byte DCB_MEMBLOCK_ID,73,DCB.ErrorChar
   Write memblock byte DCB_MEMBLOCK_ID,74,DCB.EofChar
   Write memblock byte DCB_MEMBLOCK_ID,75,DCB.EvtChar
   Write memblock word DCB_MEMBLOCK_ID,76,DCB.wReservedl
ret = call dll (KERNEL_DLL_ID, "SetCommState", nCid, get memblock ptr(DCB_MEMBLOCK_ID))

if ret = 0
   print "Could not set Com port state"
   wait key
   end
endif

endfunction ret

function GetCommTimeouts(nCid as dword)
ret = call dll (KERNEL_DLL_ID, "GetCommTimeouts", nCid, get memblock ptr(TIMEOUTS_MEMBLOCK_ID))
if ret = 0
   print "Could not get Com Timeouts."
   wait key
   end
endif
   CommTimeouts.ReadIntervalTimeout = memblock dword(TIMEOUTS_MEMBLOCK_ID,0)
   CommTimeouts.ReadTotalTimeoutMultiplier = memblock dword(TIMEOUTS_MEMBLOCK_ID,4)
   CommTimeouts.ReadTotalTimeOutConstant = memblock dword(TIMEOUTS_MEMBLOCK_ID,8)
   CommTimeouts.WriteTotalTimeoutMultiplier = memblock dword(TIMEOUTS_MEMBLOCK_ID,12)
   CommTimeouts.WriteTotalTimeoutConstant = memblock dword(TIMEOUTS_MEMBLOCK_ID,16)
endfunction ret

function SetCommTimeouts(nCid as dword)
   Write memblock dword TIMEOUTS_MEMBLOCK_ID,0,CommTimeouts.ReadIntervalTimeout
   Write memblock dword TIMEOUTS_MEMBLOCK_ID,4,CommTimeouts.ReadTotalTimeoutMultiplier
   Write memblock dword TIMEOUTS_MEMBLOCK_ID,8,CommTimeouts.ReadTotalTimeOutConstant
   Write memblock dword TIMEOUTS_MEMBLOCK_ID,12,CommTimeouts.WriteTotalTimeoutMultiplier
   Write memblock dword TIMEOUTS_MEMBLOCK_ID,16,CommTimeouts.WriteTotalTimeoutConstant
ret = call dll (KERNEL_DLL_ID, "SetCommTimeouts", nCid, get memblock ptr(TIMEOUTS_MEMBLOCK_ID))

if ret = 0
   print "Could not set Com Timeouts."
   wait key
   end
endif

endfunction ret

function WriteFile(hFile as dword, nNumberOfBytesToWrite as dword)
if len(Buffer) > BUFFER_SIZE then Buffer = left$(Buffer,BUFFER_SIZE)
for i = 1 to len(buffer)
   write memblock byte IO_BUFFER_MEMBLOCK_ID,i-1,asc(mid$(buffer,i))
next i
ret = call dll(KERNEL_DLL_ID, "WriteFile", hfile, get memblock ptr(IO_BUFFER_MEMBLOCK_ID), nNumberOfBytesToWrite, get memblock ptr(BYTES_READ_WRITE_ID),0)
if ret = 0
   print "Could not write to com port."
   wait key
endif

endfunction ret

function ReadFile(hFile as dword, nNumberOfBytesToRead as dword)
ret = call dll(KERNEL_DLL_ID, "ReadFile", hfile, get memblock ptr(IO_BUFFER_MEMBLOCK_ID), nNumberOfBytesToRead, get memblock ptr(BYTES_READ_WRITE_ID),0)
if ret = 0
   print "Could not read from com port."
   wait key
endif
buffer = ""
for i = 0 to memblock dword(BYTES_READ_WRITE_ID,0) - 1
   buffer = buffer + chr$(memblock byte(IO_BUFFER_MEMBLOCK_ID,i))
next i
endfunction ret

function CloseHandle(hObject as dword)
ret = call dll(KERNEL_DLL_ID, "CloseHandle", hObject)
if ret = 0
   print "Could not close handle."
   wait key
   end
endif
endfunction ret

function EscapeCommFunction(hFile as dword, dwFunc as dword)
ret = call dll(KERNEL_DLL_ID, "EscapeCommFunction", hFile, dwFunc)
if ret = 0
   Print "EscapeCommFunction Failed."
   wait key
   end
endif
endfunction ret

function Cleanup_Memory()
   delete memblock DCB_MEMBLOCK_ID
   delete memblock TIMEOUTS_MEMBLOCK_ID
   delete memblock IO_BUFFER_MEMBLOCK_ID
   delete memblock BYTES_READ_WRITE_ID
   delete dll KERNEL_DLL_ID
endfunction

Rem Project: _newser_serialcom
Rem Created: Wednesday, May 14, 2014
Rem Project: newser
Rem Created: 20/01/2005 22:06:50
Rem with help from VisualProg.
Rem I am in the process of stripping down the original program found at:
Rem http://forum.thegamecreators.com/?m=forum_view&t=87450&b=1

#CONSTANT GENERIC_READ = 0x80000000
#CONSTANT OPEN_EXISTING = 3
#CONSTANT FILE_ATTRIBUTE_NORMAL = 0x80
#CONSTANT NOPARITY = 0
#CONSTANT ONESTOPBIT = 0
#CONSTANT MAXDWORD = 4294967295
#CONSTANT SETXOFF =            1    ` Simulate XOFF received
#CONSTANT SETXON  =            2    ` Simulate XON received
#CONSTANT SETRTS  =            3    ` Set RTS high
#CONSTANT CLRRTS  =            4    ` Set RTS low
#CONSTANT SETDTR  =            5    ` Set DTR high
#CONSTANT CLRDTR  =            6    ` Set DTR low
#CONSTANT RESETDEV =           7    ` Reset device if possible
#CONSTANT SETBREAK =           8    ` Set the device break line.
#CONSTANT CLRBREAK =           9    ` Clear the device break line.
#CONSTANT BUFFER_SIZE = 257
#CONSTANT KERNEL_DLL_ID = 1
#CONSTANT DCB_MEMBLOCK_ID = 1
#CONSTANT TIMEOUTS_MEMBLOCK_ID = 2
#CONSTANT IO_BUFFER_MEMBLOCK_ID = 3
#CONSTANT BYTES_READ_WRITE_ID = 4

Type T_DCB
   DCBlength as dword
   BaudRate as dword
   fBinary as dword
   fParity as dword
   fOutxCtsFlow as dword
   fOutcDsrFlow as dword
   fDtrControl as dword
   fDsrSensitivity as dword
   fTXContinueONXoff as dword
   fOutX as dword
   fInX as dword
   fErrorChar as dword
   fNull as dword
   fRtsControl as dword
   fAbortOnError as dword
   fDummy as dword
   XonLim as word
   XoffLim as word
   ByteSize as byte
   Parity as byte
   StopBits as byte
   XonChar as byte
   XoffChar as byte
   ErrorChar as byte
   EofChar as byte
   EvtChar as byte
   wReservedl as word
endtype

type T_COMMTIMEOUTS
   ReadIntervalTimeout as dword
   ReadTotalTimeoutMultiplier as dword
   ReadTotalTimeOutConstant as dword
endtype

`These Global variables will have to be inserted into you main source file
global hPort as dword
global DCB as T_DCB
global CommTimeouts as T_COMMTIMEOUTS
global Buffer as string
global Success as dword

// programming starts here
DISABLE ESCAPEKEY

Success = INITDISP(800,600)
print Success

Potential as INTEGER = 1280000
x as integer = 0
xx as string
ass as integer = 0
hh as string
DIM pw$(Potential+1) as string
pwcount as integer = 0
reset as INTEGER = 0

Initialize_Serial_Driver()  `  Initialization Driver
hPort = CreateFile("COM8", GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)     `  Initialize port
//  print "Successfully open COM8"

Success = EscapeCommFunction(hPort,SETRTS)  //  SETRTS. but why?
Success = EscapeCommFunction(hPort,SETDTR)  //  SETDTR == open gate

//  Read From Serial Port    -   big loop
print "Reading from Serial Port..."
if file exist ("test.txt")
    delete file "test.txt"
endif

//The file must not exist or the command will fail.
open to write 1,"test.txt"

one = file open(1)
print one

//if one = 1 
//    Byebye("file closed")
//endif     -- had a tough time making this work consistently
print "press anykey"
wait key
repeat 
    Success = ReadFile(hPort, BUFFER_SIZE - 1)
    //is buffer empty?
    if Buffer = ""
        print
        print "-";
        Byebye("buffer empty")
    ENDIF
    //print "String  :";Buffer
    
    //check to see if a reset is needed == experimental so far
    reset = 0
    for x = 1 to 3
        xx = MID$(Buffer,x)
        if xx = "Z"
            reset=reset+1
        ENDIF
    NEXT x

    IF reset = 3
        //  RESETDEV = attempt
        Success = EscapeCommFunction(hPort,RESETDEV)
        Byebye("zzzs filled in buffer")
    ENDIF
    
    for x = 1 to BUFFER_SIZE - 1
        xx = MID$(Buffer,x)
        xxx = xxx +1
        IF ASC(xx) > 32 AND ASC(xx) < 127   // if the output is a character we want...
            
            pwcount= pwcount +1
            ass = ASC(xx)
            hh = HEX$(ass) 
            pw$(pwcount) = xx
            print xxx;" "; xx ;" ";" asc:  "; ass ; "   hex:  "; hh ; " ";pwcount
            write byte 1,ass
            IF pwcount = Potential
                FOR Y = 1 TO Potential
                    PRINT pw$(y); 
                next y
                print
                Byebye("filled!")
            ENDIF
        ENDIF
    next x
    print  
until controlkey()

//leave prog
print "leaving VARCON_SERCOM press anykey"
wait key

Success = CloseHandle(hPort)    `  Close the COM port
print "Done!"
close file 1
Cleanup_Memory()
wait 500
end

//  Internal Functions
//
function INITDISP(x,y)
SET WINDOW POSITION 0,0
    SET WINDOW LAYOUT 1,1,3
    SET WINDOW TITLE "MDJ"
    MAXIMIZE WINDOW
    CLS RGB(0,0,0)
    INK RGB(255,255,255), RGB(0,0,0)
    SET BITMAP FORMAT 21
    SET IMAGE COLORKEY 255,0,255
    IF CHECK DISPLAY MODE(x,y,32) = 1
        SET DISPLAY MODE x,y,32,1    //  vsync on to prevent tearing
        CLS RGB(0,0,0)           //  black
        INK RGB(255,255,255), RGB(0,0,0)
     fswitch = 1     //  this function was successful
    ENDIF
    D3D_Init
    D3D_Color 255,255,0,255
    D3D_Font 1,"Arial",13,0,0,1
    D3D_Font 2,"Arial",11,0,0,1
ENDFUNCTION fswitch 
        
function byebye(Answer AS STRING)
    print "  **********"
    print Answer
    CloseHandle(hPort)
    Cleanup_Memory()
    print "press anykey"
    wait key
    close file 1
    end
ENDFUNCTION

function Initialize_Serial_Driver()
    load dll "c:\windows\system32\kernel32.dll", KERNEL_DLL_ID
    
    if dll exist(KERNEL_DLL_ID) = 0
       byebye("Could not find kernel32.dll")
    endif
    
    if dll call exist(KERNEL_DLL_ID, "CreateFileA") = 0
       byebye("Could not find CreateFile command in kernel32.dll")
    endif
    
    if dll call exist(KERNEL_DLL_ID, "GetCommState") = 0
    byebye("Could not find GetCommState command in kernel32.dll")
    endif
    
    if dll call exist(KERNEL_DLL_ID, "SetCommState") = 0
       byebye("Could not find SetCommState command in kernel32.dll")
    endif
    
    if dll call exist(KERNEL_DLL_ID, "GetCommTimeouts") = 0
    byebye("Could not find GetCommTimeouts command in kernel32.dll")
    endif
    
    if dll call exist(KERNEL_DLL_ID, "SetCommTimeouts") = 0
       byebye("Could not find SetCommTimeouts command in kernel32.dll")
    endif
    
    if dll call exist(KERNEL_DLL_ID, "ReadFile") = 0
       byebye("Could not find ReadFile command in kernel32.dll")
    endif
    
    if dll call exist(KERNEL_DLL_ID, "CloseHandle") = 0
       byebye("Could not find CloseHandle command in kernel32.dll")
    endif
    
    if dll call exist(KERNEL_DLL_ID, "EscapeCommFunction") = 0
       byebye("Could not find EscapeCommFunction command in kernel32.dll")
    endif
    
    Make memblock DCB_MEMBLOCK_ID, 80 : ` For DCB
    Make memblock TIMEOUTS_MEMBLOCK_ID, 20 : ` For TimeOuts
    Make memblock IO_BUFFER_MEMBLOCK_ID, BUFFER_SIZE : `I/O Buffer
    Make memblock BYTES_READ_WRITE_ID, 4 : `Bytes Written or Read
endfunction

function CreateFile(lpFileName as String, dwDesiredAccess as Dword, dwShareMode as dword, lpSecurityAttributes as dword, dwCreationDisposition as Dword, dwFlagsAndAttributes as dword, hTemplateFile as Dword)
ret = call dll (KERNEL_DLL_ID, "CreateFileA",lpFileName, dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
if ret = -1
    byebye("Could not retrieve handle for COM port.(Is something else using the Port?)")
endif
endfunction ret

function GetCommState(nCid as dword)
ret = call dll (KERNEL_DLL_ID, "GetCommState", nCid, get memblock ptr(DCB_MEMBLOCK_ID))
if ret = 0
   byebye("Could not get Com port state")
endif
   DCB.DCBlength  = memblock dword(DCB_MEMBLOCK_ID,0)
   DCB.BaudRate  = memblock dword(DCB_MEMBLOCK_ID,4)
   DCB.fBinary  = memblock dword(DCB_MEMBLOCK_ID,8)
   DCB.fParity  = memblock dword(DCB_MEMBLOCK_ID,12)
   DCB.fOutxCtsFlow  = memblock dword(DCB_MEMBLOCK_ID,16)
   DCB.fOutcDsrFlow  = memblock dword(DCB_MEMBLOCK_ID,20)
   DCB.fDtrControl  = memblock dword(DCB_MEMBLOCK_ID,24)
   DCB.fDsrSensitivity  = memblock dword(DCB_MEMBLOCK_ID,28)
   DCB.fTXContinueONXoff  = memblock dword(DCB_MEMBLOCK_ID,32)
   DCB.fOutX  = memblock dword(DCB_MEMBLOCK_ID,36)
   DCB.fInX  = memblock dword(DCB_MEMBLOCK_ID,40)
   DCB.fErrorChar  = memblock dword(DCB_MEMBLOCK_ID,44)
   DCB.fNull  = memblock dword(DCB_MEMBLOCK_ID,48)
   DCB.fRtsControl  = memblock dword(DCB_MEMBLOCK_ID,52)
   DCB.fAbortOnError  = memblock dword(DCB_MEMBLOCK_ID,56)
   DCB.fDummy  = memblock dword(DCB_MEMBLOCK_ID,60)
   DCB.XonLim  = memblock word(DCB_MEMBLOCK_ID,64)
   DCB.XoffLim  = memblock word(DCB_MEMBLOCK_ID,66)
   DCB.ByteSize  = memblock byte(DCB_MEMBLOCK_ID,68)
   DCB.Parity  = memblock byte(DCB_MEMBLOCK_ID,69)
   DCB.StopBits  = memblock byte(DCB_MEMBLOCK_ID,70)
   DCB.XonChar  = memblock byte(DCB_MEMBLOCK_ID,71)
   DCB.XoffChar  = memblock byte(DCB_MEMBLOCK_ID,72)
   DCB.ErrorChar  = memblock byte(DCB_MEMBLOCK_ID,73)
   DCB.EofChar  = memblock byte(DCB_MEMBLOCK_ID,74)
   DCB.EvtChar  = memblock byte(DCB_MEMBLOCK_ID,75)
   DCB.wReservedl  = memblock word(DCB_MEMBLOCK_ID,76)
endfunction ret

function SetCommState(nCid as dword)
   Write memblock dword DCB_MEMBLOCK_ID,0,DCB.DCBlength
   Write memblock dword DCB_MEMBLOCK_ID,4,DCB.BaudRate
   Write memblock dword DCB_MEMBLOCK_ID,8,DCB.fBinary
   Write memblock dword DCB_MEMBLOCK_ID,12,DCB.fParity
   Write memblock dword DCB_MEMBLOCK_ID,16,DCB.fOutxCtsFlow
   Write memblock dword DCB_MEMBLOCK_ID,20,DCB.fOutcDsrFlow
   Write memblock dword DCB_MEMBLOCK_ID,24,DCB.fDtrControl
   Write memblock dword DCB_MEMBLOCK_ID,28,DCB.fDsrSensitivity
   Write memblock dword DCB_MEMBLOCK_ID,32,DCB.fTXContinueONXoff
   Write memblock dword DCB_MEMBLOCK_ID,36,DCB.fOutX
   Write memblock dword DCB_MEMBLOCK_ID,40,DCB.fInX
   Write memblock dword DCB_MEMBLOCK_ID,44,DCB.fErrorChar
   Write memblock dword DCB_MEMBLOCK_ID,48,DCB.fNull
   Write memblock dword DCB_MEMBLOCK_ID,52,DCB.fRtsControl
   Write memblock dword DCB_MEMBLOCK_ID,56,DCB.fAbortOnError
   Write memblock dword DCB_MEMBLOCK_ID,60,DCB.fDummy
   Write memblock word DCB_MEMBLOCK_ID,64,DCB.XonLim
   Write memblock word DCB_MEMBLOCK_ID,66,DCB.XoffLim
   Write memblock byte DCB_MEMBLOCK_ID,68,DCB.ByteSize
   Write memblock byte DCB_MEMBLOCK_ID,69,DCB.Parity
   Write memblock byte DCB_MEMBLOCK_ID,70,DCB.StopBits
   Write memblock byte DCB_MEMBLOCK_ID,71,DCB.XonChar
   Write memblock byte DCB_MEMBLOCK_ID,72,DCB.XoffChar
   Write memblock byte DCB_MEMBLOCK_ID,73,DCB.ErrorChar
   Write memblock byte DCB_MEMBLOCK_ID,74,DCB.EofChar
   Write memblock byte DCB_MEMBLOCK_ID,75,DCB.EvtChar
   Write memblock word DCB_MEMBLOCK_ID,76,DCB.wReservedl
ret = call dll (KERNEL_DLL_ID, "SetCommState", nCid, get memblock ptr(DCB_MEMBLOCK_ID))

if ret = 0
  byebye("Could not set Com port state")
endif
endfunction ret

function GetCommTimeouts(nCid as dword)
ret = call dll (KERNEL_DLL_ID, "GetCommTimeouts", nCid, get memblock ptr(TIMEOUTS_MEMBLOCK_ID))
if ret = 0
   byebye("Could not get Com Timeouts.")
endif
   CommTimeouts.ReadIntervalTimeout = memblock dword(TIMEOUTS_MEMBLOCK_ID,0)
   CommTimeouts.ReadTotalTimeoutMultiplier = memblock dword(TIMEOUTS_MEMBLOCK_ID,4)
   CommTimeouts.ReadTotalTimeOutConstant = memblock dword(TIMEOUTS_MEMBLOCK_ID,8)
endfunction ret

function SetCommTimeouts(nCid as dword)
   Write memblock dword TIMEOUTS_MEMBLOCK_ID,0,CommTimeouts.ReadIntervalTimeout
   Write memblock dword TIMEOUTS_MEMBLOCK_ID,4,CommTimeouts.ReadTotalTimeoutMultiplier
   Write memblock dword TIMEOUTS_MEMBLOCK_ID,8,CommTimeouts.ReadTotalTimeOutConstant
ret = call dll (KERNEL_DLL_ID, "SetCommTimeouts", nCid, get memblock ptr(TIMEOUTS_MEMBLOCK_ID))

if ret = 0
   byebye("Could not set Com Timeouts.")
endif
endfunction ret

function ReadFile(hFile as dword, nNumberOfBytesToRead as dword)
ret = call dll(KERNEL_DLL_ID, "ReadFile", hFile, get memblock ptr(IO_BUFFER_MEMBLOCK_ID), nNumberOfBytesToRead, get memblock ptr(BYTES_READ_WRITE_ID),0)
if ret = 0
   print "Could not read from com port."
   wait key
endif
Buffer = ""
for i = 0 to memblock dword(BYTES_READ_WRITE_ID,0) - 1
   Buffer = Buffer + chr$(memblock byte(IO_BUFFER_MEMBLOCK_ID,i))
next i
endfunction ret

function CloseHandle(hObject as dword)
ret = call dll(KERNEL_DLL_ID, "CloseHandle", hObject)
if ret = 0
   byebye("Could not close handle.")
endif
endfunction ret

function EscapeCommFunction(hFile as dword, dwFunc as dword)
ret = call dll(KERNEL_DLL_ID, "EscapeCommFunction", hFile, dwFunc)
if ret = 0
  byebye("EscapeCommFunction Failed.")
endif
endfunction ret

function Cleanup_Memory()
   delete memblock DCB_MEMBLOCK_ID
   delete memblock TIMEOUTS_MEMBLOCK_ID
   delete memblock IO_BUFFER_MEMBLOCK_ID
   delete memblock BYTES_READ_WRITE_ID
   delete dll KERNEL_DLL_ID
endfunction