利用Delphi中的IdTCPServer和IdTCPClient实现高效文件传输

其它某些文件传输代码精练很多,传输的文件大小任意,个人建议:写网络文件传输程序时最好用Indy的控件(因为其默认即阻塞模式,Server端已封装了多线程,没有数据包大小限制),ClientSocket VS ServerSocket传输文件很麻烦,要自定通信协议,并且有个8KB的瓶颈,实现大文件传输比较麻烦,

服务端发送:
var
    iFileHandle:integer;
    iFileLen,cnt:integer;
    buf:array[0..4096] of byte;
begin
    iFileHandle:=FileOpen('E:\Study\深入Delphi6网络编程.rar',fmOpenRead);
    iFileLen:=FileSeek(iFileHandle,0,2);
    FileSeek(iFileHandle,0,0);
    AThread.Connection.WriteInteger(iFileLen);
    while true do
    begin
        cnt:=FileRead(iFileHandle,buf,4096);
        AThread.Connection.WriteBuffer(buf,cnt);
        if cnt<4096 then
            break;
    end;
    FileClose(iFileHandle);
end;

=======================================================

客户端接收：
procedure TForm1.Button1Click(Sender: TObject);
var
    rbyte:array[0..4096] of byte;
    sFile:TFileStream;
    iFileSize:integer;
begin
    try
        IdTcpClient1.Connect(5000);
    except
        exit;
    end;

    iFileSize:=IdTCPClient1.ReadInteger;

    sFile:=TFileStream.Create('e:\bb.tmp',fmCreate);
    While iFileSize>4096 do
    begin
        IdTCPClient1.ReadBuffer(rbyte,4096);// .ReadBuffer(rbyte,iLen);
        sFile.Write(rByte,4096);
        inc(iFileSize,-4096);
    end;
    IdTCPClient1.ReadBuffer(rbyte,iFileSize);// .ReadBuffer(rbyte,iLen);
    sFile.Write(rByte,iFileSize);
    sFile.Free;
    ShowMessage('file get ok!');
end;

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

具体代码:

Server(Receive):

procedure TFrmServer.FormCreate(Sender: TObject);
begin
   IdTCPServer1.DefaultPort:=5616;
   IdTCPServer1.Active:=True;
end;

procedure TFrmServer.IdTCPServer1Execute(AThread: TIdPeerThread);
var
    rbyte:array[0..4096] of byte;
    sFile:TFileStream;
    cnt,cmd,FileSize:integer;
    str,FileName:string;

begin
    str:=AThread.Connection.ReadLn;   //接收文件大小及文件名
    cmd:=pos('|',str); //查找分隔符
    FileName:=copy(str,1,cmd-1); //提取文件名
    FileSize:=StrToInt(copy(str,cmd+1,Length(str)-cmd+1)); //提取文件大小
    if MessageBox(0,Pchar('用户 '+AThread.Connection.Socket.Binding.PeerIP+'要给您传送文件 "'+FileName+'" 您是接受还是拒绝?'),'文件接受',MB_YesNo or MB_ICONQUESTION)=ID_Yes then //询问是否接收
    begin
      ProgressBar1.Max:=FileSize;   //初始化进度条
      ProgressBar1.Position:=0;
      SaveDialog1.FileName:=FileName; //指定保存的默认文件名,一定要在 SaveDialog1.Execute;之前,不然文件名为空
      SaveDialog1.Execute;
      sFile:=TFileStream.Create(SaveDialog1.FileName,fmCreate); //创建待写入的文件流
      While FileSize>4096 do
      begin
        AThread.Connection.ReadBuffer(rbyte,4096);// 读取文件流
        sFile.Write(rByte,4096);      //写入文件流
        cnt:=AThread.Connection.ReadInteger; //从发送端接收最新的进度位置信息
        ProgressBar1.Position:=ProgressBar1.Position+cnt; //更新显示进度
        Label1.Caption:='当前接收进度..';
        StatusBar1.Panels[0].Text:='正在接收文件中...';
        inc(FileSize,-4096);
     end;
    AThread.Connection.ReadBuffer(rbyte,FileSize);// .ReadBuffer(rbyte,iLen);
    sFile.Write(rByte,FileSize);
    sFile.Free;
    StatusBar1.Panels[0].Text:='文件接收完成!';
    Label1.Caption:='文件接收完成!';
    end;
   END;

procedure TFrmServer.FormDestroy(Sender: TObject);
begin
   IdTCPServer1.Active:=False;
   Application.Terminate;
end;

Client(Send):

procedure TFrmClient.SpeedButton1Click(Sender: TObject);
begin
   OpenDialog1.Execute;
   edtFileName.Text:=OpenDialog1.FileName;
end;

procedure TFrmClient.btnSendClick(Sender: TObject);
var
    iFileHandle:integer;
    iFileLen,cnt:integer;
    buf:array[0..4096] of byte;

begin
if (edtAddress.Text<>'')and (edtFileName.Text<>'') then
begin
    IdTCPClient1.Host:=edtAddress.Text;
    IdTCPClient1.Port:=5616;
    try
      IdTCPClient1.Connect(5000);
    except
      StatusBar1.Panels[0].Text:='连接接受方失败!';
      exit;
    end;
    if IdTCPClient1.Connected then
    begin
      iFileHandle:=FileOpen(edtFileName.Text,fmOpenRead);
      iFileLen:=FileSeek(iFileHandle,0,2);
      FileSeek(iFileHandle,0,0);
      ProgressBar1.Max:=iFileLen;
      ProgressBar1.Position := 0;
      IdTCPClient1.WriteLn(ExtractFileName(edtFileName.Text)+'|'+IntToStr(iFileLen));
      while true do
      begin
        Application.ProcessMessages;
        cnt:=FileRead(iFileHandle,buf,4096);
        IdTCPClient1.WriteBuffer(buf,cnt);
        IdTCPClient1.WriteInteger(cnt);
        ProgressBar1.Position:=ProgressBar1.Position + cnt;
        StatusBar1.Panels[0].Text:='正在传送文件...';
        if cnt<4096 then
            break;
      end;
      FileClose(iFileHandle);
      Label2.Caption:='文件传送完成!';
      StatusBar1.Panels[0].Text:='文件传送完成!';
     end;
end
else
    ShowMessage('请选择要传送的文件和或接受方地址');
end;