VPF::[Delphi] Stream и Thread - Форум программистов

Демо

Дата 21.2.2006, 14:04 (ссылка)

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

Загрузка ...

Эксперт

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

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

ZBugz,

Так с копированием одного файла фообще никаких проблем. Это на полчаса работы - реализовать такой класс..

Как освобожусь - напишу пример - минимальный, работоспособный, попроще.

Это сообщение отредактировал(а) Демо - 21.2.2006, 14:05

--------------------

ZBugz

Дата 21.2.2006, 14:11 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

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

ДЕМО - ТЫ ГЕНИЙ ! smile

Так разбираться в потоках, это супер. smile

Жду

Это сообщение отредактировал(а) ZBugz - 21.2.2006, 14:12

Демо

Дата 21.2.2006, 19:41 (ссылка)

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

Загрузка ...

Эксперт

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

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

Вот написал.
Правда, далеко не за полчаса.
Основное время отладка заняла.
Пока не удалось корректно динамически рассчитывать среднюю скорость копирования. Так что есть куда двигаться пытливому уму-)

Код


unit uTSimpleCopier;

interface

uses
  Classes, Sysutils, windows;

const
  BufSize=1*1024*1024;  //1Мб

type

  TStatusFile=(sfNone, sfStart, sfProgress, sfComplete, sfError);

  PFileCopied=^TFileCopied;
  TFileCopied=record
    Src,Dest: String;
    State: TStatusFile;
    FileSize: Int64;
    Copied: Int64;
    StartTime,EndTime: TDateTime;
    AVGSpeed: Double;
  end;

  TProgressProc=procedure(Sender: TObject; FileRec: TFileCopied) of object;

  TSimpleCopier = class(TThread)
  private
    FOver: Boolean;
    FReady: Boolean;
    FileCopied: TFileCopied;
    FProgress: TProgressProc;
    procedure Progress;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Copy(const Src,Dest: String; Overwrite: Boolean);
    procedure Terminate;

    property OnProgress: TProgressProc read FProgress write FProgress;
  end;

implementation


{ TSimpleCopier }

procedure TSimpleCopier.Copy(const Src, Dest: String; Overwrite: Boolean);
var
  Counter: Integer;
begin
  Counter := 100;
  while not FReady do
  begin
    Sleep(10);
    Dec(Counter);
    if Counter<0 then raise Exception.Create('unknown error'); 
  end;

  if FileCopied.State <> sfNone then raise Exception.Create('Thread is busy');
  if Terminated then raise Exception.Create('Thread is terminated');
  FileCopied.State := sfStart;
  FileCopied.Src := Src;
  FileCopied.Dest := Dest;
  FileCopied.AVGSpeed := 0;
  FOver := Overwrite;
  if Self.Suspended then Self.Resume;
end;

constructor TSimpleCopier.Create;
begin
  inherited Create(True);
  FReady := False;
  FreeOnTerminate := True;
  Resume;
end;

destructor TSimpleCopier.Destroy;
begin
  inherited;
end;

procedure TSimpleCopier.Execute;
var
  Buf: PChar;
  fs,fd: TFileStream;
  ModeOpen: Integer;
  Readed,Writed: Integer;
  LastTime,CurrTime: Cardinal;
  CurrSpeed: Double;
begin
  FReady := True;
  while not Terminated do
  begin
    Suspend;
    try
      GetMem(Buf,BufSize);
      try
        try
          fs := TFileStream.Create(FileCopied.Src,fmOpenRead);
          try
            FileCopied.FileSize := fs.Size;
            FileCopied.Copied := 0;
            if not FileExists(FileCopied.Dest)
              then ModeOpen := fmCreate
              else ModeOpen := fmOpenWrite;

            if FOver and (ModeOPen=fmOpenWrite) then
            begin
              SysUtils.DeleteFile(FileCopied.Dest);
              ModeOpen := fmCreate;
            end;

            try
              fd := TFileStream.Create(FileCopied.Dest,ModeOpen);
              try
                if (not FOver) and (FileCopied.FileSize<fd.Size) then
                begin
                  raise Exception.Create('Error file size destination');
                end;
                fd.Seek(0,soEnd);               //продолжаем копировать файл

                fs.Position := fd.Position;


                Readed := BufSize;

                FileCopied.StartTime := Now;
                Synchronize(Progress);
                FileCopied.State := sfProgress;

                while Readed>0 do
                begin
                  if Terminated then Break;

                  LastTime := GetTickCount;

                  Readed := fs.Read(Buf[0],Readed);
                  Writed := fd.Write(Buf[0],Readed);

                  CurrTime := GetTickCount;

                  if BufSize=Writed then
                  begin
                    if CurrTime<>LastTime then
                    begin
                      CurrSpeed := (Readed*1000)/(CurrTime-LastTime);
                    end
                    else CurrSpeed := FileCopied.AVGSpeed;


                    if FileCopied.AVGSpeed<>0 then
                    begin
                      FileCopied.AVGSpeed :=
                        (FileCopied.AVGSpeed+CurrSpeed)/2;
                    end
                    else FileCopied.AVGSpeed := CurrSpeed;
                  end;


                  FileCopied.Copied := FileCopied.Copied + Writed;

                  Synchronize(Progress);
                  if Readed<>Writed then raise Exception.Create('Error file write');
                end;

              finally
                FileCopied.EndTime := Now;
                FileCopied.State := sfComplete;
                Synchronize(Progress);
                fd.Free;
              end;
            except
              FileCopied.EndTime := Now;
              FileCopied.State := sfError;
            end;
          finally
            fs.Free;
          end;
        except
          FileCopied.EndTime := Now;
          FileCopied.State := sfError;
        end;
      finally
        FreeMem(Buf,BufSize);
      end;
    except
      FileCopied.EndTime := Now;
      FileCopied.State := sfError;
    end;
  end;
end;

procedure TSimpleCopier.Progress;
begin
  if Assigned(FProgress) then FProgress(Self,FileCopied)
end;

procedure TSimpleCopier.Terminate;
begin
  inherited;
  Resume;
end;

end.

Тестовый проект:

Присоединённый файл ( Кол-во скачиваний: 17 )

TSimpleCopier.zip 4,23 Kb

--------------------

ZBugz

Дата 22.2.2006, 11:05 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

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

Да все работает и конечно ты забыл, что еще надо продолжить копирование с того места откуда остановили smile

И коментарии подписать можешь к примеру ? Я вроде что то понимать начал smile

Демо

Дата 22.2.2006, 12:08 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(ZBugz @ 22.2.2006, 11:05

)

Да все работает и конечно ты забыл, что еще надо продолжить копирование с того места откуда остановили

В этом примере копирование продолжится, если ты укажешь, что это надо сделать;)

Обрати внимание на строку

Код


sc.Copy('d:\w1.exe','d:\w2.exe',True);

здесь True - перезаписывать выходной файл или продолжать с места прерывания.

Про остановку копирования я действительно, не то, что забыл. Спроектировал так, что после Terminate поток убивается, а неадо просто остановить, прервав копирование.

Если сегодня время будет, подправлю и комментарии добавлю.
Добавлено @ 12:09
тест

--------------------

ZBugz

Дата 26.2.2006, 09:04 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

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

Демо, а где обещанный пример smile

?
С прашедшим праздником smile

Демо

Дата 2.3.2006, 18:16 (ссылка)

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

Загрузка ...

Эксперт

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

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

ZBugz,

Спасибо, тебя тоже с прошедшими праздниками.

До примера пока так и не смог добраться, и праздники все работал, и после праздников...

--------------------

ZBugz

Дата 3.3.2006, 10:16 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

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

Привет. Ну я конечно жду примера все равно. А вообще я впринципе Terminate использую, вроде все работает или лучше подождать твоего примера ???

Демо

Дата 3.3.2006, 12:32 (ссылка)

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

Загрузка ...

Эксперт

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

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

Изменения небольшие, но пример все равно требует отладки в части расчета средней скорости копирования, проверки количества скопированных данных.

Изменения помечены значками //----------

Поток:

Код


unit uTSimpleCopier;

interface

uses
  Classes, Sysutils, windows;

const
  BufSize=1*1024*1024;  //1Мб

type

//----------
  TStatusFile=(sfNone, sfStart, sfProgress, sfComplete, sfBreak, sfError);

  PFileCopied=^TFileCopied;
  TFileCopied=record
    Src,Dest: String;
    State: TStatusFile;
    FileSize: Int64;
    Copied: Int64;
    StartTime,EndTime: TDateTime;
    AVGSpeed: Double;
  end;

  TProgressProc=procedure(Sender: TObject; FileRec: TFileCopied) of object;

  TSimpleCopier = class(TThread)
  private
    FOver: Boolean;
    FReady: Boolean;
    FStop: Boolean;
    FileCopied: TFileCopied;
    FProgress: TProgressProc;
    procedure Progress;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Copy(const Src,Dest: String; Overwrite: Boolean);
    procedure Terminate;
    procedure Stop;

    property OnProgress: TProgressProc read FProgress write FProgress;
  end;

