Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 158

Раздел: Delphi » Работа с сетями и протоколами
/ вопрос решён /

Добрый вечер, уважаемые эксперты! Нужно реализовать обновление программы. Пользуюсь следующей функцией (см. вставку). Первая часть проходит нормально (получение инфы и т.д.), а вот при загрузке файла обновления (~1 MB) данная функция не справляется - скачивает только около 150 KB и говорит, что все скачала. Данный эффект наблюдается при маленькой скорости модема. А надо, чтобы скачивание происходило при любых условиях, пусть даже скорость будет совсем маленькая. И желательно, чтобы прогресс загрузки отображался на ProgressBar. Заранее спасибо...

Приложение:
  1. function DownloadFile(SourceFile, DestFile: string): Boolean;
  2. begin
  3. try
  4. Result:=UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
  5. except
  6. Result:=False;
  7. end;
  8. end;


feenords Вопрос решён, но можно продолжить его обсуждение в мини-форуме

Вопрос задал: feenords (статус: 1-ый класс)
Вопрос отправлен: 13 ноября 2006, 15:37
Состояние вопроса: решён, ответов: 4.

Ответ #1. Отвечает эксперт: Alex Van Glukhman

Здравствуйте, feenords!
Может есть смысл производить обновление - т.е. загрузку файла через TFileStream предварительно сосчитав размер файла и данное значение связав с TProgressBar. Тогда остаётся контролировать полученное количество скачанных байтов, что будет отражено в ProgressBar.

Ответ отправил: Alex Van Glukhman (статус: 7-ой класс)
Время отправки: 13 ноября 2006, 22:12
Оценка за ответ: 4

Ответ #2. Отвечает эксперт: Матвеев Игорь Владимирович

Здравствуйте, feenords!
По-поводу отображения прогресса, UrlDownloadToFile будет вызывать метод IBindStatusCallback.OnProgress интерфейса IBindStatusCallback, если указать его в последнем параметре (смотрите MSDN).
Есть и другой способ загрузки файлов из интернета. Смотрите в приложении пример, качает с докачкой, использует InternetOpen/InternetReadFile.
См. прикреплённый файл.
К ответу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки ответа)

Ответ отправил: Матвеев Игорь Владимирович (статус: Студент)
Время отправки: 14 ноября 2006, 03:41
Оценка за ответ: 5

Ответ #3. Отвечает эксперт: min@y™

Писал я когда-то прогу, так, ради развлекухи, для скачивания креативов с удафкома в виде файлов :)). В ней есть и прогрессбар и всё остальное. Могу прислать.

В приложении привожу модуль из этой моей проги, который отвечает за закачку файлов.

Приложение:
  1. unit uDownloader;
  2.  
  3. interface
  4.  
  5. uses
  6. General,
  7. //==============================================================================
  8. Classes, SysUtils, WinInet, Windows, ExtCtrls;
  9.  
  10. type
  11. TDownloaderStatusEvent = procedure (Sender: TObject; const ByTimer: Boolean) of object;
  12.  
  13. TCustomDownloader = class
  14. private
  15. FURL: string;
  16. FBufferSize: Word;
  17. FhInet,
  18. FhFile: HINTERNET;
  19. FStream: TMemoryStream;
  20. FStatus: string;
  21. FFileName: string;
  22. FErrorCode: TDownloaderError;
  23. FDeltaSize: Cardinal;
  24. FTimer: TTimer;
  25. FOnStatus: TDownloaderStatusEvent;
  26. procedure SetURL(const ANewURL: string);
  27. procedure OnTimer(Sender: TObject);
  28. function GetInterval: Cardinal;
  29. procedure SetInterval(const ANewInterval: Cardinal);
  30. protected
  31. procedure DoOnStatus(const ByTimer: Boolean);
  32. public
  33. constructor Create; virtual;
  34. destructor Destroy; override;
  35. procedure Execute; virtual; abstract;
  36.  
  37. property URL: string read FURL write SetURL;
  38. property BufferSize: Word read FBufferSize write FBufferSize;
  39. property hInet: HINTERNET read FhInet write FhInet;
  40. property Stream: TMemoryStream read FStream;
  41. property Status: string read FStatus;
  42. property FileName: string read FFileName;
  43. property ErrorCode: TDownloaderError read FErrorCode;
  44. property DeltaSize: Cardinal read FDeltaSize;
  45. property Interval:Cardinal read GetInterval write SetInterval;
  46.  
  47. property OnStatus: TDownloaderStatusEvent read FOnStatus write FOnStatus;
  48. end;
  49.  
  50. THtmlDownloader = class(TCustomDownloader)
  51. public
  52. procedure Execute; override;
  53. end;
  54.  
  55. TImageDownloader = class(TCustomDownloader)
  56. private
  57. FFileSize: Cardinal;
  58. FProgress: Integer;
  59. public
  60. constructor Create; override;
  61. procedure Execute; override;
  62. property FileSize: Cardinal read FFileSize;
  63. property Progress: Integer read FProgress;
  64. end;
  65.  
  66. implementation
  67.  
  68. uses Main;
  69.  
  70. { TCustomDownloader }
  71.  
  72. constructor TCustomDownloader.Create;
  73. begin
  74. inherited;
  75. FURL:= '';
  76. FBufferSize:= Settings.DownloadBufferSize;
  77. FhFile:= nil;
  78. FhInet:= nil;
  79. FStream:= TMemoryStream.Create;
  80. FStatus:= '';
  81. FErrorCode:= deSuccess;
  82. FDeltaSize:= 0;
  83. FTimer:= TTimer.Create(nil);
  84. FTimer.OnTimer:= OnTimer;
  85. FTimer.Enabled:= False;
  86. end;
  87.  
  88. destructor TCustomDownloader.Destroy;
  89. begin
  90. FStream.Free;
  91. Ftimer.Free;
  92. inherited;
  93. end;
  94.  
  95. procedure TCustomDownloader.DoOnStatus(const ByTimer: Boolean);
  96. begin
  97. if Assigned(FOnStatus)
  98. then FOnStatus(Self, ByTimer);
  99. end;
  100.  
  101. {function TCustomDownloader.GetFileName: string;
  102. var
  103. Index: Integer;
  104. begin
  105. Result:= '';
  106.  
  107. for Index:= Length(FURL) downto 1 do
  108. if FURL[Index] <> '/'
  109. then Result:= FURL[Index] + Result
  110. else Break;
  111. end; }
  112.  
  113. function TCustomDownloader.GetInterval: Cardinal;
  114. begin
  115. Result:= FTimer.Interval;
  116. end;
  117.  
  118. procedure TCustomDownloader.SetInterval(const ANewInterval: Cardinal);
  119. begin
  120. if ANewInterval <> FTimer.Interval
  121. then FTimer.Interval:= ANewInterval;
  122. end;
  123.  
  124. procedure TCustomDownloader.OnTimer(Sender: TObject);
  125. begin
  126. DoOnStatus(True);
  127. end;
  128.  
  129. procedure TCustomDownloader.SetURL(const ANewURL: string);
  130. begin
  131. if FURL <> ANewURL
  132. then begin
  133. FURL:= ANewURL;
  134. FFileName:= ExtractFileNameFromURL(FURL);
  135. end;
  136. end;
  137.  
  138. { THtmlDownloader }
  139.  
  140. procedure THtmlDownloader.Execute;
  141. var
  142. Buffer: array of Char;
  143. Success: Boolean;
  144. Readed, ReadedTotal: Cardinal;
  145. begin
  146.  
  147. DoOnStatus(False);
  148. FhFile:= InternetOpenUrl(FhInet,
  149. PChar(FURL),
  150. nil,
  151. 0,
  152. INTERNET_FLAG_NO_COOKIES or INTERNET_FLAG_NO_CACHE_WRITE,
  153. 0);
  154.  
  155. if FhFile = nil
  156. then begin
  157. FErrorCode:= deInternetProblem;
  158. Exit;
  159. end;
  160.  
  161. SetLength(Buffer, FBufferSize);
  162.  
  163.  
  164. DoOnStatus(False);
  165.  
  166. ReadedTotal:= 0;
  167. FTimer.Enabled:= True;
  168.  
  169. repeat
  170. Success:= InternetReadFile(FhFile, @Buffer[0], Length(Buffer), Readed);
  171. if Success
  172. then FStream.Write(Buffer[0], Readed);
  173.  
  174. Inc(ReadedTotal, Readed);
  175.  
  176. FDeltaSize:= Readed;
  177. DoOnStatus(False);
  178. until (Readed = 0) or not Success or MainForm.FCancelled;
  179.  
  180. FTimer.Enabled:= False;
  181.  
  182. if not Success
  183. then FErrorCode:= deInternetProblem;
  184. end;
  185.  
  186. { TImageDownloader }
  187.  
  188. constructor TImageDownloader.Create;
  189. begin
  190. inherited;
  191. FFileSize:= 0;
  192. FProgress:= 0;
  193. end;
  194.  
  195. procedure TImageDownloader.Execute;
  196. var
  197. Buffer: array of Char;
  198. Success: Boolean;
  199. Readed, ReadedTotal: Cardinal;
  200. begin
  201.  
  202. DoOnStatus(False);
  203. FhFile:= InternetOpenUrl(FhInet,
  204. PChar(FURL),
  205. nil,
  206. 0,
  207. INTERNET_FLAG_NO_COOKIES or INTERNET_FLAG_NO_CACHE_WRITE,
  208. 0);
  209.  
  210.  
  211.  
  212. if FhFile = nil
  213. then begin
  214. FErrorCode:= deInternetProblem;
  215. Exit;
  216. end;
  217.  
  218. if (not InternetQueryDataAvailable(FhFile, FFileSize, 0, 0)) or (FFileSize = 0)
  219. then begin
  220. FErrorCode:= deFileNotFound;
  221. Exit;
  222. end;
  223.  
  224. SetLength(Buffer, FBufferSize);
  225.  
  226.  
  227. DoOnStatus(False);
  228.  
  229. ReadedTotal:= 0;
  230. FTimer.Enabled:= True;
  231.  
  232. repeat
  233. Success:= InternetReadFile(FhFile, @Buffer[0], Length(Buffer), Readed);
  234. if Success
  235. then FStream.Write(Buffer[0], Readed);
  236.  
  237. Inc(ReadedTotal, Readed);
  238.  
  239. FDeltaSize:= Readed;
  240. FProgress:= Round(100 * ReadedTotal / FFileSize);
  241. if FProgress > 100
  242. then FProgress:= 100;
  243.  
  244. DoOnStatus(False);
  245. //Sleep(200);
  246. until (Readed = 0) or not Success or MainForm.FCancelled;
  247.  
  248. FTimer.Enabled:= False;
  249.  
  250. if not Success
  251. then FErrorCode:= deInternetProblem;
  252. end;
  253.  
  254.  
  255. end.


Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 14 ноября 2006, 08:40
Оценка за ответ: 5

