delphi 传输多个文件

Question

写得程序已经可以传输一个文件。
我现在的问题是，我想传输多个文件怎么办？

Answer 1

unit Frm_Client;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FileCtrl,ScktComp, StdCtrls, XPMan;
const
   Buffersize=1048576;          //41943040;    //40MB
   CPort = 6656;type
  TForm1 = class(TForm)
    SClient: TClientSocket;
    BtnConn: TButton;
    BtnSelFile: TButton;
    GBxStatus: TGroupBox;
    MmStatus: TMemo;
    EDIPAddr: TEdit;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Label2: TLabel;
    EResourceFiles: TEdit;
    Label3: TLabel;
    ListBox1: TListBox;
    BtnsSplit: TButton;
    BtnAdd: TButton;
    BtnBrowse: TButton;
    EDestination: TEdit;
    Label6: TLabel;
    SaveDialog1: TSaveDialog;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure SClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure SClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure BtnConnClick(Sender: TObject);
    procedure BtnSelFileClick(Sender: TObject);
    procedure BtnAddClick(Sender: TObject);
    procedure BtnsSplitClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure BtnBrowseClick(Sender: TObject);
  private
    FFileStream:TMemoryStream;
    SFlagSize:integer;
    FFileName:string;
    function GetFileSize(Const FileName:String):integer;
    procedure SendFile;
    Procedure LoadSendFile;
    Function ConnectionServer(const Server:string):Boolean;
    Procedure StarSend;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}
Function TForm1.ConnectionServer(const Server:string):Boolean;
begin
  if SClient.Active then
    SClient.Active:=false;
  SClient.Port:= CPort;
  SClient.Host:=Server;
  try
    SClient.Active:=true;
    result:=true;
  except
    Showmessage('连接服务器失败！');
    result:=false;
  end;
end;function TForm1.GetFileSize(Const FileName:String):integer;
var
  FileS:TFileStream;
begin
  FileS:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
  result:=Files.Size;
  Files.Free;
end;procedure TForm1.SendFile;
var
  Sendsize:integer;
  buf:array [0..Buffersize] of char ;
begin
  if FFileStream.Size < 1 then
    LoadSendFile;
  if SFlagSize >= BufferSize then
    Sendsize := BufferSize
  else
    SendSize := SFlagSize;
  // getmem(Buf,BufferSize);
  FFileStream.ReadBuffer(Buf,Sendsize);
  SFlagSize:=SFlagSize - SendSize;
  if SFlagSize = 0 then
  begin
    FFileStream.Clear;
    mmstatus.Lines.Add('文件传送完毕！');
  end;
  Try
    SClient.Socket.SendBuf(buf,SendSize);
  Except
    FFileStream.Clear;
    mmstatus.Lines.Add('传送文件错误！');
  end;
end;Procedure TForm1.LoadSendFile;
begin
  with FFileStream do
  begin
    Clear;
    LoadFromFile(FFileName);
    Position:=0;
    SFlagSize:=Size;
  end;
  // Leavings
end;Procedure TForm1.StarSend;
var
  FlagStr:String;
  I:Integer;
begin
   for i:=0 to ListBox1.Count -1 do //遍历文件遂个发送
   begin
      Flagstr:='发送文件信息;'+ExtractFileName(ListBox1.Items[I])
         +';'+Inttostr(GetFileSize(ListBox1.Items[I]));
      FFileName:=ListBox1.Items[I];
      SClient.Socket.SendText(FlagStr);
      mmStatus.Lines.Add(FlagStr);
      mmstatus.Lines.Add('准备传送');
  end;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SClient.Active:=false;
  SClient.Close;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  FFileStream := TMemoryStream.Create;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  FFileStream.Free;
end;procedure TForm1.SClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Showmessage('连接成功！！');
end;procedure TForm1.SClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  FFileStream.Clear;
end;procedure TForm1.SClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  receiveS:string;
begin
  ReceiveS:=Socket.ReceiveText;
  mmStatus.Lines.Add(ReceiveS);
  if ReceiveS = '开始文件传输' then
  begin
    SendFile;
  end;
  if ReceiveS = '停止文件传输' then
  begin
    FFileStream.Clear;
    FFileStream.SetSize(0);
  end;