implementation


{ TSimpleCopier }

procedure TSimpleCopier.Copy(const Src, Dest: String; Overwrite: Boolean);
var
  Counter: Integer;
begin
  Counter := 100;
  while not FReady do
  begin
    Sleep(10);
    Dec(Counter);
    if Counter<0 then raise Exception.Create('unknown error');
  end;

  if FileCopied.State <> sfNone then raise Exception.Create('Thread is busy');
  if Terminated then raise Exception.Create('Thread is terminated');
  FileCopied.State := sfStart;
  FileCopied.Src := Src;
  FileCopied.Dest := Dest;
  FileCopied.AVGSpeed := 0;
  FOver := Overwrite;
  if Self.Suspended then Self.Resume;
end;

constructor TSimpleCopier.Create;
begin
  inherited Create(True);
  FReady := False;
  FreeOnTerminate := True;
  Resume;
end;

destructor TSimpleCopier.Destroy;
begin
  inherited;
end;

procedure TSimpleCopier.Execute;
var
  Buf: PChar;
  fs,fd: TFileStream;
  ModeOpen: Integer;
  Readed,Writed: Integer;
  LastTime,CurrTime: Cardinal;
  CurrSpeed: Double;
begin
  FReady := True;
  while not Terminated do
  begin
    Suspend;
    try
      GetMem(Buf,BufSize);
      try
        try
          fs := TFileStream.Create(FileCopied.Src,fmOpenRead);
          try
            FileCopied.FileSize := fs.Size;
            FileCopied.Copied := 0;
            if not FileExists(FileCopied.Dest)
              then ModeOpen := fmCreate
              else ModeOpen := fmOpenWrite;

            if FOver and (ModeOPen=fmOpenWrite) then
            begin
              SysUtils.DeleteFile(FileCopied.Dest);
              ModeOpen := fmCreate;
            end;

            try
              fd := TFileStream.Create(FileCopied.Dest,ModeOpen);
              try
                if (not FOver) and (FileCopied.FileSize<fd.Size) then
                begin
                  raise Exception.Create('Error file size destination');
                end;
                fd.Seek(0,soEnd);               //продолжаем копировать файл

                fs.Position := fd.Position;


                Readed := BufSize;

                FileCopied.StartTime := Now;
                Synchronize(Progress);
                FileCopied.State := sfProgress;

                while Readed>0 do
                begin
                  if Terminated then Break;
//----------
                  if FStop then Break;

                  LastTime := GetTickCount;

                  Readed := fs.Read(Buf[0],Readed);
                  Writed := fd.Write(Buf[0],Readed);

                  CurrTime := GetTickCount;

                  if BufSize=Writed then
                  begin
                    if CurrTime<>LastTime then
                    begin
                      CurrSpeed := (Readed*1000)/(CurrTime-LastTime);
                    end
                    else CurrSpeed := FileCopied.AVGSpeed;


                    if FileCopied.AVGSpeed<>0 then
                    begin
                      FileCopied.AVGSpeed :=
                        (FileCopied.AVGSpeed+CurrSpeed)/2;
                    end
                    else FileCopied.AVGSpeed := CurrSpeed;
                  end;


                  FileCopied.Copied := FileCopied.Copied + Writed;

                  Synchronize(Progress);
                  if Readed<>Writed then raise Exception.Create('Error file write');
                end;

              finally
                FileCopied.EndTime := Now;
//----------
                if not FStop
                  then  FileCopied.State := sfComplete
                  else  FileCopied.State := sfBreak;
                Synchronize(Progress);
                fd.Free;
//----------
                FStop := False;
              end;
            except
              FileCopied.EndTime := Now;
              FileCopied.State := sfError;
            end;
          finally
            fs.Free;
          end;
        except
          FileCopied.EndTime := Now;
          FileCopied.State := sfError;
        end;
      finally
        FreeMem(Buf,BufSize);
      end;
    except
      FileCopied.EndTime := Now;
      FileCopied.State := sfError;
    end;
    FileCopied.State := sfNone;
  end;
end;

procedure TSimpleCopier.Progress;
begin
  if Assigned(FProgress) then FProgress(Self,FileCopied)
end;

