?? telnet.pas
字號:
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
**
*)
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
INTERFACE
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
uses SockFunc, SockDef, Combase, BufUnit, Threads
{$IFDEF WIN32}
,Windows
{$ENDIF}
{$IFDEF OS2}
,Os2Base
{$ENDIF}
{$IFDEF VirtualPascal}
,Use32
{$ENDIF};
Const WriteTimeout = 20000; { Wait max. 20 secs }
ReadTimeOut = 20000; { General event, 20 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;
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_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_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;
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;
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
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 }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
constructor TTelnetObj.Init;
begin
inherited Init;
ThreadsInitted := false;
NeedNewCarrier := true;
TelnetCarrier := TRUE;
Com_InitVars;
end; { constructor Init }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
destructor TTelnetObj.Done;
begin
inherited done;
end; { destructor Done }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_SendRawStr(TempStr: String);
begin
SockSend(ClientRC,
@TempStr[1],
Length(TempStr),
0);
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 }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
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
Case CurBuffer[Counter] of
TELNET_IAC : begin { Escape command character }
Inc(Counter);
if CurBuffer[Counter] = TELNET_IAC then
begin
TempOut.Put(CurBuffer[Counter], 1);
end
else Case CurBuffer[Counter] of
TELNET_DONT,
TELNET_DO : begin
Inc(Counter);
Case CurBuffer[Counter] of
TELNETOPT_BINARY,
TELNETOPT_ECHO : begin
Com_SendRawStr(Com_SendWill(CurBuffer[Counter]));
end
else begin
Com_SendRawStr(Com_SendWont(CurBuffer[Counter]));
end; { if }
end; { case }
end;
end; { case }
end; { if }
else begin
TempOut.Put(CurBuffer[Counter], 1);
end; { if }
end; { case }
Inc(Counter);
end; { while }
end; { proc. Com_PrepareBufferRead }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TTelnetObj.Com_PrepareBufferWrite(var CurBuffer, TmpOutBuffer: CharBufType; var BlockLen: Longint);
var Counter : Longint;
TempStr : String;
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 }
TempStr := TELNET_IAC + TELNET_IAC;
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
Written := 00;
BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf^, OutBuffer^.BufUsed, false);
Com_PrepareBufferWrite(OutBuffer^.TmpBuf^, TempBuf^, BlockLen);
Written := SockSend(ClientRC,
TempBuf,
BlockLen,
0);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -