clsocket.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

    OnProgress(Self, ABytesProceed, ATotalBytes);
  end;
end;

procedure TclConnection.InitProgress(ABytesProceed, ATotalBytes: Int64);
begin
  FTotalBytesProceed := ABytesProceed;
  FBytesProceed := 0;
  FTotalBytes := ATotalBytes;
end;

function TclConnection.IsProceedLimit: Boolean;
begin
  Result := (FBytesToProceed > -1) and (FBytesToProceed <= FBytesProceed);
end; 

procedure TclConnection.SetNetworkStream(const Value: TclNetworkStream);
begin
  if (FNetworkStream = Value) then Exit;

  if (FNetworkStream <> nil) and (Value <> nil) then
  begin
    Value.Assign(FNetworkStream);
  end;
  
  FNetworkStream.Free();
  FNetworkStream := Value;

  if (FNetworkStream <> nil) then
  begin
    FNetworkStream.FConnection := Self;
  end;
end;

function TclConnection.GetNetworkStream: TclNetworkStream;
begin
  if (FNetworkStream = nil) then
  begin
    raise EclSocketError.Create(cNoNetworkStream, -1);
  end;
  Result := FNetworkStream;
end;

procedure TclConnection.DoReady;
begin
  if Assigned(OnReady) then
  begin
    OnReady(Self);
  end;
end;

{ TclTcpClientConnection }

function TclTcpClientConnection.GetIP: string;
begin
  Result := NetworkStream.IP;
end;

function TclTcpClientConnection.GetPort: Integer;
begin
  Result := NetworkStream.Port;
end;

procedure TclTcpClientConnection.Open(const AIP: string; APort: Integer);
var
  res: Integer;
  networkEvents: TWSANetworkEvents;
  isReadIntilCloseOld: Boolean;
begin
  isReadIntilCloseOld := IsReadUntilClose;
  IsReadUntilClose := False;
  
  CreateSocket(SOCK_STREAM, IPPROTO_TCP);
  SelectSocketEvent(FD_CONNECT);

  if not NetworkStream.Connect(AIP, APort) then
  begin
    InitTimeOutTicks();

    repeat
      if WaitForEvent(SocketEvent, FTimeOutTicks, TimeOut) then
      begin
        res := WSAEnumNetworkEvents(Socket, SocketEvent, @networkEvents);
        if (res = SOCKET_ERROR) then
        begin
          RaiseSocketError(WSAGetLastError());
        end;
        if ((networkEvents.lNetworkEvents and FD_CONNECT) > 0) then
        begin
          if (networkEvents.iErrorCode[FD_CONNECT_BIT] <> 0) then
          begin
            RaiseSocketError(networkEvents.iErrorCode[FD_CONNECT_BIT]);
          end;
          Break;
        end;
      end;
    until IsAborted;
  end;

  SelectSocketEvent(FD_READ or FD_CLOSE or FD_WRITE);
  
  if IsAborted then
  begin
    Close(False);
  end else
  begin
    FActive := True;
    DispatchNextAction();
    NetworkStream.StreamReady();
  end;

  IsReadUntilClose := isReadIntilCloseOld;
end;

procedure TclTcpClientConnection.OpenSession;
var
  isReadIntilCloseOld: Boolean;
begin
  Assert(Active);
  
  isReadIntilCloseOld := IsReadUntilClose;
  IsReadUntilClose := False;

  NetworkStream.OpenClientSession();

  if IsAborted then
  begin
    Close(False);
  end else
  begin
    DispatchNextAction();
    NetworkStream.StreamReady();
  end;
  
  IsReadUntilClose := isReadIntilCloseOld;
end;

{ TclTcpServerConnection }

function TclTcpServerConnection.Open(APort: Integer): Integer;
begin
  CreateSocket(SOCK_STREAM, IPPROTO_TCP);
  NetworkStream.Listen(APort);
  Result := NetworkStream.ListenPort;
end;

procedure TclTcpServerConnection.AcceptConnection;
var
  sock: TSocket;
  res: Integer;
  networkEvents: TWSANetworkEvents;
  isReadIntilCloseOld: Boolean;
begin
  isReadIntilCloseOld := IsReadUntilClose;
  IsReadUntilClose := False;

  SelectSocketEvent(FD_ACCEPT);

  InitTimeOutTicks();

  repeat
    if WaitForEvent(SocketEvent, FTimeOutTicks, TimeOut) then
    begin
      res := WSAEnumNetworkEvents(Socket, SocketEvent, @networkEvents);
      if (res = SOCKET_ERROR) then
      begin
        RaiseSocketError(WSAGetLastError());
      end;
      if ((networkEvents.lNetworkEvents and FD_ACCEPT) > 0) then
      begin
        if (networkEvents.iErrorCode[FD_ACCEPT_BIT] <> 0) then
        begin
          RaiseSocketError(networkEvents.iErrorCode[FD_ACCEPT_BIT]);
        end;
        Break;
      end;
    end;
  until IsAborted;

  sock := Socket;
  NetworkStream.Accept();
  winsock.closesocket(sock);

  SelectSocketEvent(FD_READ or FD_CLOSE or FD_WRITE);

  if IsAborted then
  begin
    Close(False);
  end else
  begin
    FActive := True;
    DispatchNextAction();
    NetworkStream.StreamReady();
  end;

  IsReadUntilClose := isReadIntilCloseOld;
