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

ZBugz

Дата 15.2.2006, 12:54 (ссылка)

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

Загрузка ...

Опытный

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

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

Привет всем. Есть 2 вопроса:

1: Не могу скопировать файлы больше 2 гб. Помогите smile

Я это делаю так и это не пашет:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  Stream,
    Stream1: TFileStream;
  Temp: array[0..$FFFF] of Byte;
  Access: Integer;
  FileNames, Filenames1: string;
begin
  with TOpenDialog.Create(Form1) do
  begin
    Execute;
    FileNames := FileName;
    Free;
  end;
  if Filenames = '' then
    Exit;
  with TSaveDialog.Create(Form1) do
  begin
    Execute;
    FileNames1 := FileName;
    Free;
  end;
  if Filenames1 = '' then
    Exit;
  Access := fmOpenReadWrite;
  ZeroMemory(@Temp, sizeof(Temp));
  Stream := TFileStream.Create(FileNames, fmOpenRead);
  if not FileExists(Filenames1) then
    Access := fmCreate;
  Stream1 := TFileStream.Create(Filenames1, Access);

  Stream.Position := Stream1.Size;
  Stream1.Position := Stream1.Size;

  while Stream.Size <> Stream1.Size do
  begin
    if (Stream.Size - Stream1.Position) < sizeof(Temp) then
    begin
      Stream1.CopyFrom(Stream, Stream.Size - Stream1.Position);
    end
    else
      Stream1.CopyFrom(Stream, sizeof(Temp));
    Form1.Update;
    Application.ProcessMessages;
  end;
  Stream.Free;
  Stream1.Free;
end;

2. А можно качать много файлов одновременно ? smile

А надо чтобы, если вы поможте, выполнялись такие условия как: остановить копирование, продолжить с тогот места где остановили. Если много файлов, то как остановить выделенный или все, а потом докачать.

Ребята, перерыл весь инет, все форумы, ну так как я только учусь, я не могу разобраться даже в литературе, а на других форумах если и что то отвечают, то не доконца или смеются надомной. Помогите пожайлуста. Мнеб желательно пример с коментариями. smile

Заранее благодарен.

Guedda

Дата 15.2.2006, 13:06 (ссылка)

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

Загрузка ...

Подрывник

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

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

Цитата(ZBugz @ 15.2.2006, 13:54)

2. А можно качать много файлов одновременно ? smile

С точки зрения пользователя - можно (визуально)
А с точки зрения машины нельзя. Порт для скачивания только один... Поэтому побайтно скачивать каждый файл прийдется.

А насчет остановки и докачки поищи на форуме. Вопрос неоднократно задавался.

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

Ll 2

ZBugz

Дата 15.2.2006, 13:26 (ссылка)

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

Загрузка ...

Опытный

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

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

Поискал, не нашел ответа вообще, тока один пример как у меня smile

А копирование больше 2 гб вообще нет, тем более с докачкой. smile

Мне локально надо файлы копировать smile

. Короче я ничего путевого не нашел, мож я слепой ? smile

Демо

Дата 15.2.2006, 19:07 (ссылка)

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

Загрузка ...

Эксперт

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

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

Вроде бы никаких проблем нет с копированием файлов любого размера.
Специально пример написал:

Код


unit Unit1;

interface

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

const
  BufSIze=1024*1024*4;

type

  TDispProc=procedure(Count: Int64) of object;

  TCopier=class(TThread)
  private
    FSrc: String;
    FDest: String;
    FCounter: Int64;
    FBuffer: PChar;
    FDispProc: TDispProc;
    procedure FOnProgress;
  protected
    procedure Execute; override;
  public
    constructor Create(const Src,Dest: String; Proc: TDispProc);
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure OnProgress(Counter: Int64);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.OnProgress(Counter: Int64);
begin
  Label1.Caption := 'Скопировано '+FormatFloat('#,##0.00 КБайт',Counter/1024);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  TCopier.Create('\\ADMIN\e\Distr\DIskX-Diasoft_Upd_2005-07-04.bkf','d:\aaa',OnProgress);
end;

{ TCopier }

constructor TCopier.Create(const Src, Dest: String; Proc: TDispProc);
begin
  inherited Create(True);
  FSrc := Src;
  FDest := Dest;
  FDispProc := Proc;
  FreeOnTerminate := True;
  Resume;
