Нужна помощь (совет, консультация) в реализации доскачки (дозагрузки) фаила при разрыве соединения во время его передачи (на подобии как у торрента). Технология сокеты. Среда программирования 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.
|
|