Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
IDTCP
#1
Hello, i have code server
Code:
unit Unit1;

interface

uses
 System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
 FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
 IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
 FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, IdGlobal;

type
 TRec_Data = record
   Flag: char;
 end;

 TForm1 = class(TForm)
   IdTCPServer1: TIdTCPServer;
   Memo1: TMemo;
   procedure IdTCPServer1Execute(AContext: TIdContext);
   procedure IdTCPServer1Connect(AContext: TIdContext);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
 Rec : TRec_Data;
 Buffer: TIdBytes;
begin
 Form1.Memo1.Lines.Insert(0, 'подключился');
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
 Rec : TRec_Data;
 Buffer: TIdBytes;
begin
 Rec.Flag := '3';
 Buffer := RawToBytes(Rec, SizeOf(Rec));
 AContext.Connection.Socket.Write(Buffer);
 Form1.Memo1.Lines.Insert(0, Rec.Flag);

 Rec.Flag := '2';
 Buffer := RawToBytes(Rec, SizeOf(Rec));
 AContext.Connection.Socket.Write(Buffer);
 Form1.Memo1.Lines.Insert(0, Rec.Flag);
end;

end.


and code client
Code:
unit Unit1;

interface

uses
 System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
 FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
 System.Generics.Collections,
 IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo;

type
 TRec_Data = record
   Flag: char;
 end;

 TMyThread = class(TThread)
 private
   Progress: string;
   Client : TIdTCPClient;
   FQueue : TThreadedQueue<TRec_Data>;
 protected
   procedure Execute; override;
 public
   constructor Create(const AQueue : TThreadedQueue<TRec_Data>);
   destructor Destroy; override;
 end;

 TForm1 = class(TForm)
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   { Private declarations }
   FQueue : TThreadedQueue<TRec_Data>;
   FMyThread : TMyThread;
   Timer : TTimer;
   procedure OnTimer(Sender: TObject);
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
 FQueue:=TThreadedQueue<TRec_Data>.Create(100, 100, 10);

 Timer:=TTimer.Create(Self);
 Timer.Interval:=1000;
 Timer.OnTimer:=OnTimer;
 Timer.Enabled:=True;

 FMyThread:=TMyThread.Create(FQueue);
 FMyThread.Start;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 if Assigned(FMyThread) then
 begin
   FMyThread.Terminate;
   FMyThread.WaitFor;
   FMyThread.Free;
 end;
 if Assigned(Timer) then
   Timer.Free;
 if Assigned(FQueue) then
   FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
Var ARec : TRec_Data;
begin
 while FQueue.PopItem(ARec) = TWaitResult.wrSignaled do
//  if FQueue.PopItem(ARec) = TWaitResult.wrSignaled then
   Form1.Memo1.Lines.Insert(0, ARec.Flag);
end;

constructor TMyThread.Create(const AQueue : TThreadedQueue<TRec_Data>);
var
 Rec: TRec_Data;
 Buffer: TIdBytes;
begin
 inherited Create(true);

 FQueue:=AQueue;

 Client := TIdTCPClient.Create(nil);
 Client.Host := '127.0.0.1';
 Client.Port := 6000;
 Client.Connect;

//   Передаем данные
 if Client.Connected = True then
 begin
   Rec.Flag := '1';

   Buffer := RawToBytes(Rec, SizeOf(Rec));
   Client.IOHandler.Write(Buffer);
 end;
end;

destructor TMyThread.Destroy;
begin
 if Assigned(Client) then
   Client.Free;
 inherited;
end;

procedure TMyThread.Execute;
var
 Rec: TRec_Data;
 Buffer: TIdBytes;
begin
 while Not Terminated do
 begin
   if Client.Connected then
   begin
     if Client.IOHandler.InputBufferIsEmpty = false then
     begin
       Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
       BytesToRaw(Buffer, Rec, SizeOf(Rec));

       FQueue.PushItem(Rec);
     end;
   end
   else
     Client.Connect;
   TThread.Sleep(10);
 end;
end;


end.



why does the first message come several times, what is the error? 
Thanks
Reply


Messages In This Thread
IDTCP - by Rustam - 11-23-2018, 06:04 AM
RE: IDTCP - by rlebeau - 11-23-2018, 08:55 PM
RE: IDTCP - by Rustam - 11-25-2018, 06:37 PM
RE: IDTCP - by rlebeau - 11-25-2018, 07:52 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)