end;

procedure TclTcpServerConnection.OpenSession;
var
  isReadIntilCloseOld: Boolean;
begin
  Assert(Active);
  
  isReadIntilCloseOld := IsReadUntilClose;
  IsReadUntilClose := False;

  NetworkStream.OpenServerSession();

  if IsAborted then
  begin
    Close(False);
  end else
  begin
    DispatchNextAction();
    NetworkStream.StreamReady();
  end;
  
  IsReadUntilClose := isReadIntilCloseOld;
end;

{ EclSocketError }

constructor EclSocketError.Create(const AErrorMsg: string; AErrorCode: Integer);
begin
  inherited Create(AErrorMsg);
  FErrorCode := AErrorCode;
end;

{ TclSyncConnection }

constructor TclSyncConnection.Create;
begin
  inherited Create();
  //TODOFSocketEvent := CreateEvent(nil, False, False, nil);
  FSocketEvent := WSACreateEvent();
{$IFDEF LOGGER}clPutLogMessage(Self, edInside, 'FSocketEvent created');{$ENDIF}
  if (FSocketEvent = WSA_INVALID_EVENT) then
  begin
    RaiseSocketError(WSAGetLastError());
  end;
  TimeOut := 5000;
end;

procedure TclSyncConnection.DoDestroy;
begin
  if (FSocketEvent <> WSA_INVALID_EVENT) then
  begin
    WSACloseEvent(FSocketEvent);
{$IFDEF LOGGER}clPutLogMessage(Self, edInside, 'FSocketEvent closed');{$ENDIF}
  end;
  inherited DoDestroy();
end;

procedure TclSyncConnection.InitTimeOutTicks;
begin
  FTimeOutTicks := GetTickCount();
end;

procedure TclSyncConnection.WriteString(const AString: string);
var
  Data: TStream;
begin
  Data := TStringStream.Create(AString);
  try
    WriteData(Data);
    Assert(Data.Position >= (Data.Size - 1));
  finally
    Data.Free()
  end;
end;

procedure TclSyncConnection.SelectSocketEvent(lNetworkEvents: DWORD);
var
  res: Integer;
begin
  res := WSAEventSelect(Socket, SocketEvent, lNetworkEvents);
  if (res = SOCKET_ERROR) then
  begin
    RaiseSocketError(WSAGetLastError());
  end;
end;

procedure TclSyncConnection.InternalReadData(AData: TStream);
var
  res: Integer;
  networkEvents: TWSANetworkEvents;
{$IFDEF LOGGER}
  oldSize: Int64;
{$ENDIF}
begin
  InitTimeOutTicks();

{$IFDEF LOGGER}
  clPutLogMessage(Self, edInside, 'InternalReadData begin, NextAction = %d', nil, [Integer(NetworkStream.NextAction)]);
  oldSize := 0;
  if (AData <> nil) then
  begin
    oldSize := AData.Size;
  end;
  try
{$ENDIF}
  if NetworkStream.HasReadData then
  begin
    NetworkStream.HasReadData := False;
    NetworkStream.Read(AData);
{$IFDEF LOGGER}clPutLogMessage(Self, edInside, 'InternalReadData: HasReadData', AData, oldSize);{$ENDIF}

    if (not IsReadUntilClose) or (not Active) then
    begin
      if not Active then
      begin
        NetworkStream.ClearNextAction();
      end;
      
      Exit;
    end;
  end;

  repeat
    if not Active then
    begin
      RaiseSocketError(WSAENOTSOCK);
    end;

    if WaitForEvent(SocketEvent, FTimeOutTicks, TimeOut) then
    begin
      res := WSAEnumNetworkEvents(Socket, SocketEvent, @networkEvents);
      if (res = SOCKET_ERROR) then
      begin
        RaiseSocketError(WSAGetLastError());
      end;
      if ((networkEvents.lNetworkEvents and FD_READ) > 0) then
      begin
        if (networkEvents.iErrorCode[FD_READ_BIT] <> 0) then
        begin
          RaiseSocketError(networkEvents.iErrorCode[FD_READ_BIT]);
        end;
        {$IFDEF LOGGER}clPutLogMessage(Self, edInside, 'InternalReadData inside repeat-until, before NetworkStream.Read');{$ENDIF}
        {$IFDEF LOGGER}
          res := Integer(NetworkStream.Read(AData));
        {$ELSE}
          NetworkStream.Read(AData);
        {$ENDIF}
        {$IFDEF LOGGER}clPutLogMessage(Self, edInside, 'InternalReadData inside repeat-until, after NetworkStream.Read, %d', nil, [res]);{$ENDIF}
        if not IsReadUntilClose then
        begin
          Break;
        end;
        InitTimeOutTicks();
      end;

      if ((networkEvents.lNetworkEvents and FD_CLOSE) > 0) then
      begin
        if (networkEvents.iErrorCode[FD_CLOSE_BIT] <> 0) then
        begin
          RaiseSocketError(networkEvents.iErrorCode[FD_CLOSE_BIT]);
        end;
        {$IFDEF LOGGER}clPutLogMessage(Self, edInside, 'InternalReadData inside repeat-until, FD_CLOSE');{$ENDIF}
        Close(False);
        Break;
      end;

      if NetworkStream.NeedClose then
      begin
        {$IFDEF LOGGER}clPutLogMessage(Self, edInside, 'InternalReadData inside NetworkStream.NeedClose');{$ENDIF}
        Close(False);
        Break;
      end;
    end;
  until NetworkStream.NeedStop();

