fastertcp.pas

faster tcp companents delphi

procedure TFasterTCPServer.SetNoneStr(Value: String); begin end;
  {1}
procedure TFasterTCPServer.SetPort(Value: Word);
begin
  If not (csDesigning in ComponentState) then
   If FPort <> Value then
    If FListen then
     If FAllowChangeHostAndPortOnConnection then
      begin
       Listen := False;
       FPort := Value;
       Listen := True;
      end
     else
      raise Exception.Create('Can not change Port while listening')
    else FPort := Value
   else
  else FPort := Value;
end;  {2}

procedure TFasterTCPServer.SocketError(Socket: TSocket; ErrorCode: LongInt);
begin
  Listen := False;  // cancel listening
  inherited;
end;

procedure TFasterTCPServer.StopReceivingData(Client: TFasterTCPServerClient);
begin
  SendCommand(Client,DATA_RECEIVING_STOPPED_ID,0,nil,True);
end;

procedure TFasterTCPServer.StopSendingData(Client: TFasterTCPServerClient);
begin
  SendCommand(Client,DATA_SENDING_STOPPED_ID,0,nil,True);
end;

procedure TFasterTCPServer.UpdatePingStatuses;
var
  tmpTCPClient: TFasterTCPServerClient;
  I: LongInt;
  FForceClientDisconnect: Boolean;
begin
  For I := FConnections.Count - 1 downto 0 do begin
    tmpTCPClient := FConnections[I];
    SendCommand(tmpTCPClient, PING_ID, 0, nil, True);
    Case tmpTCPClient.FPingStatus of
     PingOK: tmpTCPClient.FPingStatus := WaitingPing;
     WaitingPing: begin
       Inc(tmpTCPClient.FTimeOuts);
       FForceClientDisconnect := False;
       If Assigned(FOnClientTimeOut) then
         FOnClientTimeOut(Self,tmpTCPClient,FForceClientDisconnect);
       If FForceClientDisconnect then begin
         tmpTCPClient.Connected := False;
         FConnections.Delete(I);
       end;
     end;
    End;
  end;
end;
{-------------------------------------------------------------------------------------------}














{ TFasterTCPServerClient }
constructor TFasterTCPServerClient.Create(aOwner: TComponent); 
begin
  inherited Create(aOwner);
  //FPacketsWaiting := TFasterPacketList.Create;
  FPingStatus := PingOK; 
  FTimeOuts := 0;
//  SelfClassType := OF_CLASS_CLIENT;   {### Not needed in this version}
end;

destructor TFasterTCPServerClient.Destroy;
begin
  Connected := False;
  //FPacketsWaiting.Free;
  FExtraDataObject.Free;  

  inherited Destroy;
end;

procedure TFasterTCPServerClient.ClearStreamProperties;
begin
  FStreamDataReceived := 0;
  FStream_FullSize := 0;
  FStreamDataInfo := '';
end;
{1}
procedure TFasterTCPServerClient.SetConnected(Value: Boolean);
var
  lin: TLinger;
  linx: Array[0..3] of Char absolute lin;
begin
   If FConnected <> Value then
    begin
    {$IFDEF DEBUGMODEON}
      If Value then
        FDebugInfo.Add('Server creating socket for client') else
        FDebugInfo.Add('Server closing client socket');
    {$ENDIF}
     ClearStreamProperties;
     If Value then
      begin
       SockAddrIn.sin_family := AF_INET;
       SockAddrIn.sin_port := htons(FPort);
       SockAddrIn.sin_addr.s_addr := inet_addr(PChar(Host));
       If SockAddrIn.sin_addr.s_addr = - 1 then
        begin
         HostEnt := GetHostByName(PChar(Host));
         If HostEnt = nil then
          begin
           SocketError(INVALID_SOCKET, WSAEFAULT);
           Exit;
          end;
         SockAddrIn.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
        end;

       FSocket := WinSock.Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
       If FSocket = SOCKET_ERROR then begin
         SocketError(INVALID_SOCKET, WSAGetLastError);
         Exit;
       end;

       If WSAASyncSelect(FSocket, WindowHandle, SYNCSELECT_ID,
                         FD_READ or FD_CONNECT or FD_CLOSE) <> 0 then
        begin
         SocketError(FSocket, WSAGetLastError);
         Exit;
        end;

      If (WinSock.Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0) and
         (WSAGetLastError <> WSAEWOULDBLOCK) then
       begin
         SocketError(FSocket, WSAGetLastError);
         Exit;
      end;
      FConnected := Value
      end
     else
      begin
       WSAASyncSelect(FSocket, WindowHandle, SYNCSELECT_ID, 0);
       Shutdown(FSocket, SD_BOTH);
       lin.l_onoff := 1;
       lin.l_linger := 0;
       SetSockOpt(FSocket, SOL_SOCKET, SO_LINGER, linx, SizeOf(Lin));

       If CloseSocket(FSocket) <> 0 then begin
         SocketError(FSocket, WSAGetLastError);
         Exit;
       end;

       FSocket := INVALID_SOCKET;
       FConnected := False;
      end;
    end;
end;   {2}
{------------------------------------------------------------}














{ TFasterTCPClient }

