fastertcp.pas

faster tcp companents delphi

  If Assigned(FOnError) then
    FOnError(Self, Socket, ErrorCode, ErrorMsg)
  else
    raise Exception.Create(ErrorMsg);
end;
                {1}
procedure TCustomFasterSocket.ProcessTCPSelect(var Msg: TMessage);
var
  CSocket: TCustomFasterSocket;
  SelectEvent, I: LongInt;
  MS: TMemoryStream;
  PacketData: TMemoryStream;

  DataAvail: LongInt; //data size
  HeaderInfo: TFasterHeader;
begin
  {$IFDEF DEBUGMODEON}
    DebugInfo.Add('Processing TCPSelect.');
  {$ENDIF}
  I := WSAGetSelectError(Msg.LParam);
  If I > WSABASEERR then
    SocketError(Msg.wParam, I)
  else
   begin
    SelectEvent := WSAGetSelectEvent(Msg.lParam);
    case SelectEvent of
      FD_READ: begin  { check whether data available }
        If IoctlSocket(Msg.wParam, FIONREAD, DataAvail) = SOCKET_ERROR then begin
           SocketError(Msg.wParam, WSAGetLastError);
           Exit;
        end;
        If DataAvail = 0 then begin
          {$IFDEF DEBUGMODEON}
            DebugInfo.Add('##Error: Data was to be received but data_available is zero.');
          {$ENDIF}
          Exit;
        end;

        CSocket := Self;
        { If this is the server }
        If Assigned(FConnections) then
          for I := 0 to FConnections.Count - 1 do begin
            CSocket := FConnections[I];
            If CSocket.FSocket = Msg.wParam then Break; //find the right socket
          end;

        MS := TMemoryStream.Create;
        PacketData := TMemoryStream.Create;
        with MS do try
          {$IFDEF DEBUGMODEON}
            DebugInfo.Add('##Starting data receiving, ' + IntToStr(DataAvail) +
              ' bytes available.');
          {$ENDIF}

          ReceiveStreamFrom(CSocket.FSocket, MS, DataAvail, False);
          Seek(0, soFromBeginning);
          {$IFDEF DEBUGMODEON}
            DebugInfo.Add('##Received ' + IntToStr(MS.Size + HEADER_SIZE) +
              ' bytes of ' + IntToStr(DataAvail) + ' available.');
          {$ENDIF}

          Repeat //Split packets in case they stacked to one stream (because of high traffic)
            HeaderInfo := PacketStreamToPacket( MS, PacketData );
            If HeaderInfo.Size > 0 then begin
              If Assigned(FConnections) then
                ProcessCommands(TFasterTCPServerClient(CSocket), PacketData, HeaderInfo.Command) else
                ProcessCommands(nil, PacketData, HeaderInfo.Command);
              end;
          Until HeaderInfo.Size = 0;
        finally
          Free;
          PacketData.Free;
        end;
      end;
      FD_CLOSE: DoClose(Msg.wParam);
      FD_ACCEPT: DoAccept;
      FD_CONNECT: DoConnect;
      {$IFDEF DEBUGMODEON}
      else
         DebugInfo.Add('##TCPSelect Unhandled.');
      {$ENDIF}
     end;
   end;
end;

procedure TCustomFasterSocket.WndProc(var Message: TMessage);
begin
  with Message do
   try
     If Msg = WM_QUERYENDSESSION then
       Result := 1 // Correct shutdown
     else
       Dispatch(Msg);
   except
     Application.HandleException(Self);
   end;
end;           {2}







{-------------------------------------------------------------------------------------------}






{ TFasterTCPServer }
constructor TFasterTCPServer.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FConnections := TList.Create;
//  SelfClassType := OF_CLASS_SERVER;   {### Not needed in this version}
end;

destructor TFasterTCPServer.Destroy;
begin
  Listen := False;  // cancel listening
  FConnections.Free;
  inherited Destroy;
end;

Procedure TFasterTCPServer.AskMoreData(Client: TFasterTCPServerClient);
begin
  SendCommand(Client,ASK_MORE_DATA_ID,0,nil,True);
end;

procedure  TFasterTCPServer.AskToReceiveStream(Client: TFasterTCPServerClient; Const DataSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF};
                                                Const DataInfo: String);
Var
  TempStream: TMemoryStream;
  a: LongInt;
begin
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Asking client 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(Client,ASKING_TO_RECEIVE_DATA_ID,TempStream.Size,TempStream,False);
  Finally TempStream.Free; end;
end;
      
procedure TFasterTCPServer.Broadcast(Buffer: PChar; BufLength: LongInt);
var
  I: LongInt;
  IntBuf: LongInt;
  TempBuf: Pointer;
  PositionPointer: Pointer;
begin
  If BufLength = 0 then Exit;
  IntBuf := HEADER_SIZE + BufLength;
  GetMem(TempBuf,IntBuf);
  Try
    System.Move( IntBuf, TempBuf^, HEADER_SIZE_OF_SIZE ); //Write size
    PositionPointer := Pointer( LongInt( TempBuf ) + HEADER_SIZE_OF_SIZE );
    IntBuf := MESSAGE_Packet_ID;
    System.Move( IntBuf, PositionPointer^, HEADER_SIZE_OF_COMMAND ); //Write ID
    PositionPointer := Pointer( LongInt( PositionPointer ) + HEADER_SIZE_OF_COMMAND );
    System.Move( Buffer^, PositionPointer^, BufLength ); //Write data
  Except
    FreeMem(TempBuf);
  end;
  Try
    IntBuf := HEADER_SIZE + BufLength;
    For I := FConnections.Count - 1 downto 0 do
      SendBufferTo(TFasterTCPServerClient(FConnections[I]).FSocket,TempBuf,IntBuf);
  Finally
    FreeMem(TempBuf);
  end;
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Broadcasting message: ' + String(Buffer));
  {$ENDIF}
