home *** CD-ROM | disk | FTP | other *** search
/ synchro.net / synchro.net.tar / synchro.net / main / BBS / D32_01.ZIP / TELNET.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-05-20  |  23.8 KB  |  734 lines
  1. unit TELNET;
  2. {$h-}
  3. (*
  4. **
  5. ** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
  6. ** Tested with: TurboPascal   v7.0,    (DOS)
  7. **              VirtualPascal v2.0,    (OS/2, Win32)
  8. **              FreePascal    v0.99.12 (DOS, Win32)
  9. **              Delphi        v4.0.    (Win32)
  10. **
  11. ** Version : 1.01
  12. ** Created : 21-May-1998
  13. ** Last update : 04-Apr-1999
  14. **
  15. ** Note: (c) 1998-1999 by Maarten Bekers
  16. **
  17. *)
  18.  
  19. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  20.  INTERFACE
  21. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  22.  
  23. uses SockFunc, SockDef, Combase, BufUnit, Threads
  24.  
  25.      {$IFDEF WIN32}
  26.        ,Windows
  27.      {$ENDIF}
  28.  
  29.      {$IFDEF OS2}
  30.        ,Os2Base
  31.      {$ENDIF}
  32.  
  33.      {$IFDEF VirtualPascal}
  34.        ,Use32
  35.      {$ENDIF};
  36.  
  37. Const WriteTimeout   = 20000;                             { Wait max. 20 secs }
  38.       ReadTimeOut    = 20000;                   { General event, 20 secs max }
  39.  
  40.       InBufSize      = 1024 * 32;
  41.       OutBufSize     = 1024 * 32;
  42.  
  43.       ThreadsInitted : Boolean = false;
  44.       NeedNewCarrier : Boolean = false;
  45.       TelnetErrorStr : String = '';
  46.  
  47. type TTelnetObj = Object(TCommObj)
  48.         constructor Init;
  49.         destructor Done;
  50.  
  51.         function  Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
  52.                            Parity: Char; StopBits: Byte): Boolean; virtual;
  53.         function  Com_OpenKeep(Comport: Byte): Boolean; virtual;
  54.         function  Com_GetChar: Char; virtual;
  55.         function  Com_CharAvail: Boolean; virtual;
  56.         function  Com_Carrier: Boolean; virtual;
  57.         function  Com_SendChar(C: Char): Boolean; virtual;
  58.         function  Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
  59.         function  Com_GetBPSrate: Longint; virtual;
  60.         function  Com_GetHandle: Longint; virtual;
  61.  
  62.         procedure Com_OpenQuick(Handle: Longint); virtual;
  63.         procedure Com_Close; virtual;
  64.         procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
  65.         procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
  66.         procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
  67.         procedure Com_SetDtr(State: Boolean); virtual;
  68.         procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
  69.         procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
  70.         procedure Com_PurgeInBuffer; virtual;
  71.         procedure Com_PurgeOutBuffer; virtual;
  72.  
  73.         procedure Com_PauseCom(CloseCom: Boolean); virtual;
  74.         procedure Com_ResumeCom(OpenCom: Boolean); virtual;
  75.      end; { object TTelnetObj }
  76.  
  77. Type PTelnetObj = ^TTelnetObj;
  78.  
  79. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  80.  IMPLEMENTATION
  81. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  82.  
  83. uses SysUtils;
  84.  
  85. Const TelnetCarrier  : Boolean = true;
  86.  
  87. var ClientRC      : Longint;
  88.  
  89.     InBuffer      : ^BufArrayObj;             { Buffer system internally used }
  90.     OutBuffer     : ^BufArrayObj;
  91.  
  92.     DoTxEvent     : PSysEventObj; { Event manually set when we have to transmit }
  93.     DoRxEvent     : PSysEventObj;      { Event manually set when we need data }
  94.  
  95.     TxClosedEvent : PSysEventObj;    { Event set when the Tx thread is closed }
  96.     RxClosedEvent : PSysEventObj;    { Event set when the Rx thread is closed }
  97.  
  98.     CriticalTx    : PExclusiveObj;                        { Critical sections }
  99.     CriticalRx    : PExclusiveObj;
  100.  
  101.     TxThread      : PThreadsObj;           { The Transmit and Receive threads }
  102.     RxThread      : PThreadsObj;
  103.  
  104.     EndThreads    : Boolean;    { Set to true when we have to end the threads }
  105.  
  106. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  107.  
  108. Const
  109.   { Telnet Options }
  110.   TELNET_IAC   = #255;                                 { Interpret as Command }
  111.   TELNET_DONT  = #254;     { Stop performing, or not expecting him to perform }
  112.   TELNET_DO    = #253;                    { Perform, or expect him to perform }
  113.   TELNET_WONT  = #252;                                   { Refusal to perform }
  114.   TELNET_WILL  = #251;                                    { Desire to perform }
  115.  
  116.   TELNET_SB    = #250;   { What follow is sub-negotiation of indicated option }
  117.   TELNET_GA    = #249;                                      { Go ahead signal }
  118.   TELNET_EL    = #248;                                  { Erase Line function }
  119.   TELNET_EC    = #247;                             { Erase Character function }
  120.   TELNET_AYT   = #246;                               { Are You There function }
  121.   TELNET_AO    = #245;                                { Abort Output function }
  122.   TELNET_IP    = #244;                           { Interrupt Process function }
  123.   TELNET_BRK   = #243;                                  { NVT break character }
  124.   TELNET_DM    = #242;                       { Data stream portion of a Synch }
  125.   TELNET_NOP   = #241;                                         { No operation }
  126.   TELNET_SE    = #240;                    { End of sub-negotiation parameters }
  127.   TELNET_EOR   = #239;                                        { End of record }
  128.   TELNET_ABORT = #238;                                        { Abort process }
  129.   TELNET_SUSP  = #237;                              { Suspend current process }
  130.   TELNET_EOF   = #236;                                          { End of file }
  131.  
  132.   TELNETOPT_BINARY = #0;                                    { Transmit binary }
  133.   TELNETOPT_ECHO   = #1;                                          { Echo mode }
  134.   TELNETOPT_SUPGA  = #3;                                  { Suppress Go-Ahead }
  135.   TELNETOPT_TERM   = #24;                                     { Terminal Type }
  136.   TELNETOPT_SPEED  = #32;                                    { Terminal Speed }
  137.  
  138. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  139.  
  140. constructor TTelnetObj.Init;
  141. begin
  142.   inherited Init;
  143. end; { constructor Init }
  144.  
  145. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  146.  
  147. destructor TTelnetObj.Done;
  148. begin
  149.   inherited done;
  150. end; { destructor Done }
  151.  
  152. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  153.  
  154. procedure Com_SendRawStr(TempStr: String);
  155. begin
  156.   SockSend(ClientRC,
  157.            @TempStr[1],
  158.            Length(TempStr),
  159.            0);
  160. end; { proc. Com_SendRawStr }
  161.  
  162. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  163.  
  164. function SendWill(Option: Char): String;
  165. begin
  166.   Result[1] := TELNET_IAC;
  167.   Result[2] := TELNET_WILL;
  168.   Result[3] := Option;
  169.   SetLength(Result, 3);
  170. end; { func. SendWill }
  171.  
  172. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  173.  
  174. function SendWont(Option: Char): String;
  175. begin
  176.   Result[1] := TELNET_IAC;
  177.   Result[2] := TELNET_WONT;
  178.   Result[3] := Option;
  179.   SetLength(Result, 3);
  180. end; { func. SendWont }
  181.  
  182. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  183.  
  184. procedure PrepareBufferRead(var CurBuffer: CharBufType; var TempOut: BufArrayObj; BlockLen: Longint);
  185. var Counter   : Longint;
  186. begin
  187.   Counter := 00;
  188.   if BlockLen = 0 then EXIT;
  189.  
  190.   While Counter <= (Blocklen - 01) do
  191.     begin
  192.       Case CurBuffer[Counter] of
  193.         TELNET_IAC : begin                      { Escape command character }
  194.                        Inc(Counter);
  195.  
  196.                        if CurBuffer[Counter] = TELNET_IAC then
  197.                          begin
  198.                            TempOut.Put(CurBuffer[Counter], 1);
  199.                          end
  200.                           else Case CurBuffer[Counter] of
  201.                                   TELNET_DONT,
  202.                                   TELNET_DO   : begin
  203.                                                   Inc(Counter);
  204.  
  205.                                                   Case CurBuffer[Counter] of
  206.                                                     TELNETOPT_BINARY,
  207.                                                     TELNETOPT_ECHO   : begin
  208.                                                                          Com_SendRawStr(SendWill(CurBuffer[Counter]));
  209.                                                                        end
  210.                                                        else begin
  211.                                                               Com_SendRawStr(SendWont(CurBuffer[Counter]));
  212.                                                             end; { if }
  213.                                                   end; { case }
  214.                                                 end;
  215.                                end; { case }
  216.  
  217.                      end; { if }
  218.           else begin
  219.                  TempOut.Put(CurBuffer[Counter], 1);
  220.                end; { if }
  221.       end; { case }
  222.  
  223.       Inc(Counter);
  224.     end; { while }
  225.  
  226. end; { proc. PrepareBufferRead }
  227.  
  228. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  229.  
  230. procedure PrepareBufferWrite(var CurBuffer, OutBuffer: CharBufType; var BlockLen: Longint);
  231. var Counter   : Longint;
  232.     TempStr   : String;
  233.     NewCounter: Longint;
  234. begin
  235.   Counter := 00;
  236.   NewCounter := 00;
  237.   if BlockLen = 0 then EXIT;
  238.  
  239.   While Counter <= Blocklen do
  240.     begin
  241.       Case CurBuffer[Counter] of
  242.         TELNET_IAC : begin                        { Escape command character }
  243.                        TempStr := TELNET_IAC + TELNET_IAC;
  244.  
  245.                        OutBuffer[NewCounter] := TELNET_IAC;
  246.                        Inc(NewCounter);
  247.                        OutBuffer[NewCounter] := TELNET_IAC;
  248.                        Inc(NewCounter);
  249.                      end; { if }
  250.           else begin
  251.                  OutBuffer[NewCounter] := CurBuffer[Counter];
  252.                  Inc(NewCounter);
  253.                end; { if }
  254.       end; { case }
  255.  
  256.       Inc(Counter);
  257.     end; { while }
  258.  
  259.   BlockLen := NewCounter - 1;
  260. end; { proc. PrepareBufferWrite }
  261.  
  262. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  263.  
  264. procedure ComReadProc(var TempPtr: Pointer);
  265. var Available : Boolean;
  266.     BytesRead : Longint;
  267.     BlockLen  : Longint;
  268.     ReturnCode: Longint;
  269. begin
  270.   repeat
  271.      if DoRxEvent^.WaitForEvent(ReadTimeOut) then
  272.       if NOT EndThreads then
  273.        begin
  274.          CriticalRx^.EnterExclusive;
  275.          Available := (SockSelect(ClientRC) > 00);
  276.  
  277.          DoRxEvent^.ResetEvent;
  278.  
  279.          if (Available) OR (NeedNewCarrier) then
  280.           begin
  281.             {----------- Start reading the gathered date -------------------}
  282.             NeedNewCarrier := false;
  283.  
  284.             if InBuffer^.BufRoom > 0 then
  285.               begin
  286.                 BlockLen := InBuffer^.BufRoom;
  287.                 if BlockLen > 1024 then
  288.                   BlockLen := 1024;
  289.  
  290.                 if BlockLen > 00 then
  291.                  begin
  292.                    BytesRead := SockRecv(ClientRC,
  293.                                          InBuffer^.TmpBuf,
  294.                                          BlockLen,
  295.                                          0);
  296.  
  297.                    if BytesRead = 0 then
  298.                      begin
  299.                        TelnetCarrier := false;
  300.  
  301.                        ReturnCode := SockErrorNo;
  302.                        TelnetErrorStr := 'Error in communications(1), #'+IntToStr(Returncode)+ ' / '+SysErrorMessage(Returncode);
  303.                      end; { if }
  304.  
  305.                    if BytesRead = -1 then
  306.                     begin
  307.                        ReturnCode := SockErrorNo;
  308.  
  309.                        if ReturnCode <> WSAEWOULDBLOCK then
  310.                          begin
  311.                            TelnetCarrier := false;
  312.  
  313.                            TelnetErrorStr := 'Error in communications(2), #'+IntToStr(ReturnCode)+ ' / '+SysErrorMessage(ReturnCode);
  314.                            EndThreads := true;
  315.                          end; { if }
  316.                     end; { error }
  317.  
  318.                   if BytesRead > 00 then
  319.                     begin
  320.                       PrepareBufferRead(InBuffer^.TmpBuf^, InBuffer^, BytesRead);
  321.                     end; { if }
  322.                  end; { if }
  323.               end; { if }
  324.           end; { if available }
  325.  
  326.          CriticalRx^.LeaveExclusive;
  327.        end; { if RxEvent }
  328.   until EndThreads;
  329.  
  330.   RxClosedEvent^.SignalEvent;
  331.   ExitThisThread;
  332. end; { proc. ComReadProc }
  333.  
  334. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  335.  
  336. procedure ComWriteProc(var TempPtr: Pointer);
  337. var BlockLen    : Longint;
  338.     Written     : Longint;
  339.     ReturnCode  : Longint;
  340.     TempBuf     : ^CharBufType;
  341. begin
  342.   New(TempBuf);
  343.  
  344.   repeat
  345.      if DoTxEvent^.WaitForEvent(WriteTimeOut) then
  346.       if NOT EndThreads then
  347.        begin
  348.          CriticalTx^.EnterExclusive;
  349.          DoTxEvent^.ResetEvent;
  350.  
  351.          if OutBuffer^.BufUsed > 00 then
  352.            begin
  353.              Written := 00;
  354.              BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf^, OutBuffer^.BufUsed, false);
  355.  
  356.              PrepareBufferWrite(OutBuffer^.TmpBuf^, TempBuf^, BlockLen);
  357.              Written := SockSend(ClientRC,
  358.                                  TempBuf,
  359.                                  BlockLen,
  360.                                  0);
  361.  
  362.              ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf^, Written, true);
  363.              if Written <> BlockLen then
  364.                begin
  365.                   DoTxEvent^.SignalEvent;
  366.                end; { if }
  367.            end; { if }
  368.  
  369.          CriticalTx^.LeaveExclusive;
  370.        end; { if }
  371.  
  372.   until EndThreads;
  373.  
  374.   Dispose(TempBuf);
  375.  
  376.   TxClosedEvent^.SignalEvent;
  377.   ExitThisThread;
  378. end; { proc. ComWriteProc }
  379.  
  380. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  381.  
  382. function Com_StartThread: Boolean;
  383. begin
  384.   Result := false;
  385.   EndThreads := false;
  386.   if ThreadsInitted then EXIT;
  387.   ThreadsInitted := true;
  388.  
  389.   {----------------------- Create all the events ----------------------------}
  390.   New(DoTxEvent, Init);
  391.   if NOT DoTxEvent^.CreateEvent(true) then EXIT;
  392.  
  393.   New(DoRxEvent, Init);
  394.   if NOT DoRxEvent^.CreateEvent(true) then EXIT;
  395.  
  396.   New(RxClosedEvent, Init);
  397.   if NOT RxClosedEvent^.CreateEvent(false) then EXIT;
  398.  
  399.   New(TxClosedEvent, Init);
  400.   if NOT TxClosedEvent^.CreateEvent(false) then EXIT;
  401.  
  402.  
  403.   {-------------- Startup the buffers and overlapped events -----------------}
  404.   New(InBuffer, Init(InBufSize));
  405.   New(OutBuffer, Init(OutBufSize));
  406.  
  407.   if (InBuffer^.TxtArr=nil) OR (InBuffer^.TmpBuf=nil) then EXIT;
  408.   if (OutBuffer^.TxtArr=nil) OR (OutBuffer^.TmpBuf=nil) then EXIT;
  409.  
  410.   {-------------------- Startup a seperate write thread ---------------------}
  411.   New(CriticalTx, Init);
  412.   CriticalTx^.CreateExclusive;
  413.  
  414.   New(TxThread, Init);
  415.   if NOT TxThread^.CreateThread(16384,                            { Stack size }
  416.                                @ComWriteProc,              { Actual procedure }
  417.                                nil,                              { Parameters }
  418.                                0)                            { Creation flags }
  419.                                  then EXIT;
  420.  
  421.   {-------------------- Startup a seperate read thread ----------------------}
  422.   New(CriticalRx, Init);
  423.   CriticalRx^.CreateExclusive;
  424.  
  425.   New(RxThread, Init);
  426.   if NOT RxThread^.CreateThread(16384,                            { Stack size }
  427.                                @ComReadProc,               { Actual procedure }
  428.                                nil,                              { Parameters }
  429.                                0)                            { Creation flags }
  430.                                  then EXIT;
  431.  
  432.   Result := true;
  433. end; { proc. Com_StartThread }
  434.  
  435. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  436.  
  437. procedure Com_InitVars;
  438. begin
  439.   DoTxEvent := nil;
  440.   DoRxEvent := nil;
  441.   RxClosedEvent := nil;
  442.   TxClosedEvent := nil;
  443.   TxThread := nil;
  444.   RxThread := nil;
  445.  
  446.   InBuffer := nil;
  447.   OutBuffer := nil;
  448.   CriticalRx := nil;
  449.   CriticalTx := nil;
  450. end; { proc. Com_InitVars }
  451.  
  452. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  453.  
  454. procedure Com_StopThread;
  455. begin
  456.   EndThreads := true;
  457.   ThreadsInitted := false;
  458.  
  459.   if DoTxEvent <> nil then DoTxEvent^.SignalEvent;
  460.   if DoTxEvent <> nil then DoRxEvent^.SignalEvent;
  461.  
  462.   if TxThread <> nil then TxThread^.CloseThread;
  463.   if RxThread <> nil then RxThread^.CloseThread;
  464.  
  465.   if TxClosedEvent <> nil then
  466.    if NOT TxClosedEvent^.WaitForEvent(1000) then
  467.      TxThread^.TerminateThread(0);
  468.  
  469.   if RxClosedEvent <> nil then
  470.    if NOT RxClosedEvent^.WaitForEvent(1000) then
  471.      RxThread^.TerminateThread(0);
  472.  
  473.   if TxThread <> nil then Dispose(TxThread, Done);
  474.   if RxThread <> nil then Dispose(RxThread, Done);
  475.  
  476.   if DoTxEvent <> nil then Dispose(DoTxEvent, Done);
  477.   if DoRxEvent <> nil then Dispose(DoRxEvent, Done);
  478.   if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done);
  479.   if TxClosedEvent <> nil then Dispose(TxClosedEvent, Done);
  480.  
  481.   if CriticalTx <> nil then Dispose(CriticalTx, Done);
  482.   if CriticalRx <> nil then Dispose(CriticalRx, Done);
  483.  
  484.   if InBuffer <> nil then Dispose(InBuffer, Done);
  485.   if OutBuffer <> nil then Dispose(OutBuffer, Done);
  486.  
  487.   Com_InitVars;
  488. end; { proc. Com_StopThread }
  489.  
  490. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  491.  
  492. function TTelnetObj.Com_GetHandle: Longint;
  493. begin
  494.   Result := ClientRC;
  495. end; { func. Com_GetHandle }
  496.  
  497. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  498.  
  499. procedure TTelnetObj.Com_OpenQuick(Handle: Longint);
  500. var ReturnCode: Longint;
  501. begin
  502.   ClientRC := Handle;
  503.  
  504.   if (NOT (SockInit=0)) then
  505.     begin
  506.       ReturnCode := SockErrorNo;
  507.  
  508.       TelnetErrorStr := 'Error in initializing socket, #'+IntToStr(Returncode)+ ' / '+SysErrorMessage(Returncode);
  509.       InitFailed := true;
  510.     end else
  511.       InitFailed := NOT Com_StartThread;
  512.  
  513.   { Set the telnet to binary transmission }
  514.   Com_SendRawStr(SendWill(TELNETOPT_ECHO));
  515.   Com_SendRawStr(SendWill(TELNETOPT_BINARY));
  516. end; { proc. TTelnetObj.Com_OpenQuick }
  517.  
  518. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  519.  
  520. function TTelnetObj.Com_OpenKeep(Comport: Byte): Boolean;
  521. begin
  522.   InitFailed := NOT Com_StartThread;
  523.   Com_OpenKeep := InitFailed;
  524. end; { func. Com_OpenKeep }
  525.  
  526. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  527.  
  528. function TTelnetObj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
  529.                             Parity: Char; StopBits: Byte): Boolean;
  530. begin
  531.   Com_Open := true;
  532. end; { func. TTelnetObj.Com_OpenCom }
  533.  
  534. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  535.  
  536. procedure TTelnetObj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
  537. begin
  538.   // Duhhh ;)
  539. end; { proc. TTelnetObj.Com_SetLine }
  540.  
  541. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  542.  
  543. procedure TTelnetObj.Com_Close;
  544. begin
  545.   if DontClose then EXIT;
  546.  
  547.   if ClientRC <> -1 then
  548.     begin
  549.       Com_StopThread;
  550.       SockShutdown(ClientRC, 02);
  551.       SockClose(ClientRC);
  552.  
  553.       ClientRC := -1;
  554.     end; { if }
  555.  
  556. end; { func. TTelnetObj.Com_CloseCom }
  557.  
  558. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  559.  
  560. function TTelnetObj.Com_SendChar(C: Char): Boolean;
  561. var Written: Longint;
  562. begin
  563.   Com_SendBlock(C, SizeOf(C), Written);
  564.   Com_SendChar := (Written = SizeOf(c));
  565. end; { proc. TTelnetObj.Com_SendChar }
  566.  
  567. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  568.  
  569. function TTelnetObj.Com_GetChar: Char;
  570. var Reads: Longint;
  571. begin
  572.   Com_ReadBlock(Result, SizeOf(Result), Reads);
  573. end; { func. TTelnetObj.Com_GetChar }
  574.  
  575. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  576.  
  577. procedure TTelnetObj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
  578. begin
  579.   if OutBuffer^.BufRoom < BlockLen then
  580.    repeat
  581.     {$IFDEF WIN32}
  582.       Sleep(1);
  583.     {$ENDIF}
  584.  
  585.     {$IFDEF OS2}
  586.       DosSleep(1);
  587.     {$ENDIF}
  588.    until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier);
  589.  
  590.   CriticalTx^.EnterExclusive;
  591.     Written := OutBuffer^.Put(Block, BlockLen);
  592.   CriticalTx^.LeaveExclusive;
  593.  
  594.   DoTxEvent^.SignalEvent;
  595. end; { proc. TTelnetObj.Com_SendBlock }
  596.  
  597. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  598.  
  599. procedure TTelnetObj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
  600. begin
  601.   if InBuffer^.BufUsed < BlockLen then
  602.     begin
  603.       DoRxEvent^.SignalEvent;
  604.  
  605.       repeat
  606.         {$IFDEF OS2}
  607.           DosSleep(1);
  608.         {$ENDIF}
  609.  
  610.         {$IFDEF WIN32}
  611.           Sleep(1);
  612.         {$ENDIF}
  613.       until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier);
  614.     end; { if }
  615.  
  616.   Reads := InBuffer^.Get(Block, BlockLen, true);
  617. end; { proc. TTelnetObj.Com_ReadBlock }
  618.  
  619. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  620.  
  621. function TTelnetObj.Com_CharAvail: Boolean;
  622. begin
  623.   if InBuffer^.BufUsed < 1 then DoRxEvent^.SignalEvent;
  624.  
  625.   Result := (InBuffer^.BufUsed > 0);
  626. end; { func. TTelnetObj.Com_CharAvail }
  627.  
  628. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  629.  
  630. function TTelnetObj.Com_Carrier: Boolean;
  631. begin
  632.   if TelnetCarrier then             { Carrier is only lost in 'read' sections }
  633.     begin
  634.       DoRxEvent^.SignalEvent;
  635.       NeedNewCarrier := true;
  636.     end; { if }
  637.  
  638.   Result := TelnetCarrier;
  639. end; { func. TTelnetObj.Com_Carrier }
  640.  
  641. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  642.  
  643. procedure TTelnetObj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
  644. begin
  645.   LineStatus := 00;
  646.   ModemStatus := 08;
  647.  
  648.   if Com_Carrier then ModemStatus := ModemStatus OR (1 SHL 7);
  649. end; { proc. TTelnetObj.Com_GetModemStatus }
  650.  
  651. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  652.  
  653. procedure TTelnetObj.Com_SetDtr(State: Boolean);
  654. begin
  655.   if NOT State then
  656.     begin
  657.       Com_Close;
  658.     end; { if }
  659. end; { proc. TTelnetObj.Com_SetDtr }
  660.  
  661. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  662.  
  663. function TTelnetObj.Com_GetBpsRate: Longint;
  664. begin
  665.   Com_GetBpsRate := 115200;
  666. end; { func. TTelnetObj.Com_GetBpsRate }
  667.  
  668. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  669.  
  670. procedure TTelnetObj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
  671. begin
  672.   DoRxEvent^.SignalEvent;
  673.   DoTxEvent^.SignalEvent;
  674.  
  675.   InFree := InBuffer^.BufRoom;
  676.   OutFree := OutBuffer^.BufRoom;
  677.   InUsed := InBuffer^.BufUsed;
  678.   OutUsed := OutBuffer^.BufUsed;
  679. end; { proc. TTelnetObj.Com_GetBufferStatus }
  680.  
  681. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  682.  
  683. procedure TTelnetObj.Com_PurgeInBuffer;
  684. begin
  685.   CriticalRx^.EnterExclusive;
  686.  
  687.   InBuffer^.Clear;
  688.  
  689.   CriticalRx^.LeaveExclusive;
  690. end; { proc. TTelnetObj.Com_PurgeInBuffer }
  691.  
  692. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  693.  
  694. procedure TTelnetObj.Com_PurgeOutBuffer;
  695. begin
  696.   CriticalTx^.EnterExclusive;
  697.  
  698.   OutBuffer^.Clear;
  699.  
  700.   CriticalTx^.LeaveExclusive;
  701. end; { proc. TTelnetObj.Com_PurgeInBuffer }
  702.  
  703. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  704.  
  705. function TTelnetObj.Com_ReadyToSend(BlockLen: Longint): Boolean;
  706. begin
  707.   Result := OutBuffer^.BufRoom >= BlockLen;
  708. end; { func. ReadyToSend }
  709.  
  710. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  711.  
  712. procedure TTelnetObj.Com_PauseCom(CloseCom: Boolean);
  713. begin
  714.   if CloseCom then Com_Close
  715.     else Com_StopThread;
  716. end; { proc. Com_PauseCom }
  717.  
  718. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  719.  
  720. procedure TTelnetObj.Com_ResumeCom(OpenCom: Boolean);
  721. begin
  722.   if OpenCom then Com_OpenKeep(0)
  723.     else Com_StartThread;
  724. end; { proc. Com_ResumeCom }
  725.  
  726. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  727.  
  728. initialization
  729.   Com_Initvars;
  730.  
  731. finalization
  732.   Com_StopThread;
  733. end. { unit TELNET }
  734.