unit1.pas

自写采用delphi控制的tcp通讯例程

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, Sockets, ScktComp, xmldom, XMLIntf, msxmldom,
  XMLDoc;

type
  TChatForm = class(TForm)
    MainMenu1: TMainMenu;
    ListenItem: TMenuItem;
    ConnectItem: TMenuItem;
    Disconnect: TMenuItem;
    Exit: TMenuItem;
    Memo1: TMemo;
    Memo2: TMemo;
    ClientSocket: TClientSocket;
    ServerSocket: TServerSocket;
    XMLDoc: TXMLDocument;
    loadXML: TMenuItem;
    procedure ListenItemClick(Sender: TObject);
    procedure ConnectItemClick(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ServerSocketAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ExitClick(Sender: TObject);
    procedure DisconnectClick(Sender: TObject);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ChatForm: TChatForm;
  IsServer:Boolean;
implementation

{$R *.dfm}
var root:IXMLNode;
var reqdata:IXMLNode;
var reqtop:IXMLNode;
var reqtrap:IXMLNode;

procedure TChatForm.ListenItemClick(Sender: TObject);
begin
  ListenItem.Checked:= not ListenItem.Checked;
  if ListenItem.Checked then
    begin
    ClientSocket.Active := False;
    ServerSocket.Active := True;
    Memo2.Lines.Add('服务器开启');
    end
  else
    begin
    if ServerSocket.Active then
    begin
      ServerSocket.Active := False;
      Memo2.Lines.Add('服务器关闭');
    end;
    end;
end;

procedure TChatForm.ConnectItemClick(Sender: TObject);
            var Server:String;
            begin
            if ClientSocket.Active then ClientSocket.Active := False;
            if InputQuery('Computer to connect', 'Address Name', Server) then
            if Length(Server)>0 then
            with ClientSocket do
            begin
            Host := Server;
            Active := True;
            ListenItem.Checked := False;
            end;
            end;


procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
            Shift: TShiftState);
            begin
            //if Key = VK_Return then

            end;



procedure TChatForm.ServerSocketAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    IsServer := True;
end;

procedure TChatForm.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
  var str:string;
begin
    Memo2.Lines.Add(socket.ReceiveText);
    str:= socket.ReceiveText;
    if str='newid'then
    begin
    ServerSocket.Socket.Connections[0].SendText(Memo1.Text);
    ServerSocket.Socket.Connections[0].SendText(#0);
    end;
end;

procedure TChatForm.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add('连接状态');
end;


procedure TChatForm.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TChatForm.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ListenItemClick(nil);
end;


procedure TChatForm.ExitClick(Sender: TObject);
begin
  ServerSocket.Close;
  ClientSocket.Close;
  Close;
end;

procedure TChatForm.DisconnectClick(Sender: TObject);
begin
  if IsServer then
  begin
  ServerSocket.Socket.Connections[0].SendText(Memo1.Text);
  ServerSocket.Socket.Connections[0].SendText(#0);
  end
  else
  begin
  ClientSocket.Socket.SendText(Memo1.Text);
  ClientSocket.Socket.SendText(#0);
  end;
end;

procedure TChatForm.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
       Memo2.Lines.Add('无连接');
end;


end.