Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.09.09;
Скачать: [xml.tar.bz2];

Вниз

Программа подвисает при копировании большого файла   Найти похожие ветки 

 
radix   (2002-08-27 09:49) [0]

При копировании большого файла (100 и более Мб) типа AVI моя прога подвисает до конца копирования. Как сделать копирование незаметным ?


 
MBo   (2002-08-27 09:50) [1]

в отдельном потоке (thread)


 
radix   (2002-08-27 11:37) [2]

Никогда не работал с потоками. Можно примерчик ?


 
mumu   (2002-08-27 11:39) [3]

2radix:
Не знаю, как реализовано у тебя копирование в программе, но
при обработке длительных циклов рекомендуется вставлять в них
Application.ProcessMessages для того, чтобы приложение
продолжало реагировать на пользователя.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var i: Integer;
begin
for i:=1 to 10000 do begin
Edit1.Text:=IntToStr(i);
Application.ProcessMessages
end;
end;

------------------------------
С уважением, mumu


 
MBo   (2002-08-27 12:22) [4]

http://delphi.mastak.ru/cgi-bin/forum.pl?look=1&id=1030238821&n=5


 
radix   (2002-08-27 12:25) [5]

2mumu
Коприрую с помощью CopyFile(..). Не представляю как здесь использовать Application.ProcessMessages.

2MBo
За ссылку спасибо


 
n\a   (2002-08-28 00:02) [6]

копируй по частям при помощи буфера и загони это все в поток
что то типа этого должно получиться:
with Thread_Copy.Create("C:\01.avi", "D:\02.avi", 10000) do begin
//--- а тут можно связать с прогрессом
Resume;
end;


 
radix   (2002-08-28 09:03) [7]

У меня это получилось выведя CopyFile в поток. Но вот вопрос - каким образом копирование связать с ProgressBar ?


 
Ученик   (2002-08-28 09:05) [8]

А какая операционка, на Windows NT (2000, XP) есть CopyFileEx


 
radix   (2002-08-28 09:52) [9]

Сейчас я сижу под XP, но нужно чтобы работала и под Win9х


 
Ученик   (2002-08-28 09:59) [10]

>radix (28.08.02 09:52)
Тогда, SHFileOperation поддерживает прогресс или своя реализация CopyFile


 
ЮЮ   (2002-08-28 10:09) [11]

InputStream:=TFileStrim.Create(InputFileName,fmOpenRead,fmShareDenyWrite);
OutputStream:=TFileStrim.Create(OutputFileName,fmCreate ,fmShareExclusive);

Читать/Писать блоками
InputStream.Size и InputStream.Position дадут всю необходимую информацию для ProgressBar


 
Alex4444444444   (2002-08-28 10:42) [12]

V CopyFile est" callback. Toda i vstav" ProcessMessages
i progress bar.


 
ЮЮ   (2002-08-28 10:56) [13]

Он есть в CopyFileEx, а CopyFileEx есть только под NT


 
radix   (2002-08-28 12:22) [14]

Я покопался в Королевстве Делфи и там обнаружил пример на основе
InputStream OutputStream, как и предлагал ЮЮ. Данный код я поместил в поток и убрал оттуда Application.ProcessMessages.
Теперь вроде всё работает, только копирует медленнее, чем Windows.
http://delphi.vitpc.com/asp/answer.asp?IDAnswer=1314


 
Polevi   (2002-08-28 13:24) [15]

unit Unit1;

interface

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

const
WM_COPYBLOCK_COMPLETE=WM_USER+100;

type
TFileCopier=class(TThread)
private
FSour,FDest:string;
FCallbackWindow:THandle;
public
constructor Create(ADest,ASour:string;ACallbackWindow:THandle);
procedure Execute;override;
end;



type
TForm1 = class(TForm)
Button1: TButton;
pb: TProgressBar;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure OnBlockComplete(var Msg:TMessage);message WM_COPYBLOCK_COMPLETE;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{ TFileCopier }

constructor TFileCopier.Create(ADest, ASour: string;ACallbackWindow:THandle);
begin
FDest:=ADest;
FSour:=ASour;
FCallbackWindow:=ACallbackWindow;
inherited Create(false);
end;

procedure TFileCopier.Execute;
var
ov:_OVERLAPPED;
sour,dest,fmHandle:THandle;
FileSize,FileSizeHigh,BlockSize,BytesRead:Cardinal;
fBuffer:Pointer;
begin
BlockSize:=65536;
sour:=CreateFile(PChar(FSour),GENERIC_READ,
0,nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0);
FileSize:=GetFileSize(sour,@FileSizeHigh);
if FileSize<BlockSize then BlockSize:=FileSize;

dest:=CreateFile(PChar(FDest),GENERIC_READ or GENERIC_WRITE ,
FILE_SHARE_WRITE ,nil,OPEN_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);

fmHandle:=CreateFileMapping(dest,nil,PAGE_READWRITE,0,FileSize,nil);
fBuffer:=MapViewOfFile(fmHandle,FILE_MAP_WRITE,0,0,0);

try
ov.Internal:=0;
ov.InternalHigh:=0;
ov.Offset:=0;
ov.OffsetHigh:=0;
ov.hEvent:=CreateEvent(nil,false,true,nil);
while not Terminated do
case WaitForSingleObject(ov.hEvent,INFINITE) of
WAIT_OBJECT_0:
begin
ov.Offset:=ov.Offset+ov.InternalHigh;
PostMessage(FCallbackWindow,WM_COPYBLOCK_COMPLETE,ov.Offset,FileSize);
if ov.Offset=FileSize then Terminate;
ReadFile(sour,fBuffer^,BlockSize,BytesRead,@ov);
end;
WAIT_FAILED:Terminate;
end;

finally
UnmapViewOfFile(fBuffer);
CloseHandle(fmHandle);
CloseHandle(sour);
CloseHandle(dest);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
TFileCopier.Create("c:\test.txt","c:\@install\w2ksp3.exe",Handle);
end;

procedure TForm1.OnBlockComplete(var Msg: TMessage);
begin
pb.Max:=Msg.LParam;
pb.Position:=Msg.WParam;
if Msg.LParam=Msg.WParam then ShowMessage("Done");
end;

end.


 
Polevi   (2002-08-28 13:25) [16]

PS
Стало интересно - вот соорудил тут..
Обработки ошибок остутствуют, ессноо..


 
Polevi   (2002-08-28 13:37) [17]

оопс..

вместо
>ReadFile(sour,fBuffer^,BlockSize,BytesRead,@ov);

надо так

if FileSize-ov.Offset<BlockSize then BlockSize:=FileSize-ov.Offset;
ReadFile(sour,Pointer(Cardinal(fBuffer)+ov.Offset)^,BlockSize,BytesRead,@ov);



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.09.09;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.49 MB
Время: 0.006 c
4-27276
Ильдар
2002-07-18 13:55
2002.09.09
узнать IPадрес


3-26923
kinder
2002-08-20 15:30
2002.09.09
Автоинкрементное поле


1-27000
xyz
2002-08-22 22:07
2002.09.09
User.dat system.dat... как самому такую штуку сделать?


1-26969
Oleg_Gashev
2002-08-28 01:14
2002.09.09
Невизуальный компонент


1-27009
NidHelp
2002-08-30 01:28
2002.09.09
Есть html файл, в теле между <!--begin--> и <!--end--> написан





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский