awwnsock.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   AWWNSOCK.PAS 4.06                   *}
{*********************************************************}
{* Winsock device layer and dispatcher                   *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$X+,F+,K+,B-,T-}
{$IFDEF Win32}
 {$J+}
{$ENDIF}

unit AwWnsock;
  { -Device layer for Winsock API }

interface

uses
  WinTypes,
  WinProcs,
  Classes,
  SysUtils,
  AdWUtil,
  AdSocket,
  OoMisc,
  awUser;

const
  DefAsyncStyles = FD_READ or FD_WRITE or FD_ACCEPT or FD_CONNECT or FD_CLOSE;
  DefWsTerminal = 'vt100';
  DefOptSupga  = True;
  DefOptEcho   = True;

  { Telnet Commands }
  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 (DATAMARK) }
  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 }

  TELNET_NULL  = #0;
  TELNET_LF    = #10;
  TELNET_CR    = #13;                                               

  { Telnet Options }
  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 }

type
  PServerClientRec = ^TServerClientRec;
  TServerClientRec = record
    ServerSocket : TSocket;
    ClientSocket : TSocket;
  end;

  TWsConnectionState = (wcsInit, wcsConnected);

  TTelnetOpt = (tnoFalse, tnoNegotiating, tnoTrue);                

  TApdWinsockDispatcher = class;

  TWsConnection = class(TComponent)
  private
    FSimBuf : Cardinal;                                               
    FCommSocket : TSocket;        { Socket which the IO goes through }
    FDispatcher : TApdWinsockDispatcher; { Pointer to the associated ComRec }
    FConnectionState : TWsConnectionState;
    FInBuf : PChar;               { Pointer to input buffer }
    FInBufEnd : PChar;            { Sentinel at end of input buffer }
    FInBufFull : Boolean;         { Flag set when buffer is full }
    FInSize : Cardinal;           { Size of input buffer }
    FInStart : PChar;             { Pointer to first character of data }
    FInCursor : PChar;            { Pointer to first char to be telnet checked }
    FInEnd : PChar;               { Pointer to first free character in buffer }
    FIsClient : Boolean;          { True if socket is a client -- false if server }
    FIsTelnet : Boolean;          { True if telnet parsing should be done }
    FOutBuf : PChar;              { Pointer to output buffer }
    FOutBufEnd : PChar;           { Sentinel at end of output buffer }
    FOutBufFull : Boolean;        { Flag set when buffer is full }
    FOutSize : Cardinal;          { Size of output buffer }
    FOutStart : PChar;            { Pointer to first character of data }
    FOutEnd : PChar;              { Pointer to first free character in buffer }
    FSocketHandle : TSocket;      { Socket that is associated with the comport }
    FOptBinary : TTelnetOpt;
    FOptSupga  : TTelnetOpt;
    FOptEcho   : TTelnetOpt;
  protected
    function GetConnected : Boolean;
    function GetInChars : Cardinal;
    function GetOutChars : Cardinal;
    procedure SetConnectionState(Value : TWsConnectionState);
  public
    constructor CreateInit(AOwner: TComponent; InSize, OutSize : Cardinal); virtual;
    destructor Destroy; override;
    function FindIAC(Start : PChar; Size : Cardinal) : PChar;
    procedure FlushInBuffer;
    procedure FlushOutBuffer;
    function HandleCommand(Command, Option : Char) : Boolean;         
    function ProcessCommands(Dest : PChar; Size : Cardinal) : Integer;
    function ReadBuf(var Buf; Size : Integer) : Integer;
    procedure SendDo(Option: Char);
    procedure SendDont(Option: Char);
    procedure SendWill(Option: Char);
    procedure SendWont(Option: Char);
    procedure SendTerminal;
    function Shutdown : Integer;
    function WriteBuf(var Buf; Size : Integer) : Integer;
    property CommSocket : TSocket read FCommSocket;
    property Connected : Boolean read GetConnected;
    property ConnectionState : TWsConnectionState
      read FConnectionState write SetConnectionState;
    property InChars : Cardinal read GetInChars;
    property InSize : Cardinal read FInSize;
    property IsClient : Boolean read FIsClient write FIsClient;
    property IsTelnet : Boolean read FIsTelnet write FIsTelnet;
    property OutChars : Cardinal read GetOutChars;
    property OutSize : Cardinal read FOutSize;
    property SocketHandle : TSocket read FSocketHandle;
  end;


  TApdDeviceSocket = class(TApdSocket)
  private
    FWsTerminal : string;
    {$IFDEF Win32}
    SockSection : TRTLCriticalSection;                               
    {$ENDIF}
  protected
    function DoDispMessage(Socket : TSocket; Event : Cardinal; LP : LongInt) : LongInt;
    function DoWsMessage(Socket : TSocket; Event : Cardinal; LP : LongInt) : LongInt;
    procedure DoAccept(Socket : TSocket); override;
    procedure DoConnect(Socket : TSocket); override;
    procedure DoDisconnect(Socket : TSocket); override;
    procedure DoError(Socket : TSocket; ErrCode : Integer); override;
    procedure DoRead(Socket : TSocket); override;
    procedure DoWrite(Socket : TSocket); override;
    function TweakSocket(Socket : TSocket) : TSocket;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {$IFDEF Win32}
    procedure LockList;                                               
    procedure UnLockList;                                            
    {$ENDIF}
    function FindConnection(Socket : TSocket) : TWsConnection;
    property WsTerminal : string read FWsTerminal write FWsTerminal;
  end;

  TApdWinsockDispatcher = class(TApdBaseDispatcher)
  private
    InDispatcher : Boolean;
    WsSockAddr : TSockAddrIn;
    WsHostAddr : TSockAddrIn;
    WsIsClient : Boolean;
    WsIsTelnet : Boolean;
  protected
    function EscapeComFunction(Func : Integer) : LongInt; override;
    function FlushCom(Queue : Integer) : Integer; override;
    function GetComError(var Stat : TComStat) : Integer; override;
    function GetComEventMask(EvtMask : Integer) : Cardinal; override;
    function GetComState(var DCB: TDCB): Integer; override;
    {$IFNDEF Win32}
    function SetComEventMask(EvtMask : Cardinal) : PWord; override;
    {$ENDIF}
    function SetComState(var DCB : TDCB) : Integer; override;
    procedure StartDispatcher; override;
    procedure StopDispatcher; override;
    function ReadCom(Buf : PChar; Size: Integer) : Integer; override;
    function WriteCom(Buf : PChar; Size: Integer) : Integer; override;
    {$IFNDEF Win32}
    procedure SetMsrShadow(OnOff : Boolean); override;
    {$ENDIF}
    function SetupCom(InSize, OutSize : Integer) : Boolean; override;
    {$IFDEF Win32}
    function WaitComEvent(var EvtMask : DWORD;
      lpOverlapped : POverlapped) : Boolean; override;
    {$ENDIF}
    function Dispatcher(Msg : Cardinal;
                         wParam : Cardinal; lParam : LongInt) : Cardinal;
  public
    function CloseCom : Integer; override;
    procedure InitSocketData(LocalAddress, Address : Longint; Port : Cardinal;
      IsClient, IsTelnet : Boolean);
    function OpenCom(ComName: PChar; InQueue,
      OutQueue : Cardinal) : Integer; override;
    function ProcessCommunications : Integer; override;              
  end;

