开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > P2P编程 > 查看源码
06_U_Server.pas
资源名称：网络文件传输原代码.rar　[点击查看]
上传用户：lzzxgs
上传日期：2013-03-15
资源大小：474k
文件大小：4k
源码类别：

P2P编程

开发平台：

Delphi

06_U_Server.pas：源码内容
  1. unit U_Server;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPServer, Math;
  9. type
  10.   Tfrm_Server = class(TForm)
  11.     IdTCPServer1: TIdTCPServer;
  12.     Button1: TButton;
  13.     Button2: TButton;
  14.     Button3: TButton;
  15.     ProgressBar1: TProgressBar;
  16.     StatusBar1: TStatusBar;
  17.     Edit1: TEdit;
  18.     Button4: TButton;
  19.     OpenDialog1: TOpenDialog;
  20.     Edit2: TEdit;
  21.     Label1: TLabel;
  22.     Label2: TLabel;
  23.     procedure Button1Click(Sender: TObject);
  24.     procedure Button4Click(Sender: TObject);
  25.     procedure Button2Click(Sender: TObject);
  26.     procedure Button3Click(Sender: TObject);
  27.     procedure IdTCPServer1Execute(AThread: TIdPeerThread);
  28.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  29.   private
  30.     AFileStream: TFileStream; //传输的文件流
  31.     procedure ButtonBegin;
  32.     procedure ButtonEnd;
  33.     { Private declarations }
  34.   public
  35.     { Public declarations }
  36.   end;
  38. var
  39.   frm_Server: Tfrm_Server;
  41. implementation
  43. {$R *.dfm}
  45. procedure Tfrm_Server.Button1Click(Sender: TObject);
  46. begin
  47.   if OpenDialog1.Execute then
  48.     Edit1.Text := OpenDialog1.FileName;
  49. end;
  51. procedure Tfrm_Server.Button4Click(Sender: TObject);
  52. begin
  53.   Close;
  54. end;
  56. procedure Tfrm_Server.Button2Click(Sender: TObject);
  57. begin
  58.   if not FileExists(Edit1.Text) then //检测文件是否存在
  59.   begin
  60.     Showmessage('文件不存在，请选择文件！');
  61.     //exit;
  62.   end
  63.   else
  64.   begin
  65.   //建立文件流
  66.   AFileStream := TFileStream.Create(Edit1.Text, fmOpenRead);
  67.   ProgressBar1.Max := AFileStream.Size;
  68.   ProgressBar1.Position := 0;
  69.   ButtonBegin; //VCL开始状态设置
  70.   //服务器准备好连接
  71.   IdTCPServer1.DefaultPort := StrToIntDef(Edit2.Text, 9925);
  72.   if not IdTCPServer1.Active then IdTCPServer1.Active := True;
  73.   end;
  74. end;
  76. procedure Tfrm_Server.ButtonBegin;
  77. begin //VCL开始状态设置
  78.   Button1.Enabled := False;
  79.   Button2.Enabled := False;
  80.   Button3.Enabled := True;
  81.   Button4.Enabled := False;
  82. end;
  84. procedure Tfrm_Server.ButtonEnd;
  85. begin //VCL结束状态设置
  86.   Button1.Enabled := True;
  87.   Button2.Enabled := True;
  88.   Button3.Enabled := False;
  89.   Button4.Enabled := True;
  90. end;
  92. procedure Tfrm_Server.Button3Click(Sender: TObject);
  93. begin
  94.   StatusBar1.SimpleText := '传输取消...';
  95.   AFileStream.Free; //释放文件流
  96.   ButtonEnd; //VCL结束状态设置
  97. end;
  99. procedure Tfrm_Server.IdTCPServer1Execute(AThread: TIdPeerThread);
  100. var
  101.   cmd: string; //接收到客户端的字符串信息
  102.   ASize: Integer; //需要传输的流大小
  103. begin
  104.   with AThread.Connection do //已经连街上的一个进程
  105.   begin
  106.     cmd := UpperCase(ReadLn); //客户端发送的命令字符串
  107.     if cmd = 'BEGIN' then //开始传输
  108.     begin
  109.       //告诉远程传输文件的大小和文件名
  110.       WriteLn(Format('%d|%s', [AFileStream.Size, ExtractFileName(Edit1.Text)]));
  111.       StatusBar1.SimpleText := '准备传输...';
  112.       Exit;
  113.     end;
  114.     if cmd = 'END' then
  115.     begin //传输完成
  116.       Button3.Click;
  117.       StatusBar1.SimpleText := '传输完成...';
  118.       Exit;
  119.     end;
  120.     if cmd = 'CANCEL' then
  121.     begin //传输取消
  122.       StatusBar1.SimpleText := '传输取消...';
  123.       //保持传输状态
  124.       Exit;
  125.     end;
  126.     //按照指定位置传输文件
  127.     AFileStream.Seek(StrToInT(cmd), soFromBeginning); //转到文件流传输的位置
  128.     ASize := Min(AFileStream.Size - AFileStream.Position, RecvBufferSize);
  129.     //计算需要发送的大小，Min()函数在Math单元
  130.     OpenWriteBuffer; //准备发送缓冲
  131.     WriteStream(AFileStream, false, false, ASize);
  132.     //注意这个函数的参数。
  133.     CloseWriteBuffer; //结束发送缓冲
  134.     StatusBar1.SimpleText := Format('当前传输位置%s/大小%d', [cmd, AFileStream.Size]);
  135.     ProgressBar1.Position := ProgressBar1.Position + ASize;
  136.   end;
  137. end;
  139. procedure Tfrm_Server.FormClose(Sender: TObject; var Action: TCloseAction);
  140. begin
  141.   IdTCPServer1.Active := False;
  142. end;
  144. end.