end;

destructor TCopier.Destroy;
begin
  inherited;
end;

procedure TCopier.Execute;
var
  FS,FD: TFileStream;
  Readed: Integer;
  Cnt: Integer;
begin
  FS := TFileStream.Create(FSrc,fmOpenRead or fmShareDenyNone);
  try
    FD := TFileStream.Create(FDest,fmCreate);
    try
      GetMem(FBuffer,BufSize);
      try
        Readed := BufSize;
        Cnt := 0;
        repeat
          Readed := FS.Read(FBuffer[0],Readed);
          if Readed>0 then FD.Write(FBuffer[0],Readed);
          FCounter := FCounter+Readed;
            Synchronize(FOnProgress);
{          if (Cnt mod 10) = 0 then
          begin
            Synchronize(FOnProgress);
            Cnt := 0;
          end;
          Inc(Cnt);
}
          if Terminated then Break;
        until Readed=0;
      finally
        FreeMem(FBuffer);
      end;
    finally
      FD.Free;
    end;
  finally
    FS.Free;
  end;

end;

procedure TCopier.FOnProgress;
begin
  if Assigned(FDispProc) then FDispProc(FCounter);
end;

end.

Файл размером более 9Гб был скопирован без проблем.

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

ZBugz

Дата 16.2.2006, 15:09 (ссылка)

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

Загрузка ...

Опытный

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

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

Вообще не работает smile

. Мож я проект скину тебе DEMO скину, то что я написал smile

Демо

Дата 16.2.2006, 17:02 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(ZBugz @ 16.2.2006, 16:09

)

Вообще не работает . Мож я проект скину тебе DEMO скину, то что я написал

Шли, конечно. Постараюсь глянуть оперативно. Но сильно загружен на работе.

PS.

у меня Delphi6.

palmih<>gmail.com

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

ZBugz

Дата 17.2.2006, 14:47 (ссылка)

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

Загрузка ...

Опытный

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

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

Заработало smile

, но проект я все равно выслал smile

. Там еще вопросы есть. smile

Демо

Дата 17.2.2006, 18:46 (ссылка)

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

Загрузка ...

Эксперт

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

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

ZBugz,

Твой исправленный проект прикрепляю прямо сюда - вдруг интересно еще кому будет.

Код


{Как докачать файл с того места где остановили и как остановить докачку ?
И еще, я там кинул прогресс бар, а как его заполнить ?
И последнее, а можно копировать блоками, к примеру по 20 кб и т.д. ?
}

См. измененные места, они помечены как (*Changed*)

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

proba1.ra_ 3,79 Kb

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

ZBugz

Дата 21.2.2006, 10:38 (ссылка)

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

Загрузка ...

Опытный

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

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

Пашет, но очень медленно. Что то тут не так smile

На мыло выслал все.

Демо

Дата 21.2.2006, 10:42 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(ZBugz @ 21.2.2006, 10:38

)

Пашет, но очень медленно. Что то тут не так

Ну так естественно. Код ведь не оптимизирован. После копирования каждого блока обновляется VCL. А это не правильно.

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

Демо

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

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

Загрузка ...

Эксперт

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

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

Задача не так проста, как кажется.

Давай начнем с самого начала. Сначала поставим корректно задачу, потом по шагам ее реализуем.

Общая задача.

Необходимо реализовать копирование файлов в отдельном потоке/потоках с возможностью остановки/возобновления копирования и возможностью динамического добавления файлов для копирования.

Сразу возникает пара вопросов -
1. Приведет ли разделение копирования по нескольким потокам к уменьшению общего времени копирования и при каких условиях?
2. Каким образом определять, что копирование было прервано после его возобновления?

На первый вопрос можно ответитить так:

Уменьшение времени копирования возможно в том случае, если диски участвующие в копировании(исходный и выходной) будут разными физическими дисками. Ускорение копирования будет за счет того, что во время записи в одном потоке одновременно будет производиться чтение в другом. Уменьшение времени будет за счет того времени, пока контроллер дисков занимается операциями ввода вывода.

Т.е. можно предполагать, что количество потоков более 1 позволит при таком условии уменьшить общее время копирования.
Сложно сказать, какое количество потоков будет оптимальным, но думаю, что не стоит его делать больше 2.

