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.