awwnsock.pas

测试用例

end;

{ Send Telnet Terminal type }
procedure TWsConnection.SendTerminal;
var
  Temp : string;
begin
  Temp := TELNET_IAC + TELNET_SB + TELNETOPT_TERM + #0 +
    ApdSocket.WsTerminal + TELNET_IAC + TELNET_SE;
  ApdSocket.WriteSocket(FCommSocket, Temp[1], Length(Temp), 0);
  if FDispatcher.DLoggingOn then
    FDispatcher.AddDispatchEntry(dtTelnet, dstSTerm, 0, @ApdSocket.FWsTerminal[1],
      Length(ApdSocket.WsTerminal));
end;

{ Send Telnet WILL command with option }
procedure TWsConnection.SendWill(Option: Char);
var
  Buf : array[1..3] of Char;
begin
  Buf[1] := TELNET_IAC;
  Buf[2] := TELNET_WILL;
  Buf[3] := Option;
  ApdSocket.WriteSocket(FCommSocket, Buf, SizeOf(Buf), 0);
  if FDispatcher.DLoggingOn then
    FDispatcher.AddDispatchEntry(dtTelnet, dstSWill, Ord(Option), nil, 0);
end;

{ Send Telnet WONT command with option }
procedure TWsConnection.SendWont(Option: Char);
var
  Buf : array[1..3] of Char;
begin
  Buf[1] := TELNET_IAC;
  Buf[2] := TELNET_WONT;
  Buf[3] := Option;
  ApdSocket.WriteSocket(FCommSocket, Buf, SizeOf(Buf), 0);
  if FDispatcher.DLoggingOn then
    FDispatcher.AddDispatchEntry(dtTelnet, dstSWont, Ord(Option), nil, 0);
end;

{ Shuts down the connection }
function TWsConnection.Shutdown : Integer;
begin
  with ApdSocket do begin
    { If we have a client connected, shut it down first }
    if not FIsClient and (FCommSocket <> SOCKET_ERROR) then          
      CloseSocket(FCommSocket);
    CloseSocket(FSocketHandle);
  end;
  Result := 0;
end;

function TWsConnection.WriteBuf(var Buf; Size : Integer) : Integer;
var
  Start, Cursor, SrcPtr, DestPtr, EndBuf : PChar;
  CanMove, CanMove2 : Integer;
  Sent : Integer;
begin
  Inc(FSimBuf, Size);                                               
  Start := @Buf;
  Result := 0;
  if Size > 0 then begin
    if FIsTelnet then
      Cursor := FindIAC(Start, Size)
    else
      Cursor := (Start + Size);
    if not FOutBufFull then begin
      if (Cursor - Start) = Size then begin
        { No IACs -- move as much of the buffer as possible }
        if FOutEnd >= FOutStart then begin
          { Not wrapped }
          CanMove := (FOutBufEnd - FOutEnd);
          if Size > CanMove then begin
            { Need to wrap }
            Move(Buf, FOutEnd^, CanMove);
            Inc(Result, CanMove);
            CanMove2 := (FOutStart - FOutBuf);
            if CanMove2 > (Size - CanMove) then
              CanMove2 := (Size - CanMove);
            Move((PChar(@Buf)+CanMove)^, FOutBuf^, CanMove2);
            Inc(Result, CanMove2);
            FOutEnd := FOutBuf + CanMove2;
            if (FOutEnd = FOutStart) then
              FOutBufFull := True;
          end else begin
            { Don't need to wrap }
            Move(Buf, FOutEnd^, Size);
            FOutEnd := FOutEnd + Size;
            if FOutEnd = FOutBufEnd then
              FOutEnd := FOutBuf;
            if (FOutEnd = FOutStart) then
              FOutBufFull := True;
            Inc(Result, Size);
          end;
        end else begin
          { Already wrapped }
          CanMove := (FOutStart - FOutEnd);
          if CanMove > Size then
            CanMove := Size;
          Move(Buf, FOutEnd^, CanMove);
          Inc(Result, CanMove);
          FOutEnd := (FOutEnd + CanMove);
          if FOutEnd = FOutBufEnd then
            FOutEnd := FOutBuf;
          if (FOutEnd = FOutStart) then
            FOutBufFull := True;
        end;
      end else begin
        { Move data by bytes -- doubling each $FF }
        SrcPtr := @Buf;
        EndBuf := (SrcPtr + Size);
        DestPtr := FOutEnd;
        while SrcPtr < EndBuf do begin
          if SrcPtr^ = TELNET_IAC then begin
            { IAC needs to be doubled (escaped) }
            DestPtr^ := SrcPtr^;
            SrcPtr := (SrcPtr + 1);
            Inc(Result);
            DestPtr := (DestPtr + 1);
            if (DestPtr = FOutBufEnd) then
              DestPtr := FOutBuf;
            if (DestPtr = FOutStart) then
              EndBuf := SrcPtr;
            { Write second character and advance DestPtr }
            DestPtr^ := TELNET_IAC;
            DestPtr := (DestPtr + 1);
            if (DestPtr = FOutBufEnd) then
              DestPtr := FOutBuf;
            if (DestPtr = FOutStart) then
              EndBuf := SrcPtr;
          end else if (SrcPtr^ = TELNET_CR) and
                      ((SrcPtr + 1)^ <> TELNET_LF) and
                      (FOptBinary = tnoFalse) then begin
            { CR needs a null added after it }
            DestPtr^ := SrcPtr^;
            SrcPtr := (SrcPtr + 1);
            Inc(Result);
            DestPtr := (DestPtr + 1);
            if (DestPtr = FOutBufEnd) then
              DestPtr := FOutBuf;
            if (DestPtr = FOutStart) then
              EndBuf := SrcPtr;
            { Write second character and advance DestPtr }
            DestPtr^ := TELNET_NULL;
            DestPtr := (DestPtr + 1);
            if (DestPtr = FOutBufEnd) then
              DestPtr := FOutBuf;
            if (DestPtr = FOutStart) then
              EndBuf := SrcPtr;
          end else begin
            { Simple case, just copy }
            DestPtr^ := SrcPtr^;
            SrcPtr := (SrcPtr + 1);
            Inc(Result);
            DestPtr := (DestPtr + 1);
            if (DestPtr = FOutBufEnd) then
              DestPtr := FOutBuf;
            if DestPtr = FOutStart then
              EndBuf := SrcPtr;
          end;                                                      
        end;
        FOutEnd := DestPtr;
        if (FOutEnd = FOutStart) then
          FOutBufFull := True;
      end;
    end;
  end;
  if FOutEnd > FOutStart then begin
    { Not wrapped, can send in one chunk }
    Sent := ApdSocket.WriteSocket(FCommSocket, FOutStart^, (FOutEnd - FOutStart), 0);
    if Sent > 0 then
      FOutBufFull := False;
    if Sent <> SOCKET_ERROR then begin
      FOutStart := (FOutStart + Sent);
      if FOutStart = FOutBufEnd then
        FOutStart := FOutBuf;
    end;
  end else begin
    { Wrapped, send first half }
    Sent := ApdSocket.WriteSocket(FCommSocket, FOutStart^, (FOutBufEnd - FOutStart), 0);
    if Sent > 0 then
      FOutBufFull := False;
    if Sent <> SOCKET_ERROR then begin
      FOutStart := (FOutStart + Sent);
      if FOutStart = FOutBufEnd then begin
        FOutStart := FOutBuf;
        { Send second half }
        Sent := ApdSocket.WriteSocket(FCommSocket, FOutBuf^, (FOutEnd - FOutBuf), 0);
        if Sent > 0 then
          FOutBufFull := False;
        if Sent <> SOCKET_ERROR then
          FOutStart := (FOutBuf + Sent);
      end;
    end;
  end;
end;

{ TApdDeviceSocket methods }

constructor TApdDeviceSocket.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWsTerminal := DefWsTerminal;
  {$IFDEF Win32}
  FillChar(SockSection, SizeOf(SockSection), #0);
  InitializeCriticalSection(SockSection);                            
  {$ENDIF}
end;

destructor TApdDeviceSocket.Destroy;
begin
  {$IFDEF Win32}
  DeleteCriticalSection(SockSection);                              
  {$ENDIF}
  inherited Destroy;
end;

function TApdDeviceSocket.DoDispMessage(Socket: TSocket; Event : Cardinal; LP : LongInt) : LongInt;
var
  ComRec : Pointer;
begin
  Result := 0;
  ComRec := TApdBaseDispatcher(GetTComRecPtr(Socket, TApdWinsockDispatcher));
  if Assigned(ComRec) then
    Result := SendMessage(TApdBaseDispatcher(ComRec).DispatcherWindow, CM_APDSOCKETMESSAGE, Socket, LP);
end;

function TApdDeviceSocket.DoWsMessage(Socket : TSocket; Event : Cardinal; LP : LongInt) : LongInt;
var
  ComRec : TApdBaseDispatcher;
begin
  Result := 0;
  ComRec := TApdBaseDispatcher(GetTComRecPtr(Socket, TApdWinsockDispatcher));
  if Assigned(ComRec) then begin
    ComRec.EventBusy := True;
    { Send the message to the comport }
    if ComRec.Owner <> nil then
      Result := SendMessage(TApdCustomComPort(ComRec.Owner).ComWindow, CM_APDSOCKETMESSAGE, Event, LP);
    ComRec.EventBusy := False;
  end;
end;

{ Handle FD_ACCEPT Message }
procedure TApdDeviceSocket.DoAccept(Socket: TSocket);
var
  Connection : TWsConnection;
  ComRec : TApdWinsockDispatcher;
  TempSocket : TSocket;                                             
begin
  ComRec := nil;
  Connection := ApdSocket.FindConnection(Socket);
  if Assigned (Connection) then
    ComRec := Connection.FDispatcher;
  if Assigned(ComRec) then begin
    with ComRec, Connection do begin
      if FCommSocket = SOCKET_ERROR then begin
        FCommSocket := ApdSocket.AcceptSocket(Socket, WsSockAddr);
        if FCommSocket = SOCKET_ERROR then begin
          { Error Occurred -- Clean up and exit }
          FillChar(WsSockAddr, SizeOf(WsSockAddr), #0);
          Exit;
        end;
      { We already have a client, so kill this one... }
      end else begin
        TempSocket := ApdSocket.AcceptSocket(Socket, WsSockAddr);
        ApdSocket.CloseSocket(TempSocket);
        Exit;
      end;
      if DoWsMessage(Socket, FD_ACCEPT, LongInt(WsSockAddr.sin_addr)) = 1 then begin
        { Accept connection }
        ConnectionState := wcsConnected;
      end else begin
        { Kill connection }
        ApdSocket.CloseSocket(FCommSocket);
        FillChar(WsSockAddr, SizeOf(WsSockAddr), #0);
        FCommSocket := SOCKET_ERROR;
      end;
    end;
  end;
  inherited DoAccept(Socket);
end;

{ Handle FD_CONNECT Message }
procedure TApdDeviceSocket.DoConnect(Socket: TSocket);
var
  Connection : TWsConnection;
begin
  Connection := ApdSocket.FindConnection(Socket);
  if not Assigned(Connection) then Exit;
  with TWsConnection(Connection) do begin                           
    ConnectionState := wcsConnected;
    if FIsClient then
      FCommSocket := Socket;
  end;
  DoWsMessage(Socket, FD_CONNECT, 0);
  inherited DoConnect(Socket);
end;

{ Handle FD_CLOSE Message }
procedure TApdDeviceSocket.DoDisconnect(Socket: TSocket);
var
  Connection : TWsConnection;
  ComRec : TApdWinsockDispatcher;
begin
  Connection := ApdSocket.FindConnection(Socket);
  if Assigned (Connection) then begin
    with Connection do begin
      ComRec := TApdWinsockDispatcher(GetTComRecPtr(FSocketHandle, TApdWinsockDispatcher));
      if Assigned(ComRec) then begin
        with ComRec do begin
          FillChar(WsSockAddr, SizeOf(WsSockAddr), #0);
          FCommSocket := SOCKET_ERROR;
          ConnectionState := wcsInit;
        end;
      end;
      if Socket = FSocketHandle then
        DoWsMessage(FSocketHandle, FD_CLOSE, 0)
      else begin
        { "Special" msg to signal it's the connected client closing }
        DoWsMessage(FSocketHandle, FD_CLOSE or FD_CONNECT, 0);
        CloseSocket(Socket);                                         
      end;
    end;
  end;
  inherited DoDisconnect(Socket);
end;

{ Handle Async Errors Without Raising Exceptions }
procedure TApdDeviceSocket.DoError(Socket : TSocket; ErrCode : Integer);
var
  CorrectedSocket : TSocket;
begin
  CorrectedSocket := TweakSocket(Socket);
  if CorrectedSocket <> -1 then                                      
    DoWsMessage(CorrectedSocket, ErrCode, 0);
  if Assigned(FOnWsError) then FOnWsError(Self, Socket, ErrCode);
end;

{ Handle FD_READ Message }
procedure TApdDeviceSocket.DoRead(Socket: TSocket);
var
  CorrectedSocket : TSocket;
begin
  CorrectedSocket := TweakSocket(Socket);
  if CorrectedSocket <> -1 then                                       
    DoDispMessage(CorrectedSocket, FD_READ, 0);
  inherited DoRead(Socket);
end;

{ Handle FD_WRITE Message }
procedure TApdDeviceSocket.DoWrite(Socket: TSocket);
begin
  inherited DoWrite(Socket);
end;

{ Returns a Socket handle for a CommSocket handle }
function TApdDeviceSocket.TweakSocket(Socket : TSocket) : TSocket;
var
  Connection : TWsConnection;
begin
  Connection := ApdSocket.FindConnection(Socket);
  if Assigned(Connection) then
    Result := Connection.SocketHandle
  else
    Result := -1;
end;

{ Finds a connection that corresponds to a Socket handle }
const
  LastSocket : TSocket = -1;
  LastConnection : TWsConnection = nil;

{$IFDEF Win32}
procedure TApdDeviceSocket.LockList;
begin
  EnterCriticalSection(SockSection);
end;

procedure TApdDeviceSocket.UnLockList;
begin
  LeaveCriticalSection(SockSection);
end;
{$ENDIF}

function TApdDeviceSocket.FindConnection(Socket : TSocket) : TWsConnection;
var
  I : Integer;
begin
  {$IFDEF Win32}
  LockList;
  try                                                                 
  {$ENDIF}
    if (Socket = LastSocket) and (LastConnection <> nil) then
      Result := LastConnection
    else begin
      for I := 0 to Pred(ComponentCount) do begin
        if Components[I] is TWsConnection then begin
          if (TWsConnection(Components[I]).CommSocket = Socket) or
             (TWsConnection(Components[I]).SocketHandle = Socket) then begin
            Result := TWsConnection(Components[I]);
            LastSocket := Socket;
            LastConnection := Result;
            Exit;
          end;
        end;