fastertcp.pas

faster tcp companents delphi

      Result := inet_ntoa(SockAddrIn.sin_addr);
     end;
   end
  else
   SocketError(FSocket, WSAGetLastError);
end;   {2}

procedure TFasterTCPServer.KickOutAClient(Client: TFasterTCPServerClient);
begin
  SendCommand(Client,SERVER_KICK_OUT_ID,0,nil,False);
end;

procedure TFasterTCPServer.MakeRoomUserNameList(Const RoomName: String; var TheList: TStringList);
Var
  I: LongInt;
  TempClient: TFasterTCPServerClient;
begin
  TheList.Clear;
  For I := 0 to FConnections.Count - 1 do begin
    TempClient := FConnections[I];
    If TempClient.FRoom = RoomName then
      TheList.Add(TempClient.FUserName);
  end;
end;

procedure TFasterTCPServer.MakeUserNameList(var TheList: TStringList);
Var
  I: LongInt;
begin
  For I := 0 to FConnections.Count - 1 do
    TheList.Add(TFasterTCPServerClient(FConnections[I]).FUserName);
end;

Procedure TFasterTCPServer.ProcessCommands(Client: TFasterTCPServerClient; Data: TMemoryStream; Command: LongInt);
Var
  AcceptStream: Boolean;
  AlreadyInUse: Boolean;
  DontLetIn_: Boolean;
  I: LongInt;
  Reader: TReader;
  TempMessage: String;
  TempSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt{$ENDIF};
  TmpUserName: String;
