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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Download from http server, Проблема с размером 
:(
    Опции темы
Rodman
Дата 29.8.2006, 12:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


CIO
****


Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122
Дароф.

Я разобрал такой код:

Код

unit DownloadThreadUnit;

interface

uses
 Classes, IdComponent, IdHTTP;

type
 TDownloadThread = class(TThread)
 private
   FUrl: string;
   FFileName: string;
   FPrevTime: TDateTime;
   FProgress: Integer;
   FMaxProgress: Integer;
   FSpeed: Real;
   FTime: Integer;

   procedure WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
   procedure Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
   procedure FSetMaxProgress;
   procedure FSetprogress;
 protected
   procedure Execute; override;
 public
   FDownloadHTTP: TIdHTTP;

   constructor Create(AUrl, AFileName: string);
   procedure StopDownload;
 end;

implementation

uses
 MainUnit, SysUtils, Windows, DateUtils, Math;

{ TDownloadThread }

constructor TDownloadThread.Create(AUrl, AFileName: string);
begin
 FUrl := AUrl;
 FFileName := AFileName;
 FProgress := 0;
 FMaxProgress := 0;
 FPrevTime := Now;
 inherited Create(False);
end;

procedure TDownloadThread.Execute;
var
 Response: TFileStream;
begin
 try
   Response := TFileStream.Create(FFileName, fmCreate);
   FDownloadHTTP := TIdHTTP.Create(nil);
   try
     FDownloadHTTP.Request.Referer := 'AdsCleaner Bundle';
     FDownloadHTTP.OnWorkBegin := WorkBegin;
     FDownloadHTTP.OnWork := Work;
     FDownloadHTTP.Get(FUrl, Response);
   finally
     FDownloadHTTP.Free;
     Response.Free;
   end;
 except
   SysUtils.DeleteFile(FFileName);
   Halt(1);
 end;
end;

procedure TDownloadThread.WorkBegin(Sender: TObject;
 AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
 FMaxProgress := AWorkCountMax;
 Synchronize(FSetMaxProgress);
end;

procedure TDownloadThread.Work(Sender: TObject; AWorkMode: TWorkMode;
 const AWorkCount: Integer);
begin
 FProgress := AWorkCount;
 Synchronize(FSetProgress);
end;

procedure TDownloadThread.FSetMaxProgress;
begin
 MainForm.Gauge.MaxValue := FMaxProgress;
end;

procedure TDownloadThread.FSetProgress;
var
 ResultStr: string;
 ATime: TDateTime;
 ASecond: Real;
begin
 ATime := Now;
 ASecond := MilliSecondsBetween(Now, FPrevTime) / 1000;
 FPrevTime := ATime;
 if ASecond <> 0 then
 begin
   FSpeed := (FDownloadHTTP.RecvBufferSize / ASecond) / 1024;
   FTime := Round(((FMaxProgress - FProgress) / 1024 )/ FSpeed);
   ResultStr := '';
   if FTime div 3600 = 0 then
     ResultStr := '00:'
   else
   begin
     ResultStr := IntToStr(FTime div 3600) + ':';
     FTime := FTime - FTime div 3600 * 3600;
   end;
   if FTime div 60 = 0 then
     ResultStr := ResultStr + '00:'
   else
   begin
     if FTime div 60 < 10 then
       ResultStr := ResultStr + '0' + IntToStr(FTime div 60) + ':'
     else
       ResultStr := ResultStr + IntToStr(FTime div 60) + ':';
     FTime := FTime - FTime div 60 * 60;
   end;
   if FTime = 0 then
     ResultStr := ResultStr + '00'
   else
   begin
     if FTime < 10 then
       ResultStr := ResultStr + '0' + IntToStr(FTime)
     else
     ResultStr := ResultStr + IntToStr(FTime);
   end;
   MainForm.ProgressLabel.Caption := FormatFloat('# ###', Max(1, MainForm.Gauge.Progress div 1024)) + ' from ' +
     FormatFloat('# ###', MainForm.Gauge.MaxValue div 1024) + 'Kb (' + FormatFloat('#.##', FSpeed) + 'Kb/s)' +
     ' - ' + ResultStr + ' remaining';
 end;
 MainForm.Gauge.Progress := FProgress;
 MainForm.Update;
end;

procedure TDownloadThread.StopDownload;
begin
 try
   FDownloadHTTP.Disconnect;
 except
 end;  
end;


но прога выдает для любого файла шаг и размер 1754...

В чем бок??? 

Спасибо

Это сообщение отредактировал(а) Girder - 29.8.2006, 13:16


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

Лотереи мира
PM MAIL WWW Skype GTalk YIM MSN   Вверх
_hunter
Дата 29.8.2006, 12:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 5
Всего: 98
во-первых: есть такая полезная кнопка "код"
во-вторых: выноси весь код из потока, бери отладчик и тестируй. когда найдеш косяк -- спрашивай.


--------------------
Tempora mutantur, et nos mutamur in illis...
PM ICQ   Вверх
Rodman
Дата 29.8.2006, 16:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


CIO
****


Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122
Вот эти две процедуры:
Код


procedure TDownloadThread.WorkBegin(Sender: TObject;
 AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
 FMaxProgress := AWorkCountMax;
 Synchronize(FSetMaxProgress);
end;

procedure TDownloadThread.Work(Sender: TObject; AWorkMode: TWorkMode;
 const AWorkCount: Integer);
begin
 FProgress := AWorkCount;
 Synchronize(FSetProgress);
end;



переменные  AWorkCountMax и AWorkCount возвращают обе значение 1754...

из главной формы я вызываю загрузку так
Код


function TFormDownload.GetInetFile(fileURL,FileName: String): boolean;
var co:TThread;
    s:String;
begin
  FormDownload.StatusBar1.Panels.Items[0].Text:='Status: Downloading';
  GetDir(0, s);
  FormDownload.Label3.Caption:='To: '+s+'\Client.exe';
  co:=TDownloadThread.Create(fileURL,FileName);
  co.Priority:=tplowest;
end;

procedure TFormDownload.FormShow(Sender: TObject);
begin
  if(GetInetFile('http://localhost/','index.php')=True)then
    ShowMessage('OK!!!');
end;


Подскажите где проблема плиз...


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

Лотереи мира
PM MAIL WWW Skype GTalk YIM MSN   Вверх
dumb
Дата 29.8.2006, 16:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


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

Репутация: 5
Всего: 158
http://forum.vingrad.ru/index.php?showtopic=82753
PM MAIL   Вверх
Rodman
Дата 29.8.2006, 17:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


CIO
****


Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122
Вот у меня  таже проблема, что в "WorkBegin" FMaxProgress:=1514 (эта процедура вызывается один раз), а в "Work" сначала FProgress:=226, а второй раз уже FProgress:=1514.

И проверки я добавил
Код


...
if AWorkMode = wmRead then ProgressBar1.Max := AWorkCountMax;
..

...
 if AWorkMode = wmRead then ProgressBar1.Position := AWorkCount;
...


файл скачивается в текущую папку, но размером 1514, хотя он более двух метров...

Что в этом случае не так???? smile 


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

Лотереи мира
PM MAIL WWW Skype GTalk YIM MSN   Вверх
Teran
Дата 29.8.2006, 17:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: нет
Всего: 3
Цитата(Snowy @  7.2.2006,  21:00 Найти цитируемый пост)
На форме IdHTTP1 и IdAntiFreeze1.
У IdHTTP RecvBuferSize = 1
У антифриза OnlyWenIdle = false, IdleTimeOut = 64

Код

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  if AWorkMode = wmRead then ProgressBar1.Position := AWorkCount;
end;

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  if AWorkMode = wmRead then ProgressBar1.Max := AWorkCountMax;
end;

procedure TForm1.Button1Click(Sender: TObject);
var s: string;
begin
   s := IdHttp1.Get('http://www.vingrad.ru/');
   ShowMessage(s);
end;


и будет вам щастье


--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Rodman
Дата 29.8.2006, 18:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


CIO
****


Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122
Так эти процедуры у тя описаны в обычном юните с формой???

Просто я их описывал классом TThread, или у тебя также???




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

Лотереи мира
PM MAIL WWW Skype GTalk YIM MSN   Вверх
Teran
Дата 29.8.2006, 18:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: нет
Всего: 3
я делал без потоков и описывал их просто в классе с формой


--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Rodman
Дата 30.8.2006, 17:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


CIO
****


Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122
Скажи а вот та строка несет в себе какую нить функциональную особенность???
Код

FDownloadHTTP.Request.Referer := 'AdsCleaner Bundle';



Teran   Спасибо за пример...


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

Лотереи мира
PM MAIL WWW Skype GTalk YIM MSN   Вверх
Rodman
Дата 30.8.2006, 17:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


CIO
****


Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122
Исходник Teran'a

Вот этот вот исходник показывает на ProgressBar'e уровень закачки, а есть ли какая нить возможность еще выводить количество закаченных байт / всего байт (размер файла) и также количество времени до окончания...


Такая процедура есть (см. выше)
Код

procedure TDownloadThread.FSetProgress;


но если я добавляю в код исходника 
Код

procedure TFormDownloader.httpWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  if AWorkMode = wmRead then
    progress.Progress := AWorkCount;
  [B]Synchronize(FSetProgress);[/B]
end;


то выдается ошибка 
Missing operator or semicolon

Это можно как нить обойти??? Просто если я напишу
Код

procedure TFormDownloader.httpWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  if AWorkMode = wmRead then
    progress.Progress := AWorkCount;
  [B]FSetProgress;[/B]
end;


выдастся значение только после окончания закачки...

Посдкажите...


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

Лотереи мира
PM MAIL WWW Skype GTalk YIM MSN   Вверх
Teran
Дата 30.8.2006, 18:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: нет
Всего: 3
Цитата(Rodman @  30.8.2006,  17:59 Найти цитируемый пост)
а есть ли какая нить возможность еще выводить количество закаченных байт / всего байт (размер файла) и также количество времени до окончания...

1 в процедуре
procedure TFormDownloader.httpWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
ты присваиваеш progress.max=AWorkCountMax - это и есть "всего байт"
2 в процедуре
procedure TFormDownloader.httpWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
progress.Progress := AWorkCount; - это есть "количество закаченных байт "
3 время необходимо расчитывать самому

Цитата(Rodman @  30.8.2006,  17:59 Найти цитируемый пост)
выдастся значение только после окончания закачки...

пропробуй так:
Код

procedure TFormDownloader.httpWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  if AWorkMode = wmRead then  progress.Progress := AWorkCount;
  Application.ProcessMessages;
  FSetProgress;
  Application.ProcessMessages;
end;



--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Rodman
Дата 30.8.2006, 18:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


CIO
****


Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122
то что значат progress.max=AWorkCountMax и progress.Progress := AWorkCount я понял... просто мне в цыфрах надо было... и чтобы обновлялось в процессе...

вот теперь обновляется...


Спасибо...

Добавлено @ 18:36 
А вот теперь такое... Я таким образом скачиваю более новую версию приложения...

Возможно ли такое???

Определил наличие новой версии->Скачал->закрыл старую версию (возможно даже удалить)->открыл новую

Все автоматически...

???


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

Лотереи мира
PM MAIL WWW Skype GTalk YIM MSN   Вверх
Teran
Дата 30.8.2006, 18:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: нет
Всего: 3
конечно возможно у меня это реализовано с помощью еще одного exe файла который обновляет главную программу


--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Rodman
Дата 30.8.2006, 18:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


CIO
****


Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122
т.е. я понимаю так...


Старое приложение запускает вспомогательный *.ехе файл и он в свою очередь занимается заменой...

Ну а возможно это совершить имея только старую и новую версию... без третье проги????


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

Лотереи мира
PM MAIL WWW Skype GTalk YIM MSN   Вверх
Teran
Дата 30.8.2006, 19:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: нет
Всего: 3
Цитата(Rodman @  30.8.2006,  18:53 Найти цитируемый пост)
Ну а возможно это совершить имея только старую и новую версию... без третье проги???? 

без третьей стороны - никак


--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

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

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

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

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

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


 




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


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

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