end;procedure TForm1.BtnConnClick(Sender: TObject);
begin
  self.ConnectionServer(EDIPAddr.Text);
end;procedure TForm1.BtnSelFileClick(Sender: TObject);
begin
 Self.StarSend;
end;procedure TForm1.BtnAddClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    EResourceFiles.Text := OpenDialog1.FileName;
end;procedure TForm1.BtnsSplitClick(Sender: TObject);
var
  I, K, Rest: Integer;
  Af, Bf: TFileStream; //文件流对象
  str,Fn: string; //子文件名
begin
  try
    str:=ExtractFileName(EResourceFiles.Text);                  //返回Edit1中的文件名
    Af := TFileStream.Create(EResourceFiles.Text, fmOpenRead);  //以只读方式打开Edit1指定的文件
    K := Af.Size div Buffersize;                              //计算Af文件需要分成几个子文件
    Rest := Af.Size - K * Buffersize;                         //Af剩余的不足以成为一个子文件容量
    for I := 1 to K do                                 //按标准分割的子文件
      begin
        Fn := EDestination.Text+IntToStr(I)+str;              //子文件名
        ListBox1.Items.Add(EDestination.Text+IntToStr(I)+str);
        Bf := TFileStream.Create(Fn, fmCreate);        //用指定的文件名建立子文件
        Bf.CopyFrom(Af, Buffersize);                          //从Af文件中拷贝Buf个字节数到Bf中
        Bf.Free;                                      //释放Bf
      end;
    if Rest > 0 then
      begin
        Fn := EDestination.Text+IntToStr(I)+str;
        ListBox1.Items.Add(EDestination.Text+IntToStr(I)+str);
        Bf := TFileStream.Create(Fn, fmCreate);
        Bf.CopyFrom(Af, Rest);
        Bf.Free;
      end;
  finally
    Af.Free;                                           //释放Af
  end;
  begin
     ShowMessage('文件切割完成!');
  end;
end;procedure TForm1.ListBox1Click(Sender: TObject);
begin
   SendMessage(ListBox1.Handle,LB_SetHorizontalExtent,600,   longint(0));
end;procedure TForm1.BtnBrowseClick(Sender: TObject);
var
    Dir: string;
     I:Integer;
begin
    if SelectDirectory('选择存储目录:', '', Dir) then
      begin
        EDestination.Text := Dir + '\';
      end;
end;end.
这是客户端，传输多个文件好似是解决了。

Answer 2

可是服务器那端的接收多个文件就有问题了，总是提示栈溢出，10053。自动就关闭了。
unit Frm_FileServer;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, XPMan;
const
   BufferSize=41943040;
   CPort = 6656;type
  TDataFlag = Record
    FileName : String;
    FileSize : Integer;
    WorkFlag : Integer;
  end;
  PDataFlag = ^TDataFlag;type
  TFrmServerFile = class(TForm)
    SServer: TServerSocket;
    BtnStart: TButton;
    BtnStop: TButton;
    BtnClose: TButton;
    GBxStarus: TGroupBox;
    MmStatus: TMemo;
    BtnDisConne: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SServerAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure SServerClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure BtnStartClick(Sender: TObject);
    procedure BtnStopClick(Sender: TObject);
    procedure BtnDisConneClick(Sender: TObject);
    procedure BtnCloseClick(Sender: TObject);
  private
    MemoStream:TMemoryStream;
    Trancing:boolean;
    userhost:string;
    Procedure ConneRun;
    procedure StopConn;
    Procedure StartConn;
    { Private declarations }
  public
    { Public declarations }
  end;var
  FrmServerFile: TFrmServerFile;implementation{$R *.dfm}
Procedure TFrmServerFile.ConneRun;
begin
  Trancing:=false;
  SServer.Port:=CPort;
  SServer.Active:=true;
  MemoStream.Clear;
  showmessage('服务器已经启动！');
end;procedure TFrmServerFile.StopConn;
begin
  MemoStream.clear;
  Trancing:=false;
  if SServer.Socket.ActiveConnections>0 then
  begin
    SServer.Socket.Connections[0].SendText('停止文件传输');
    MmStatus.Lines.Add('当前任务停止！');
  end;
