mainfrm.pas

《delphi深度编程及其项目开发》

unit Mainfrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer,
  IdTCPConnection, IdTCPClient, ExtCtrls,communication,DiskList, Menus;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    btnClientOpen: TButton;
    btnServerOpen: TButton;
    btnClientSend: TButton;
    btnServerRecv: TButton;
    btnClientStop: TButton;
    btnServerStop: TButton;
    btnClientClose: TButton;
    btnServerClose: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    mmoRecv: TMemo;
    mmoSend: TMemo;
    procedure btnClientOpenClick(Sender: TObject);
    procedure btnServerOpenClick(Sender: TObject);
    procedure btnClientSendClick(Sender: TObject);
    procedure btnServerRecvClick(Sender: TObject);
    procedure btnClientStopClick(Sender: TObject);
    procedure btnServerStopClick(Sender: TObject);
    procedure btnClientCloseClick(Sender: TObject);
    procedure btnServerCloseClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
  //客户端发送线程
  TclientSend = class(TThread)
  private
    procedure send;
  public
    procedure execute; override;
  end;
  //服务器端接收线程
  TServerRecv = class(TThread)
  private
    procedure recv;
  public
    procedure execute; override;
  end;

var
  frmMain: TfrmMain;
  //标识客户端的发送线程是否运行
  clientSend: boolean = False;
  //标识服务器端的接收线程是否运行
  serverRecv: boolean = false;
implementation

{$R *.dfm}

//线程执行函数，循环向队列里写数据，作为测试使用
procedure TclientSend.send;
var
  sendStr: string;
begin
  sendStr := 'welcome to Program in Delphi';
  while ClientSend do
  begin
    if ClientWriteBuffer(sendStr, Length(sendStr)) < 0 then
    begin
      clientSend := false;
      showMessage('磁盘队列已满');
    end;
    frmMain.mmoSend.Lines.Add(sendStr);
    sleep(90);
    application.ProcessMessages;
  end;
end;

//线程执行
procedure TClientSend.execute;
begin
  synchronize(send);
end;

//线程执行函数，循环从队列检测是否有可读队列，
//如有，便读出来
procedure TServerRecv.recv;
var
  recvStr: string;
  buffersize: integer;
begin
  while serverRecv do
  begin
    recvstr := '';
    bufferSize := 0;
    serverReadBuffer(recvstr, buffersize);
    if bufferSize > 0 then
      frmMain.mmoRecv.lines.add(recvStr);
    sleep(100);
    application.ProcessMessages;
  end;
end;

//线程执行
procedure TServerRecv.execute;
begin
  synchronize(recv);
end;

//调用initServerConnect初始化服务器端的连接，开始监听，
//并在服务器端建立或打开磁盘队列
procedure TfrmMain.btnServerOpenClick(Sender: TObject);
begin
  if not initServerConnect(1234, 'd:\Server.dat', 1024 * 1024) then
    raise exception.Create('error');
end;

//调用initClientConnect初始化客户端的连接，
//并建立或打开磁盘队列
procedure TfrmMain.btnClientOpenClick(Sender: TObject);
begin
  if not initClientConnect('127.0.0.1', 1234, 'd:\client.dat', 1024 * 1024) then
    raise exception.Create('error');
end;

//服务器端调用线程，循环向从队列里读出数据
procedure TfrmMain.btnServerRecvClick(Sender: TObject);
begin
  ServerRecv := True;
  TServerRecv.Create(false);
end;

//客户端调用线程，循环向队列里写数据
procedure TfrmMain.btnClientSendClick(Sender: TObject);
begin
  ClientSend := True;
  TClientSend.Create(False);
end;

//停止服务器端读队列线程
procedure TfrmMain.btnServerStopClick(Sender: TObject);
begin
  ServerRecv := False;
end;

//停止客户端写队列线程
procedure TfrmMain.btnClientStopClick(Sender: TObject);
begin
  ClientSend := False;
end;

//关闭服务器端Socket的连接
procedure TfrmMain.btnServerCloseClick(Sender: TObject);
begin
  DesServerConnect;
end;

//关闭客户端socket的连接
procedure TfrmMain.btnClientCloseClick(Sender: TObject);
begin
  desClientConnect;
end;


end.