{$IFDEF LOGGER}
  finally
    if (AData <> nil) and ((AData.Size - oldSize) > 0) then
    begin
      clPutLogMessage(Self, edInside, 'InternalReadData, received data', AData, oldSize);
    end;
    clPutLogMessage(Self, edInside, 'InternalReadData end, NextAction = %d', nil, [Integer(NetworkStream.NextAction)]);
  end;
{$ENDIF}
end;

procedure TclSyncConnection.ReadData(AData: TStream);
begin
  InternalReadData(AData);
  repeat
    case NetworkStream.NextAction of
      saRead: InternalReadData(nil);
      saWrite: WriteData(nil);
    else
      Break;
    end;
  until False;
end;

procedure TclSyncConnection.InternalWriteData(AData: TStream);
var
  res: Integer;
  networkEvents: TWSANetworkEvents;
begin
{$IFDEF LOGGER}try clPutLogMessage(Self, edEnter, 'InternalWriteData');{$ENDIF}
  InitTimeOutTicks();

  if NetworkStream.Write(AData) then Exit;

  repeat
    if WaitForEvent(SocketEvent, FTimeOutTicks, TimeOut) then
    begin
      res := WSAEnumNetworkEvents(Socket, SocketEvent, @networkEvents);
      if (res = SOCKET_ERROR) then
      begin
        RaiseSocketError(WSAGetLastError());
      end;

      if ((networkEvents.lNetworkEvents and FD_READ) > 0) then
      begin
        if (networkEvents.iErrorCode[FD_READ_BIT] <> 0) then
        begin
          RaiseSocketError(networkEvents.iErrorCode[FD_READ_BIT]);
        end;
        NetworkStream.HasReadData := True;
      end;

      if ((networkEvents.lNetworkEvents and FD_WRITE) > 0) then
      begin
        if (networkEvents.iErrorCode[FD_WRITE_BIT] <> 0) then
        begin
          RaiseSocketError(networkEvents.iErrorCode[FD_WRITE_BIT]);
        end;
        InitTimeOutTicks();

        if NetworkStream.Write(AData) then Break;
      end;

      if ((networkEvents.lNetworkEvents and FD_CLOSE) > 0) then
      begin
        if (networkEvents.iErrorCode[FD_CLOSE_BIT] <> 0) then
        begin
          RaiseSocketError(networkEvents.iErrorCode[FD_CLOSE_BIT]);
        end;
        Close(False);
        Break;
      end;
    end;
  until NetworkStream.NeedStop();
{$IFDEF LOGGER}clPutLogMessage(Self, edLeave, 'InternalWriteData'); except on E: Exception do begin clPutLogMessage(Self, edLeave, 'InternalWriteData', E); raise; end; end;{$ENDIF}
end;

procedure TclSyncConnection.WriteData(AData: TStream);
begin
  InternalWriteData(AData);
  repeat
    case NetworkStream.NextAction of
      saRead: ReadData(nil);
      saWrite: InternalWriteData(nil)
    else
      Break;
    end;
  until False;
end;

procedure TclSyncConnection.CreateSocket(AStruct, AProtocol: Integer);
begin
  Assert(Socket = INVALID_SOCKET);
  Socket := winsock.socket(AF_INET, AStruct, AProtocol);
  if (Socket = INVALID_SOCKET) then
  begin
    RaiseSocketError(WSAGetLastError());
  end;
end;

procedure TclSyncConnection.DispatchNextAction;