Комментарий к оценке: Вышлите, если не сложно! (feenords@rambler.ru)

Ответ #4. Отвечает эксперт: Dron

Здравствуйте, feenords!
Я, например, использовал такой код - см. приложение. В нём в ProgressBar отображается процесс закачки, а в Label выводится объём уже закачанной части и общий объём файла. Вот эти самые строки (они есть в коде):
ProgressBar.Position:=FileSize(f_loc)*100 div StrToInt(chType);
Status.Caption:=Str2+' of '+Str1+' completed';
Код достаточно надёжный, ни разу меня не подводил.
Желаю удачи!

Приложение:
  1. function TfrmVoices.GetInetFile(const fileURL, FileName: String): Boolean;
  2. const BufferSize = 1024;
  3. var
  4. hSession, hURL: HInternet;
  5. Buffer: array[1..BufferSize] of Byte;
  6. BufferLen: DWORD;
  7. chType : array[1..20] of Char;
  8. cLength : cardinal;
  9. cIndex : cardinal;
  10. f_loc:file;
  11. sAppName: string;
  12. Str1,Str2: String;
  13. begin
  14. Result:=False;
  15. sAppName := ExtractFileName(Application.ExeName);
  16. hSession := InternetOpen(PChar(sAppName),INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
  17. try
  18. hURL := InternetOpenURL(hSession,PChar(fileURL),nil,0,0,0);
  19. try
  20. AssignFile(f_loc, FileName);
  21. Rewrite(f_loc,1);
  22. repeat
  23. InternetReadFile(hURL, @Buffer,SizeOf(Buffer), BufferLen);BlockWrite(f_loc, Buffer, BufferLen);
  24. cLength := 250;
  25. cIndex := 0;
  26. HTTPQueryInfo(hURL,HTTP_QUERY_CONTENT_LENGTH,@chType,cLength,cIndex);
  27. Str1:=FloatToStrF(StrToFloat(chType)/(1024*1024),ffNumber,2,2)+' MB';
  28. Str2:=FloatToStrF(FileSize(f_loc)/(1024*1024),ffNumber,2,2)+' MB';
  29. ProgressBar.Position:=FileSize(f_loc)*100 div StrToInt(chType) ;
  30. Status.Caption:=Str2+' of '+Str1+' completed';
  31. Application.ProcessMessages();
  32. until BufferLen = 0;
  33. CloseFile(f_loc);
  34. Result:=True;
  35. finally
  36. InternetCloseHandle(hURL);
  37. end
  38. finally
  39. InternetCloseHandle(hSession);
  40. end
  41. end;


Ответ отправил: Dron (статус: Студент)
Время отправки: 14 ноября 2006, 12:09
Оценка за ответ: 5

Комментарий к оценке: Спасибо за столь короткую функцию...

Мини-форум вопроса

Всего сообщений: 3; последнее сообщение — 15 ноября 2006, 08:53; участников в обсуждении: 2.
feenords

feenords (статус: 1-ый класс), 13 ноября 2006, 22:57 [#1]:

Связать закачку с ProgressBar, в принципе, легко... вот ещё бы скачать файл нормально... Подскажите, кто может, какой-нибудь проверенный примерчик.
min@y™

min@y™ (статус: Доктор наук), 15 ноября 2006, 08:40 [#2]:

Превед, feenords, кагдила?
//====================================

Закачал прогу на FTPшник.
Сливай:
Сорцы: http://sourceviewer.narod.ru/downloads/udaff32.7z
EXEшник: http://sourceviewer.narod.ru/downloads/udaff32_src.7z

//====================================
С уважением,
min@y™ mailto:minay.tm@gmail.com ICQ UIN: 5466111
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
feenords

feenords (статус: 1-ый класс), 15 ноября 2006, 08:53 [#3]:

Всем спасибо, помогли!..
2Матвеев Игорь Владимирович
Комментарий находится у min@y!
Но все равно спасибо...

31 января 2011, 19:56: Статус вопроса изменён на решённый (изменил модератор Ерёмин А.А.): Автоматическая обработка (2 и более ответов с оценкой 5)

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 18:56
Выполнено за 0.02 сек.