end;Procedure TFrmServerFile.StartConn;
begin
  if SServer.Socket.ActiveConnections>0 then
  begin
    Caption:='start';
    MemoStream.Clear;
    Trancing:=true;
    SServer.Socket.Connections[0].SendText('开始文件传输');
    MmStatus.Lines.Add('准备好接受文件！');
  end;
end;
procedure TFrmServerFile.FormCreate(Sender: TObject);
begin
  MemoStream:=TMemoryStream.Create;
  MemoStream.Position:=0;
  ConneRun;
end;procedure TFrmServerFile.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SServer.Active:=False;
  SServer.Close;
end;procedure TFrmServerFile.SServerAccept(Sender: TObject; Socket: TCustomWinSocket);
begin
  mmStatus.Lines.Add('客户:'+Socket.RemoteHost+'连接成功！')
end;procedure TFrmServerFile.SServerClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  DataF:PDataFlag;
begin
  DataF := New(pDataFlag);
  Dataf.FileName:='';
  Dataf.FileSize:=0;
  DataF.WorkFlag:=0;
  Socket.Data:=Dataf;
  socket.SendText('已经连接好，准备传输文件！'#13#10);
//  socket.RemoteHost+' '
end;procedure TFrmServerFile.SServerClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  Buf:array[0..buffersize] of char;
  dataf:PDataFlag;
  NumberBytes:integer;
  cmd:string;
begin
  dataf:=Socket.Data;
  Case dataf.WorkFlag of
  0:
    begin
      cmd := Trim(Socket.ReceiveText);             //从给定的字符串中删除空格及控制字符
      if pos('发送文件信息',cmd) > 0 then         //pos函数是在字符串中搜索子串cmd中查找''中信息，返回第一个字的位置
      begin
        DataF.FileName:=Trim(Copy(cmd,pos(';',cmd)+1,Length(cmd)));        //从cmd字符串中拷贝从 ‘；’在字符串中的出现的位置加1起到cmd字符中的总长度为止  去掉空格等
        Dataf.FileSize:=StrToInt(Copy(Dataf.FileName,pos(';',Dataf.FileName)+1,Length(dataf.FileName)));
        DataF.FileName:=Trim(copy(Dataf.FileName,0,pos(';',dataf.FileName)-1));
        Dataf.WorkFlag:=1;
        socket.Data:=Dataf;
        mmStatus.Lines.Add('文件名:'+dataf.FileName+'文件大小：'+inttostr(Dataf.FileSize));
        userhost :=Socket.RemoteHost;
      end;
    end;
  1:
     begin
       if Trancing then
       begin
         begin
           NumberBytes:= socket.ReceiveLength;
           socket.ReceiveBuf(buf,NumberBytes);
           MemoStream.Write(buf,numberBytes);
           if numberbytes >= BufferSize then
           begin
              socket.SendText('开始文件传送');
              mmstatus.Lines.Add(inttostr(NumberBytes));
           end;
           if numberbytes < BufferSize then
           begin
             socket.Sendtext('停止文件传送');
             MemoStream.Position:=0;
             try
               mmstatus.Lines.Add('来自：'+Socket.RemoteHost+ '的文件传送完毕！');
               Trancing:=false;
               Dataf.WorkFlag:=0;
               socket.Data:=Dataf;
               MemoStream.savetofile(DataF.filename);
             except
               showmessage('在保存文件时出现错误！');
               exit;
             end;
             Memostream.clear;
           end;
         end;
       end;
     end;
   end;
end;procedure TFrmServerFile.BtnStartClick(Sender: TObject);
begin
  StartConn;
end;procedure TFrmServerFile.BtnStopClick(Sender: TObject);
begin
  stopconn;
end;procedure TFrmServerFile.BtnDisConneClick(Sender: TObject);
begin
  SServer.Socket.SendText('我要断开了！');
  SServer.Active:=False;
end;procedure TFrmServerFile.BtnCloseClick(Sender: TObject);
begin
  Close;
end;end.

Answer 3

发源码最好标识一下是Pascal，看着不舒服