864 lines
28 KiB
Plaintext
864 lines
28 KiB
Plaintext
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.
|