现在的位置: 首页 > 综合 > 正文

DELPHI TIdTCPClient,TIdTCPServer,SOCKET通讯小例子

2013年06月27日 ⁄ 综合 ⁄ 共 3215字 ⁄ 字号 评论关闭

SERVER:

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Sockets, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdTCPServer;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    IdTCPServer1: TIdTCPServer;
    Button2: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure Button2Click(Sender: TObject);
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPServer1.DefaultPort:=167;
IdTCPServer1.Active:=True;
Memo1.Lines.Append('启动成功!');
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  str:string;
begin
  with AThread.Connection do
  begin
    str:=readln('',20);
    Memo1.Lines.Append('来自'+Socket.Binding.PeerIP+'的数据');
    Memo1.Lines.Append(str);
    WriteLn('数据接收成功');
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Threads:TThreadList;
  LThreads:TList;
  i:integer;
  AThread: TIdPeerThread;
begin
  if IdTCPServer1.Active then
  begin
    Threads:=IdTCPServer1.Threads;
    if Assigned(Threads) then
    begin
      LThreads:=Threads.LockList;
      try
        for i:=0 to LThreads.Count-1 do
        begin
          AThread:=TIdPeerThread(LThreads[i]);
          AThread.Connection.WriteLn(Edit1.Text);
        end;
      finally
        Threads.UnlockList;
      end;
    end;
  end;
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
  str:string;
begin
  str:=AThread.Connection.Socket.Binding.PeerIP;
  Memo1.Lines.Append(str+'连接成功!');
end;

end.
---------------------------------------------------------

CLIENT:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Sockets, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    IdTCPClient1: TIdTCPClient;
    Edit1: TEdit;
    Button2: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure IdTCPClient1Disconnected(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPClient1.Host :='127.0.0.1';
IdTCPClient1.Port :=167;
IdTCPClient1.Connect();
Timer1.Enabled:=true;    //死在那里为什么,下面的 Timer1 事件里有解决方法,唯一的哦,嘿嘿
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
Memo1.Lines.Append('已连接');
end;

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
Memo1.Lines.Append('已断开');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with IdTCPClient1 do
  begin
    try
      WriteLn(Edit1.Text);
      Memo1.Lines.Append(ReadLn());
    except
      Memo1.Lines.Append('发送数据失败');
    end;

  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  temp:string; 
begin
  IdTCPClient1.readfromstack(false,1,false);       //結案啦?那只好給大家自己去參考我的解決方案啦!這是IDTcpConnection的bug,解決方法如下~~~~
  while IdTCPClient1.InputBuffer.Size>0 do begin
     temp:=IdTCPClient1.ReadLn;
     Memo1.Lines.Append(temp);
  end;
end;

end.

【上篇】
【下篇】

抱歉!评论已关闭.