IDTCP - Rustam - 11-23-2018
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
RE: IDTCP - rlebeau - 11-23-2018
I already addressed this on your same question on StackOverflow. However, what you have shown here is not quite the same code you posted on StackOverflow. For instance, your server event handlers are accessing the UI without synchronizing with the main UI thread. You did not show that on StackOverflow.
RE: IDTCP - Rustam - 11-25-2018
(11-23-2018, 08:55 PM)rlebeau Wrote: I already addressed this on your same question on StackOverflow. However, what you have shown here is not quite the same code you posted on StackOverflow. For instance, your server event handlers are accessing the UI without synchronizing with the main UI thread. You did not show that on StackOverflow.
Everything works, thank you. One more question, how to send by tcp from the form (for example, by pressing a button Rec.Flag: = 'addPass'). We created a TIdTCPClient in Execute, and now I cannot pass parameters from the form. I need to transfer data from the form every time, not to make a stream every time. and why my client form not close, FMyThread.WaitFor, FMyThread.Free - keeps the form from closing
RE: IDTCP - rlebeau - 11-25-2018
(11-25-2018, 06:37 PM)Rustam Wrote: One more question, how to send by tcp from the form (for example, by pressing a button Rec.Flag: = 'addPass'). We created a TIdTCPClient in Execute, and now I cannot pass parameters from the form. I need to transfer data from the form every time, not to make a stream every time. and why my client form not close, FMyThread.WaitFor, FMyThread.Free - keeps the form from closing
I already addressed those on your StackOverflow post. Please stop repeating things here. Pick one forum and stick with it. Either post there, or post here, please not both.
|