谁有Socket文件传输的例子？

借花现佛：
unit Unit1; interface uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, StdCtrls; type
  TCon = record
    FileName : String;
    TotalSize : Integer;
    Status : Integer;
  end;   PCON = ^TCON;   TForm1 = class(TForm)
    SS: TServerSocket;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure SSClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end; var
  Form1: TForm1; implementation uses Unit2; {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject);
begin
    SS.Port := 9000;
    SS.Active := True;
end; procedure TForm1.SSClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var c : pcon;
begin     c :=new(pcon);
    c.FileName := '';
    c.TotalSize :=  0 ;
    c.Status := 0;
    Socket.Data := c;
    Socket.SendText('已经连接,请输入UPLOAD FILENAME SIZE'#13#10); end; procedure TForm1.SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
var C : PCON;
    cmd:String;
    Buffer : pointer;
    nRetr : integer;
    fs : TFileStream;
const bufferSize =  1024 ; begin
    C:= Socket.Data ;
    case c.Status of
        0 :
        begin
               cmd := trim(Socket.ReceiveText) ;                if  Pos('UPLOAD ',uppercase(cmd)) >  0 then
               begin
                    c.FileName := trim(Copy(cmd,Pos(' ',cmd)+1,Length(cmd)));
                    c.TotalSize := StrToInt(Copy(c.FileName,Pos(' ',c.FileName)+1,Length(c.FileName)));
                    c.FileName := trim(Copy(c.FileName,1,Pos(' ',c.FileName)));
                    c.Status := 1;
                    Socket.Data := C;
                    Socket.SendText('you can send File  !'#13#10);
               end;
            end;
        1 : begin
                GetMem(Buffer,BufferSize);
                nRetr := Socket.ReceiveBuf(Buffer^,BufferSize);                 if not FIleExists('c:\'+c.FileName) then
                begin
                     fs :=TFileStream.Create('c:\'+c.FileName,fmCreate or fmShareDenyNone);
                     fs.Seek(0,soFromBeginning);
                end
                else
                begin
                     fs :=TFileStream.Create('c:\'+c.FileName,fmOpenWrite or fmShareDenyNone);
                     fs.Seek(0,soFromEnd);
                end;                 fs.WriteBuffer(Buffer^,nRetr);                 fs.Destroy;
                FreeMem(Buffer);
            end;
    end;
end; procedure TForm1.Button2Click(Sender: TObject);
begin
    Form2.Show;
end; end.

<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
unit Unit2; interface uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp; type
  TForm2 = class(TForm)
    CS: TClientSocket;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    SendCommand: TButton;
    Label1: TLabel;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SendCommandClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CSRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end; var
  Form2: TForm2; implementation {$R *.DFM}
function GetFileSize(const FileName: string):integer;
var f : TFileStream;
begin
    f := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
    Result :=f.Size;
    F.Free;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
    with OpenDialog1 do
    begin
        Execute;
        if FileName <> '' then
        begin
            Edit1.Text := 'UPLOAD '+ ExtractFileName(FileName) +' '+Inttostr(GetFileSize(FileName));
            Label1.Caption := FileName;
            cs.Socket.SendText(edit1.Text);
        end;
    end;
end; procedure TForm2.Button2Click(Sender: TObject);
begin
    CS.Active := True; end; procedure TForm2.SendCommandClick(Sender: TObject);
var fs : TFileStream;
    Buf : pointer; begin
    //CS.Socket.SendText(Edit1.Text+#13#10);
    //Memo1.Lines.Add();
    fs := TFileStream.Create(Label1.Caption ,fmOpenRead or fmShareDenyNone);     GetMem(Buf,fs.Size);
    fs.Seek(0,soFromBeginning);     fs.ReadBuffer(Buf^,fs.Size);     memo1.Lines.Add('has send : '+inttostr(Cs.Socket.SendBuf(Buf^,fs.Size))); end; procedure TForm2.Button3Click(Sender: TObject);
begin
    cs.Close;
end; procedure TForm2.CSRead(Sender: TObject; Socket: TCustomWinSocket);
begin    Memo1.Lines.add(socket.receiveText); end; end. 记得给分：）

怎么没有人回答，
上面贴出来的程序好象不能释放内存，
如果被传输的文件有80MB，就得需要80MB的内存，
那样的话，我的服务器有20个客户端连接不就死定了？

因为我是刚接触DELPHI，所以不知道怎么分，
就是上面的
var fs : TFileStream;
    Buf : pointer;
begin
    fs := TFileStream.Create(Label1.Caption ,fmOpenRead or fmShareDenyNone);
    GetMem(Buf,fs.Size);
    fs.Seek(0,soFromBeginning);
    fs.ReadBuffer(Buf^,fs.Size);
    memo1.Lines.Add('has send : '+inttostr(Cs.Socket.SendBuf(Buf^,fs.Size)));
end;
这里怎么分块传输？

为什么这样不行？
var fs : TFileStream;
    Buf : pointer;
    intSize :integer;
const bufferSize =  1024 ;
begin
    fs := TFileStream.Create(Label1.Caption ,fmOpenRead or fmShareDenyNone);
    intSize := fs.Size;
    fs.Seek(0,soFromBeginning);
    while intSize>0 do
    begin
      GetMem(Buf,bufferSize);
      fs.ReadBuffer(Buf^,bufferSize);
      memo1.Lines.Add('has send : '+inttostr(Cs.Socket.SendBuf(Buf^,bufferSize)));
      intSize := intSize - 1024;
      FreeMem(Buf);
    end;
end;

var fs : TFileStream;
    Buf : pointer;
begin
    fs := TFileStream.Create(Label1.Caption ,fmOpenRead or fmShareDenyNone);
    GetMem(Buf,fs.Size);
    fs.Seek(0,soFromBeginning);
    fs.ReadBuffer(Buf^,fs.Size);
    memo1.Lines.Add('has send : '+inttostr(Cs.Socket.SendBuf(Buf^,fs.Size)));
end; 同意

var fs : TFileStream;
    Buf : pointer;
begin
    fs := TFileStream.Create(Label1.Caption ,fmOpenRead or fmShareDenyNone);
    GetMem(Buf,fs.Size);
    fs.Seek(0,soFromBeginning);
    fs.ReadBuffer(Buf^,fs.Size);
    memo1.Lines.Add('has send : '+inttostr(Cs.Socket.SendBuf(Buf^,fs.Size)));
end;
这样肯定不行，如果这作为服务端的，有50位客户端同时连上，要下载80MB的文件，服务端要50＊80=4000MB的内存，不死才怪。

大家用NMStrmServ1控件试试看呢?
越大文件越慢慢只要拆分文件就快了
用PostIt方法广播呵呵

我这里有一个例子(不是我写的).
socket,文件流传输,只要网络不断,传多大的文件都没问题.周末到了,程序在家里,如果愿意等到下个星期的话,留下email.

to:zdcnow(磁效应) 请给我一份，谢谢！
[email protected]

接收文件的一段！var
  F : File;
  BufRecv:array[0..4096] of byte;
  len,re : Integer;
  skt:TSOCKET;
begin
            repeat
              if len>4096 then
                re := recv(skt, BufRecv,4096, 0)
              else
                re := recv(skt, BufRecv,len, 0);
              len:=len-re;
              iLen := iLen + re;
              blockwrite(f,bufrecv,re);
            Until len <= 0;
end;

to zdcnow(磁效应) 我也想要一份，多谢了！

你好！麻烦也给我一份[email protected]

我也要一份,谢了
[email protected]

unit FTPThreadUnit;interfaceuses
  Windows, SysUtils, Classes, winsock, Dialogs, ComCtrls;type
  TSendThread = class(TThread)
    private
      FileName                : String;
      FTPSocket               : Integer;
      RemotePort              : Integer;
      FileSize                : Integer;
      BlockSize               : Integer;
      RemoteIP                : String;
      UnitNum                 : Integer;
      FTP_Packet_Sent         : Integer;
    protected
      procedure Execute; override;
    public
      Constructor Create(fName, rIP: String; Socket, fSize, bSize, rPort: Integer);
  end;  TRecvThread = class(TThread)
    private
      FileName                : String;
      FTPSocket               : Integer;
      RemotePort              : Integer;
      FileSize                : Integer;
      BlockSize               : Integer;
      RemoteIP                : String;
      UnitNum                 : Integer;
      FTP_Packet_Received     : Integer;
    protected
      procedure Execute; override;
    public
      Constructor Create(fName, rIP: String; Socket, fSize, bSize, rPort: Integer);
  end;implementation// Send Thread
Constructor TSendThread.Create;
begin
  FTPSocket := Socket;
  RemoteIP := rIP;
  RemotePort := rPort;
  FileName := fName;
  FileSize := fSize;
  BlockSize := bSize;
  UnitNum := 0;
  FTP_Packet_Sent := 0;
  Inherited Create(False);
  FreeOnTerminate := True;
end;procedure TSendThread.Execute;
Var
  Buf: array[1..10240] of char;
  Command: array[1..3] of char;
  To_Addr,
  From_Addr: Sockaddr_in;
  Bytes_Sent,
  Bytes_Received,
  Bytes_Remain,
  len: Integer;  smFile: TFilestream;
  i: Integer;
begin
  To_Addr.sin_family := AF_INET;
  To_Addr.sin_port := RemotePort;
  To_Addr.sin_addr.S_addr := inet_addr(PChar(RemoteIP));  Command[1] := '@'; Command[2] := '@'; Command[3] := '1';  // 开始传输指令
  Bytes_Sent := SendTo(FTPSocket, Command, 3, 0, To_Addr, sizeof(To_Addr));
  if Bytes_Sent <> 3 then;  len := sizeof(From_Addr);
  Bytes_Received := recv(FTPSocket, Buf, sizeof(Buf), 0);  if (Buf[1] = '@') and (Buf[2] = '@') and (Buf[3] = '0') then begin // 收到指令以后的确认信息
    smFile := TFilestream.Create(FileName, fmOpenRead);    UnitNum := trunc((FileSize - 1) / BlockSize) + 1;
    Bytes_Remain := FileSize;    for i:=1 to UnitNum do begin      if i = UnitNum then begin
        smFile.Read(Buf, Bytes_Remain);
        Bytes_Sent := sendto(FTPSocket, Buf, Bytes_Remain, 0, To_Addr, sizeof(To_Addr));
      end
      else begin
        smFile.Read(Buf, BlockSize);
        Bytes_Sent := sendto(FTPSocket, Buf, BlockSize, 0, To_Addr, sizeof(To_Addr));
      end;      if Bytes_Sent>0 then begin
        Dec(Bytes_Remain, Bytes_Sent);
        Inc(FTP_Packet_Sent);
      end;      Bytes_Received := recv(FTPSocket, Buf, sizeof(Buf), 0);
      if (Buf[1] = '@') and (Buf[2] = '@') and (Buf[3] = '0') then continue
      else begin
        if (Buf[1] = '@') and (Buf[2] = '@') and (Buf[3] = '9') then // 文件传输失败。
          MessageBox(0, '文件传输出错！', '出错', MB_OK + MB_ICONERROR);
        shutdown(FTPSocket, SD_BOTH);
        closesocket(FTPSocket);
        smFile.Free;
        exit;
      end;
    end;
  end;  Command[1] := '@'; Command[2] := '@'; Command[3] := '2'; // 文件传输结束
  Bytes_Sent := SendTo(FTPSocket, Command, 3, 0, To_Addr, sizeof(To_Addr));
  smFile.Free;  Bytes_Received := recv(FTPSocket, Buf, sizeof(Buf), 0); // 确认对方是否接收成功  shutdown(FTPSocket, SD_BOTH);
  closesocket(FTPSocket);
  Synchronize(CloseProgressBar);
end;// Receive Thread
Constructor TRecvThread.Create;
begin
  FTPSocket := Socket;
  RemoteIP := rIP;
  RemotePort := rPort;
  FileName := fName;
  FileSize := fSize;
  BlockSize := bSize;
  UnitNum := 0;
  FTP_Packet_Received := 0;
  Inherited Create(False);
  FreeOnTerminate := True;
end;procedure TRecvThread.Execute;
Var
  Buf: array[1..10240] of char;
  Command: array[1..3] of char;
  To_Addr,
  From_Addr: Sockaddr_in;
  Bytes_Sent,
  Bytes_Received,
  Bytes_Remain,
  Total_Bytes_Received,
  len: Integer;  smFile: TFilestream;
  i: Integer;
begin
  To_Addr.sin_family := AF_INET;
  To_Addr.sin_port := RemotePort;
  To_Addr.sin_addr.S_addr := inet_addr(PChar(RemoteIP));  len := sizeof(From_Addr);
  Bytes_Received := recv(FTPSocket, Buf, sizeof(Buf), 0);  if (Buf[1] = '@') and (Buf[2] = '@') and (Buf[3] = '6') then begin
    Command[1] := '@'; Command[2] := '@'; Command[3] := '0';
    Bytes_Sent := SendTo(FTPSocket, Command, 3, 0, To_Addr, sizeof(To_Addr));    Bytes_Remain := FileSize;
    Total_Bytes_Received := 0;
    try
      smFile := TFilestream.Create(filename, fmCreate);
      smFile.Size := FileSize;
      smFile.Position := 0;
    except
      MessageBox(0, '创建新文件失败！', '错误', MB_ICONERROR +  MB_OK);
      exit;
    end;    Bytes_Received := recv(FTPSocket, Buf, sizeof(Buf), 0);
    while ((Bytes_Received > 0) and (not((Buf[1] = '@') and (Buf[2] = '@') and (Buf[3] = '2')))) do begin
      smFile.Write(Buf, Bytes_Received);
      Inc(Total_Bytes_Received, Bytes_Received);      Command[1] := '@'; Command[2] := '@'; Command[3] := '0';
      Bytes_Sent := SendTo(FTPSocket, Command, 3, 0, To_Addr, sizeof(To_Addr));      Bytes_Received := recv(FTPSocket, Buf, sizeof(Buf), 0);
      Inc(FTP_Packet_Received);
    end;    if Total_Bytes_Received = FileSize then begin
      Command[1] := '@'; Command[2] := '@'; Command[3] := '8'; // 文件接收成功
      Bytes_Sent := SendTo(FTPSocket, Command, 3, 0, To_Addr, sizeof(To_Addr));
      smFile.Free;
    end
    else begin
      Command[1] := '@'; Command[2] := '@'; Command[3] := '9'; // 文件接收成功
      Bytes_Sent := SendTo(FTPSocket, Command, 3, 0, To_Addr, sizeof(To_Addr));
      smFile.Free;
    end;
  end;  shutdown(FTPSocket, SD_BOTH);
  closesocket(FTPSocket);
  Synchronize(CloseProgressBar);
end;end.

调试易

谁有Socket文件传输的例子？

解决方案 »