01_u_server.pas

利用TCP协议连接双方

unit U_Server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPServer, Math;

type
  Tfrm_Server = class(TForm)
    IdTCPServer1: TIdTCPServer;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ProgressBar1: TProgressBar;
    StatusBar1: TStatusBar;
    Edit1: TEdit;
    Button4: TButton;
    OpenDialog1: TOpenDialog;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    AFileStream: TFileStream; //传输的文件流
    procedure ButtonBegin;
    procedure ButtonEnd;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_Server: Tfrm_Server;

implementation

{$R *.dfm}

procedure Tfrm_Server.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Edit1.Text := OpenDialog1.FileName;
end;

procedure Tfrm_Server.Button4Click(Sender: TObject);
begin
  Close;
end;

procedure Tfrm_Server.Button2Click(Sender: TObject);
begin
  if not FileExists(Edit1.Text) then //检测文件是否存在
  begin
    Showmessage('文件不存在，请选择文件！');
    //exit;
  end
  else
  begin
  //建立文件流
  AFileStream := TFileStream.Create(Edit1.Text, fmOpenRead);
  ProgressBar1.Max := AFileStream.Size;
  ProgressBar1.Position := 0;
  ButtonBegin; //VCL开始状态设置
  //服务器准备好连接
  IdTCPServer1.DefaultPort := StrToIntDef(Edit2.Text, 9925);
  if not IdTCPServer1..Active then IdTCPServer1.Active := True;
  end;
end;

procedure Tfrm_Server.ButtonBegin;
begin //VCL开始状态设置
  Button1.Enabled := False;
  Button2.Enabled := False;
  Button3.Enabled := True;
  Button4.Enabled := False;
end;

procedure Tfrm_Server.ButtonEnd;
begin //VCL结束状态设置
  Button1.Enabled := True;
  Button2.Enabled := True;
  Button3.Enabled := False;
  Button4.Enabled := True;
end;

procedure Tfrm_Server.Button3Click(Sender: TObject);
begin
  StatusBar1.SimpleText := '传输取消...';
  AFileStream.Free; //释放文件流
  ButtonEnd; //VCL结束状态设置
end;

procedure Tfrm_Server.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  cmd: string; //接收到客户端的字符串信息
  ASize: Integer; //需要传输的流大小
begin
  with AThread.Connection do //已经连街上的一个进程
  begin
    cmd := UpperCase(ReadLn); //客户端发送的命令字符串
    if cmd = 'BEGIN' then //开始传输
    begin
      //告诉远程传输文件的大小和文件名
      WriteLn(Format('%d|%s', [AFileStream.Size, ExtractFileName(Edit1.Text)]));
      StatusBar1.SimpleText := '准备传输...';
      Exit;
    end;
    if cmd = 'END' then
    begin //传输完成
      Button3.Click;
      StatusBar1.SimpleText := '传输完成...';
      Exit;
    end;
    if cmd = 'CANCEL' then
    begin //传输取消
      StatusBar1.SimpleText := '传输取消...';
      //保持传输状态
      Exit;
    end;
    //按照指定位置传输文件
    AFileStream.Seek(StrToInT(cmd), soFromBeginning); //转到文件流传输的位置
    ASize := Min(AFileStream.Size - AFileStream.Position, RecvBufferSize);
    //计算需要发送的大小，Min()函数在Math单元
    OpenWriteBuffer; //准备发送缓冲
    WriteStream(AFileStream, false, false, ASize);
    //注意这个函数的参数。
    CloseWriteBuffer; //结束发送缓冲
    StatusBar1.SimpleText := Format('当前传输位置%s/大小%d', [cmd, AFileStream.Size]);
    ProgressBar1.Position := ProgressBar1.Position + ASize;
  end;
end;

procedure Tfrm_Server.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  IdTCPServer1.Active := False;
end;

end.