Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Скопировать файл и отобразить процесс на ProgressB 
V
    Опции темы
User32
Дата 4.6.2007, 13:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Пишу мини инсталлятор, сейчас решил дополнить его ProgressBar'ом для визуализации...
Но столкнулся с такой проблемой: Нужно скопировать ОДИН! файл но отображая процесс копирования на ProgressBar.
Делаю так:
Код

...
var
  CancelCopy: bool;

function CopyProgressRoutime(TotalFileSize, TotalBytesTransferred, StreamSize,
  StreamBytesTransferred: int64; dwStreamNumber, dwCallbackReason: dword;
  hSourceFile, hDestinationFile: THandle; lpData: pointer): dword;
begin
  Form1.ProgressBar1.Position := Round(TotalBytesTransferred / TotalFileSize);
  Result := PROGRESS_CONTINUE;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin        
  CopyFileEx(PChar(ParamStr(0)),'C:\NEW.EXE',
  @CopyProgressRoutime, nil, @CancelCopy, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CancelCopy := True;
end;
...


И всё работает но только на Windows 2000 и XP а вот на Windows 95 и 98 неработает  smile 
Как быть? Каким ещё можно способом скопировать один файл с визуализацией процесса на ProgressBar?
PM MAIL   Вверх
Yanis
Дата 4.6.2007, 13:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 72
Всего: 111
А stdcall где же?


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
User32
Дата 4.6.2007, 14:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Цитата(Yanis @ 4.6.2007,  13:45)
А stdcall где же?

Не совсем понял, причём тут tdcall. Насколько я знаю это 32-разрядный режим...
Или я не прав?


Код

function CopyProgressRoutime(TotalFileSize, TotalBytesTransferred, StreamSize,
  StreamBytesTransferred: int64; dwStreamNumber, dwCallbackReason: dword;
  hSourceFile, hDestinationFile: THandle; lpData: pointer): dword; stdcall;
PM MAIL   Вверх
MetalFan
Дата 4.6.2007, 14:32 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


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


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

Репутация: 62
Всего: 128
Цитата(User32 @  4.6.2007,  14:00 Найти цитируемый пост)
Не совсем понял, причём тут tdcall. Насколько я знаю это 32-разрядный режим...

а причем тут stdcall и 32 разрядный режим???


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
User32
Дата 4.6.2007, 14:56 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Цитата(MetalFan @ 4.6.2007,  14:32)
Цитата(User32 @  4.6.2007,  14:00 Найти цитируемый пост)
Не совсем понял, причём тут tdcall. Насколько я знаю это 32-разрядный режим...

а причем тут stdcall и 32 разрядный режим???


Что по теме то? Как проблему то решать?

Это сообщение отредактировал(а) User32 - 4.6.2007, 18:05
PM MAIL   Вверх
MetalFan
Дата 4.6.2007, 21:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


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


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

Репутация: 62
Всего: 128
а в чем проблема то? 
что значит "не работает"? какую ошибку выдает? что GetLastError возвращает?


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Poseidon
Дата 4.6.2007, 22:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133
Цитата(User32 @  4.6.2007,  14:56 Найти цитируемый пост)
Как проблему то решать?
Копируй CopyFile
Что бы узнать прогресс, смотри сколько уже скопировано (соотношение размер файла-получателя/размер файла-источника)



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
dumb
Дата 5.6.2007, 01:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: 13
Всего: 158
User32, уже давно бы "руками" скопировал, избежав проблем с совместимостью итд.

чей-то меня пробило позаниматься фигней(фигня потому, что это стопудово есть в faq'ах):
Код

procedure TForm1.Button1Click(Sender: TObject);
const
  BLOCKSIZE = 32768;
var
  FromF, ToF: File;
  Buf: PByte;
  CopyOk: Boolean;
  FSize, NumRead, NumWritten: Integer;
begin
  Buf := nil;
  CopyOk := false;
  try
    GetMem(Buf, BLOCKSIZE);
    AssignFile(FromF, ParamStr(0));
    FileMode := 0; {Set file access to read only }
    Reset(FromF, 1); { Record size = 1 }
    FSize := FileSize(FromF);
    ProgressBar1.Max := FSize;
    AssignFile(ToF, 'C:\NEW.EXE'); { Open output file }
    Rewrite(ToF, 1); { Record size = 1 }
    repeat
      BlockRead(FromF, Buf^, BLOCKSIZE, NumRead);
      BlockWrite(ToF, Buf^, NumRead, NumWritten);
      ProgressBar1.StepBy(NumWritten);
      Application.ProcessMessages;
    until (NumRead < BLOCKSIZE) or (NumWritten <> NumRead);
    ProgressBar1.Position := ProgressBar1.Max;
    CopyOk := true;
  finally
    if Buf <> nil then FreeMem(Buf);
    CloseFile(FromF);
    CloseFile(ToF);
  end;
  if not CopyOk then ShowMessage(SysErrorMessage(GetLastError()));
end;


ps. delphi не разумею особо, посему критика "идет лесом" - сами улуЧЧайте. smile
PM MAIL   Вверх
User32
Дата 5.6.2007, 13:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Добавлено @ 13:27
Цитата(MetalFan @ 4.6.2007,  21:37)
а в чем проблема то? 
что значит "не работает"? какую ошибку выдает? что GetLastError возвращает?

1) Проблема в неработоспособности... т.е. не копирует.
2) А то и значит что вообще ничего не выдаёт и неработает.

Добавлено @ 13:29
Цитата(Poseidon @ 4.6.2007,  22:00)
Цитата(User32 @  4.6.2007,  14:56 Найти цитируемый пост)
Как проблему то решать?
Копируй CopyFile

Низя, нужна визуализация процесса.


Добавлено @ 13:29
Цитата(Poseidon @ 4.6.2007,  22:00)
Цитата(User32 @  4.6.2007,  14:56 Найти цитируемый пост)
Как проблему то решать?

Что бы узнать прогресс, смотри сколько уже скопировано (соотношение размер файла-получателя/размер файла-источника)


Знаю, так и зделал...


Всем спасибо, проблема решена.

И всё заработало как надо даже на 9х виндах...
Ошибок (I\O error ...) больше невыдаёт, т.к. всё дело было в режиме доступа к файлу FileMode := fmOpenRead 

Код

procedure TSetupForm.CopyFile_Progress; // !!!
var
  FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer; 
  FileLength: longint;
begin
  AssignFile(FromF, PChar(ParamStr(0))); 
  FileMode := fmOpenRead; 
  Reset(FromF);

  AssignFile(ToF, SelectDir + 'NEW.EXE'); 
//  FileMode := fmOpenWrite;  
  ReWrite(ToF);

  FileLength := FileSize(FromF);
  with ProgressBar1 do
  begin
    Min := 0; 
    Max := FileLength;
    while FileLength > 0 do 
    begin 
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead); 
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      Position := Position + NumRead; 
    end; 
    CloseFile(FromF); 
    CloseFile(ToF); 
  end; 
end;




Это сообщение отредактировал(а) User32 - 5.6.2007, 13:31
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0734 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.