frmserverform.pas

数据通信,没什么很详细的,只是一个素材源玛

unit frmServerForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, ExtCtrls, CheckLst, ComCtrls, Buttons,
  IdBaseComponent, IdComponent, IdTCPServer;

type
  TfrmServer = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    sptPort: TSpinEdit;
    btnStart: TBitBtn;
    btnStop: TBitBtn;
    StatusBar1: TStatusBar;
    IdTCPServer: TIdTCPServer;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    memLog: TMemo;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure IdTCPServerConnect(AThread: TIdPeerThread);
    procedure IdTCPServerDisconnect(AThread: TIdPeerThread);
    procedure IdTCPServerExecute(AThread: TIdPeerThread);
  private
    FRecMsg: String;
    { Private declarations }
    procedure LogMsg(AMsg:String);
    procedure SetRecMsg(const Value: String);
  public
    { Public declarations }
    Procedure DoStart;
    Procedure DoStop;
 //   Procedure ListClients;
    Procedure DisconnectFromClient(AClientThread:TIDPeerThread);
    Property RecMsg:String read FRecMsg write SetRecMsg;
  end;

var
  frmServer: TfrmServer;

implementation

{$R *.dfm}

{ TfrmServer }

procedure TfrmServer.DoStart;
begin
  if not Self.IdTCPServer.Active then
  begin
    Self.IdTCPServer.DefaultPort := Self.sptPort.Value;
    Self.IdTCPServer.Active := true;
    Self.btnStart.Enabled := false;
    Self.btnStop.Enabled := not Self.btnStart.Enabled;
    Self.LogMsg('Start');
  end;
end;

procedure TfrmServer.DoStop;
//var
//  i :integer;
//  lsClient:TList;
begin
//  if Self.IdTCPServer.Active then
//  begin
//    try
//      lsClient := Self.IdTCPServer.Threads.LockList;
//      for i := 0 to lsClient.Count -1 do
//      begin
//        TIDPeerThread(lsClient).Connection.WriteLn('DisConnect by Server!');
//        TIDPeerThread(lsClient).Connection.Disconnect();
 //     end;
 //   finally
 //     Self.IdTCPServer.Threads.UnlockList;
//    end;
    Self.IdTCPServer.Active := false;
    Self.btnStart.Enabled := true;
    Self.btnStop.Enabled := not Self.btnStart.Enabled;
    Self.LogMsg('Stop');
 // end;
end;

//procedure TfrmServer.ListClients;
//var
//  i :integer;
//  lsClients:TList;
//  AThread:TIDPeerThread;
//begin
//  try
//    lsClients := Self.IdTCPServer.Threads.LockList;
//    for i := 0 to lsClients.Count -1 do
//    begin
//      AThread := TIDPeerThread(lsClients.Items[i]);
//    end;
//  finally
//    Self.IdTCPServer.Threads.UnlockList;
//  end;
//end;

procedure TfrmServer.btnStartClick(Sender: TObject);
begin
  Self.DoStart;
end;

procedure TfrmServer.btnStopClick(Sender: TObject);
begin
  Self.DoStop;
end;

procedure TfrmServer.LogMsg(AMsg: String);
begin
  Self.memLog.Lines.Add(DateTimeToStr(Now)+' '+AMsg);
end;

procedure TfrmServer.IdTCPServerConnect(AThread: TIdPeerThread);
var
  Amsg :String;
begin
  AMsg := AThread.Connection.Socket.Binding.PeerIP+':'+
        Inttostr(AThread.Connection.Socket.Binding.PeerPort)+
        ' Connected ';
  Self.LogMsg(AMsg);
//  Self.ListClients;

end;

procedure TfrmServer.IdTCPServerDisconnect(AThread: TIdPeerThread);
var
  Amsg :String;
begin
  AMsg := AThread.Connection.Socket.Binding.PeerIP+':'+
        Inttostr(AThread.Connection.Socket.Binding.PeerPort)+
        ' DisConnected ';
  Self.LogMsg(AMsg);
//  Self.ListClients;
end;

procedure TfrmServer.IdTCPServerExecute(AThread: TIdPeerThread);
var
  Amsg :String;
begin
try
  Self.RecMsg := AThread.Connection.ReadLn();
  if Self.RecMsg<>'' then
  begin
    AMsg := ' Recieve [  '+Self.RecMsg+'  ] from '+
          AThread.Connection.Socket.Binding.PeerIP+':'+
          Inttostr(AThread.Connection.Socket.Binding.PeerPort);
    Self.LogMsg(AMsg);
    AThread.Connection.WriteLn(AMsg);
  end;
except
  ;
end;
end;

procedure TfrmServer.SetRecMsg(const Value: String);
begin
  FRecMsg := Value;
end;

procedure TfrmServer.DisconnectFromClient(AClientThread: TIDPeerThread);
begin
  AClientThread.Connection.Disconnect();
end;
end.