begin
  Case Command of

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

    ASKING_TO_RECEIVE_DATA_ID: begin
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Client asking to prepare for receiving data.');
      {$ENDIF}
      Data.Read{Integer}(TempSize, StreamSize_of_Size);
      If Data.Size > StreamSize_of_Size then begin
        SetLength(TempMessage,Data.Size - StreamSize_of_Size);
        Data.Read(TempMessage[1],Data.Size - StreamSize_of_Size);
      end;
      AcceptStream := False;
      If Assigned(FOnNewStreamComing) then
        FOnNewStreamComing(Self, Client, TempSize, TempMessage, AcceptStream);
      If AcceptStream then begin
        Client.FStreamDataReceived := 0;
        Client.FStream_FullSize := TempSize;
        Client.FStreamDataInfo := TempMessage;
        SendCommand(Client,DATA_RECEIVE_OK_ID,0,nil,True); { ###Does not sent PacketSendSize anymore }
      end else
       SendCommand(Client,DATA_RECEIVE_DENIED_ID,0,nil,True);
    end;

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

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

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

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

    MESSAGE_Packet_ID: begin
      //Debugging handled in DoMessageCome
      DoMessageCome(Client, ConvertToString(Data));
    end;

    PING_ID: SendCommand(Client, PONG_ID, 0, nil, True);

    PONG_ID: begin
      Client.FPingStatus := PingOK;
      Client.FTimeOuts := 0;
      If Assigned(FOnClientPong) then
        FOnClientPong( Self, Client );
    end;

    REGISTER_NAME_ROOM_ID: begin
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Registering name and room for client.');
      {$ENDIF}
      AlreadyInUse := False;
      Reader := TReader.Create(Data,4096);
      Try
        TmpUserName := Reader.ReadString;
        TempMessage := Reader.ReadString;
      Finally Reader.Free; end;
      If not AllowSameUserNames then
        For I := 0 to FConnections.Count - 1 do
          If TFasterTCPServerClient(FConnections[I]).FUserName = TmpUserName then begin
            AlreadyInUse := True;
            Break;
          end;                      // this should be the 2nd message sent by server
      If not AlreadyInUse then begin
        Client.FUserName := TmpUserName;  
        Client.FRoom := TempMessage;
        DontLetIn_ := False;
        If Assigned(FOnServerGetUserName) then
          FOnServerGetUserName(Self, Client, DontLetIn_, PChar(TempMessage), PChar(TmpUserName));
        If DontLetIn_ then
          SendCommand(Client,SERVER_NOT_LET_IN_ID,0,nil,True)
        else
          SendCommand(Client,SERVER_REGISTER_OK_ID,0,nil,True);
      end else
       SendCommand(Client,SERVER_NAME_IN_USE_ID,0,nil,True);
    end;

    STREAM_Packet_ID: begin
      Inc(Client.FStreamDataReceived,Data.Size);
      DoPacketCome(Client,Data, Data.Size);
    end;

    STREAM_RECEIVED_ID: begin
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Stream received from client.');
      {$ENDIF}
      If Assigned(FOnClientReceivedStream) then
        FOnClientReceivedStream(Self, Client);
    end;
    
    else begin //unknownID
      {$IFDEF DEBUGMODEON}
        DebugInfo.Add('Received packet from client with unknown header.');
      {$ENDIF}
      If Assigned(FOnUnknownPacketID) then
        FOnUnknownPacketID(Self, Client, Data, Command);
    end;
  end; //~CASE END
 // SendWaitingPackets(Client); {### Not needed in this version yet.}
end;

Function TFasterTCPServer.Send(Client: TFasterTCPServerClient; Buffer: PChar; BufLength: LongInt): LongInt;
begin
  If BufLength = 0 then begin
    Result := 0;
    Exit;
  end;
    Result := SendPacketTo(Client.FSocket,CreatePacket(BufLength,MESSAGE_Packet_ID,Buffer),False) - HEADER_SIZE;
    {$IFDEF DEBUGMODEON}
      FDebugInfo.Add('Message sent to client: ' + String(Buffer));
    {$ENDIF}

//  begin
//    GetMem(Data,BufLength);
//    Try
//      System.Move(Buffer^,Data^,BufLength);   //Write buffer to data and add to waiting packets
//    Except FreeMem(Data); end;                //or send immediately
//    Client.FPacketsWaiting.Add(CreatePacket(BufLength,MESSAGE_Packet_ID,Data));
//    {$IFDEF DEBUGMODEON}
//      FDebugInfo.Add('Message added to waiting list: ' + String(Buffer));
//    {$ENDIF}
//  end;                                       Was commented out because Packets are sent immediately in this version.

end;

Procedure TFasterTCPServer.SendCommand(Client: TFasterTCPServerClient; Command, CommandDataSize: LongInt; Data: TMemoryStream; Immediately: Boolean);
Var TempData: Pointer;
  TempPacket: TFasterPacket;
begin
  If CommandDataSize > 0 then begin
    GetMem(TempData,CommandDataSize);
    Try
      Data.Seek(0, soFromBeginning);
      Data.Read(TempData^,CommandDataSize);
      TempPacket := CreatePacket(CommandDataSize,Command,TempData);
    Except //packetlist uses autofree - feature
     FreeMem(TempData);
    end;
  end else
    TempPacket := CreatePacket(0,Command,nil);

  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Command sent immediately :' + IntToStr(Command));
  {$ENDIF}
    SendPacketTo(Client.FSocket,TempPacket,True);
end;

Function TFasterTCPServer.SendCustomPacket(Client: TFasterTCPServerClient; ID, DataSize: LongInt; Data: TStream; AutoFreeData: Boolean): LongInt;
Var TempData: Pointer;
  TempPacket: TFasterPacket;
begin
  If DataSize > 0 then begin
      GetMem(TempData,DataSize);
      Try
        Data.Read(TempData^,DataSize);
        If AutoFreeData then Data.Free;
        TempPacket := CreatePacket(DataSize,ID,TempData);
      Except //packetlist uses autofree - feature
       FreeMem(TempData);
      end;
  end else
    TempPacket := CreatePacket(0,ID,nil);

  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Custom packet - ID sent immediately :' + IntToStr(ID));
  {$ENDIF}
    Result := SendPacketTo(Client.FSocket,TempPacket,True);
end;

Function TFasterTCPServer.SendCustomPacketEx(Client: TFasterTCPServerClient; ID, DataSize: LongInt; Data: Pointer): LongInt;
Var TempPacket: TFasterPacket;
begin
  If DataSize > 0 then begin
    Try
      TempPacket := CreatePacket(DataSize,ID,Data);
    Except //packetlist uses autofree - feature
    end;
  end else
    TempPacket := CreatePacket(0,ID,nil);

  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Custom packet - ID sent immediately :' + IntToStr(ID));
  {$ENDIF}
    result := SendPacketTo(Client.FSocket,TempPacket,True);
end;

Procedure TFasterTCPServer.SendStream(Client: TFasterTCPServerClient; Stream: TStream; Size: LongInt);
begin
  SendStreamTo(Client.FSocket, Client, Stream, Size);
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Stream sending started, size: ' + IntToStr(Size));
  {$ENDIF}
end;

//Procedure TFasterTCPServer.SendWaitingPackets(Client: TFasterTCPServerClient);
//Var  a: LongInt;
//begin
//  For a := Client.FPacketsWaiting.Count - 1 downto 0 do begin
//    SendPacketTo(Client.FSocket,Client.FPacketsWaiting[a],False);
//    {$IFDEF DEBUGMODEON}
//      FDebugInfo.Add('Packet sent from list :' + IntToStr(Client.FPacketsWaiting[a].Command));
//    {$ENDIF}
//    Client.FPacketsWaiting.Delete(a);
//  end;
//end;
   {1}
procedure TFasterTCPServer.SetListen(Value: Boolean);
var
  I: LongInt;
  tmpTCPClient: TFasterTCPServerClient;
begin
  If not (csDesigning in ComponentState) then
   If FListen <> Value then
    begin
    {$IFDEF DEBUGMODEON}
      If Value then
        FDebugInfo.Add('Server starts listening') else
        FDebugInfo.Add('Server stops listening');
    {$ENDIF}
     If Value then
      begin
       FSocket := WinSock.Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
       If FSocket = SOCKET_ERROR then
        begin
         SocketError(INVALID_SOCKET, WSAGetLastError);
         Exit;
        end;

       SockAddrIn.sin_family := AF_INET;
       SockAddrIn.sin_addr.s_addr := INADDR_ANY;
       SockAddrIn.sin_port := htons(FPort);
       If Bind(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 then
        begin
         SocketError(FSocket, WSAGetLastError);
         Exit;
        end;

       If WinSock.Listen(FSocket, SOMAXCONN) <> 0 then
        begin
         SocketError(FSocket, WSAGetLastError);
         Exit;
        end;

       If WSAAsyncSelect(FSocket, WindowHandle, SYNCSELECT_ID,
                         FD_READ or FD_ACCEPT or FD_CLOSE) <> 0 then
        begin
         SocketError(FSocket, WSAGetLastError);
         Exit;
        end;
      end
     else
      begin
       // Closing all connections first
       //if I <> 0 then
        for I := FConnections.Count - 1 downto 0 do
         begin
          tmpTCPClient := FConnections[I];
          tmpTCPClient.Connected := False;
          FConnections.Delete(I);
         end;

       // Cancel listening
       WSAASyncSelect(FSocket, WindowHandle, SYNCSELECT_ID, 0);
       Shutdown(FSocket, 2);

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

       FSocket := INVALID_SOCKET;
      end;
      FListen := Value;
    end
   else
  else
   FListen := Value;
end;   {2}