end;

procedure TFasterTCPServer.BroadcastStream(Stream: TStream; SendSize: LongInt);
var
  I: LongInt;
  IntBuf: LongInt;
  TempBuf: Pointer;  //There is no need to create a new packet for every client,
                    //instead we use buffer to send data.
  PositionPointer: Pointer;
begin                       //Code copied from SendPacketTo-procedure.
  If SendSize = 0 then Exit;

  IntBuf := HEADER_SIZE + SendSize;
  GetMem(TempBuf,IntBuf);
  Try                   //Creating packet manually
    System.Move( IntBuf, TempBuf^, HEADER_SIZE_OF_SIZE ); //Write size
    PositionPointer := Pointer( LongInt( TempBuf ) + HEADER_SIZE_OF_SIZE );
    IntBuf := BroadCast_STREAM_Packet_ID;
    System.Move( IntBuf, PositionPointer^, HEADER_SIZE_OF_COMMAND ); //Write ID
    PositionPointer := Pointer( LongInt( PositionPointer ) + HEADER_SIZE_OF_COMMAND );
    Stream.Read( PositionPointer^, SendSize ); //Write data
  Except
    FreeMem(TempBuf);
  end;
  Try       
    IntBuf := HEADER_SIZE + SendSize;
    For I := FConnections.Count - 1 downto 0 do
      SendBufferTo(TFasterTCPServerClient(FConnections[I]).FSocket,TempBuf,IntBuf);
  Finally
    FreeMem(TempBuf);
  end;
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Broadcasting stream, size: ' + IntToStr(SendSize));
  {$ENDIF}
end;

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

procedure TFasterTCPServer.DisconnectEveryone;
Var
  I: LongInt;
begin
   For I := FConnections.Count - 1 downto 0 do
    SendCommand(TFasterTCPServerClient(FConnections[I]),SERVER_DISCONNECT_YOU_ID,0,nil,False);
end;
            {1}
procedure TFasterTCPServer.DoAccept;
var
  Tmp: LongInt;
  tmpSocket: TSocket;
  tmpTCPClient: TFasterTCPServerClient;
  IsAccept: Boolean;
begin
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Client is connecting.');
  {$ENDIF}
  Tmp := SizeOf(SockAddrIn);
  {$IFNDEF D3}
  tmpSocket := WinSock.Accept(FSocket, SockAddrIn, Tmp);
  {$ELSE}
  tmpSocket := WinSock.Accept(FSocket, @SockAddrIn, @Tmp);
  {$ENDIF}
  If tmpSocket = SOCKET_ERROR then
    SocketError(tmpSocket, WSAGetLastError);

{$WARNINGS OFF}
  tmpTCPClient := TFasterTCPServerClient.Create(nil);
{$WARNINGS ON}
  tmpTCPClient.FSocket := tmpSocket;
  tmpTCPClient.FHost := inet_ntoa(SockAddrIn.SIn_Addr);
  tmpTCPClient.FPort := FPort;
  tmpTCPClient.FConnected := True;

  IsAccept := True; //Accept is true by default
  If Assigned(FOnAccept) then
   begin
    FOnAccept(Self, tmpTCPClient, IsAccept);
    If IsAccept then
      FConnections.Add(tmpTCPClient)
    else
      tmpTCPClient.Free;
   end
  else
   FConnections.Add(tmpTCPClient);

If IsAccept then
  SendCommand(tmpTCPClient,SERVER_ASK_REGISTER_NAME_ROOM_ID,0,nil,True);

  If Assigned(FOnClientConnected) then
    FOnClientConnected(Self, tmpTCPClient);
end;
          
procedure TFasterTCPServer.DoClose(Socket: TSocket);
var
  I: LongInt;
  tmpTCPClient: TFasterTCPServerClient;
begin
  {$IFDEF DEBUGMODEON}
    FDebugInfo.Add('Server closing down.');
  {$ENDIF}
  tmpTCPClient := nil;
   for I := 0 to FConnections.Count - 1 do
    begin
     tmpTCPClient := FConnections[I];
     If tmpTCPClient.FSocket = Socket then
      begin
       FConnections.Delete(I);
       Break;
      end;
    end;

  If Assigned(tmpTCPClient) then
   begin
    If Assigned(FOnClientDisconnected) and not (csDestroying in ComponentState) then
      FOnClientDisconnected(Self, tmpTCPClient);

    tmpTCPClient.Free;
   end;
end;    {2}

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

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

  If Client.FStreamDataReceived >= Client.FStream_FullSize then begin //completely received
    If Assigned(FOnStreamReceived) then
      FOnStreamReceived(Self, Client, Client.FStreamDataReceived, Client.FStreamDataInfo);
    SendCommand(Client,STREAM_RECEIVED_ID,0,nil,True);     
  end;
end;
       {1}
function TFasterTCPServer.GetLocalHostName: String;
var
  HostName: Array[0..MAX_PATH] of Char;
begin
  If GetHostName(HostName, MAX_PATH) = 0 then
    Result := HostName
  else
    SocketError(FSocket, WSAGetLastError);
end;
       
function TFasterTCPServer.GetLocalIP: String;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  HostName: Array[0..MAX_PATH] of Char;
begin
  If GetHostName(HostName, MAX_PATH) = 0 then
   begin
    HostEnt := GetHostByName(HostName);
    If HostEnt = nil then
      Result := ''
    else
     begin
      SockAddrIn.sin_addr.S_addr := LongInt(PInteger(HostEnt^.h_addr_list^)^);