825 lines
26 KiB
Plaintext
825 lines
26 KiB
Plaintext
unit W32SNGL;
|
|
(*
|
|
**
|
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
|
** Tested with: TurboPascal v7.0, (DOS)
|
|
** VirtualPascal v2.1, (OS/2, Win32)
|
|
** FreePascal v0.99.15 (DOS, Win32)
|
|
** Delphi v4.0. (Win32)
|
|
**
|
|
** Version : 1.02
|
|
** Created : 09-Sep-1999
|
|
** Last update : 21-Jul-2001
|
|
**
|
|
** Note: (c) 1998-2000 by Maarten Bekers
|
|
**
|
|
** Note2: The problem with this approach that we only retrieve the data when
|
|
** we want to. If data arrives and we dont call either Com_ReadBlock(),
|
|
** Com_CharAvail or Com_GetBufferStatus() we dont receive the data.
|
|
** Therefore, we rely on Windows to actually buffer the data. We do this
|
|
** by calling SetupComm() with the buffer-sizes as defined by
|
|
** Win32OutBufSize and Win32InBufSize.
|
|
** If you want to avoid this, you can implement another mutex that you
|
|
** let set by Win32's API calls SetEventMask() and WaitCommEvent().
|
|
** That way, you can also monitor other events which would eliminate
|
|
** some overhead. In general, this approach will suffice.
|
|
**
|
|
*)
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
INTERFACE
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
uses Windows, Combase, BufUnit, Threads
|
|
{$IFDEF VirtualPascal}
|
|
,Use32
|
|
{$ENDIF};
|
|
|
|
Const DataTimeout = 20000; { Wait max. 20 secs }
|
|
|
|
InBufSize = 1024 * 32;
|
|
OutBufSize = 1024 * 32;
|
|
Win32OutBufSize = 1024 * 3;
|
|
Win32InBufSize = 1024 * 3;
|
|
|
|
|
|
type TWin32Obj = Object(TCommObj)
|
|
DataProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
|
|
ThreadsInitted: Boolean; { Are the thread(s) up and running? }
|
|
|
|
SaveHandle : THandle;
|
|
|
|
InitPortNr : Longint;
|
|
InitHandle : Longint;
|
|
|
|
ReadOL : TOverLapped; { Overlapped structure for ReadFile }
|
|
WriteOL : TOverLapped; { Overlapped structure for WriteFile }
|
|
|
|
InBuffer : ^BufArrayObj; { Buffer system internally used }
|
|
OutBuffer : ^BufArrayObj;
|
|
|
|
ReadEvent : PSysEventObj; { Event set by ReadFile overlapped routine }
|
|
WriteEvent : PSysEventObj; { Event set by WriteFile overlapped routine }
|
|
|
|
DoTxEvent : PSysEventObj;{ Event manually set when we have to transmit }
|
|
DoRxEvent : PSysEventObj; { Event manually set when we want data }
|
|
|
|
DataClosedEvent: PSysEventObj; { Event set when the Tx thread is closed }
|
|
|
|
CriticalTx : PExclusiveObj; { Critical sections }
|
|
CriticalRx : PExclusiveObj;
|
|
|
|
DataThread : PThreadsObj;
|
|
EndThreads : Boolean; { Set to true when we have to end the threads }
|
|
|
|
|
|
constructor Init;
|
|
destructor Done;
|
|
|
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
|
Parity: Char; StopBits: Byte): Boolean; virtual;
|
|
function Com_OpenKeep(Comport: Byte): Boolean; virtual;
|
|
function Com_GetChar: Char; virtual;
|
|
function Com_CharAvail: Boolean; virtual;
|
|
function Com_Carrier: Boolean; virtual;
|
|
function Com_SendChar(C: Char): Boolean; virtual;
|
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
|
|
function Com_GetBPSrate: Longint; virtual;
|
|
function Com_GetHandle: Longint; virtual;
|
|
|
|
procedure Com_OpenQuick(Handle: Longint); virtual;
|
|
procedure Com_Close; virtual;
|
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
|
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
|
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
|
|
procedure Com_SetDtr(State: Boolean); virtual;
|
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
|
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
|
|
procedure Com_PurgeInBuffer; virtual;
|
|
procedure Com_PurgeOutBuffer; virtual;
|
|
procedure Com_FlushOutBuffer(Slice: SliceProc); virtual;
|
|
|
|
procedure Com_PauseCom(CloseCom: Boolean); virtual;
|
|
procedure Com_ResumeCom(OpenCom: Boolean); virtual;
|
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual;
|
|
|
|
procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual;
|
|
procedure Com_DataProc(var TempPtr: Pointer); virtual;
|
|
|
|
function Com_StartThread: Boolean;
|
|
procedure Com_InitVars;
|
|
procedure Com_StopThread;
|
|
procedure Com_InitDelayTimes;
|
|
end; { object TWin32Obj }
|
|
|
|
type PWin32Obj = ^TWin32Obj;
|
|
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
IMPLEMENTATION
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
uses SysUtils;
|
|
|
|
{$IFDEF FPC}
|
|
{$I WINDEF.FPC}
|
|
{$ENDIF}
|
|
|
|
const
|
|
dcb_Binary = $00000001;
|
|
dcb_ParityCheck = $00000002;
|
|
dcb_OutxCtsFlow = $00000004;
|
|
dcb_OutxDsrFlow = $00000008;
|
|
dcb_DtrControlMask = $00000030;
|
|
dcb_DtrControlDisable = $00000000;
|
|
dcb_DtrControlEnable = $00000010;
|
|
dcb_DtrControlHandshake = $00000020;
|
|
dcb_DsrSensivity = $00000040;
|
|
dcb_TXContinueOnXoff = $00000080;
|
|
dcb_OutX = $00000100;
|
|
dcb_InX = $00000200;
|
|
dcb_ErrorChar = $00000400;
|
|
dcb_NullStrip = $00000800;
|
|
dcb_RtsControlMask = $00003000;
|
|
dcb_RtsControlDisable = $00000000;
|
|
dcb_RtsControlEnable = $00001000;
|
|
dcb_RtsControlHandshake = $00002000;
|
|
dcb_RtsControlToggle = $00003000;
|
|
dcb_AbortOnError = $00004000;
|
|
dcb_Reserveds = $FFFF8000;
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
constructor TWin32Obj.Init;
|
|
begin
|
|
inherited Init;
|
|
|
|
InitPortNr := -1;
|
|
InitHandle := -1;
|
|
ThreadsInitted := false;
|
|
Com_Initvars;
|
|
end; { constructor Init }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
destructor TWin32Obj.Done;
|
|
begin
|
|
inherited done;
|
|
end; { destructor Done }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_DataProc(var TempPtr: Pointer);
|
|
var Success : Boolean;
|
|
Props : TCommProp;
|
|
ObjectCode : Longint;
|
|
ReturnCode : Longint;
|
|
DidRead : DWORD;
|
|
Written : DWORD;
|
|
BlockLen : DWORD;
|
|
ObjectArray : Array[0..1] of THandle;
|
|
TryReading : Boolean;
|
|
Stats : TComStat;
|
|
ErrMask : DWORD;
|
|
begin
|
|
ObjectArray[0] := DoTxEvent^.SemHandle;
|
|
ObjectArray[1] := DoRxEvent^.SemHandle;
|
|
|
|
repeat
|
|
ObjectCode := WaitForMultipleObjects(2,
|
|
@ObjectArray,
|
|
false,
|
|
DataTimeOut);
|
|
if EndThreads then EXIT;
|
|
|
|
{-----------------------------------------------------------------------}
|
|
{-------------------------- Receive signalled --------------------------}
|
|
{-----------------------------------------------------------------------}
|
|
if (ObjectCode - WAIT_OBJECT_0) = 1 then { DoReceive }
|
|
begin
|
|
DidRead := 00;
|
|
if (EndThreads) then EXIT;
|
|
|
|
{-- Make sure there is something to be read ------------------------}
|
|
ErrMask := 0;
|
|
TryReading := FALSE;
|
|
|
|
if ClearCommError(SaveHandle, ErrMask, @Stats) then
|
|
if Stats.cbInQue > 0 then
|
|
TryReading := TRUE;
|
|
|
|
|
|
{----------------- Start reading the gathered date -----------------}
|
|
if TryReading then
|
|
begin
|
|
CriticalRx^.EnterExclusive;
|
|
|
|
FillChar(Props, SizeOf(TCommProp), 0);
|
|
if GetCommProperties(SaveHandle, Props) then
|
|
if InBuffer^.BufRoom > 0 then
|
|
begin
|
|
BlockLen := Props.dwCurrentRxQueue;
|
|
{ We want the complete BUFFER size, and not }
|
|
{ the actual queue size. The queue may have }
|
|
{ grown since last query, and we always }
|
|
{ want as much data as possible }
|
|
|
|
if Longint(BlockLen) > InBuffer^.BufRoom then
|
|
BlockLen := InBuffer^.BufRoom;
|
|
|
|
Success := ReadFile(SaveHandle,
|
|
InBuffer^.TmpBuf,
|
|
BlockLen,
|
|
DidRead,
|
|
@ReadOL);
|
|
|
|
if NOT Success then
|
|
begin
|
|
ReturnCode := GetLastError;
|
|
|
|
if ReturnCode = ERROR_IO_PENDING then
|
|
begin
|
|
ReturnCode := WaitForSingleObject(ReadOL.hEvent, DataTimeOut);
|
|
|
|
if ReturnCode = WAIT_OBJECT_0 then
|
|
begin
|
|
GetOverLappedResult(SaveHandle, ReadOL, DidRead, false);
|
|
end; { if }
|
|
end; { if }
|
|
end
|
|
else GetOverlappedResult(SaveHandle, ReadOL, DidRead, false);
|
|
|
|
if DidRead > 00 then
|
|
begin
|
|
InBuffer^.Put(InBuffer^.TmpBuf, DidRead);
|
|
DoRxEvent^.ResetEvent;
|
|
end; { if }
|
|
end; { if }
|
|
|
|
CriticalRx^.LeaveExclusive;
|
|
end; { try reading }
|
|
end; { DoReceive call }
|
|
|
|
{-----------------------------------------------------------------------}
|
|
{-------------------------- Transmit signalled -------------------------}
|
|
{-----------------------------------------------------------------------}
|
|
if (ObjectCode - WAIT_OBJECT_0) = 0 then { DoTransmit }
|
|
begin
|
|
CriticalTx^.EnterExclusive;
|
|
DoTxEvent^.ResetEvent;
|
|
|
|
if OutBuffer^.BufUsed > 00 then
|
|
begin
|
|
Written := 00;
|
|
BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf, OutBuffer^.BufUsed, false);
|
|
|
|
Success := WriteFile(SaveHandle,
|
|
OutBuffer^.TmpBuf,
|
|
BlockLen,
|
|
Written,
|
|
@WriteOL);
|
|
if NOT Success then
|
|
begin
|
|
ReturnCode := GetLastError;
|
|
|
|
if ReturnCode = ERROR_IO_PENDING then
|
|
begin
|
|
ReturnCode := WaitForSingleObject(WriteOL.hEvent, DataTimeOut);
|
|
|
|
if ReturnCode = WAIT_OBJECT_0 then
|
|
begin
|
|
if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then
|
|
begin
|
|
ResetEvent(WriteOL.hEvent);
|
|
end; { if }
|
|
end; { if }
|
|
end; { result is pending }
|
|
end { if }
|
|
else begin
|
|
|
|
if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then
|
|
begin
|
|
ResetEvent(WriteOL.hEvent);
|
|
end; { if }
|
|
end; { if (did succeed) }
|
|
|
|
{-- remove the data from the buffer, but only remove the data ---}
|
|
{-- thats actually written --------------------------------------}
|
|
ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf, Written, true);
|
|
if ReturnCode <> Longint(Written) then
|
|
begin
|
|
{ not everything is removed! }
|
|
end; { if }
|
|
|
|
{-- if theres data in the buffer left, run this event again -----}
|
|
if Written <> BlockLen then
|
|
DoTxEvent^.SignalEvent;
|
|
end; { if }
|
|
|
|
CriticalTx^.LeaveExclusive;
|
|
end; { DoTransmit call }
|
|
|
|
|
|
until EndThreads;
|
|
|
|
DataClosedEvent^.SignalEvent;
|
|
ExitThisThread;
|
|
end; { proc. ComDataProc }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_StartThread: Boolean;
|
|
begin
|
|
Result := false;
|
|
EndThreads := false;
|
|
if ThreadsInitted then EXIT;
|
|
ThreadsInitted := true;
|
|
|
|
{----------------------- Create all the events ----------------------------}
|
|
New(ReadEvent, Init);
|
|
if NOT ReadEvent^.CreateEvent(true) then EXIT;
|
|
|
|
New(WriteEvent, Init);
|
|
if NOT WriteEvent^.CreateEvent(true) then EXIT;
|
|
|
|
New(DoTxEvent, Init);
|
|
if NOT DoTxEvent^.CreateEvent(false) then EXIT;
|
|
|
|
New(DoRxEvent, Init);
|
|
if NOT DoRxEvent^.CreateEvent(false) then EXIT;
|
|
|
|
New(DataClosedEvent, Init);
|
|
if NOT DataClosedEvent^.CreateEvent(false) then EXIT;
|
|
|
|
{-------------- Startup the buffers and overlapped events -----------------}
|
|
FillChar(WriteOL, SizeOf(tOverLapped), 0);
|
|
FillChar(ReadOL, SizeOf(tOverLapped), 0);
|
|
WriteOl.hEvent := WriteEvent^.SemHandle;
|
|
ReadOl.hEvent := ReadEvent^.SemHandle;
|
|
|
|
New(InBuffer, Init(InBufSize));
|
|
New(OutBuffer, Init(OutBufSize));
|
|
|
|
{-------------------- Startup the critical section objects ----------------}
|
|
New(CriticalTx, Init);
|
|
CriticalTx^.CreateExclusive;
|
|
|
|
New(CriticalRx, Init);
|
|
CriticalRx^.CreateExclusive;
|
|
|
|
{-------------------- Startup a seperate tx / rx thread -------------------}
|
|
New(DataThread, Init);
|
|
if NOT DataThread^.CreateThread(16384, { Stack size }
|
|
DataProcPtr, { Actual procedure }
|
|
nil, { Parameters }
|
|
0) { Creation flags }
|
|
then EXIT;
|
|
|
|
Result := true;
|
|
end; { proc. Com_StartThread }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_InitVars;
|
|
begin
|
|
DoTxEvent := nil;
|
|
DoRxEvent := nil;
|
|
DataClosedEvent := nil;
|
|
DataThread := nil;
|
|
ReadEvent := nil;
|
|
WriteEvent := nil;
|
|
|
|
InBuffer := nil;
|
|
OutBuffer := nil;
|
|
CriticalRx := nil;
|
|
CriticalTx := nil;
|
|
end; { proc. Com_InitVars }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_StopThread;
|
|
begin
|
|
EndThreads := true;
|
|
ThreadsInitted := false;
|
|
|
|
if DoTxEvent <> nil then DoTxEvent^.SignalEvent;
|
|
if DoTxEvent <> nil then DoRxEvent^.SignalEvent;
|
|
if DataThread <> nil then DataThread^.CloseThread;
|
|
|
|
if DataClosedEvent <> nil then
|
|
if NOT DataClosedEvent^.WaitForEvent(1000) then
|
|
DataThread^.TerminateThread(0);
|
|
|
|
if DataThread <> nil then Dispose(DataThread, Done);
|
|
if DoTxEvent <> nil then Dispose(DoTxEvent, Done);
|
|
if DoRxEvent <> nil then Dispose(DoRxEvent, Done);
|
|
if DataClosedEvent <> nil then Dispose(DataClosedEvent, Done);
|
|
if ReadEvent <> nil then Dispose(ReadEvent, Done);
|
|
if WriteEvent <> nil then Dispose(WriteEvent, Done);
|
|
|
|
if CriticalTx <> nil then Dispose(CriticalTx, Done);
|
|
if CriticalRx <> nil then Dispose(CriticalRx, Done);
|
|
|
|
if InBuffer <> nil then Dispose(InBuffer, Done);
|
|
if OutBuffer <> nil then Dispose(OutBuffer, Done);
|
|
|
|
Com_InitVars;
|
|
end; { proc. Com_StopThread }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_InitDelayTimes;
|
|
var CommTimeOut: TCommTimeouts;
|
|
RC : Longint;
|
|
begin
|
|
FillChar(CommTimeOut, SizeOf(TCommTimeOuts), 00);
|
|
CommTimeOut.ReadIntervalTimeout := MAXDWORD;
|
|
|
|
if NOT SetCommTimeOuts(SaveHandle, CommTimeOut) then
|
|
begin
|
|
RC := GetLastError;
|
|
ErrorStr := 'Error setting communications timeout: #'+IntToStr(RC) + ' / ' + SysErrorMessage(rc);
|
|
end; { if }
|
|
|
|
end; { proc. InitDelayTimes }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_GetHandle: Longint;
|
|
begin
|
|
Result := SaveHandle;
|
|
end; { func. Com_GetHandle }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_OpenQuick(Handle: Longint);
|
|
var LastError: Longint;
|
|
begin
|
|
SaveHandle := Handle;
|
|
InitHandle := Handle;
|
|
|
|
FillChar(ReadOl, SizeOf(ReadOl), 00);
|
|
FillChar(WriteOl, SizeOf(WriteOl), 00);
|
|
|
|
if NOT SetupComm(Com_GetHandle, Win32InBufSize, Win32OutBufSize) then
|
|
begin
|
|
LastError := GetLastError;
|
|
|
|
ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError);
|
|
end; { if }
|
|
|
|
Com_InitDelayTimes;
|
|
InitFailed := NOT Com_StartThread;
|
|
Com_SetLine(-1, 'N', 8, 1);
|
|
end; { proc. TWin32Obj.Com_OpenQuick }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_OpenKeep(Comport: Byte): Boolean;
|
|
var TempSave : THandle;
|
|
Security : TSECURITYATTRIBUTES;
|
|
LastError : Longint;
|
|
begin
|
|
InitPortNr := Comport;
|
|
|
|
FillChar(ReadOl, SizeOf(ReadOl), 00);
|
|
FillChar(WriteOl, SizeOf(WriteOl), 00);
|
|
|
|
FillChar(Security, SizeOf(TSECURITYATTRIBUTES), 0);
|
|
Security.nLength := SizeOf(TSECURITYATTRIBUTES);
|
|
Security.lpSecurityDescriptor := nil;
|
|
Security.bInheritHandle := true;
|
|
|
|
TempSave := CreateFile(PChar('\\.\COM' + IntToStr(ComPort)),
|
|
GENERIC_READ or GENERIC_WRITE,
|
|
0,
|
|
@Security, { No Security }
|
|
OPEN_EXISTING, { Creation action }
|
|
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
|
|
0); { No template }
|
|
LastError := GetLastError;
|
|
if LastError <> 0 then
|
|
ErrorStr := 'Unable to open communications port';
|
|
|
|
SaveHandle := TempSave;
|
|
Result := (TempSave <> INVALID_HANDLE_VALUE);
|
|
|
|
if Result then { Make sure that "CharAvail" isn't going to wait }
|
|
begin
|
|
Com_InitDelayTimes;
|
|
end; { if }
|
|
|
|
if NOT SetupComm(Com_GetHandle, Win32InBufSize, Win32OutBufSize) then
|
|
begin
|
|
LastError := GetLastError;
|
|
|
|
ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError);
|
|
end; { if }
|
|
|
|
InitFailed := NOT Com_StartThread;
|
|
end; { func. Com_OpenKeep }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
|
Parity: Char; StopBits: Byte): Boolean;
|
|
begin
|
|
Com_Open := Com_OpenKeep(Comport);
|
|
Com_SetLine(Baudrate, Parity, DataBits, StopBits);
|
|
end; { func. TWin32Obj.Com_OpenCom }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
|
var DCB : TDCB;
|
|
BPSID : Longint;
|
|
begin
|
|
if BpsRate = 11520 then { small fix for EleBBS inability to store the bps }
|
|
BpsRate := 115200; { rate in anything larger than a 16-bit integer }
|
|
|
|
GetCommState(Com_GetHandle, DCB);
|
|
|
|
if NOT (Parity in ['N', 'E', 'O', 'M']) then Parity := 'N';
|
|
if BpsRate >= 0 then dcb.BaudRate := BpsRate;
|
|
dcb.StopBits := ONESTOPBIT;
|
|
|
|
Case Parity of
|
|
'N' : dcb.Parity := NOPARITY;
|
|
'E' : dcb.Parity := EVENPARITY;
|
|
'O' : dcb.Parity := ODDPARITY;
|
|
'M' : dcb.Parity := MARKPARITY;
|
|
end; { case }
|
|
|
|
Case StopBits of
|
|
1 : dcb.StopBits := ONESTOPBIT;
|
|
2 : dcb.StopBits := TWOSTOPBITS;
|
|
3 : dcb.StopBits := ONE5STOPBITS;
|
|
end; { case }
|
|
|
|
dcb.ByteSize := DataBits;
|
|
dcb.Flags := dcb.Flags OR dcb_Binary OR Dcb_DtrControlEnable;
|
|
|
|
if not SetCommState (Com_GetHandle, DCB) then
|
|
begin
|
|
BPSId := GetLastError;
|
|
|
|
ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId);
|
|
end; { if }
|
|
end; { proc. TWin32Obj.Com_SetLine }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_Close;
|
|
begin
|
|
if DontClose then EXIT;
|
|
|
|
if DWORD(Com_GetHandle) <> INVALID_HANDLE_VALUE then
|
|
begin
|
|
Com_StopThread;
|
|
CloseHandle(Com_GetHandle);
|
|
|
|
SaveHandle := INVALID_HANDLE_VALUE;
|
|
end;
|
|
|
|
end; { func. TWin32Obj.Com_CloseCom }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_SendChar(C: Char): Boolean;
|
|
var Written: Longint;
|
|
begin
|
|
Com_SendBlock(C, SizeOf(C), Written);
|
|
Com_SendChar := (Written = SizeOf(c));
|
|
end; { proc. TWin32Obj.Com_SendChar }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_GetChar: Char;
|
|
var Reads: Longint;
|
|
begin
|
|
Com_ReadBlock(Result, SizeOf(Result), Reads);
|
|
end; { func. TWin32Obj.Com_GetChar }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
|
begin
|
|
if OutBuffer^.BufRoom < BlockLen then
|
|
repeat
|
|
{$IFDEF WIN32}
|
|
Sleep(1);
|
|
{$ENDIF}
|
|
until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier);
|
|
|
|
CriticalTx^.EnterExclusive;
|
|
Written := OutBuffer^.Put(Block, BlockLen);
|
|
CriticalTx^.LeaveExclusive;
|
|
|
|
DoTxEvent^.SignalEvent;
|
|
end; { proc. TWin32Obj.Com_SendBlock }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
|
begin
|
|
if InBuffer^.BufUsed < BlockLen then
|
|
begin
|
|
DoRxEvent^.SignalEvent;
|
|
|
|
while (InBuffer^.BufUsed < BlockLen) AND (Com_Carrier) do
|
|
begin
|
|
Sleep(1);
|
|
|
|
if Com_CharAvail then
|
|
DoRxEvent^.SignalEvent;
|
|
end; { while }
|
|
end; { if }
|
|
|
|
CriticalRx^.EnterExclusive;
|
|
Reads := InBuffer^.Get(Block, BlockLen, true);
|
|
CriticalRx^.LeaveExclusive;
|
|
end; { proc. TWin32Obj.Com_ReadBlock }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_CharAvail: Boolean;
|
|
var Props : TComStat;
|
|
ErrMask : DWORD;
|
|
begin
|
|
if InBuffer^.BufUsed < 1 then
|
|
begin
|
|
ErrMask := 0;
|
|
|
|
if ClearCommError(Com_GetHandle, ErrMask, @Props) then
|
|
if Props.cbInQue > 0 then
|
|
DoRxEvent^.SignalEvent;
|
|
end; { if }
|
|
|
|
Result := (InBuffer^.BufUsed > 0);
|
|
end; { func. TWin32Obj.Com_CharAvail }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_Carrier: Boolean;
|
|
var Status: DWORD;
|
|
begin
|
|
if Com_GetHandle <> INVALID_HANDLE_VALUE then
|
|
begin
|
|
GetCommModemStatus(Com_GetHandle,
|
|
Status);
|
|
|
|
Result := (Status AND MS_RLSD_ON) <> 00;
|
|
end
|
|
else Result := FALSE;
|
|
end; { func. TWin32Obj.Com_Carrier }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
|
var Data: DWORD;
|
|
begin
|
|
GetCommModemStatus(Com_GetHandle, Data);
|
|
|
|
ModemStatus := ModemStatus and $0F;
|
|
ModemStatus := ModemStatus or Byte(Data);
|
|
end; { proc. TWin32Obj.Com_GetModemStatus }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_SetDtr(State: Boolean);
|
|
begin
|
|
if State then
|
|
EscapeCommFunction(Com_GetHandle, SETDTR)
|
|
else EscapeCommFunction(Com_GetHandle, CLRDTR);
|
|
end; { proc. TWin32Obj.Com_SetDtr }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_GetBpsRate: Longint;
|
|
var DCB : TDCB;
|
|
begin
|
|
GetCommState(Com_GetHandle, DCB);
|
|
|
|
Com_GetBpsRate := dcb.Baudrate;
|
|
end; { func. TWin32Obj.Com_GetBpsRate }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
|
var Stats : TComStat;
|
|
ErrMask : DWORD;
|
|
begin
|
|
if ClearCommError(Com_GetHandle, ErrMask, @Stats) then
|
|
begin
|
|
if Stats.cbInQue > 0 then
|
|
begin
|
|
DoRxEvent^.SignalEvent;
|
|
Sleep(1);
|
|
end; { if }
|
|
end; { if }
|
|
|
|
|
|
InFree := InBuffer^.BufRoom;
|
|
OutFree := OutBuffer^.BufRoom;
|
|
InUsed := InBuffer^.BufUsed;
|
|
OutUsed := OutBuffer^.BufUsed;
|
|
end; { proc. TWin32Obj.Com_GetBufferStatus }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_PurgeInBuffer;
|
|
begin
|
|
CriticalRx^.EnterExclusive;
|
|
|
|
InBuffer^.Clear;
|
|
PurgeComm(Com_GetHandle, PURGE_RXCLEAR);
|
|
|
|
CriticalRx^.LeaveExclusive;
|
|
end; { proc. TWin32Obj.Com_PurgeInBuffer }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_PurgeOutBuffer;
|
|
begin
|
|
CriticalTx^.EnterExclusive;
|
|
|
|
OutBuffer^.Clear;
|
|
PurgeComm(Com_GetHandle, PURGE_TXCLEAR);
|
|
|
|
CriticalTx^.LeaveExclusive;
|
|
end; { proc. TWin32Obj.Com_PurgeInBuffer }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TWin32Obj.Com_ReadyToSend(BlockLen: Longint): Boolean;
|
|
begin
|
|
Result := OutBuffer^.BufRoom >= BlockLen;
|
|
end; { func. ReadyToSend }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_PauseCom(CloseCom: Boolean);
|
|
begin
|
|
if CloseCom then Com_Close
|
|
else Com_StopThread;
|
|
end; { proc. Com_PauseCom }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_ResumeCom(OpenCom: Boolean);
|
|
begin
|
|
if OpenCom then
|
|
begin
|
|
if InitPortNr <> -1 then Com_OpenKeep(InitPortNr)
|
|
else Com_OpenQuick(InitHandle);
|
|
end
|
|
else InitFailed := NOT Com_StartThread;
|
|
end; { proc. Com_ResumeCom }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_FlushOutBuffer(Slice: SliceProc);
|
|
begin
|
|
Windows.FlushFileBuffers(Com_GetHandle);
|
|
|
|
inherited Com_FlushOutBuffer(Slice);
|
|
end; { proc. Com_FlushOutBuffer }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
|
|
var DCB : TDCB;
|
|
BPSID : Longint;
|
|
begin
|
|
GetCommState(Com_GetHandle, DCB);
|
|
|
|
if Hard then
|
|
dcb.Flags := dcb.Flags OR NOT dcb_OutxCtsFlow OR NOT dcb_RtsControlHandshake;
|
|
|
|
if SoftTX then
|
|
dcb.Flags := dcb.Flags OR NOT dcb_OutX;
|
|
|
|
if SoftRX then
|
|
dcb.Flags := dcb.Flags OR NOT dcb_InX;
|
|
|
|
if not SetCommState(Com_GetHandle, DCB) then
|
|
begin
|
|
BPSId := GetLastError;
|
|
|
|
ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId);
|
|
end; { if }
|
|
|
|
Com_InitDelayTimes;
|
|
end; { proc. Com_SetFlow }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TWin32Obj.Com_SetDataProc(ReadPtr, WritePtr: Pointer);
|
|
begin
|
|
DataProcPtr := ReadPtr;
|
|
end; { proc. Com_SetDataProc }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
end.
|