{procedure TFasterTCPClient.WndProc(var Message: TMessage);
begin
  inherited WndProc(Message);
end;}

Procedure TFasterTCPClient.AskMoreData;
begin
  SendCommand(ASK_MORE_DATA_ID,0,nil,True);
end;

procedure TFasterTCPClient.AskToReceiveStream(Const DataSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF}; Const DataInfo: String);
Var
  TempStream: TMemoryStream;
  a: LongInt;
begin
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Asking server to prepare receiving stream.');
  {$ENDIF}
  TempStream := TMemoryStream.Create;
  Try
    TempStream.Write{Integer}(DataSize, StreamSize_of_Size);
    a := Length(DataInfo);
    If a > 0 then
      TempStream.Write(DataInfo[1],a);
    SendCommand(ASKING_TO_RECEIVE_DATA_ID,TempStream.Size,TempStream,False);
  Finally TempStream.Free; end;
end;

procedure TFasterTCPClient.DoClose(Socket: TSocket);
begin
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Client closing down.');
  {$ENDIF}
  Connected := False;
  If not (csDestroying in ComponentState) then
   begin
    If Assigned(FOnDisconnected) then
      FOnDisconnected(Self);

    If FAutoTryReconnect then
      Connected := True;
   end;   
end;

procedure TFasterTCPClient.DoConnect;
begin
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Client established connection to server.');
  {$ENDIF}
  FConnected := True;
  If Assigned(FOnConnected) then
     FOnConnected(Self);
end;

procedure TFasterTCPClient.DoMessageCome(ProcessedMessage: String);
begin
  Try
    {$IFDEF DEBUGMODEON}
      FDebugInfo.Add('Received message from client :' + ProcessedMessage);
    {$ENDIF}
    If Assigned(FOnMessageCome) then
      FOnMessageCome(Self, ProcessedMessage);
  Except  end;
end;

procedure TFasterTCPClient.DoPacketCome(Data: TMemoryStream; DataSize: LongInt);
begin
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Received packet, size: ' + IntToStr(DataSize));
  {$ENDIF}
  If Assigned(FOnPacketCome) then
    FOnPacketCome(Self, Data, DataSize);

  If FStreamDataReceived >= FStream_FullSize then begin
    If Assigned(FOnStreamReceived) then
      FOnStreamReceived(Self, FStreamDataReceived, FStreamDataInfo);
    SendCommand(STREAM_RECEIVED_ID,0,nil,True);
  end;
end;

function  TFasterTCPClient.GetIP: LongInt;
begin
  Result := StrToIP(PChar(Host));
end;

procedure TFasterTCPClient.SetIP(Value: LongInt);
begin
  Host := IPToStr(Value);
end;

procedure TFasterTCPClient.ProcessCommands(Client: TFasterTCPServerClient; Data: TMemoryStream; Command: LongInt);
Var
  AcceptStream: Boolean;
  Writer: TWriter;
  TempDataInfo: String;
  TempSize: LongInt;
  TempStream: TMemoryStream;
begin
  Case Command of

    ASK_MORE_DATA_ID: begin 
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Server asking more data');
      {$ENDIF}
      If Assigned(FOnServerNeedMoreData) then
        FOnServerNeedMoreData(Self);  
    end;

    ASKING_TO_RECEIVE_DATA_ID: begin 
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Server asking to prepare for receiving data.');
      {$ENDIF}
      Data.Read{Integer}(TempSize, StreamSize_of_Size);
      If Data.Size > StreamSize_of_Size then begin
        SetLength(TempDataInfo,Data.Size - StreamSize_of_Size);
        Data.Read(TempDataInfo[1],Data.Size - StreamSize_of_Size);
      end;
      AcceptStream := False;
      If Assigned(FOnNewStreamComing) then
        FOnNewStreamComing(Self, TempSize,TempDataInfo, AcceptStream);

      If AcceptStream then begin
        FStreamDataReceived := 0;
        FStream_FullSize := TempSize;
        FStreamDataInfo := TempDataInfo;
        SendCommand(DATA_RECEIVE_OK_ID,0,nil,True);
      end else
        SendCommand(DATA_RECEIVE_DENIED_ID,0,nil,True);
    end;

    DATA_RECEIVE_DENIED_ID: begin 
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Server refuses to accept stream.');
      {$ENDIF}
      If Assigned(FOnServerDenyStream) then
        FOnServerDenyStream(Self);
    end;

    DATA_RECEIVE_OK_ID: begin  
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Server is ready to receive stream.');
      {$ENDIF}
      If Assigned(FOnServerAcceptStream) then
        FOnServerAcceptStream(Self);
    end;

    DATA_RECEIVING_STOPPED_ID: begin
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Server stops receiving stream.');
      {$ENDIF}
      If Assigned(FOnServerStopReceivingStream) then
        FOnServerStopReceivingStream(Self); 
    end;

    DATA_SENDING_STOPPED_ID: begin  
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Server stops sending stream.');
      {$ENDIF}
      If Assigned(FOnServerStopSendingStream) then
        FOnServerStopSendingStream(Client);    
    end;

    MESSAGE_Packet_ID: begin
      DoMessageCome(Conv