VPF::Копирование в отдельном потоке

14SatanA88

Дата 21.11.2011, 22:04 (ссылка)

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

Загрузка ...

Опытный

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

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

Доброго времени суток, уважаемые программеры.

Сделал у себя в проге копирование (файлы немаленькие).
Столкнулся с некоторыми проблемами, в частности отсутствие перерисовки главной формы при копировании.
У меня на главной форме много визуальных компонентов, которые при наведении курсора на них должны перерисовываться.
Читал про потоки ( http://forum.vingrad.ru/topic-60076.html ), пытался сделать, но ничего не получилось...

Так как я в этом деле некомпетентен, то рассчитываю на Вашу помощь.

Как было до "внедрения" потока:

Код


unit copyr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, eff_button, StdCtrls, ExtCtrls, PDirSelected, ComCtrls,
  Gauges, CommCtrl;

type
  TCopyForm = class(TForm)
    DestPathEdit: TEdit;
    DestPathChangeBtn: TButton;
    InfoLabel: TLabel;
    CancelBtn: TEffectButton;
    CopyBtn: TEffectButton;
    CopyBGImage: TImage;
    DirDialog: TDirDialog;
    ProgressLabel: TLabel;
    PercentLabel: TLabel;
    ProgressBar: TProgressBar;
    procedure DestPathChangeBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure CopyBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure WMNCHITTEST(var Msg: TMessage); message WM_NCHITTEST;
    { Private declarations }
  public
    { Public declarations }
  end;

  
var
  CopyForm: TCopyForm;

implementation

uses main;

{$R *.dfm}


procedure TCopyForm.DestPathChangeBtnClick(Sender: TObject);
begin

  // указать папку, куда будем копировать
  if DirDialog.Execute then
  begin
    DestPathEdit.Text:=DirDialog.DirPath;
  end;

end;

procedure TCopyForm.CancelBtnClick(Sender: TObject);
begin

  CopyForm.Hide;
  MainForm.Enabled:=true;
  copying:=false;

end;

function GetFileSize64(const FileName: String): Int64;
var
  myFile: THandle;
  myFindData: TWin32FindData;
begin
  // set default value
  Result := 0;
  // get the file handle.
  myFile := FindFirstFile(PChar(FileName), myFindData);
  if (myFile <> INVALID_HANDLE_VALUE) then
  begin
    Windows.FindClose(myFile);
    Int64Rec(Result).Lo := myFindData.nFileSizeLow;
    Int64Rec(Result).Hi := myFindData.nFileSizeHigh;
  end;
end;

function Triade(source: string): string;
var i,j: integer;
    temp: string;
begin
  j:=1;
  temp:='';
  result:='';
  for i:=length(source) downto 1 do
  begin
    if j mod 3 = 0
      then temp:=temp+source[i]+' ' else temp:=temp+source[i];
    inc(j);
  end;
  for i:=length(temp) downto 1 do result:=result+temp[i];
end;

procedure CopyFile(const sSourceName, sDestinationName: String; ProgressControl: TProgressBar);
const
  nChunkSize = 8192;
var
  uCopyBuffer:                           Pointer;
  FSource, FDestination:                 Integer;
  nFileSize, nBytesCopied, nTotalCopied: Int64;
  sTotalCopied, sFileSize:               string;
begin

  GetMem(uCopyBuffer, nChunkSize);
  try
    nFileSize := GetFileSize64(sSourceName);
    nTotalCopied := 0;
    FSource := FileOpen(sSourceName, fmShareDenyNone);
    try
      if (ProgressControl <> nil) then begin
        with ProgressControl do begin
          Max := Round(nFileSize/10);
          Min := 0;
          Position := 0;
        end;
      end;
      ForceDirectories(ExtractFilePath(sDestinationName));
      FDestination := FileCreate(sDestinationName);
      try
        repeat
          Application.ProcessMessages;
          sTotalCopied:=Triade(inttostr(Round(nTotalCopied/1000)));
          sFileSize:=Triade(inttostr(Round(nFileSize/1000)));
          CopyForm.ProgressLabel.Caption:=sTotalCopied+' / '+sFileSize+' Kb';
          CopyForm.PercentLabel.Caption:=inttostr(Round(nTotalCopied/nFileSize*100))+'%';
          nBytesCopied := FileRead(FSource, uCopyBuffer^, nChunkSize);
          nTotalCopied := nTotalCopied + nBytesCopied;
          FileWrite(FDestination, uCopyBuffer^, nBytesCopied);
          if (ProgressControl <> nil)
            then ProgressControl.Position := Round(nTotalCopied/10);
        until (nBytesCopied < nChunkSize);
        FileSetDate(FDestination, FileGetDate(FSource));
      finally
        FileClose(FDestination);
      end;
      finally
        FileClose(FSource);
      end;
    finally
      FreeMem(uCopyBuffer, nChunkSize);
      if (ProgressControl <> nil)
        then ProgressControl.Position := 0;
   end;

end;

procedure TCopyForm.CopyBtnClick(Sender: TObject);
var i: integer;   // счетчик цикла
    dest: string; // папка
    FreeBytesAvailableToCaller: TLargeInteger;
    FreeSize: TLargeInteger;
    TotalSize: TLargeInteger;
    dlgRes: integer;
begin

  // проверить существование папки
  dest:=DestPathEdit.Text;
  if not(DirectoryExists(dest))
  then showmessage('Указанной папки не существует!')
  else begin
    // смещаем окно, отдаем фокус главному
    MainForm.Enabled:=true;
    CopyForm.Left:=5;
    CopyForm.Top:=5;
    MainForm.SetFocus;
    // прячем ненужные компоненты
    DestPathEdit.Hide;
    DestPathChangeBtn.Hide;
    CancelBtn.Hide;
    CopyBtn.Hide;
    PercentLabel.Show;
    ProgressLabel.Show;
    ProgressBar.Show;
    Progressbar.Brush.Color := clBlack;
    SendMessage( ProgressBar.Handle, PBM_SETBARCOLOR, 0, clBlue );
    // копирование
    for i:=0 to copylist.Count-1 do
    begin
      // проверка свободного места
      GetDiskFreeSpaceEx(PAnsiChar(dest),FreeBytesAvailableToCaller,Totalsize,@FreeSize);
      if GetFileSize64(copylist.Strings[i]) >= FreeBytesAvailableToCaller then
        repeat // показывать мессагу пока не будет достаточно места или нажата кнопка отмены
          GetDiskFreeSpaceEx(PAnsiChar(dest),FreeBytesAvailableToCaller,Totalsize,@FreeSize);
          dlgres:=MessageBox(Application.Handle, 'Недостаточно места на диске!', 'CineFil', MB_RETRYCANCEL);
          if dlgres=idCancel then
          begin // отмена
            CancelBtnClick(Self);
            exit;
          end;
        until GetFileSize64(copylist.Strings[i]) <= FreeBytesAvailableToCaller;
      // копирование
      InfoLabel.Caption:='Копируется '+inttostr(i+1)+'-й из '+inttostr(copylist.Count)+' ('+ExtractFileName(copylist.Strings[i])+')';
      CopyFile(copylist.Strings[i], dest+ExtractFileName(copylist.Strings[i]), ProgressBar);
      ProgressLabel.Caption:='';
      PercentLabel.Caption:='';
    end;
    // финиш
    CancelBtnClick(Self);
  end;

end;

procedure TCopyForm.FormCreate(Sender: TObject);
begin

  // разрешить таскать форму
  SetWindowLong(Handle, GWL_STYLE,
    GETWINDOWLONG(Handle, GWL_STYLE) and (not WS_CAPTION));
  Height := ClientHeight;

end;

procedure TCopyForm.WMNCHITTEST(var Msg: TMessage);
begin
  inherited;
  Msg.Result := HTCAPTION;
end;

end.

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

Код


unit copyr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, eff_button, StdCtrls, ExtCtrls, PDirSelected, ComCtrls,
  Gauges, CommCtrl;

type
  TCopyForm = class(TForm)
    DestPathEdit: TEdit;
    DestPathChangeBtn: TButton;
    InfoLabel: TLabel;
    CancelBtn: TEffectButton;
    CopyBtn: TEffectButton;
    CopyBGImage: TImage;
    DirDialog: TDirDialog;
    ProgressLabel: TLabel;
    PercentLabel: TLabel;
    ProgressBar: TProgressBar;
    procedure DestPathChangeBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure CopyBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure WMNCHITTEST(var Msg: TMessage); message WM_NCHITTEST;
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TCopyThread = class(TThread)
  private
    function GetFileSize64(const FileName: String): Int64;
    function Triade(source: string): string;
    procedure CopyFile(const sSourceName, sDestinationName: String; ProgressControl: TProgressBar);
  protected
    procedure DoCopy;
    procedure Execute; override;
  end;

var
  CopyForm: TCopyForm;
  CT: TCopyThread;

implementation

uses main;

{$R *.dfm}

procedure TCopyThread.Execute;
begin

  Synchronize(DoCopy);
  
end;

procedure TCopyForm.DestPathChangeBtnClick(Sender: TObject);
begin

  // указать папку, куда будем копировать
  if DirDialog.Execute then
  begin
    DestPathEdit.Text:=DirDialog.DirPath;
  end;

end;

procedure TCopyForm.CancelBtnClick(Sender: TObject);
begin

  CopyForm.Hide;
  MainForm.Enabled:=true;
  copying:=false;

end;

function TCopyThread.GetFileSize64(const FileName: String): Int64;
var
  myFile: THandle;
  myFindData: TWin32FindData;
begin
  // set default value
  Result := 0;
  // get the file handle.
  myFile := FindFirstFile(PChar(FileName), myFindData);
  if (myFile <> INVALID_HANDLE_VALUE) then
  begin
    Windows.FindClose(myFile);
    Int64Rec(Result).Lo := myFindData.nFileSizeLow;
    Int64Rec(Result).Hi := myFindData.nFileSizeHigh;
  end;
end;

function TCopyThread.Triade(source: string): string;
var i,j: integer;
    temp: string;
begin
  j:=1;
  temp:='';
  result:='';
  for i:=length(source) downto 1 do
  begin
    if j mod 3 = 0
      then temp:=temp+source[i]+' ' else temp:=temp+source[i];
    inc(j);
  end;
  for i:=length(temp) downto 1 do result:=result+temp[i];
end;

procedure TCopyThread.CopyFile(const sSourceName, sDestinationName: String; ProgressControl: TProgressBar);
const
  nChunkSize = 8192;
var
  uCopyBuffer:                           Pointer;
  FSource, FDestination:                 Integer;
  nFileSize, nBytesCopied, nTotalCopied: Int64;
  sTotalCopied, sFileSize:               string;
begin

  GetMem(uCopyBuffer, nChunkSize);
  try
    nFileSize := GetFileSize64(sSourceName);
    nTotalCopied := 0;
    FSource := FileOpen(sSourceName, fmShareDenyNone);
    try
      if (ProgressControl <> nil) then begin
        with ProgressControl do begin
          Max := Round(nFileSize/10);
          Min := 0;
          Position := 0;
        end;
      end;
      ForceDirectories(ExtractFilePath(sDestinationName));
      FDestination := FileCreate(sDestinationName);
      try
        repeat
          Application.ProcessMessages;
          sTotalCopied:=Triade(inttostr(Round(nTotalCopied/1000)));
          sFileSize:=Triade(inttostr(Round(nFileSize/1000)));
          CopyForm.ProgressLabel.Caption:=sTotalCopied+' / '+sFileSize+' Kb';
          CopyForm.PercentLabel.Caption:=inttostr(Round(nTotalCopied/nFileSize*100))+'%';
          nBytesCopied := FileRead(FSource, uCopyBuffer^, nChunkSize);
          nTotalCopied := nTotalCopied + nBytesCopied;
          FileWrite(FDestination, uCopyBuffer^, nBytesCopied);
          if (ProgressControl <> nil)
            then ProgressControl.Position := Round(nTotalCopied/10);
        until (nBytesCopied < nChunkSize);
        FileSetDate(FDestination, FileGetDate(FSource));
      finally
        FileClose(FDestination);
      end;
      finally
        FileClose(FSource);
      end;
    finally
      FreeMem(uCopyBuffer, nChunkSize);
      if (ProgressControl <> nil)
        then ProgressControl.Position := 0;
   end;

end;

procedure TCopyThread.DoCopy;
var i: integer;   // счетчик цикла
    dest: string; // папка
    FreeBytesAvailableToCaller: TLargeInteger;
    FreeSize: TLargeInteger;
    TotalSize: TLargeInteger;
    dlgRes: integer;
begin

  // проверить существование папки
  dest:=CopyForm.DestPathEdit.Text;
  if not(DirectoryExists(dest))
  then showmessage('Указанной папки не существует!')
  else begin
    // смещаем окно, отдаем фокус главному
    MainForm.Enabled:=true;
    CopyForm.Left:=5;
    CopyForm.Top:=5;
    MainForm.SetFocus;
    // прячем ненужные компоненты
    CopyForm.DestPathEdit.Hide;
    CopyForm.DestPathChangeBtn.Hide;
    CopyForm.CancelBtn.Hide;
    CopyForm.CopyBtn.Hide;
    CopyForm.PercentLabel.Show;
    CopyForm.ProgressLabel.Show;
    CopyForm.ProgressBar.Show;
    CopyForm.Progressbar.Brush.Color := clBlack;
    SendMessage( CopyForm.ProgressBar.Handle, PBM_SETBARCOLOR, 0, clBlue );
    // копирование
    for i:=0 to copylist.Count-1 do
    begin
      // проверка свободного места
      GetDiskFreeSpaceEx(PAnsiChar(dest),FreeBytesAvailableToCaller,Totalsize,@FreeSize);
      if GetFileSize64(copylist.Strings[i]) >= FreeBytesAvailableToCaller then
        repeat // показывать мессагу пока не будет достаточно места или нажата кнопка отмены
          GetDiskFreeSpaceEx(PAnsiChar(dest),FreeBytesAvailableToCaller,Totalsize,@FreeSize);
          dlgres:=MessageBox(Application.Handle, 'Недостаточно места на диске!', 'CineFil', MB_RETRYCANCEL);
          if dlgres=idCancel then
          begin // отмена
            CopyForm.CancelBtnClick(Self);
            exit;
          end;
        until GetFileSize64(copylist.Strings[i]) <= FreeBytesAvailableToCaller;
      // копирование
      CopyForm.InfoLabel.Caption:='Копируется '+inttostr(i+1)+'-й из '+inttostr(copylist.Count)+' ('+ExtractFileName(copylist.Strings[i])+')';
      // проверка, есть ли уже такой файл, предложение замены если есть
      if FileExists(dest+ExtractFileName(copylist.Strings[i])) then
      begin
        dlgres:=MessageBox(Application.Handle, 'Такой файл уже существует! Заменить?', 'CineFil', MB_YESNO);
        if dlgres=idYes
        then CopyFile(copylist.Strings[i], dest+ExtractFileName(copylist.Strings[i]), CopyForm.ProgressBar);
      end
      else CopyFile(copylist.Strings[i], dest+ExtractFileName(copylist.Strings[i]), CopyForm.ProgressBar);
      CopyForm.ProgressLabel.Caption:='';
      CopyForm.PercentLabel.Caption:='';
    end;
    // финиш
    CopyForm.CancelBtnClick(Self);
  end;

end;

procedure TCopyForm.CopyBtnClick(Sender: TObject);
begin

  // создаем поток
  CT:=TCopyThread.Create(false);
  CT.FreeOnTerminate:=true;
  CT.Priority:=tpHighest;

end;

procedure TCopyForm.FormCreate(Sender: TObject);
begin

  // разрешить таскать форму
  SetWindowLong(Handle, GWL_STYLE,
    GETWINDOWLONG(Handle, GWL_STYLE) and (not WS_CAPTION));
  Height := ClientHeight;

end;

procedure TCopyForm.WMNCHITTEST(var Msg: TMessage);
begin

  inherited;
  Msg.Result := HTCAPTION;
  
end;

end.

Желаемой перерисовки главной формы не достиг. Видимо, я в корне неверно организовал поток.
Помогите загнать копирование в поток так, чтобы компоненты на главной форме адекватно реагировали на курсор мыши.

MetalFan

Дата 21.11.2011, 22:56 (ссылка)

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

Код


procedure TCopyThread.Execute;
begin
  Synchronize(DoCopy);
  
end;

Еще как "в корне не верно"!
Смысл в использовании доп.потока в корне теряется при данном подходе.
Почитай еще разок ту статейку про потоки...
Ну или воспользуйся функцией CopyFileEx

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

There are always someone smarter than you...

14SatanA88

Дата 21.11.2011, 23:15 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(MetalFan @ 21.11.2011, 22:56

)

Смысл в использовании доп.потока в корне теряется при данном подходе.

не могли бы вы провести небольшой мастер-класс, чтобы я наконец понял все?

northener

Дата 21.11.2011, 23:35 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(14SatanA88 @ 21.11.2011, 23:15

)

не могли бы вы провести небольшой мастер-класс, чтобы я наконец понял все?

"Мастер класс" тут нафиг не нужен. Достаточно понять одну простую вещь.
Процедура Synchronize выполняется в контексте основного потока! Именно для этого она и введена в класс TThread.

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

Но только лошади летают вдохновенно.
Иначе лошади разбились бы мгновенно!

14SatanA88

Дата 22.11.2011, 08:11 (ссылка)

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

Загрузка ...

Опытный

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

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

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

тогда я пойму. а так до меня не доходит...

superVad

Дата 22.11.2011, 10:55 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 735
Регистрация: 6.4.2006
Где: Черкассы, Украина

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

14SatanA88, может это поможет: ссылка.

14SatanA88

Дата 22.11.2011, 11:00 (ссылка)

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

Загрузка ...

Опытный

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

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

superVad, спасибо, поэкспериментирую.
но хотелось бы разобраться с делфийским Tthread

CodeMonkey

Дата 22.11.2011, 11:33 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(14SatanA88 @ 22.11.2011, 00:15

)

не могли бы вы провести небольшой мастер-класс, чтобы я наконец понял все?

Сам же всё и нашёл: http://forum.vingrad.ru/topic-60076.html

Там всё написано. Хочешь поток - юзай TThread и вставляй код в Execute. Чего там понимать-то?

Цитата(14SatanA88)

тогда я пойму. а так до меня не доходит...

По твоеё же ссылке есть раздел TThread.Synchronize. Где не только написано что он делает (выполняет код в главном потоке), но и показаны графики(!) того, что при этом происходит. Synchronize = "нет потока". Приведён код и примеры. Что ещё можно сказать, чтобы дошло?

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

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.

14SatanA88

Дата 22.11.2011, 11:50 (ссылка)

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

Загрузка ...

Опытный

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

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

CodeMonkey, в том то и проблема, что я читал тот раздел и ничего у меня не вышло, даже графики не помогли.

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

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

MetalFan

Дата 22.11.2011, 12:42 (ссылка)

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

Цитата(14SatanA88 @ 22.11.2011, 11:50

)

вечером попробую сделать

разбирайся, показывай новую версию, тогда подскажем что неправильно.
А переписывать твой код на работу потоке... ну лично мне просто некогда и неинтересно с этим возиться. Делов то - разнести визуальную часть от части, что будет производить копирование в потоке...

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

There are always someone smarter than you...

ZBugz

Дата 22.11.2011, 18:04 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(14SatanA88 @ 21.11.2011, 22:04)

Доброго времени суток, уважаемые программеры.

Лови, там есть пример с картинками smile

http://forum.vingrad.ru/forum/topic-312953...y2233596/0.html

CodeMonkey

Дата 22.11.2011, 18:10 (ссылка)

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

Загрузка ...

Эксперт

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

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

offtopic

"С картинками"? Скоро комиксы рисовать будем. smile

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

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.

14SatanA88

Дата 22.11.2011, 20:23 (ссылка)

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

Загрузка ...

Опытный

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

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

все же я неправильно понял...

Цитата(CodeMonkey @ 22.11.2011, 11:33

)

Хочешь поток - юзай TThread и вставляй код в Execute

делаю так

Код


unit copyr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, eff_button, StdCtrls, ExtCtrls, PDirSelected, ComCtrls,
  Gauges, CommCtrl;

type
  TCopyForm = class(TForm)
    DestPathEdit: TEdit;
    DestPathChangeBtn: TButton;
    InfoLabel: TLabel;
    CancelBtn: TEffectButton;
    CopyBtn: TEffectButton;
    CopyBGImage: TImage;
    DirDialog: TDirDialog;
    ProgressLabel: TLabel;
    PercentLabel: TLabel;
    ProgressBar: TProgressBar;
    procedure DestPathChangeBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure CopyBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure WMNCHITTEST(var Msg: TMessage); message WM_NCHITTEST;
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TCopyThread = class(TThread)
  private
    function GetFileSize64(const FileName: String): Int64;
    function Triade(source: string): string;
    procedure CopyFile(const sSourceName, sDestinationName: String; ProgressControl: TProgressBar);
  protected
    procedure DoCopy;
    procedure Execute; override;
  end;

var
  CopyForm: TCopyForm;
  CT: TCopyThread;

implementation

uses main;

{$R *.dfm}

procedure TCopyThread.Execute;
begin

  DoCopy;
  
end;

procedure TCopyForm.DestPathChangeBtnClick(Sender: TObject);
begin

  // указать папку, куда будем копировать
  if DirDialog.Execute then
  begin
    DestPathEdit.Text:=DirDialog.DirPath;
  end;

end;

procedure TCopyForm.CancelBtnClick(Sender: TObject);
begin

  CopyForm.Hide;
  MainForm.Enabled:=true;
  copying:=false;

end;

function TCopyThread.GetFileSize64(const FileName: String): Int64;
var
  myFile: THandle;
  myFindData: TWin32FindData;
begin
  // set default value
  Result := 0;
  // get the file handle.
  myFile := FindFirstFile(PChar(FileName), myFindData);
  if (myFile <> INVALID_HANDLE_VALUE) then
  begin
    Windows.FindClose(myFile);
    Int64Rec(Result).Lo := myFindData.nFileSizeLow;
    Int64Rec(Result).Hi := myFindData.nFileSizeHigh;
  end;
end;

function TCopyThread.Triade(source: string): string;
var i,j: integer;
    temp: string;
begin
  j:=1;
  temp:='';
  result:='';
  for i:=length(source) downto 1 do
  begin
    if j mod 3 = 0
      then temp:=temp+source[i]+' ' else temp:=temp+source[i];
    inc(j);
  end;
  for i:=length(temp) downto 1 do result:=result+temp[i];
end;

procedure TCopyThread.CopyFile(const sSourceName, sDestinationName: String; ProgressControl: TProgressBar);
const
  nChunkSize = 8192;
var
  uCopyBuffer:                           Pointer;
  FSource, FDestination:                 Integer;
  nFileSize, nBytesCopied, nTotalCopied: Int64;
  sTotalCopied, sFileSize:               string;
begin

  GetMem(uCopyBuffer, nChunkSize);
  try
    nFileSize := GetFileSize64(sSourceName);
    nTotalCopied := 0;
    FSource := FileOpen(sSourceName, fmShareDenyNone);
    try
      if (ProgressControl <> nil) then begin
        with ProgressControl do begin
          Max := Round(nFileSize/10);
          Min := 0;
          Position := 0;
        end;
      end;
      ForceDirectories(ExtractFilePath(sDestinationName));
      FDestination := FileCreate(sDestinationName);
      try
        repeat
          Application.ProcessMessages;
          sTotalCopied:=Triade(inttostr(Round(nTotalCopied/1000)));
          sFileSize:=Triade(inttostr(Round(nFileSize/1000)));
          CopyForm.ProgressLabel.Caption:=sTotalCopied+' / '+sFileSize+' Kb';
          CopyForm.PercentLabel.Caption:=inttostr(Round(nTotalCopied/nFileSize*100))+'%';
          nBytesCopied := FileRead(FSource, uCopyBuffer^, nChunkSize);
          nTotalCopied := nTotalCopied + nBytesCopied;
          FileWrite(FDestination, uCopyBuffer^, nBytesCopied);
          if (ProgressControl <> nil)
            then ProgressControl.Position := Round(nTotalCopied/10);
        until (nBytesCopied < nChunkSize);
        FileSetDate(FDestination, FileGetDate(FSource));
      finally
        FileClose(FDestination);
      end;
      finally
        FileClose(FSource);
      end;
    finally
      FreeMem(uCopyBuffer, nChunkSize);
      if (ProgressControl <> nil)
        then ProgressControl.Position := 0;
   end;

end;

procedure TCopyThread.DoCopy;
var i: integer;   // счетчик цикла
    dest: string; // папка
    FreeBytesAvailableToCaller: TLargeInteger;
    FreeSize: TLargeInteger;
    TotalSize: TLargeInteger;
    dlgRes: integer;
begin

  // проверить существование папки
  dest:=CopyForm.DestPathEdit.Text;
  if not(DirectoryExists(dest))
  then showmessage('Указанной папки не существует!')
  else begin
    // смещаем окно, отдаем фокус главному
    MainForm.Enabled:=true;
    CopyForm.Left:=5;
    CopyForm.Top:=5;
    MainForm.SetFocus;
    // прячем ненужные компоненты
    CopyForm.DestPathEdit.Hide;
    CopyForm.DestPathChangeBtn.Hide;
    CopyForm.CancelBtn.Hide;
    CopyForm.CopyBtn.Hide;
    CopyForm.PercentLabel.Show;
    CopyForm.ProgressLabel.Show;
    CopyForm.ProgressBar.Show;
    CopyForm.Progressbar.Brush.Color := clBlack;
    SendMessage( CopyForm.ProgressBar.Handle, PBM_SETBARCOLOR, 0, clBlue );
    // копирование
    for i:=0 to copylist.Count-1 do
    begin
      // проверка свободного места
      GetDiskFreeSpaceEx(PAnsiChar(dest),FreeBytesAvailableToCaller,Totalsize,@FreeSize);
      if GetFileSize64(copylist.Strings[i]) >= FreeBytesAvailableToCaller then
        repeat // показывать мессагу пока не будет достаточно места или нажата кнопка отмены
          GetDiskFreeSpaceEx(PAnsiChar(dest),FreeBytesAvailableToCaller,Totalsize,@FreeSize);
          dlgres:=MessageBox(Application.Handle, 'Недостаточно места на диске!', 'CineFil', MB_RETRYCANCEL);
          if dlgres=idCancel then
          begin // отмена
            CopyForm.CancelBtnClick(Self);
            exit;
          end;
        until GetFileSize64(copylist.Strings[i]) <= FreeBytesAvailableToCaller;
      // копирование
      CopyForm.InfoLabel.Caption:='Копируется '+inttostr(i+1)+'-й из '+inttostr(copylist.Count)+' ('+ExtractFileName(copylist.Strings[i])+')';
      // проверка, есть ли уже такой файл, предложение замены если есть
      if FileExists(dest+ExtractFileName(copylist.Strings[i])) then
      begin
        dlgres:=MessageBox(Application.Handle, 'Такой файл уже существует! Заменить?', 'CineFil', MB_YESNO);
        if dlgres=idYes
        then CopyFile(copylist.Strings[i], dest+ExtractFileName(copylist.Strings[i]), CopyForm.ProgressBar);
      end
      else CopyFile(copylist.Strings[i], dest+ExtractFileName(copylist.Strings[i]), CopyForm.ProgressBar);
      CopyForm.ProgressLabel.Caption:='';
      CopyForm.PercentLabel.Caption:='';
    end;
    // финиш
    CopyForm.CancelBtnClick(Self);
  end;

end;

procedure TCopyForm.CopyBtnClick(Sender: TObject);
begin

  // создаем поток
  CT:=TCopyThread.Create(false);
  CT.FreeOnTerminate:=true;

end;

procedure TCopyForm.FormCreate(Sender: TObject);
begin

  // разрешить таскать форму
  SetWindowLong(Handle, GWL_STYLE,
    GETWINDOWLONG(Handle, GWL_STYLE) and (not WS_CAPTION));
  Height := ClientHeight;

end;

procedure TCopyForm.WMNCHITTEST(var Msg: TMessage);
begin

  inherited;
  Msg.Result := HTCAPTION;
  
end;

end.

в итоге визуально на этой форме творится безобразие, на главной форме наблюдается частичная перерисовка, а прога в целом через несколько секунд валится с ошибкой stack overflow либо system out of resources

CodeMonkey

Дата 22.11.2011, 20:37 (ссылка)

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

Загрузка ...

Эксперт

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

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

Ну, уже лучше.

Осталось понять такой факт: обращаться к VCL из вторичных потоков нельзя.

Читай: нельзя трогать форму TCopyForm и её компоненты из TCopyThread.

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

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.

14SatanA88

Дата 22.11.2011, 20:44 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(CodeMonkey @ 22.11.2011, 20:37

)

обращаться к VCL из вторичных потоков нельзя.

я правильно понял, что куски с обращением к VCL надо сунуть в Synchronize?

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