procedure TSimpleCopier.Stop;
begin
//----------
  FStop := True;
end;

procedure TSimpleCopier.Terminate;
begin
  inherited;
  Resume;
end;

end.

Вызывающий модуль:

Код


unit ufMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  uTSimpleCopier;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure ProgressThread(Sender: TObject; FileRec: TFileCopied);
  end;

var
  Form1: TForm1;
  sc: TSimpleCopier;

implementation


{$R *.dfm}

procedure TForm1.ProgressThread(Sender: TObject; FileRec: TFileCopied);
begin
  case  FileRec.State of
    sfStart:
      begin
        Memo1.Lines.Add(
          FormatDateTime('dd.mm.yyyy hh:nn:ss.zzz',FileRec.StartTime)+': Start copy file '+
          FileRec.Src+' to '+FileRec.Dest+', FileSize='+IntToStr(FileRec.FileSize)+
          ' Bytes'
          );
        Memo1.Lines.Add('');
      end;
    sfProgress:
      begin
        Memo1.Lines[Memo1.Lines.Count-1] :=
          FormatDateTime('dd.mm.yyyy hh:nn:ss.zzz',Now)+': Progress copy. Copied '+
          IntToStr(FileRec.Copied)+ ' Bytes '+
          'AvgSpeed ='+ FormatFloat('#,##0.00',FileRec.AVGSpeed)+ ' Bytes/Sec';
      end;
    sfComplete:
      begin
        Memo1.Lines.Add(
          FormatDateTime('dd.mm.yyyy hh:nn:ss.zzz',FileRec.EndTime)+': Copy file Complete'
          );
        Memo1.Lines.Add(
          'Время копирования '+ FormatDateTime('hh:nn:ss.zzz',FileRec.EndTime-FileRec.StartTime)+
          ', AvgSpeed ='+ FormatFloat('#,##0.00',FileRec.AVGSpeed)+ ' Bytes/Sec'
        );
      end;
//----------
    sfBreak:
      begin
        Memo1.Lines.Add(
          FormatDateTime('dd.mm.yyyy hh:nn:ss.zzz',FileRec.EndTime)+': Copy file Break'
          );
        Memo1.Lines.Add(
          'Время копирования '+ FormatDateTime('hh:nn:ss.zzz',FileRec.EndTime-FileRec.StartTime)+
          ', AvgSpeed ='+ FormatFloat('#,##0.00',FileRec.AVGSpeed)+ ' Bytes/Sec'
        );
      end;
    sfError:
      begin
        Memo1.Lines.Add(FormatDateTime('dd.mm.yyyy hh:nn:ss.zzz',Now)+': Error copy file');
      end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  sc := TSimpleCopier.Create;
  sc.OnProgress := ProgressThread;
  sc.Copy('d:\20031031_2_015_1_3.zi_','d:\20031031_2_015_1_3.zi-',True);
end;

//----------
procedure TForm1.Button2Click(Sender: TObject);
begin
  sc.Stop;
end;
//----------
procedure TForm1.Button3Click(Sender: TObject);
begin
  sc.Copy('d:\20031031_2_015_1_3.zi_','d:\20031031_2_015_1_3.zi-',False);
end;

end.

Это сообщение отредактировал(а) Демо - 3.3.2006, 15:45

--------------------

ZBugz

Дата 4.3.2006, 13:29 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

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

Спасибо. Все вроде пашет.
Последний вопрос, а можно на этом коде !!! сделать ограничение скорости копирования ??? smile

Демо

Дата 4.3.2006, 21:57 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(ZBugz @ 4.3.2006, 13:29

)

, а можно на этом коде !!! сделать ограничение скорости копирования ??

Можно. Для этого нужно во время расчета скорости копирования делать задержку в цикле чтения и записи(Sleep), время которой придется рассчитывать тоже.

--------------------

ZBugz

Дата 7.3.2006, 10:24 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

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

Все, я понял. БОЛЬШОЕ СПАСИБО !!! Очень помог. Когда я с этим все разберусь. пристану еще smile

Демо

Дата 16.3.2006, 21:52 (ссылка)

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

Загрузка ...

Эксперт

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

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

Кстати, твоя программка мне понравилась. Добротный, приятный интерфейс и разннобразие настроек.

--------------------

Демо

Дата 22.5.2006, 22:42 (ссылка)

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

Загрузка ...

Эксперт

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

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

ZBugz,

Как привяжешь последнее майское решение, покажи проект - тестировать будем;)

--------------------

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