var
  ApdSocket : TApdDeviceSocket;

implementation
uses
  AdPort;

{ TWsConnection methods }

{ Create and initialize connection -- owner is assumed to be a TApdDeviceSocket }
constructor TWsConnection.CreateInit(AOwner: TComponent; InSize, OutSize : Cardinal);
begin
  inherited Create(AOwner);
  FSocketHandle := TApdDeviceSocket(Owner).CreateSocket;
  { Create input buffer, and initialize -- full flag is already False }
  GetMem(FInBuf, InSize);
  FInSize := InSize;
  FInBufEnd := FInBuf + FInSize;
  FInStart := FInBuf;
  FInEnd := FInBuf;
  FInCursor := FInBuf;
  { Create output buffer, and initialize -- full flag is already False }
  { Extra space for telnet escaping }
  GetMem(FOutBuf, OutSize + 4096);
  FOutSize := OutSize + 4096;                                    
  FOutBufEnd := FOutBuf + FOutSize;
  FOutStart := FOutBuf;
  FOutEnd := FOutBuf;
  { Other inits }
  FCommSocket := SOCKET_ERROR;
  ConnectionState := wcsInit;
end;

function TWsConnection.FindIAC(Start : PChar; Size : Cardinal) : PChar;
var
  I : Cardinal;
begin
  if FIsTelnet then begin
    Result := Start;
  end else begin
    Result := Start + Size;
    Exit;
  end;
  for I := 0 to Size do begin
    if (Result^ = TELNET_IAC) then Exit;
    if (FOptBinary = tnoFalse) and (Result^ = TELNET_CR) then Exit;  
    Result := (Start + I);
  end;
end;

{ Flush local input buffer }
procedure TWsConnection.FlushInBuffer;
begin
  FInStart := FInBuf;
  FInCursor := FInBuf;
  FInEnd := FInBuf;
  FInBufFull := False;
end;

{ Flush local output buffer }
procedure TWsConnection.FlushOutBuffer;
begin
  FOutStart := FOutBuf;
  FOutEnd := FOutBuf;
  FOutBufFull := False;
end;

{ Handle a telnet command - result is True if negotation command }
function TWsConnection.HandleCommand(Command, Option : Char) : Boolean; 
begin
  Result := True;
  case Command of
    TELNET_DONT :
    begin
      if FDispatcher.DLoggingOn then
        FDispatcher.AddDispatchEntry(dtTelnet, dstRDont, Ord(Option), nil, 0);
      case Option of
        TELNETOPT_BINARY :
        begin
          if FOptBinary <> tnoNegotiating then
            SendWont(Option);
          FOptBinary := tnoFalse;
        end;
        TELNETOPT_SUPGA  :
        begin
          if FOptSupga <> tnoNegotiating then
            SendWont(Option);
          FOptSupga := tnoFalse;
        end else begin
          SendWont(Option);
        end;
      end;
    end;
    TELNET_DO :
    begin
      if FDispatcher.DLoggingOn then
        FDispatcher.AddDispatchEntry(dtTelnet, dstRDo, Ord(Option), nil, 0);
      case Option of
        TELNETOPT_BINARY :
        begin
          if FOptBinary <> tnoNegotiating then
            SendWill(Option);
          FOptBinary := tnoTrue;
        end;
        TELNETOPT_SUPGA  :
        begin
          if FOptSupga <> tnoNegotiating then begin
            if FOptSupga = tnoTrue then begin
              SendWill(Option);
            end else begin
              SendWont(Option);
            end;
          end else begin
            FOptSupga := tnoTrue;
          end;
        end;
        TELNETOPT_TERM   :
        begin
          SendWill(Option);
        end;
        TELNETOPT_SPEED  :
        begin
          SendWont(Option);
        end;
        TELNETOPT_ECHO   :
        begin
          SendWont(Option);
        end else begin
          SendWont(Option);
        end;
      end;
    end;
    TELNET_WONT :
    begin
      if FDispatcher.DLoggingOn then
        FDispatcher.AddDispatchEntry(dtTelnet, dstRWont, Ord(Option), nil, 0);
      case Option of
        TELNETOPT_BINARY :
        begin
          if FOptBinary <> tnoNegotiating then
            SendDont(Option);
          FOptBinary := tnoFalse;
        end;
        TELNETOPT_SUPGA  :
        begin
          if FOptSupga <> tnoNegotiating then
            SendDont(Option);
          FOptSupga := tnoFalse;
        end;
        TELNETOPT_ECHO   :
        begin
          if FOptEcho <> tnoNegotiating then
            SendDont(Option);
          FOptEcho := tnoFalse;
        end else begin
          SendDont(Option);
        end;
      end;
    end;
    TELNET_WILL :
    begin
      if FDispatcher.DLoggingOn then
        FDispatcher.AddDispatchEntry(dtTelnet, dstRWill, Ord(Option), nil, 0);
      case Option of
        TELNETOPT_BINARY :
        begin
          if FOptBinary <> tnoNegotiating then
            SendDo(Option);
          FOptBinary := tnoTrue;
        end;
        TELNETOPT_SUPGA  :
        begin