Ответ на второй вопрос.

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

Добавлено @ 11:25

Далее общую задачу можно разбить на несколько более мелких подзадач:

Исходя из общей постановки задачи необходимо создать:

1. класс потокобезопасной очереди для помещения в нее заданий на копирование;
2. класс для потокобезопасного ведения протокола копирования;
3. класс собственно для копирования
4. класс для управления потоками копирования
Добавлено @ 11:30
После этого можно начать реализовывать отдельные подзадачи.

1. TSafeQueue
2. TSafeLog
3. TCopier
4. TMgrCopier

Добавлено @ 11:34

1. TSafeQueue

Можно реализовать как простейший двусвязный список, в котором обращение к элементам защищено критической секцией.

Например:

Код


{
  Защищенный связный список для работы с очередью
  в многопоточном режиме(первый вошел-первый вышел)

}
unit uSafeQueue;

interface

uses
  windows,Sysutils;
type


  PItemList=^TItemList;
  TItemList=record
    Prev,Next: PItemList;
    Data: PChar;
  end;

  TSafeQueue=class
  private
    FCS: RTL_CRITICAL_SECTION;
    FRootItem: PItemList;
    FLastItem: PItemList;
    FItemsCount: Integer;
    procedure Lock;
    procedure Unlock;
    procedure DeleteItem0;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy;override;
    procedure Push(const Str: String);
    function Pop: String;
    function Peek: String;
    procedure Clear;
    property Count: Integer read GetCount;
  end;

implementation

{ TSafeQueue }

constructor TSafeQueue.Create;
begin
  New(FRootItem);
  New(FLastItem);

  FRootItem.Prev := nil;
  FRootItem.Next := FLastItem;
  FRootItem.Data := nil;
  FLastItem.Prev := FRootItem;
  FLastItem.Data := nil;
  FLastItem.Next := nil;

  FItemsCount := 0;
  InitializeCriticalSection(FCS);
end;

destructor TSafeQueue.Destroy;
begin
  Lock;
    while FRootItem.Next<>FLastItem do DeleteItem0;
    Dispose(FRootItem);
    Dispose(FLastItem);
  Unlock;
end;

procedure TSafeQueue.Lock;
begin
  EnterCriticalSection(FCS);
end;

procedure TSafeQueue.Unlock;
begin
  LeaveCriticalSection(FCS);
end;

procedure TSafeQueue.DeleteItem0;
var
  p: PItemList;
begin
  if FItemsCount=0 then Exit;
  p := FRootItem.Next;

  p.Prev.Next := p.Next;
  p.Next.Prev := p.Prev;

  Dispose(p);
  Dec(FItemsCount);
end;

function TSafeQueue.Peek: String;
var
  Len: Integer;
begin
  Lock;
  try
    Len := StrLen(FRootItem.Next.Data);
    SetLength(Result,Len);
    move(FRootItem.Next.Data^, Result[1], Len);
  finally
    Unlock;
  end;
end;

function TSafeQueue.Pop: String;
var
  Len: Integer;
begin
  Lock;
  try
    Len := StrLen(FRootItem.Next.Data);
    SetLength(Result,Len);
    move(FRootItem.Next.Data^, Result[1], Len);
    FreeMem(FRootItem.Next.Data);
    DeleteItem0;
  finally
    Unlock;
  end;
end;

procedure TSafeQueue.Push(const Str: String);
var
  p: PItemList;
  pi: PChar;
begin
  pi := AllocMem(Length(Str)+1);
  move(Str[1],pi^,Length(Str));
  Lock;
  try
    New(p);
    p.Data := pi;

    p.Prev := FLastItem.Prev;
    p.Next := FLastItem;
    FLastItem.Prev.Next := p;
    FLastItem.Prev := p;

    Inc(FItemsCount);
  finally
    Unlock;
  end;
end;

function TSafeQueue.GetCount: Integer;
begin
  Lock;
  try
    Result := FItemsCount;
  finally
    Unlock;
  end;
end;

procedure TSafeQueue.Clear;
begin
  while Count<>0 do Pop;
end;

end.

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

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

Демо

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

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

Загрузка ...

Эксперт

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

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

2. TSafeLog

Код


