⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmthreadclientform.pas

📁 数据通信,没什么很详细的,只是一个素材源玛
💻 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 + -