310 lines
9.2 KiB
Plaintext
310 lines
9.2 KiB
Plaintext
unit ComBase;
|
|
(*
|
|
**
|
|
** 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.12 (DOS, Win32)
|
|
** Delphi v4.0. (Win32)
|
|
**
|
|
** Version : 1.01
|
|
** Created : 21-May-1998
|
|
** Last update : 14-May-1999
|
|
**
|
|
** Note: (c)1998-2003 by Maarten Bekers
|
|
**
|
|
*)
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
INTERFACE
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
{$IFDEF VirtualPascal}
|
|
uses Use32;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MSDOS}
|
|
Type ShortString = String;
|
|
{$ENDIF}
|
|
|
|
type SliceProc = procedure;
|
|
|
|
type TCommObj = Object
|
|
DontClose : Boolean;
|
|
InitFailed : Boolean;
|
|
ErrorStr : ShortString;
|
|
BlockAll : Boolean;
|
|
|
|
constructor Init;
|
|
destructor Done;
|
|
|
|
procedure Com_OpenQuick(Handle: Longint); virtual;
|
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
|
Parity: Char; StopBits: Byte): Boolean; virtual;
|
|
function Com_OpenKeep(Comport: Byte): Boolean; virtual;
|
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
|
|
|
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
|
|
function Com_GetBPSrate: Longint; virtual;
|
|
|
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
|
|
procedure Com_SetDtr(State: Boolean); virtual;
|
|
|
|
function Com_CharAvail: Boolean; virtual;
|
|
function Com_Carrier: Boolean; virtual;
|
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
|
|
|
|
function Com_GetChar: Char; virtual;
|
|
function Com_PeekChar: Char; virtual;
|
|
function Com_SendChar(C: Char): Boolean; virtual;
|
|
function Com_GetDriverInfo: String; virtual;
|
|
function Com_GetHandle: Longint; virtual;
|
|
function Com_InitSucceeded: Boolean; virtual;
|
|
|
|
procedure Com_Close; virtual;
|
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
|
|
procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); virtual;
|
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
|
|
procedure Com_PurgeOutBuffer; virtual;
|
|
procedure Com_PurgeInBuffer; virtual;
|
|
procedure Com_PauseCom(CloseCom: Boolean); virtual;
|
|
procedure Com_ResumeCom(OpenCom: Boolean); virtual;
|
|
procedure Com_FlushOutBuffer(Slice: SliceProc); virtual;
|
|
procedure Com_SendString(Temp: ShortString); virtual;
|
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual;
|
|
|
|
procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual;
|
|
|
|
end; { object TCommObj }
|
|
|
|
Type PCommObj = ^TCommObj;
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
IMPLEMENTATION
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
{-- We disable warnings as this is just an abstract -}
|
|
|
|
constructor TCommObj.Init;
|
|
begin
|
|
DontClose := false;
|
|
InitFailed := false;
|
|
BlockAll := false;
|
|
ErrorStr := '';
|
|
end; { constructor Init }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
destructor TCommObj.Done;
|
|
begin
|
|
end; { destructor Done }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
|
Parity: Char; StopBits: Byte): Boolean;
|
|
begin
|
|
Com_Open := FALSE;
|
|
end; { func. Com_Open }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_OpenQuick(Handle: Longint);
|
|
begin
|
|
end; { proc. TCommObj.Com_OpenQuick }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_Close;
|
|
begin
|
|
end; { proc. TCommObj.Com_Close }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_GetChar: Char;
|
|
begin
|
|
Com_GetChar := #0;
|
|
end; { func. TCommObj.Com_GetChar }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_PeekChar: Char;
|
|
begin
|
|
Com_PeekChar := #0;
|
|
end; { func. TCommObj.Com_GetChar }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_SendChar(C: Char): Boolean;
|
|
begin
|
|
Com_SendChar := FALSE;
|
|
end; { proc. TCommObj.Com_SendChar }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
|
begin
|
|
end; { proc. TCommObj.Com_SendBlock }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
|
begin
|
|
end; { proc. TCommObj.Com_ReadBlock }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_CharAvail: Boolean;
|
|
begin
|
|
Com_CharAvail := FALSE;
|
|
end; { func. TCommObj.Com_CharAvail }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_Carrier: Boolean;
|
|
begin
|
|
Com_Carrier := FALSE;
|
|
end; { func. Comm_Carrier }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_SetDtr(State: Boolean);
|
|
begin
|
|
end; { proc. TCommObj.Com_SetDtr }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_OpenKeep(Comport: Byte): Boolean;
|
|
begin
|
|
Com_OpenKeep := FALSE;
|
|
end; { func. TCommObj.Com_OpenKeep }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_ReadyToSend(BlockLen: Longint): Boolean;
|
|
begin
|
|
Com_ReadyToSend := FALSE;
|
|
end; { func. TCommObj.Com_ReadyToSend }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
|
begin
|
|
end; { proc. TCommObj.Com_GetModemStatus }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_GetBPSrate: Longint;
|
|
begin
|
|
Com_GetBpsRate := -1;
|
|
end; { func. TCommObj.Com_GetBPSrate }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
|
begin
|
|
end; { proc. TCommObj.Com_SetLine }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
|
begin
|
|
end; { proc. TCommObj.Com_GetBufferStatus }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_PurgeInBuffer;
|
|
begin
|
|
end; { proc. TCommObj.Com_PurgeInBuffer }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_PurgeOutBuffer;
|
|
begin
|
|
end; { proc. TCommObj.Com_PurgeOutBuffer }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_GetDriverInfo: String;
|
|
begin
|
|
Com_GetDriverInfo := '';
|
|
end; { func. Com_GetDriverInfo }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_GetHandle: Longint;
|
|
begin
|
|
Com_GetHandle := -1;
|
|
end; { func. Com_GetHandle }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_PauseCom(CloseCom: Boolean);
|
|
begin
|
|
end; { proc. Com_PauseCom }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_ResumeCom(OpenCom: Boolean);
|
|
begin
|
|
end; { proc. Com_ResumeCom }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
function TCommObj.Com_InitSucceeded: Boolean;
|
|
begin
|
|
Com_InitSucceeded := NOT InitFailed;
|
|
end; { func. Com_InitFailed }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_FlushOutBuffer(Slice: SliceProc);
|
|
var InFree,
|
|
OutFree,
|
|
InUsed,
|
|
OutUsed : Longint;
|
|
begin
|
|
Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed);
|
|
|
|
while (OutUsed > 1) AND (Com_Carrier) do
|
|
{ X00 (fossil) will never go below 1 ! }
|
|
begin
|
|
Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed);
|
|
|
|
if @Slice <> nil then
|
|
begin
|
|
Slice;
|
|
Slice;
|
|
end; { if }
|
|
end; { while }
|
|
end; { proc. Com_FlushOutBuffer }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc);
|
|
begin
|
|
Com_SendBlock(Block, BlockLen, Written);
|
|
end; { proc. Com_SendWait }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_SendString(Temp: ShortString);
|
|
var Written: Longint;
|
|
begin
|
|
Com_SendBlock(Temp[1], Length(Temp), Written);
|
|
end; { proc. Com_SendString }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
|
|
begin
|
|
end; { proc. Com_Setflow }
|
|
|
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
|
|
|
procedure TCommObj.Com_SetDataProc(ReadPtr, WritePtr: Pointer);
|
|
begin
|
|
end; { Com_SetDataProc }
|
|
|
|
end.
|