{$WARN SYMBOL_PLATFORM OFF}
{
  Ведение журнала в многопоточном режиме.
}
unit uSafeLog;

interface

uses
  windows,classes,SysUtils,uSafeQueue;

const
  MaxSizeLog=8;       //Максимальный размер журнала  (Мб)
  MaxLenMsg=500;       //Максимальная длина сообщения (б)

type

{
  Коды ошибок и строки, им соответствующие
}
  TSafeLogError=(tlNone,                            //Нет ошибок
                     tlCreateObj,                     //Ошибка при инициализации
                     tlWriteError,                    //Ошибка при записи в лог
                     tlArchiveError,                  //Ошибка при копировании в архив
                     tlInSuffSize,                    //Нет места на диске
                     tlErrorOpenLog,                  //Ошибка при открытии лога
                     tlErrorCreateDir,                //Ошибка при создании каталогов
                     tlUnknow);                       //Неизвестная ошибка
const
  ErrorMsg:array[tlNone..tlUnknow] of String=(
                      'Нет ошибок',
                      'Ошибка при создании объекта',
                      'Ошибка при записи в журнал',
                      'Ошибка при архивации журнала',
                      'Не хватает места на диске',
                      'Ошибка при открытии журнала',
                      'Ошибка при создании каталога',
                      'Неизвестная ошибка');

type
//callback-метод для обработки ошибок
  TProcErrorLog=procedure(const CodeError:TSafeLogError; const StrError: String) of object;

  TSafeLog=class(TThread)
  private
    FHandle: THandle;                        //Дескриптор файла
    FEvent: THandle;                         //Event для поточной процедуры
    FActive: Boolean;                        //Статус потока
    FMaxSize: Integer;                       //Максимальный размер лога
    FNameLog: String;                        //Имя файла лога
    FArchDir: String;                        //Каталог для архивов
    FLogDir: String;                         //Каталог для лога
    FQueue: TSafeQueue;                        //Очередь сообщений для записи
    FError: TSafeLogError;                 //Код ошибки
    FProcError: TProcErrorLog;               //Клиентская процедура обработки ошибки
    procedure Init(const DirLog,DirArch: String;MaxSize: Integer=0);
    procedure ProcessError;                  //Процедура обработки ошибок
    function Open: Boolean;                  //Открыть файл лога
    procedure Close;                         //Закрыть файл лога
    function ArchiveLog: Boolean;            //Перенести в архив лог
    function WriteMsg: Boolean;              //Записать в лог сообщение
    procedure Flush;                         //записать в лог все сообщения из очереди
    procedure SetLastError(const Value: TSafeLogError);
    procedure ProcessTerminate(Sender: TObject); //Процесс завершения потока

  protected
    procedure Execute; override;
  public
    constructor Create(const DirLog,DirArch: String;MaxSize: Integer=0);
    constructor CreateDefault;
    destructor Destroy;override;

    procedure Add(const s: String);          //Добавление сообщения в очередь
    procedure Start;                         //Запуск потока
    procedure Release;                       //Завершение потока
    property OnError: TProcErrorLog read FProcError write FProcError;
    property LastError: TSafeLogError read FError write SetLastError;
  end;

implementation

{ TSafeLog }

function TSafeLog.ArchiveLog: Boolean;
var
  fNameAr: String;
begin
  Result := False;
  Close;
  if not DirectoryExists(FArchDir) then
  begin
    ForceDirectories(FArchDir);
    if not DirectoryExists(FArchDir) then
    begin
      LastError := tlErrorCreateDir;
      Exit;
    end;
  end;

  try
      fNameAr := fArchDir+FormatDateTime('yymmdd_hhmmss',now)+'.log';
      if not MoveFile(
         PChar(FLogDir+FNameLog),
         PChar(FNameAr)) then LastError := tlArchiveError;
  except
    LastError := tlArchiveError;
    Close;
  end;
  if LastError=tlNone then
  begin
    if Open then Result := True else LastError := tlErrorOpenLog;
  end;
end;

procedure TSafeLog.Close;
begin
  if FHandle=0 then Exit;
  CloseHandle(FHandle);
  FHandle := 0;
end;

procedure TSafeLog.Init(const DirLog, DirArch: String; MaxSize: Integer);
begin
  FreeOnTerminate := True;
  if MaxSize=0
    then FMaxSize := MaxSizeLog
    else FMaxSize := MaxSize;
  FLogDir :=  DirLog;
  FArchDir := DirArch;
  FNameLog := ExtractFileName(ParamStr(0));
  SetLength(FNameLog,Length(FNameLog)-3);
  FNameLog := FNameLog+'log';
  FActive := False;
  FQueue := TSafeQueue.Create;
  FEvent := CreateEvent(nil,False,False,nil);
  if FEvent=0 then
  begin
    LastError := tlCreateObj;
  end
  else
  begin
    LastError := tlNone;
    if not Open then LastError := tlErrorOpenLog;
  end;
  OnTerminate := ProcessTerminate;
  Resume;
end;

constructor TSafeLog.CreateDefault;
begin
  inherited Create(True);
  Init(ExtractFilePath(ParamStr(0)),ExtractFilePath(ParamStr(0))+'Archive\',0);
end;


constructor TSafeLog.Create(const DirLog,DirArch: String;MaxSize: Integer=0);
begin
  inherited Create(True);
  Init(IncludeTrailingBackSlash(DirLog),IncludeTrailingBackSlash(DirArch),MaxSize);
end;

destructor TSafeLog.Destroy;
begin
  FQueue.Clear;
  FQueue.Free;
  Close;
  CloseHandle(FEvent);
  inherited;
end;

procedure TSafeLog.Execute;
var
  RC: DWORD;
begin
  if FError<>tlNone then Exit;
  SetEvent(FEvent);
  while not Terminated do
  begin
    RC := WaitForSingleObject(FEvent,1000);
    if FError<>tlNone then Exit;
    case RC of
      WAIT_OBJECT_0,WAIT_TIMEOUT: Flush;
    else
      begin
        LastError := tlUnknow;
        Exit;
      end;
    end;
  end;
end;

procedure TSafeLog.Flush;
begin
   while (LastError=tlNone) and (FQueue.Count>0) do
   begin
     if not FActive then break;
     WriteMsg;
   end;
end;

function TSafeLog.Open: Boolean;
begin
  Result := False;
  if not DirectoryExists(FLogDir) then
  begin
    if not ForceDirectories(FLogDir) then
    begin
      LastError := tlErrorCreateDir;
      Exit;
    end;
  end;

  FHandle := CreateFile(
             PChar(String(FLogDir+FNameLog)),
             GENERIC_READ+GENERIC_WRITE,
             FILE_SHARE_READ,
             nil,
             OPEN_ALWAYS,
             0,
             0);
  if FHandle=INVALID_HANDLE_VALUE then
  begin
    LastError := tlErrorOpenLog;
    FHandle := 0;
    Exit;
  end;
  SetFilePointer(FHandle,0,nil,FILE_END);
  Result := True;
end;

procedure TSafeLog.Add(const s: String);
var
  Msg: String;
begin
  Msg := FormatDateTime('dd.mm.yyyy hh:nn:ss ',now)+s;
  if Length(Msg)>MaxLenMsg then SetLength(Msg,MaxLenMsg);
  FQueue.Push(Msg);
  if FActive then SetEvent(FEvent);
end;

function TSafeLog.WriteMsg: Boolean;
var
  ResultCount:Cardinal;
  Len:Integer;
  SizeHigh: Integer;
  Size: Integer;
  Msg: String;
begin
  Result := True;
  if FQueue.Count=0 then Exit;
  Msg := FQueue.Peek+#13#10;
  Len := Length(Msg);
  if WriteFile(FHandle,Msg[1],Len,ResultCount,nil) then
  begin
    FQueue.Pop;
  end
  else
  begin
    if GetLastError=112
      then LastError := tlInSuffSize
      else LastError := tlWriteError;
    Result := False;
    Exit;
  end;
  Size := GetFileSize(fHandle,@SizeHigh);
  if Size+(SizeHigh shl 32)>FMaxSize*1024*1024 then
  begin
    if not ArchiveLog then
    begin
      Result := False;
      Msg := 'Ошибка при архивации. Журнал закрыт'+#13#10;
      Len := Length(Msg);
      WriteFile(fHandle,Msg[1],Len,ResultCount,nil);
      FlushFileBuffers(FHandle);
    end;
  end;
end;

procedure TSafeLog.Release;
begin
  FActive := False;
  Terminate;
end;

procedure TSafeLog.ProcessError;
var
  s: String;
begin
  s := ErrorMsg[FError];
  if Assigned(FProcError) then FProcError(FError,s);
end;

procedure TSafeLog.Start;
begin
  FActive := True;
  SetEvent(FEvent);
end;

procedure TSafeLog.SetLastError(const Value: TSafeLogError);
begin
  FError := Value;
  if FError<>tlNone then
  begin
    FActive := False;
  end;
end;

procedure TSafeLog.ProcessTerminate(Sender: TObject);
begin
  ProcessError;
end;


end.

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

ZBugz

Дата 21.2.2006, 13:36 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(Демо @ 21.2.2006, 11:20

)

2. Каким образом определять, что копирование было прервано после его возобновления?

Я что то не понял о чем ты ?

Демо

Дата 21.2.2006, 13:36 (ссылка)

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

Загрузка ...

Эксперт

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

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

Код


4. TMgrCopier.

Так как это самый сложный класс, связанный с TCopier, начнем с него.

Для начала "костяк", или "рыба", на которую будем наращивать мускулы класса:

Код


unit uMgrCopier;

interface

uses
  Windows, Classes, SysUtils,
    uSafeLog, uSafeQueue;

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;

  TMgrCopier = class(TThread)
  private
    FList: TThreadList;
    FCS: RTL_CRITICAL_SECTION;
    FReady: Boolean;
    FMaxThreads: Integer;
    FLog: TSafeLog;
    FQ: TSafeQueue;
    function AddCopier: Boolean;
    procedure ClearList;
  protected
    procedure Execute; override;
  public
    constructor Create(MaxThreads: Integer=2);
    destructor Destroy; override;

//    procedure CopyDirectory(const Src,Dest: String; Overwrote: Boolean=True);
//    procedure CopyFile(const SrcFilePath,DestFilePath: String);
  end;

implementation

{ TMgrCopier }

//Функция для добавления потока в пул.
function TMgrCopier.AddCopier: Boolean;
begin
  Result := False;
  with FList.LockList do
  try
    if Count=FMaxThreads then Exit;
    //Add(TCopier.Create);
  finally
    FList.UnlockList;
  end;
end;

//Очистка списка потоков и их уничтожение.
procedure TMgrCopier.ClearList;
begin
  with FList.LockList do
  try
    while Count>0 do
    begin
//      TCopier(Items[0]).Release;
      Delete(0);
    end;
  finally
    FList.UnlockList;
  end;
end;

constructor TMgrCopier.Create(MaxThreads: Integer=2);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FMaxThreads := MaxThreads;
  if (FMaxThreads<1) or (FMaxThreads>10) then
  begin
    raise Exception.Create('Error parameter');
  end;
  FReady := False;
  FList := TThreadList.Create;
  FLog := TSafeLog.CreateDefault;
  FQ := TSafeQueue.Create;
  InitializeCriticalSection(FCS);
  Resume;
end;

destructor TMgrCopier.Destroy;
begin
  ClearList;
  FLog.Release;
  FQ.Free;
  DeleteCriticalSection(FCS);
  inherited;
end;

procedure TMgrCopier.Execute;
begin
  FReady := True;
end;

end.

Добавлено @ 13:38

Цитата(ZBugz @ 21.2.2006, 13:36

)

Я что то не понял о чем ты ?

Это о том, что после прерырывания программы, и после того, как она заново стартует, нужно определить, что нужно продолжить копирование, а не начать с начала.

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

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

ZBugz

Дата 21.2.2006, 13:57 (ссылка)

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

Загрузка ...

Опытный

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

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

Demo STOP !

Я уже и 1% не пойму что ты написал smile

. Погоди, давай немного назад, к примеру, который ты прекрепил. Может его сделаем быстрым, апотом потихоньку будем углубляться. Я хочу пока с одним файлом разобраться, а со многими попоже, а то у меня оперативки не хватает smile

. А по остальным вопросам я думаю та: Все таки тут все зависит от контролерра диска. Я думаю что один файл пока выгоднее копировать, чем два, если диск не SCSI

Давай покап один доделаем пример, хорошо ? smile

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