eric
/
Renegade-1.19
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Renegade-1.19/SOURCE/ELECOM/TELNET.PAS

864 lines
28 KiB
Plaintext
Raw Permalink Normal View History

Reset
2022-06-21 17:11:35 -07:00
unit TELNET;
{$h-}
(*
**
** 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 : 04-Apr-1999
**
** Note: (c) 1998-1999 by Maarten Bekers
**
** Note: Same story of what we said in Win32, only we have here 2 seperate
** threads. The Write-thread has no problems, the read-thread is run
** max every 5 seconds, or whenever a carrier-check is performed. This
** carrier check is run on most BBS programs each second. You can
** optimize this by making the ReadThread a blocking select() call on
** the fd_read socket, but this can have other issues. A better approach
** on Win32 would be to call the WsaAsyncSelect() call, but this is
** non portable.
**
*)
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
INTERFACE
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
uses SockFunc, SockDef, Combase, BufUnit, Threads
{$IFDEF WIN32}
,Windows
{$ENDIF}
{$IFDEF OS2}
,Os2Base
{$ENDIF}
{$IFDEF VirtualPascal}
,Use32
{$ENDIF};
Const WriteTimeout = 5000; { Wait max. 5 secs }
ReadTimeOut = 5000; { General event, 5 secs max }
InBufSize = 1024 * 32;
OutBufSize = 1024 * 32;
type TTelnetObj = Object(TCommObj)
ReadProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
WriteProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
ThreadsInitted : Boolean;
NeedNewCarrier : Boolean;
TelnetCarrier : Boolean;
IacDontDo : Longint; { ugly hack to prevent missed IACs }
IacState : Longint; { 0 = nothing }
{ 1 = received IAC }
{ 2 = handing the IAC }
ClientRC : Longint;
InBuffer : ^BufArrayObj; { Buffer system internally used }
OutBuffer : ^BufArrayObj;
DoTxEvent : PSysEventObj; { Event manually set when we have to transmit }
DoRxEvent : PSysEventObj; { Event manually set when we need data }
TxClosedEvent : PSysEventObj; { Event set when the Tx thread is closed }
RxClosedEvent : PSysEventObj; { Event set when the Rx thread is closed }
CriticalTx : PExclusiveObj; { Critical sections }
CriticalRx : PExclusiveObj;
TxThread : PThreadsObj; { The Transmit and Receive threads }
RxThread : 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_PeekChar: 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_PeekBlock(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_PauseCom(CloseCom: Boolean); virtual;
procedure Com_ResumeCom(OpenCom: Boolean); virtual;
procedure Com_ReadProc(var TempPtr: Pointer);
procedure Com_WriteProc(var TempPtr: Pointer);
procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual;
function Com_StartThread: Boolean;
procedure Com_InitVars;
procedure Com_StopThread;
function Com_SendWill(Option: Char): String;
function Com_SendWont(Option: Char): String;
function Com_SendDo(Option: Char): String;
procedure Com_SendRawStr(TempStr: String);
procedure Com_PrepareBufferRead(var CurBuffer: CharBufType; var TempOut: BufArrayObj; BlockLen: Longint);
procedure Com_PrepareBufferWrite(var CurBuffer, TmpOutBuffer: CharBufType; var BlockLen: Longint);
end; { object TTelnetObj }
Type PTelnetObj = ^TTelnetObj;
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
IMPLEMENTATION
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
uses SysUtils;
{$IFDEF FPC}
{$I WINDEF.FPC}
{$ENDIF}
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
Const
{ Telnet Options }
TELNET_IAC = #255; { Interpret as Command }
TELNET_DONT = #254; { Stop performing, or not expecting him to perform }
TELNET_DO = #253; { Perform, or expect him to perform }
TELNET_WONT = #252; { Refusal to perform }
TELNET_WILL = #251; { Desire to perform }
TELNET_SB = #250; { What follow is sub-negotiation of indicated option }
TELNET_GA = #249; { Go ahead signal }
TELNET_EL = #248; { Erase Line function }
TELNET_EC = #247; { Erase Character function }
TELNET_AYT = #246; { Are You There function }
TELNET_AO = #245; { Abort Output function }
TELNET_IP = #244; { Interrupt Process function }
TELNET_BRK = #243; { NVT break character }
TELNET_DM = #242; { Data stream portion of a Synch }
TELNET_NOP = #241; { No operation }
TELNET_SE = #240; { End of sub-negotiation parameters }
TELNET_EOR = #239; { End of record }
TELNET_ABORT = #238; { Abort process }
TELNET_SUSP = #237; { Suspend current process }
TELNET_EOF = #236; { End of file }
TELNETOPT_BINARY = #0; { Transmit binary }
TELNETOPT_ECHO = #1; { Echo mode }
TELNETOPT_SUPGA = #3; { Suppress Go-Ahead }
TELNETOPT_TERM = #24; { Terminal Type }
TELNETOPT_SPEED = #32; { Terminal Speed }
TELNETOPT_FLOWCNT= #33; { Toggle flow-control }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
constructor TTelnetObj.Init;
begin
inherited Init;
ThreadsInitted := false;
NeedNewCarrier := true;
TelnetCarrier := TRUE;
IacState := 0; { default to none }
Com_InitVars;
end; { constructor Init }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
destructor TTelnetObj.Done;
begin
inherited done;
end; { destructor Done }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_SendRawStr(TempStr: String);
var BytesSnt: Longint;
TmpByte : Longint;
BufFlag : Longint;
TmpError: Longint;
begin
BufFlag := 00;
TmpByte := 01;
REPEAT
BytesSnt := SockSend(ClientRC,
@TempStr[TmpByte],
Length(TempStr),
BufFlag);
if BytesSnt > 0 then
Inc(TmpByte, BytesSnt)
else begin
TmpError := SockErrorNo;
if TmpError <> WSAEWOULDBLOCK then EXIT;
end; { else }
UNTIL (TmpByte > Length(TempStr));
end; { proc. Com_SendRawStr }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_SendWill(Option: Char): String;
begin
Result[1] := TELNET_IAC;
Result[2] := TELNET_WILL;
Result[3] := Option;
SetLength(Result, 3);
end; { func. Com_SendWill }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_SendWont(Option: Char): String;
begin
Result[1] := TELNET_IAC;
Result[2] := TELNET_WONT;
Result[3] := Option;
SetLength(Result, 3);
end; { func. Com_SendWont }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_SendDo(Option: Char): String;
begin
Result[1] := TELNET_IAC;
Result[2] := TELNET_DO;
Result[3] := Option;
SetLength(Result, 3);
end; { func. Com_SendDo }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_PrepareBufferRead(var CurBuffer: CharBufType; var TempOut: BufArrayObj; BlockLen: Longint);
var Counter : Longint;
begin
Counter := 00;
if BlockLen = 0 then EXIT;
While Counter <= (Blocklen - 01) do
begin
{-- and now handle the IAC state ---------------------------------------}
Case IacState of
1 : begin { DO / DONT }
{-- we received an IAC, and this is the next char --------------}
if CurBuffer[Counter] = TELNET_IAC then
begin
TempOut.Put(CurBuffer[Counter], 1);
IacState := 0; { reset parser state }
end
else begin
IacState := 2;
Case CurBuffer[Counter] of
TELNET_DONT,
TELNET_DO : IacDontDo := 1;
else IacDontDo := 0;
end; { case }
end; { else }
end; { DO/DONT }
2 : begin { WHAT }
{ if IacDontDo = 1 then }
begin
Case CurBuffer[Counter] of
TELNETOPT_BINARY,
TELNETOPT_SUPGA,
TELNETOPT_ECHO : begin
Com_SendRawStr(Com_SendWill(CurBuffer[Counter]));
end
else begin
Com_SendRawStr(Com_SendWont(CurBuffer[Counter]));
end; { if }
end; { case }
end; { if this is a state we will reply to }
IacState := 0; { reset IAC state machine }
end; { WHAT }
else begin
if CurBuffer[Counter] = TELNET_IAC then
begin
IacState := 1
end
else TempOut.Put(CurBuffer[Counter], 1);
end; { else }
end; { case }
{-- and loop through the buffer ----------------------------------------}
Inc(Counter);
end; { while }
end; { proc. Com_PrepareBufferRead }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_PrepareBufferWrite(var CurBuffer, TmpOutBuffer: CharBufType; var BlockLen: Longint);
var Counter : Longint;
NewCounter: Longint;
begin
Counter := 00;
NewCounter := 00;
if BlockLen = 0 then EXIT;
While Counter <= Blocklen do
begin
Case CurBuffer[Counter] of
TELNET_IAC : begin { Escape command character }
TmpOutBuffer[NewCounter] := TELNET_IAC;
Inc(NewCounter);
TmpOutBuffer[NewCounter] := TELNET_IAC;
Inc(NewCounter);
end; { if }
else begin
TmpOutBuffer[NewCounter] := CurBuffer[Counter];
Inc(NewCounter);
end; { if }
end; { case }
Inc(Counter);
end; { while }
BlockLen := NewCounter - 1;
end; { proc. Com_PrepareBufferWrite }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_ReadProc(var TempPtr: Pointer);
var Available : Boolean;
BytesRead : Longint;
BlockLen : Longint;
ReturnCode: Longint;
begin
repeat
if DoRxEvent^.WaitForEvent(ReadTimeOut) then
if NOT EndThreads then
begin
CriticalRx^.EnterExclusive;
Available := (SockSelect(ClientRC) > 00);
DoRxEvent^.ResetEvent;
if (Available) OR (NeedNewCarrier) then
begin
{----------- Start reading the gathered date -------------------}
NeedNewCarrier := false;
if InBuffer^.BufRoom > 0 then
begin
BlockLen := InBuffer^.BufRoom;
if BlockLen > 1024 then
BlockLen := 1024;
if BlockLen > 00 then
begin
BytesRead := SockRecv(ClientRC,
@InBuffer^.TmpBuf,
BlockLen,
0);
if BytesRead = 0 then
begin
TelnetCarrier := false;
ReturnCode := SockErrorNo;
ErrorStr := 'Error in communications(1), #'+IntToStr(Returncode)+ ' / '+SysErrorMessage(Returncode);
end; { if }
if BytesRead = -1 then
begin
ReturnCode := SockErrorNo;
if ReturnCode <> WSAEWOULDBLOCK then
begin
TelnetCarrier := false;
ErrorStr := 'Error in communications(2), #'+IntToStr(ReturnCode)+ ' / '+SysErrorMessage(ReturnCode);
EndThreads := true;
end; { if }
end; { error }
if BytesRead > 00 then
begin
Com_PrepareBufferRead(InBuffer^.TmpBuf, InBuffer^, BytesRead);
end; { if }
end; { if }
end; { if }
end; { if available }
CriticalRx^.LeaveExclusive;
end; { if RxEvent }
until EndThreads;
RxClosedEvent^.SignalEvent;
ExitThisThread;
end; { proc. Com_ReadProc }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_WriteProc(var TempPtr: Pointer);
var BlockLen : Longint;
Written : Longint;
ReturnCode : Longint;
TempBuf : ^CharBufType;
begin
New(TempBuf);
repeat
if DoTxEvent^.WaitForEvent(WriteTimeOut) then
if NOT EndThreads then
begin
CriticalTx^.EnterExclusive;
DoTxEvent^.ResetEvent;
if OutBuffer^.BufUsed > 00 then
begin
BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf, OutBuffer^.BufUsed, false);
Com_PrepareBufferWrite(OutBuffer^.TmpBuf, TempBuf^, BlockLen);
Written := SockSend(ClientRC,
TempBuf,
BlockLen,
0);
{-- 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
begin
DoTxEvent^.SignalEvent;
end; { if }
end; { if }
CriticalTx^.LeaveExclusive;
end; { if }
until EndThreads;
Dispose(TempBuf);
TxClosedEvent^.SignalEvent;
ExitThisThread;
end; { proc. Com_WriteProc }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_StartThread: Boolean;
begin
Result := false;
EndThreads := false;
if ThreadsInitted then EXIT;
ThreadsInitted := true;
{----------------------- Create all the events ----------------------------}
New(DoTxEvent, Init);
if NOT DoTxEvent^.CreateEvent(false) then EXIT;
New(DoRxEvent, Init);
if NOT DoRxEvent^.CreateEvent(false) then EXIT;
New(RxClosedEvent, Init);
if NOT RxClosedEvent^.CreateEvent(false) then EXIT;
New(TxClosedEvent, Init);
if NOT TxClosedEvent^.CreateEvent(false) then EXIT;
{-------------- Startup the buffers and overlapped events -----------------}
New(InBuffer, Init(InBufSize));
New(OutBuffer, Init(OutBufSize));
{-------------------- Startup a seperate write thread ---------------------}
New(CriticalTx, Init);
CriticalTx^.CreateExclusive;
New(TxThread, Init);
if NOT TxThread^.CreateThread(16384, { Stack size }
WriteProcPtr, { Actual procedure }
nil, { Parameters }
0) { Creation flags }
then EXIT;
{-------------------- Startup a seperate read thread ----------------------}
New(CriticalRx, Init);
CriticalRx^.CreateExclusive;
New(RxThread, Init);
if NOT RxThread^.CreateThread(16384, { Stack size }
ReadProcPtr, { Actual procedure }
nil, { Parameters }
0) { Creation flags }
then EXIT;
Result := true;
end; { proc. Com_StartThread }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_InitVars;
begin
DoTxEvent := nil;
DoRxEvent := nil;
RxClosedEvent := nil;
TxClosedEvent := nil;
TxThread := nil;
RxThread := nil;
InBuffer := nil;
OutBuffer := nil;
CriticalRx := nil;
CriticalTx := nil;
end; { proc. Com_InitVars }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_StopThread;
begin
EndThreads := true;
ThreadsInitted := false;
if DoTxEvent <> nil then DoTxEvent^.SignalEvent;
if DoTxEvent <> nil then DoRxEvent^.SignalEvent;
if TxThread <> nil then TxThread^.CloseThread;
if RxThread <> nil then RxThread^.CloseThread;
if TxClosedEvent <> nil then
if NOT TxClosedEvent^.WaitForEvent(1000) then
TxThread^.TerminateThread(0);
if RxClosedEvent <> nil then
if NOT RxClosedEvent^.WaitForEvent(1000) then
RxThread^.TerminateThread(0);
if TxThread <> nil then Dispose(TxThread, Done);
if RxThread <> nil then Dispose(RxThread, Done);
if DoTxEvent <> nil then Dispose(DoTxEvent, Done);
if DoRxEvent <> nil then Dispose(DoRxEvent, Done);
if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done);
if TxClosedEvent <> nil then Dispose(TxClosedEvent, 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 }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_GetHandle: Longint;
begin
Result := ClientRC;
end; { func. Com_GetHandle }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_OpenQuick(Handle: Longint);
var ReturnCode: Longint;
begin
ClientRC := Handle;
if (NOT (SockInit=0)) then
begin
ReturnCode := SockErrorNo;
ErrorStr := 'Error in initializing socket, #'+IntToStr(Returncode)+ ' / '+SysErrorMessage(Returncode);
InitFailed := true;
end
else InitFailed := NOT Com_StartThread;
{ Set the telnet to binary transmission }
Com_SendRawStr(Com_SendWill(TELNETOPT_ECHO));
Com_SendRawStr(Com_SendWill(TELNETOPT_BINARY));
end; { proc. TTelnetObj.Com_OpenQuick }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_OpenKeep(Comport: Byte): Boolean;
begin
InitFailed := NOT Com_StartThread;
Com_OpenKeep := InitFailed;
end; { func. Com_OpenKeep }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
Parity: Char; StopBits: Byte): Boolean;
begin
Com_Open := true;
end; { func. TTelnetObj.Com_OpenCom }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
begin
// Duhhh ;)
end; { proc. TTelnetObj.Com_SetLine }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_Close;
begin
if DontClose then EXIT;
if ClientRC <> -1 then
begin
Com_StopThread;
SockShutdown(ClientRC, 02);
SockClose(ClientRC);
ClientRC := -1;
end; { if }
end; { func. TTelnetObj.Com_CloseCom }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_SendChar(C: Char): Boolean;
var Written: Longint;
begin
Com_SendBlock(C, SizeOf(C), Written);
Com_SendChar := (Written = SizeOf(c));
end; { proc. TTelnetObj.Com_SendChar }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_GetChar: Char;
var Reads: Longint;
begin
Com_ReadBlock(Result, SizeOf(Result), Reads);
end; { func. TTelnetObj.Com_GetChar }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_PeekChar: Char;
var Reads: Longint;
begin
Com_PeekBlock(Result, SizeOf(Result), Reads);
end; { func. TTelnetObj.Com_GetChar }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
begin
if OutBuffer^.BufRoom < BlockLen then
repeat
{$IFDEF WIN32}
Sleep(1);
{$ENDIF}
{$IFDEF OS2}
DosSleep(1);
{$ENDIF}
until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier);
CriticalTx^.EnterExclusive;
Written := OutBuffer^.Put(Block, BlockLen);
CriticalTx^.LeaveExclusive;
DoTxEvent^.SignalEvent;
end; { proc. TTelnetObj.Com_SendBlock }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
begin
if InBuffer^.BufUsed < BlockLen then
begin
DoRxEvent^.SignalEvent;
repeat
{$IFDEF OS2}
DosSleep(1);
{$ENDIF}
{$IFDEF WIN32}
Sleep(1);
{$ENDIF}
if Com_CharAvail then
DoRxEvent^.SignalEvent;
until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier);
end; { if }
Reads := InBuffer^.Get(Block, BlockLen, true);
end; { proc. TTelnetObj.Com_ReadBlock }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_PeekBlock(var Block; BlockLen: Longint; var Reads: Longint);
begin
if InBuffer^.BufUsed < BlockLen then
begin
DoRxEvent^.SignalEvent;
repeat
{$IFDEF OS2}
DosSleep(1);
{$ENDIF}
{$IFDEF WIN32}
Sleep(1);
{$ENDIF}
if Com_CharAvail then
DoRxEvent^.SignalEvent;
until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier);
end; { if }
Reads := InBuffer^.Get(Block, BlockLen, false);
end; { proc. TTelnetObj.Com_PeekBlock }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_CharAvail: Boolean;
begin
if InBuffer^.BufUsed < 1 then
begin
if (SockSelect(ClientRC) > 0) then
DoRxEvent^.SignalEvent;
end; { if }
Result := (InBuffer^.BufUsed > 0);
end; { func. TTelnetObj.Com_CharAvail }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_Carrier: Boolean;
begin
if TelnetCarrier then { Carrier is only lost in 'read' sections }
begin
DoRxEvent^.SignalEvent;
NeedNewCarrier := true;
end; { if }
Result := TelnetCarrier;
end; { func. TTelnetObj.Com_Carrier }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
begin
LineStatus := 00;
ModemStatus := 08;
if Com_Carrier then ModemStatus := ModemStatus OR (1 SHL 7);
end; { proc. TTelnetObj.Com_GetModemStatus }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_SetDtr(State: Boolean);
begin
if NOT State then
begin
Com_Close;
end; { if }
end; { proc. TTelnetObj.Com_SetDtr }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_GetBpsRate: Longint;
begin
Com_GetBpsRate := 115200;
end; { func. TTelnetObj.Com_GetBpsRate }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
begin
DoRxEvent^.SignalEvent;
DoTxEvent^.SignalEvent;
InFree := InBuffer^.BufRoom;
OutFree := OutBuffer^.BufRoom;
InUsed := InBuffer^.BufUsed;
OutUsed := OutBuffer^.BufUsed;
end; { proc. TTelnetObj.Com_GetBufferStatus }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_PurgeInBuffer;
begin
CriticalRx^.EnterExclusive;
InBuffer^.Clear;
CriticalRx^.LeaveExclusive;
end; { proc. TTelnetObj.Com_PurgeInBuffer }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_PurgeOutBuffer;
begin
CriticalTx^.EnterExclusive;
OutBuffer^.Clear;
CriticalTx^.LeaveExclusive;
end; { proc. TTelnetObj.Com_PurgeInBuffer }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TTelnetObj.Com_ReadyToSend(BlockLen: Longint): Boolean;
begin
Result := OutBuffer^.BufRoom >= BlockLen;
end; { func. ReadyToSend }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_PauseCom(CloseCom: Boolean);
begin
if CloseCom then Com_Close
else Com_StopThread;
end; { proc. Com_PauseCom }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_ResumeCom(OpenCom: Boolean);
begin
if OpenCom then Com_OpenKeep(0)
else Com_StartThread;
end; { proc. Com_ResumeCom }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_SetDataProc(ReadPtr, WritePtr: Pointer);
begin
ReadProcPtr := ReadPtr;
WriteProcPtr := WritePtr;
end; { proc. Com_SetDataProc }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
end.