Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi ServerSocket executing only 2 events on stThreadBlocking mode (https://www.delphipraxis.net/194761-serversocket-executing-only-2-events-stthreadblocking-mode.html)

flashcoder 2. Jan 2018 14:31

Delphi-Version: XE5

ServerSocket executing only 2 events on stThreadBlocking mode
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hello,

i have this following code that use ServerSocket component in stThreadBlocking mode.
My trouble is that only OnListen and OnGetThread events are executed in this mode (stThreadBlocking).
How i must make to execute others events?

PS: following was compiled on Delphi XE5

Delphi-Quellcode:
type
  TSock_Thread = class(TServerClientThread)
  private
    Png: TPngImage;
    procedure PngReceived;
  protected
    procedure ClientExecute; override;
  end;

type
  TInt32Bytes = record
    case Integer of
      0:
        (Bytes: array [0 .. SizeOf(Int32) - 1] of Byte);
      1:
        (Value: Int32);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
// ===============================================================================

procedure TSock_Thread.ClientExecute;
var
  SocketStrm: TWinSocketStream;
  Buffer: TMemoryStream;
  Size: TInt32Bytes;
  Offset: Integer;
  BytesReceived: Integer;
  BufferPtr: PByte;
begin
  SocketStrm := TWinSocketStream.Create(ClientSocket, 5000);
  try
    Buffer := TMemoryStream.Create;
    try
      Png := TPngImage.Create;
      try
        while ClientSocket.Connected do
        begin
          if not SocketStrm.WaitForData(100) then
            Continue;

          Offset := 0;
          while Offset < SizeOf(Int32) do
          begin
            BytesReceived := SocketStrm.Read(Size.Bytes[Offset],
              SizeOf(Int32) - Offset);
            if BytesReceived <= 0 then
              Exit;
            Inc(Offset, BytesReceived);
          end;
          Size.Value := ntohl(Size.Value);
          Buffer.Size := Size.Value;
          BufferPtr := PByte(Buffer.Memory);

          Offset := 0;
          while Offset < Size.Value do
          begin
            BytesReceived := SocketStrm.Read(BufferPtr^, Size.Value - Offset);
            if BytesReceived <= 0 then
              Exit;
            Inc(BufferPtr, BytesReceived);
            Inc(Offset, BytesReceived);
          end;

          Buffer.Position := 0;
          try
            Png.LoadFromStream(Buffer);
          except
            Png.Assign(nil);
          end;

          Synchronize(PngReceived);
        end;
      finally
        Png.Free;
      end;
    finally
      Buffer.Free;
    end;
  finally
    SocketStrm.Free;
  end;
end;

procedure TSock_Thread.PngReceived;
var
  Item: TListItem;
begin
  Item := Form1.ListView1.Selected;
  if (Item <> nil) and (Item.Data = ClientSocket) then
    Form1.img1.Picture.Graphic := Png;
end;

//================================================================================

procedure TForm1.Ativar1Click(Sender: TObject);
begin
  ServerSocket1.Active := true;
end;

procedure TForm1.Desativar1Click(Sender: TObject);
begin
  ServerSocket1.Active := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.DoubleBuffered := true;
end;

procedure TForm1.Foto1Click(Sender: TObject);
var
  Index: Integer;
begin
  Index := ListView1.ItemIndex;
  if Index = -1 then
    Exit;
  ServerSocket1.Socket.Connections[Index].SendText('screencapture' + #13#10);
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  Item: TListItem;
begin
  Item := Form1.ListView1.Items.Add;
  Item.Caption := IntToStr(Socket.Handle);
  Item.SubItems.Add(Socket.RemoteAddress);
  Item.SubItems.Add(Socket.RemoteHost);
  Item.Data := Socket.Data;
  Form1.stat1.Panels.Items[1].Text := 'Conectado';
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  Item: TListItem;
begin
  Item := Form1.ListView1.FindData(0, Socket, true, False);
  if Item <> nil then
    Item.Delete;
  Form1.stat1.Panels.Items[1].Text := 'Desconectado';
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ErrorCode := 0;
  Socket.Close;
  Form1.stat1.Panels.Items[1].Text := 'Erro ao conectar';
end;

procedure TForm1.ServerSocket1GetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
  SocketThread := TSock_Thread.Create(False, ClientSocket);
end;

procedure TForm1.ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
begin
  Form1.stat1.Panels.Items[1].Text := 'Aguardando conexões na porta: ' + IntToStr(ServerSocket1.Port);
end;

flashcoder 8. Jan 2018 15:27

AW: ServerSocket executing only 2 events on stThreadBlocking mode
 
Thank to all by attention, but i already solved this question.


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:09 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz