📄 frmthreadclientform.pas
字号:
unit frmThreadClientForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons, Spin, ExtCtrls, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient;
type
TfrmThreadClient = class(TForm)
Panel1: TPanel;
Label1: TLabel;
edtIP: TEdit;
Label2: TLabel;
sptPort: TSpinEdit;
btnConnect: TBitBtn;
btnDisConnect: TBitBtn;
btnSend: TBitBtn;
edtMsg: TEdit;
StatusBar1: TStatusBar;
memLog: TMemo;
IdTCPClient: TIdTCPClient;
procedure btnConnectClick(Sender: TObject);
procedure btnDisConnectClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure IdTCPClientConnected(Sender: TObject);
procedure IdTCPClientDisconnected(Sender: TObject);
private
FRecStr: String;
procedure SetRecStr(const Value: String);
{ Private declarations }
public
{ Public declarations }
Procedure DoConnect();
Procedure DoDisConnect();
Procedure DoSendMsg();
Procedure DoLog(AMsg :String);
Procedure DoSynchronize();
Property RecStr :String read FRecStr write SetRecStr;
end;
TClientThread = Class(TThread)
private
FMainThreadForm: TfrmThreadClient;
procedure SetMainThreadForm(const Value: TfrmThreadClient);
public
Procedure Execute();Override;
Destructor Destroy;Override;
Property MainThreadForm:TfrmThreadClient read FMainThreadForm write SetMainThreadForm;
end;
var
frmThreadClient: TfrmThreadClient;
implementation
{$R *.dfm}
{ TfrmThreadClient }
procedure TfrmThreadClient.DoConnect;
begin
if not Self.IdTCPClient.Connected then
begin
Self.IdTCPClient.Host := Self.edtIP.Text;
Self.IdTCPClient.Port := Self.sptPort.Value;
Self.IdTCPClient.Connect(5000);
end;
end;
procedure TfrmThreadClient.DoDisConnect;
begin
if Self.IdTCPClient.Connected then
begin
Self.IdTCPClient.Disconnect();
end;
end;
procedure TfrmThreadClient.DoLog(AMsg: String);
var
AStr :String;
begin
AStr := DatetimeToStr(Now)+' '+ AMsg;
Self.memLog.Lines.Add(AStr);
end;
procedure TfrmThreadClient.DoSendMsg;
var
ALogStr :String;
begin
if Self.IdTCPClient.Connected then
begin
Self.IdTCPClient.WriteLn(Self.edtMsg.Text);
ALogStr := 'Send [ ' + Self.edtMsg.Text +' ] to '+
Self.edtIP.Text + InttoStr(Self.sptPort.Value);
Self.DoLog(ALogStr);
end
else
begin
Showmessage(' 发送数据之前请确保连接已经建立! ');
end;
end;
procedure TfrmThreadClient.btnConnectClick(Sender: TObject);
begin
Self.DoConnect;
end;
procedure TfrmThreadClient.btnDisConnectClick(Sender: TObject);
begin
Self.DoDisConnect;
end;
procedure TfrmThreadClient.btnSendClick(Sender: TObject);
begin
Self.DoSendMsg;
end;
procedure TfrmThreadClient.IdTCPClientConnected(Sender: TObject);
var
ALogStr :String;
AClientThread :TClientThread;
begin
Self.btnConnect.Enabled := false;
Self.btnDisConnect.Enabled:= not Self.btnConnect.Enabled;
Self.btnSend.Enabled := not Self.btnConnect.Enabled;
ALogStr := 'Connect to Svr :'+ Self.edtIP.Text +
inttostr(Self.sptPort.Value);
Self.DoLog(ALogStr);
Self.DoLog('启动后台接收线程');
AClientThread := TClientThread.Create(True); //新的线程创建的时候处于 Suspeded 状态,不工作
AClientThread.FreeOnTerminate := true ;// 当线程关闭时释放线程对象
AClientThread.MainThreadForm := Self;
AClientThread.Resume ; //启动后台线程,开始工作
end;
procedure TfrmThreadClient.IdTCPClientDisconnected(Sender: TObject);
var
ALogStr :String;
begin
Self.btnConnect.Enabled := True;
Self.btnDisConnect.Enabled:= not Self.btnConnect.Enabled;
Self.btnSend.Enabled := not Self.btnConnect.Enabled;
ALogStr := 'DisConnect from Svr :'+ Self.edtIP.Text +
inttostr(Self.sptPort.Value);
Self.DoLog(ALogStr);
end;
procedure TfrmThreadClient.DoSynchronize();
var
AlogStr :String;
begin
AlogStr := 'Recieve [ '+ Self.RecStr +' ] from '+
Self.edtIP.Text+':'+
IntToStr(Self.sptPort.Value);
Self.DoLog(Self.RecStr);
end;
procedure TfrmThreadClient.SetRecStr(const Value: String);
begin
FRecStr := Value;
end;
{ TClientThread }
destructor TClientThread.Destroy;
begin
inherited;
end;
procedure TClientThread.Execute;
var
ARecStr :String ;//接收到的数据
ALogStr :String ;
begin
ARecStr := '';
while ((ARecStr='' ) and ( not Self.Terminated))do
begin
try
if Self.MainThreadForm.IdTCPClient.Connected then
begin
ARecStr := Self.MainThreadForm.IdTCPClient.ReadLn('',1000);
if ARecStr <> '' then
begin
Self.MainThreadForm.RecStr := ARecStr ;
Synchronize(Self.MainThreadForm.DoSynchronize);
end;
end
else
begin
Self.Terminate;
end;
finally
ARecStr := '';
end;
end;
end;
procedure TClientThread.SetMainThreadForm(const Value: TfrmThreadClient);
begin
FMainThreadForm := Value;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -