VPF::Дозагрузка файла после потери соединения

BDQ

Дата 25.1.2016, 02:33 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 25.1.2016

Репутация: нет
Всего: нет

Нужна помощь (совет, консультация) в реализации доскачки (дозагрузки) фаила при разрыве соединения во время его передачи (на подобии как у торрента). Технология сокеты. Среда программирования delphi. Если это не возможно или посоветуйте новую среду и расскажите о реализации. Заранее спасибо!

Код Сервера

Код


unit UnitServer;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Gauges, Mask, ScktComp, Vcl.ComCtrls;
 
type
  TFServer = class(TForm)
    Gauge1: TGauge;
    btn1: TButton;
    ServerSocket1: TServerSocket;
    edtFileName: TEdit;
    RxRichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn1Click(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Jornal(txt: string; fst : TFontStyle; clr : TColor = clBlack);
    procedure SendFileSocket(fName : string);
    procedure Progress(prg, maxprg : Integer);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    fs : TFileStream;
    cmd : TStringList;
    CancelSend : Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  FServer: TFServer;
 
const
  // bSize - размер блока данных для передачи.
  // при большом блоке возможны потери пакетов
  // например, у меня при передаче файла более 100 Мб при размере блока 8000
  // файл доходил неполностью.
  bSize : Integer = 4000;
  // SleepTime - время задержки между отправкой очередного блока
  // при значении менее 3 бывают потери пакетов
  // чтобы такого не происходило, небоходимо дописывать функционал контроля
  // целостности блоков данных при отправке и получении
  SleepTime : ShortInt = 3;
  btnNameSend : string[4] = 'Send';
  btnNameCancel : string[6] = 'Cancel';
 
implementation
 
{$R *.dfm}
 
// процедура вывода журнала сообщений
procedure TFServer.Jornal(txt: string; fst : TFontStyle; clr : TColor);
var
  time : string;
begin
if txt = '' then Exit;
time := '[' + DateTimeToStr(now) + '] ';
RxRichEdit1.Lines.Add(time+txt);
RxRichEdit1.SelStart := Length(RxRichEdit1.Lines.Text) - Length(time+txt) - RxRichEdit1.Lines.Count - 1;
RxRichEdit1.SelLength := Length(time+txt);
RxRichEdit1.SelAttributes.Color := clr;
if fst <> Unassigned then RxRichEdit1.SelAttributes.Style := RxRichEdit1.SelAttributes.Style + [fst];
end;
 
 
 
procedure TFServer.FormCreate(Sender: TObject);
var leng:Integer;
    str:string;
begin
  str := Application.ExeName;
  leng := Length(str) - 10;// путь минус имя экзешника
  Delete(str,leng, 11);
  edtFileName.Text := str + '\Файлы сервера\1.txt';
  ServerSocket1.Active := True;
  if ServerSocket1.Active then Jornal('Сервер запущен', Unassigned, clGreen);
  CancelSend := False;
  btn1.Caption := btnNameSend;
end;
 
 
procedure TFServer.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i : Integer;
begin
// закрытие подключений клиентов
for i := ServerSocket1.Socket.ActiveConnections - 1 downto 0 do
        ServerSocket1.Socket.Connections[i].Close;
if ServerSocket1.Active then ServerSocket1.Active := False;
end;
 
 
 
 
 
 
procedure TFServer.btn1Click(Sender: TObject);
var
  getfsize : TFileStream;
begin
if ServerSocket1.Socket.ActiveConnections = 1 then
  begin
    if btn1.Caption = btnNameSend then
      begin
        if FileExists(edtFileName.Text) then
            begin
              cmd.Clear;
              getfsize := TFileStream.Create(edtFileName.Text, fmOpenRead);
              cmd.Add(ExtractFileName(edtFileName.Text));
              cmd.Add(IntToStr(getfsize.Size));
              getfsize.Free;
 
              // уведомление клиента о передаче файла
              // отправляется имя и размер файла посредство размещения
              // данных в cmd (TStringList)
              ServerSocket1.Socket.Connections[0].SendText(cmd.Text);
            end;
      end
    else
      begin
         CancelSend := True;
         Jornal('Передача файла отменена пользователем', Unassigned, clRed);
      end;
  end;
end;
 
 
 
 
procedure TFServer.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
// cmd можно создавать и в formcreate
cmd := TStringList.Create;
Jornal('> Клиент подключился: [' + Socket.RemoteAddress + ']', Unassigned, clGreen);
end;
 
 
 
procedure TFServer.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
if Assigned(cmd) then cmd.Free;
Jornal('< Клиент отключился: [' + Socket.RemoteAddress + ']', Unassigned, clGray);
end;
 
 
//посылка файла через сокет [имя файла; позиция, с которой нужно начинать слать файл]
procedure TFServer.SendFileSocket(fName: string);
var
  nSend : Integer;
  sBuf : Pointer;
begin
try
    if CancelSend then Exit;
    btn1.Caption := btnNameCancel;
    nSend := 0;
 
    // открытие файла для чтения и последующей отправки
    fs := TFileStream.Create(edtFileName.Text, fmOpenRead);
    // курсор на начальную позицию, с которой нужно слать файл
    fs.Position := 0;
 
    // управление прогресс баром
    Progress(fs.Position, fs.Size);
 
    Jornal('Отправка файла ' + QuotedStr(ExtractFileName(edtFileName.Text)), fsItalic);
    Jornal('Размер файла ' + QuotedStr(IntToStr(fs.Size)), fsBold);
 
    repeat
       // если нажата кнопка отмены, то выход
       if CancelSend then Break;
       // хватаем буфера (.)(.)
       GetMem(sBuf, bSize + 1);
       // чтение куска данных (bSize) из файла
       nSend := fs.Read(sBuf^, bSize);
       // если что то прочиталось, то отправляем клиенту
       if nSend > 0 then
         begin
           ServerSocket1.Socket.Connections[0].SendBuf(sBuf^, nSend);
           // корректировка значений прогрес бара
           Progress(fs.Position, fs.Size);
           // задержка иначе будут потери пакетов
           Sleep(SleepTime);
         end;
       // отпускаем буфера (.)(.)
       FreeMem(sBuf);
       Application.ProcessMessages;
    until nSend <= 0; // цикл выполняется пока хоть 1 байт будет прочитан из потока fs
 
    // если не нажата кнопка отмены, то файл отправлен
    if not CancelSend then Jornal('Файл отправлен!', fsBold, clGreen);
finally
    if Assigned(fs) then fs.Free;
    btn1.Caption := btnNameSend;
    if CancelSend then CancelSend := False;
end;
end;
 
 
// процедура управления прогресс баром
procedure TFServer.Progress(prg, maxprg: Integer);
begin
  Gauge1.Progress := prg;
  Gauge1.MaxValue := maxprg;
end;
 
procedure TFServer.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
    cmd.Text := Socket.ReceiveText;
    //клиент сообщил о готовности приёма файла fName
    if cmd.Strings[0] = 'send' then
      begin
         Jornal('Клиент [' + socket.RemoteAddress + '] готов принять файл ' + QuotedStr(cmd.Strings[1]), Unassigned);
 
         // отправка файла клиенту
         if (ExtractFileName(edtFileName.Text) = cmd.Strings[1]) then SendFileSocket(edtFileName.Text);
      end;
end;
 
end.

Код клиента

Код


unit UnitClient;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Gauges, ScktComp, ComCtrls;
 
type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    Gauge1: TGauge;
    RxRichEdit1: TRichEdit;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Jornal(txt: string; fst : TFontStyle; clr : TColor = clBlack);
    procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
  private
    Receiving : Boolean;
    cmd : TStringList;
    fName : string;
    fSize : Int64;
    fs : TFileStream;
    { Private declarations }
  public
    { Public declarations }
  end;
 
const
  bSize : Integer = 4000;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
 
procedure TForm1.FormShow(Sender: TObject);
begin
ClientSocket1.Active := True;
Receiving := False;
cmd := TStringList.Create;
fSize := 0;
fName := '';
end;
 
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ClientSocket1.Active then ClientSocket1.Active := False;
if Assigned(cmd) then cmd.Free;
end;
 
 
 
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  nRead : Integer;
  rBuf : Pointer;
begin
// если не находимся в режиме получения файла, то значит пришли команды
// в нашем случае это имя и размер файла 
if not Receiving then //получение команды - параметров файла
  begin
      cmd.Text := Socket.ReceiveText;
 
      fName := cmd.Strings[0];
      fSize := StrToInt64(cmd.Strings[1]);
      Jornal('Прием файла ' + QuotedStr(cmd.Strings[0]), fsItalic);
      Jornal('Размер файла ' + QuotedStr(cmd.Strings[1]), fsBold);
 
      Gauge1.MinValue := 0;
      Gauge1.Progress := 0;
      Gauge1.MaxValue := fSize;
      Jornal('------------------------------------------', Unassigned);
 
      // переход в режим приема файла  и создание потока для приема файла
      Receiving := True;
      fs := TFileStream.Create(fName, fmCreate);
 
      Gauge1.Progress := 0;
      //Уведомление сервера о готовности приема файла
      cmd.Clear;
      cmd.Add('send');
      cmd.Add(fName);
      Socket.SendText(cmd.Text);
  end
else // режим получения файла
  begin
    repeat
      Socket.Lock;
      // выделение памяти под принятый кусок данных
      GetMem(rBuf, bSize + 1);
      // считывание данных nRead = количество считанных байт
      nRead := Socket.ReceiveBuf(rBuf^, bSize);
      // если что то считалось, то запись данных в файл
      if nRead > 0 then
        begin
          //fs.Seek(0, soFromEnd);
          fs.WriteBuffer(rBuf^, nRead);
          Gauge1.Progress := fs.Size;
        end;
      FreeMem(rBuf);
      Socket.Unlock;
      Application.ProcessMessages;
    until (nRead <= 0);
    // если всё данные считались, то переключение режима приема обратно и освобождение переменной потока
    if fs.Size = fSize then
       begin
          Receiving := False;
          fs.Free;
          Jornal('Файл принят!', Unassigned, clGreen);
       end;
  end;
end;
 
 
// процедура вывода данных в журнал [текст сообщения, стиль текста, цвет текста]
procedure TForm1.Jornal(txt: string; fst : TFontStyle; clr : TColor);
var
  time : string;
  totallen, curlen, sstart : Integer;
begin
if txt = '' then Exit;
time := '[' + DateTimeToStr(now) + '] ';
RxRichEdit1.Lines.Add(time+txt);
RxRichEdit1.SelStart := Length(RxRichEdit1.Lines.Text) - Length(time+txt) - RxRichEdit1.Lines.Count - 1;
RxRichEdit1.SelLength := Length(time+txt);
RxRichEdit1.SelAttributes.Color := clr;
if fst <> Unassigned then RxRichEdit1.SelAttributes.Style := RxRichEdit1.SelAttributes.Style + [fst];
end;
 
 
procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
Jornal('> Подключён к серверу [' + Socket.RemoteAddress + ']', Unassigned, clGreen);
end;
 
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Jornal('< Отключён от сервера [' + Socket.RemoteAddress + ']', Unassigned, clRed);
end;
 
end.

kami

Дата 2.2.2016, 22:12 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 6
Всего: 72

Код некорректен с точки зрения работы с сокетами.
Нельзя использовать задержки типа Sleep и ProcessMessages.

В очередной раз "пропиарю" свои надстройки: http://forum.vingrad.ru/forum/topic-290376...y2090440/0.html

Общая методология передачи с возможностью докачки, по упрощенной аналогии с торрентами:
1. Клиент запрашивает сводную информацию по файлу: общий размер и хеши блоков с размером каждого блока и возможно - позицией начала блока от начала файла. Сервер отдает эти данные в какой-либо заранее определенной структуре.
2. Клиент, получив данные, если файла нет - создает файл.
2.1. Клиент устанавливает файлу общий размер, полученный от сервера.
2.2. Клиент на основании полученной информации смотрит в имеющийся у него файл поблочно.
- если хеш локального блока соответствует информации, полученной от сервера - пропускаем
- если хеш локального блока не соответствует - запрашиваем у сервера блок (указывая номер блока или позицию от начала файла, его размер и имя файла).
Все запросы делаются асинхронно. Т.е. клиент отправив запрос не сидит в ожидании ответа сервера, а продолжает выполнение дальше. В нашем случае - продолжает п.2.2, пока не отправит запросы на все необходимые блоки, после чего спокойно выходит из события и ожидает, пока не возникнет событие приема из п.3
- сервер на основании каждого полученного запроса на отправку блока вычленяет нужные данные из файла и отправляет их клиенту, сопровождая служебным заголовком (имя файла, номер блока или позиция от начала файла, размер блока).
3. Клиент, получив от сервера служебную информацию с блоком данных: открывает файл, смещается на нужную позицию в файле и записывает блок.

Для полноты картины можно рядом с файлом создавать служебный файлик с информацией из п.1 и работать в том числе с ним.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »