personal.pas

基于delphi的聊天室工具

unit personal;

interface

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

type
  Tfmper = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    OpenDialog1: TOpenDialog;
    ProgressBar1: TProgressBar;
    StatusBar1: TStatusBar;
    Button5: TButton;
    SaveDialog1: TSaveDialog;
    IdTCPServer1: TIdTCPServer;
    IdTCPClient1: TIdTCPClient;
    Timer1: TTimer;
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    AFileStream: TFileStream; //传输的文件流
  public
    { Public declarations }
  end;

var
  fmper: Tfmper;

implementation

uses csMain,IP;

{$R *.dfm}

procedure Tfmper.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
  if (key=#13) and (Memo1.Text<>'') then
      begin
        frmCChat.cs.Socket.SendText('私聊@#!^'+HisIP+'^'+HisPort+'^'+username+'说：'+Memo1.Text+'^');
        Memo2.Lines.Add(username+'说：'+Memo1.Text);
        Memo1.Text:='';
      end;
end;

procedure Tfmper.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Edit1.Text := OpenDialog1.FileName;
  Button2.Enabled := True;
  Button3.Enabled := False;
end;

procedure Tfmper.Button2Click(Sender: TObject);
begin
if not FileExists(Edit1.Text) then //检测文件是否存在
  begin
    Showmessage('文件不存在，请选择文件！');
    exit;
  end;
  frmCChat.cs.Socket.SendText('文件@#!^'+ HisIP +'^'+HisPort+'^');
  //建立文件流
  AFileStream := TFileStream.Create(Edit1.Text, fmOpenRead);
  ProgressBar1.Max := AFileStream.Size;
  ProgressBar1.Position := 0;
  Button1.Enabled := False;
  Button2.Enabled := False;
  Button3.Enabled := True;
  IdTCPServer1.DefaultPort :=9925;
  if not IdTCPServer1.Active then
    IdTCPServer1.Active := True;
end;

procedure Tfmper.Button3Click(Sender: TObject);
begin
  StatusBar1.SimpleText := '传输取消...';
  AFileStream.Free; //释放文件流
  Button1.Enabled := True;
  Button2.Enabled := True;
  Button3.Enabled := False;
end;

procedure Tfmper.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 //传输完成
      StatusBar1.SimpleText := '传输完成...';
      Timer1.Enabled:=True;
      exit;
    end;
    if cmd = 'CANCEL' then
    begin //传输取消
      StatusBar1.SimpleText := '传输取消...';
      Timer1.Enabled:=True;
      Exit;
    end;
    if cmd = 'REFUSE' then
    begin //传输取消
      StatusBar1.SimpleText := '传输拒绝...';
      Timer1.Enabled:=True;
      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('当前传输位置%d/大小%d', [StrToInT(cmd)+2*ASize, AFileStream.Size]);
    ProgressBar1.Position := ProgressBar1.Position + ASize;
  end;
end;

procedure Tfmper.Button4Click(Sender: TObject);
var
  cmd: string;
  ASize, TotalSize: Int64;
  AFileStream: TFileStream;
begin
  sleep(100);
  IdTCPClient1.Host := TcpSerIP ; //连接主机
  IdTCPClient1.Port := 9925; //端口
  IdTCPClient1.Connect; //连接
  Button4.Enabled:=False;
  Button5.Enabled:=False;
  try
    IdTCPClient1.WriteLn('BEGIN'); //提示服务器开始接收
    cmd := IdTCPClient1.ReadLn;
    //以“|”符号分离文件名
    SaveDialog1.FileName := Copy(cmd, Pos('|', cmd) + 1, Length(cmd));
    if not SaveDialog1.Execute then
    begin
      IdTCPClient1.WriteLn('CANCEL'); //告诉服务器取消
      IdTCPClient1.Disconnect; //断开连接
      exit;
    end;
    TotalSize := StrToInt(Copy(cmd, 0, Pos('|', cmd) - 1)); //分离文件大小
    //建立文件流准备接收
    AFileStream := TFileStream.Create(SaveDialog1.FileName, fmCreate);
    ProgressBar1.Max := TotalSize;
    ProgressBar1.Position := 0;
    try //循环开始接受
      repeat
        IdTCPClient1.WriteLn(IntToStr(AFileStream.Size));//发送当前传输的位置
        ASize := Min(TotalSize - AFileStream.Size, IdTCPClient1.RecvBufferSize);
        //选择剩余大小和缓冲区大小小的一个作为传输的大小
        IdTCPClient1.ReadStream(AFileStream, ASize); //接收流
        StatusBar1.SimpleText := Format('当前传输位置%d/大小%d', [AFileStream.Size, TotalSize]);
        ProgressBar1.Position := AFileStream.Size;
        Application.ProcessMessages;
      until AFileStream.Size = TotalSize; //大小一致了表示结束
    finally
      AFileStream.Free; //释放文件流
    end;
    IdTCPClient1.WriteLn('END'); //提示服务器传输完成
    StatusBar1.SimpleText := '传输完成...';
  except
    StatusBar1.SimpleText := '连接服务器失败或者对方已经中断传输！';
  end;
  IdTCPClient1.Disconnect;
end;

procedure Tfmper.Button5Click(Sender: TObject);
begin
  IdTCPClient1.Host := TcpSerIP ; //连接主机
  IdTCPClient1.Port := 9925; //端口
  IdTCPClient1.Connect; //连接
  Button4.Enabled:=False;
  Button5.Enabled:=False;
  IdTCPClient1.WriteLn('REFUSE'); //告诉服务器取消
  IdTCPClient1.Disconnect; //断开连接
  StatusBar1.SimpleText := '传输拒绝...';
end;

procedure Tfmper.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled:=False;
  IdTCPServer1.Active:=False;
  Button1.Enabled:=True;
  Button2.Enabled:=True;
  Button3.Enabled:=False;
end;

end.