服务端

var

  FS:TFileStream;

  FileSize:Int64;



procedure TForm1.WSocketServer1DataAvailable(Sender: TObject;

  ErrCode: Word);

var

  iLen,iCmdType:Integer;

  Client:TWSocketClient;

  sFN:string;

  Buf:Pointer;

  MS:TMemoryStream;

begin

  Client:=TWSocketClient(Sender);

  if Assigned(Client) then

  begin

    iLen:=Client.RcvdCount;

    GetMem(Buf,iLen);

    try

      Client.Receive(Buf,iLen);

      MS:=TMemoryStream.Create;

      try

        MS.WriteBuffer(Buf^,iLen);

        MS.Position:=0;

        MS.Read(iCmdType,sizeof(iCmdType));

        if iCmdType=-1 then

        begin

          MS.ReadBuffer(iLen,sizeof(iLen));

          SetLength(sFN,iLen);

          MS.ReadBuffer(sFN[1],iLen);

          MS.ReadBuffer(FileSize,sizeof(FileSize));

          if Assigned(FS) then FreeAndNil(FS);

          FS:=TFileStream.Create('./'+sFN,fmCreate);

          iCmdType:=-11;

          Client.Send(@iCmdType,sizeof(iCmdType));

        end

        else if iCmdType=-2 then

        begin

          iCmdType:=-12;

          Client.Send(@iCmdType,sizeof(iCmdType));

        end

        else if iLen>0 then

        begin

          FS.WriteBuffer(Buf^,iLen);

          iCmdType:=-12;

          Client.Send(@iCmdType,sizeof(iCmdType));

          if FS.Position>=FileSize then FreeAndNil(FS);

        end;

      finally

        MS.Free;

      end;

    finally

      FreeMem(Buf);

    end;

  end;

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

  WSocketServer1.Close;

  WSocketServer1.Addr:='127.0.0.1';

  WSocketServer1.Port:='1235';



  WSocketServer1.Listen;

end;



procedure TForm1.WSocketServer1ClientConnect(Sender: TObject;

  Client: TWSocketClient; Error: Word);

begin

  Client.OnDataAvailable:=WSocketServer1DataAvailable;

end;



客户端

var

  FS:TFileStream;

  FFileSize:Int64;



procedure TForm1.Button1Click(Sender: TObject);

var

  iCmdType,iLen:Integer;

  sFN:string;

  FS:TFileStream;



  procedure SendFileInfo;

  var

    MS:TMemoryStream;

  begin

    MS:=TMemoryStream.Create;

    try

      iLen:=length(sFN);

      iCmdType:=-1;

      MS.Write(iCmdType,sizeof(iCmdType));

      MS.Write(iLen,sizeof(iLen));

      MS.Write(sFN[1],iLen);

      MS.Write(FFileSize,sizeof(FFileSize));

      MS.Position:=0;

      WSocket1.Send(MS.Memory,MS.Size);

    finally

      MS.Free;

    end;

  end;

begin

  if OpenDialog1.Execute  then

  begin

   sFN:=ExtractFileName(OpenDialog1.FileName);

   FS:=TFileStream.Create(sFN,fmOpenRead);

   try

     FFileSize:=FS.Size;

   finally

     FS.Free;

   end;



   SendFileInfo;

  end;

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

   WSocket1.Addr :='127.0.0.1';

   WSocket1.Port :='1235';

   WSocket1.Connect;

   WSocket1.OnDataAvailable:=WSocket1DataAvailable;

end;



procedure TForm1.WSocket1DataAvailable(Sender: TObject; ErrCode: Word);

var

  iLen,iCmdType:integer;

  Buf:Pointer;

  SendBuf:array[0..4095] of Byte;

begin

  iLen:=WSocket1.RcvdCount;

  GetMem(Buf,iLen);

  try

    WSocket1.Receive(Buf,iLen);

    Move(Buf^,iCmdType,sizeof(iCmdType));

    if iCmdType=-11 then

    begin

      if Assigned(FS) then FreeAndNil(FS);

      FS:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);

      iCmdType:=-2;

      WSocket1.Send(@iCmdType,sizeof(iCmdType));

      Memo1.Lines.Add(DateTimeToStr(Now)+' 准备传输文件:'+OpenDialog1.FileName);

    end

    else if iCmdType=-12 then

    begin

      while FS.Position<FFileSize do

      begin                                                   

        iLen:=FS.Read(SendBuf,4096);

        WSocket1.Send(@SendBuf,iLen);

      end;



      FreeAndNil(FS);

      Memo1.Lines.Add(DateTimeToStr(Now)+' 文件传输完成.');

    end;

  finally

    FreeMem(Buf);

  end;

end;