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

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

Delphi.int.ru Expert

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

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

#   

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


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

Подробнее »

Вопрос # 3 332

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

Здравствуйте, эксперты!
Взял кусок готового фтп клиента! все работает-отображает файлы,размер. как отобразить процесс скачивания в Gauge1.Progress.

Приложение:
  1.  
  2. var
  3.  
  4. Spisok:TStringList;
  5. i:integer;
  6.  
  7.  
  8. begin
  9. If IdFTP.Connected then
  10.  
  11. IdFTP.ChangeDir('/pochta');
  12.  
  13. Spisok:=TStringList.Create();
  14. IdFTP.List(Spisok,'*.*',False);
  15.  
  16.  
  17. If Spisok.Count>0 Then
  18. Begin
  19. For i:=0 To Spisok.Count-1 Do
  20. Begin
  21.  
  22.  
  23.  
  24. IF IdFTP.Size(Spisok.Strings[i])<>-1 THEN
  25. BEGIN
  26. //Application.ProcessMessages;
  27.  
  28.  
  29.  
  30.  
  31.  
  32. //Application.ProcessMessages;
  33.  
  34. //Gauge1.Progress:=0;
  35. //Gauge1.MinValue:=0;
  36. //Gauge1.Progress:=IdFTP.Size(Spisok.Strings[i]);
  37.  
  38.  
  39. IdFTP.Get(Spisok.Strings[i],'D:netfilein' + Spisok.Strings[i],True, False );


djemov Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: djemov (статус: Посетитель)
Вопрос отправлен: 27 октября 2009, 18:37
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: DNK

Здравствуйте, djemov!
Когда-то писал программу с FTP-клиентом. В приложении кусок кода для загрузки списка файлов. А также .pas и .dfm-файлы формы отображающую процесс. Кроме того на форме отображается скорость, прошедшее время и оставшееся до конца загрузки списка файлов.

Приложение:
  1. function TMainForm.Get(const Operation: string; SourceFiles, ReceiverFiles,
  2. Information: TStrings): Integer;
  3. var
  4. I: Integer;
  5. t: Integer;
  6. fs: array of integer;
  7. begin
  8. if (SourceFiles.Count <> ReceiverFiles.Count) or
  9. (SourceFiles.Count <> Information.Count) then begin
  10. Result := -5;
  11. exit;
  12. end;
  13. if not Connected then begin
  14. Result := -1;
  15. exit;
  16. end;
  17. with PrForm do begin
  18. ResetDataForm;
  19. Caption := S_FormCaption + FTPClient.Host;
  20. Show;
  21. OperationLabel.Caption := S_CheckGet;
  22. AllSize := 0;
  23. Aborted := false;
  24. setLength(fs, SourceFiles.Count);
  25. for i := 0 to SourceFiles.Count - 1 do begin
  26. t := SizeFile(SourceFiles.Strings[i]);
  27. if t >= 0 then begin
  28. fs[i] := t;
  29. AllSize := AllSize + t;
  30. end else begin
  31. if Connected then
  32. Result := -4
  33. else
  34. Result := -1;
  35. Close;
  36. exit;
  37. end;
  38. end;
  39. OperationLabel.Caption := Operation;
  40. OperationGauge.MaxValue := AllSize;
  41. AllSizeSText.Caption := IntToStr(AllSize);
  42. StartTime := Now;
  43. for i := 0 to SourceFiles.Count - 1 do begin
  44. FileInfoLabel.Caption := Information.Strings[i];
  45. if not DirectoryExists(ExtractFileDir(ReceiverFiles.Strings[i])) then
  46. CreateLocalDir(ExtractFileDir(ReceiverFiles.Strings[i]));
  47. FileGauge.MaxValue := fs[i];
  48. try
  49. FTPClient.TransferType := ftBinary;
  50. FTPClient.Get(SourceFiles.Strings[i], ReceiverFiles.Strings[i], true);
  51. SaveLog(S_SaveFile + SourceFiles.Strings[i] + S_w + ReceiverFiles.Strings[i] + '"');
  52. except
  53. Close;
  54. if Aborted then
  55. Result := -3
  56. else
  57. if Connected then
  58. Result := -2
  59. else
  60. Result := -1;
  61. exit;
  62. end;
  63. Application.ProcessMessages;
  64. if Aborted then Break;
  65. end;
  66. Close;
  67. if Aborted then
  68. Result := -3
  69. else
  70. Result := 0
  71. end;
  72. end;
  73.  
  74.  
  75.  
  76. unit ProgressFormUnit;
  77.  
  78. interface
  79.  
  80. uses
  81. Windows, Messages, SysUtils, {Variants, }Classes, Graphics, Controls, Forms,
  82. Dialogs, StdCtrls, Buttons, ExtCtrls, Gauges, IdBaseComponent,
  83. IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IdAntiFreezeBase,
  84. IdAntiFreeze;
  85.  
  86. type
  87. TProgressForm = class (TForm)
  88. AbortBtn: TBitBtn;
  89. AllSizeSText: TStaticText;
  90. AntiFreeze: TIdAntiFreeze;
  91. FileGauge: TGauge;
  92. FileInfoLabel: TLabel;
  93. FTPClient: TIdFTP;
  94. GuardTimer: TTimer;
  95. OperationGauge: TGauge;
  96. OperationLabel: TLabel;
  97. ProgerssTimeSText: TStaticText;
  98. RestOfTimeSText: TStaticText;
  99. SizeTransferSText: TStaticText;
  100. SpeedSText: TStaticText;
  101. StaticText1: TStaticText;
  102. StaticText2: TStaticText;
  103. StaticText3: TStaticText;
  104. StaticText5: TStaticText;
  105. StaticText6: TStaticText;
  106. StaticText7: TStaticText;
  107. StatusSText: TStaticText;
  108. procedure AbortBtnClick(Sender: TObject);
  109. procedure FTPClientStatus(ASender: TObject; const AStatus: TIdStatus; const
  110. AStatusText: String);
  111. procedure FTPClientWork(Sender: TObject; AWorkMode: TWorkMode; const
  112. AWorkCount: Integer);
  113. procedure FTPClientWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const
  114. AWorkCountMax: Integer);
  115. procedure FTPClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
  116. procedure GuardTimerTimer(Sender: TObject);
  117. private
  118. AverageSpeed: Double;
  119. GuardCount: Integer;
  120. public
  121. Aborted: Boolean;
  122. AllSize: LongInt;
  123. StartTime: TDateTime;
  124. procedure ResetDataForm;
  125. end;
  126.  
  127. var
  128. ProgressForm: TProgressForm;
  129.  
  130. implementation
  131. // START resource string wizard section
  132. resourcestring
  133. SProgressFormUnit_Time = '%2d:%2d:%2d';
  134. SProgressFormUnit_Speed = '0.00 KB/s';
  135.  
  136. // END resource string wizard section
  137.  
  138.  
  139. {$R *.dfm}
  140.  
  141. {
  142. ******************************** TProgressForm *********************************
  143. }
  144. procedure TProgressForm.AbortBtnClick(Sender: TObject);
  145. begin
  146. Aborted := true;
  147. end;
  148.  
  149. procedure TProgressForm.FTPClientStatus(ASender: TObject; const AStatus:
  150. TIdStatus; const AStatusText: String);
  151. begin
  152. //
  153. StatusSText.Caption := AStatusText;
  154. end;
  155.  
  156. procedure TProgressForm.FTPClientWork(Sender: TObject; AWorkMode: TWorkMode;
  157. const AWorkCount: Integer);
  158. var
  159. TotalTime: TDateTime;
  160. H, M, Sec, MS: Word;
  161. s: string;
  162. DLTime: Double;
  163. begin
  164. //
  165. OperationGauge.Progress := OperationGauge.Progress + AWorkCount - FileGauge.Progress;
  166. FileGauge.Progress := AWorkCount;
  167. SizeTransferSText.Caption := IntToStr(OperationGauge.Progress);
  168. TotalTime := Now - StartTime;
  169. DecodeTime(TotalTime, H, M, Sec, MS);
  170. s := Format(SProgressFormUnit_Time, [H, M, Sec]);
  171. ProgerssTimeSText.Caption := s;
  172. Sec := Sec + M * 60 + H * 3600;
  173. DLTime := Sec + MS / 1000;
  174. if DLTime > 0 then
  175. AverageSpeed := (OperationGauge.Progress / 1024) / DLTime;
  176. SpeedSText.Caption := FormatFloat(SProgressFormUnit_Speed, AverageSpeed);
  177. if AverageSpeed > 0 then begin
  178. Sec := Trunc(((OperationGauge.MaxValue - OperationGauge.Progress) / 1024) / AverageSpeed);
  179. S := Format(SProgressFormUnit_Time, [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);
  180. end
  181. else S := '';
  182. RestOfTimeSText.Caption := s;
  183. inc(GuardCount);
  184. Application.ProcessMessages;
  185. if Aborted then FTPClient.Abort;
  186. end;
  187.  
  188. procedure TProgressForm.FTPClientWorkBegin(Sender: TObject; AWorkMode:
  189. TWorkMode; const AWorkCountMax: Integer);
  190. begin
  191. //
  192. if AWorkMode = wmWrite then FileGauge.MaxValue := AWorkCountMax;
  193. FileGauge.Progress := 0;
  194. GuardCount := 0;
  195. GuardTimer.Enabled := true;
  196. end;
  197.  
  198. procedure TProgressForm.FTPClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
  199. begin
  200. //
  201. FileGauge.Progress := FileGauge.MaxValue;
  202. GuardTimer.Enabled := false;
  203. end;
  204.  
  205. procedure TProgressForm.GuardTimerTimer(Sender: TObject);
  206. begin
  207. if GuardCount > 0 then
  208. GuardCount := 0
  209. else begin
  210. GuardTimer.Enabled := false;
  211. FTPClient.Abort;
  212. end;
  213. end;
  214.  
  215. procedure TProgressForm.ResetDataForm;
  216. begin
  217. FileGauge.Progress := 0;
  218. OperationGauge.Progress := 0;
  219. AllSizeSText.Caption := '';
  220. FileInfoLabel.Caption := '';
  221. OperationLabel.Caption := '';
  222. ProgerssTimeSText.Caption := '';
  223. RestOfTimeSText.Caption := '';
  224. SizeTransferSText.Caption := '';
  225. SpeedSText.Caption := '';
  226. StatusSText.Caption := '';
  227. end;
  228.  
  229. end.
  230.  
  231.  
  232.  
  233. object ProgressForm: TProgressForm
  234. Left = 321
  235. Top = 214
  236. BorderIcons = [biSystemMenu]
  237. BorderStyle = bsDialog
  238. Caption = 'FTP - &#234;&#235;&#232;&#229;&#237;&#242;'
  239. ClientHeight = 178
  240. ClientWidth = 371
  241. Color = clBtnFace
  242. Font.Charset = DEFAULT_CHARSET
  243. Font.Color = clWindowText
  244. Font.Height = -11
  245. Font.Name = 'MS Sans Serif'
  246. Font.Style = []
  247. OldCreateOrder = False
  248. Position = poScreenCenter
  249. PixelsPerInch = 96
  250. TextHeight = 13
  251. object OperationLabel: TLabel
  252. Left = 8
  253. Top = 8
  254. Width = 72
  255. Height = 13
  256. Caption = 'OperationLabel'
  257. end
  258. object OperationGauge: TGauge
  259. Left = 9
  260. Top = 24
  261. Width = 353
  262. Height = 17
  263. BackColor = clYellow
  264. Color = clBtnFace
  265. ForeColor = clNavy
  266. ParentColor = False
  267. Progress = 0
  268. end
  269. object FileInfoLabel: TLabel
  270. Left = 8
  271. Top = 48
  272. Width = 60
  273. Height = 13
  274. Caption = 'FileInfoLabel'
  275. end
  276. object FileGauge: TGauge
  277. Left = 9
  278. Top = 64
  279. Width = 353
  280. Height = 17
  281. BackColor = clYellow
  282. ForeColor = clNavy
  283. Progress = 0
  284. end
  285. object AbortBtn: TBitBtn
  286. Left = 137
  287. Top = 149
  288. Width = 97
  289. Height = 25
  290. Caption = '&#206;&#242;&#236;&#229;&#237;&#224;'
  291. TabOrder = 0
  292. OnClick = AbortBtnClick
  293. Kind = bkAbort
  294. end
  295. object StaticText1: TStaticText
  296. Left = 8
  297. Top = 111
  298. Width = 105
  299. Height = 17
  300. AutoSize = False
  301. BorderStyle = sbsSingle
  302. Caption = '&#207;&#240;&#238;&#248;&#235;&#238; &#226;&#240;&#229;&#236;&#229;&#237;&#232;:'
  303. TabOrder = 1
  304. end
  305. object ProgerssTimeSText: TStaticText
  306. Left = 111
  307. Top = 111
  308. Width = 74
  309. Height = 17
  310. AutoSize = False
  311. BorderStyle = sbsSingle
  312. TabOrder = 2
  313. end
  314. object StaticText2: TStaticText
  315. Left = 8
  316. Top = 126
  317. Width = 105
  318. Height = 17
  319. AutoSize = False
  320. BorderStyle = sbsSingle
  321. Caption = '&#209;&#234;&#238;&#240;&#238;&#241;&#242;&#252;:'
  322. TabOrder = 3
  323. end
  324. object SpeedSText: TStaticText
  325. Left = 111
  326. Top = 126
  327. Width = 74
  328. Height = 17
  329. AutoSize = False
  330. BorderStyle = sbsSingle
  331. TabOrder = 4
  332. end
  333. object StatusSText: TStaticText
  334. Left = 287
  335. Top = 126
  336. Width = 74
  337. Height = 17
  338. AutoSize = False
  339. BorderStyle = sbsSingle
  340. TabOrder = 6
  341. end
  342. object StaticText5: TStaticText
  343. Left = 8
  344. Top = 96
  345. Width = 105
  346. Height = 17
  347. AutoSize = False
  348. BorderStyle = sbsSingle
  349. Caption = '&#207;&#229;&#240;&#229;&#228;&#224;&#237;&#238;:'
  350. TabOrder = 7
  351. end
  352. object SizeTransferSText: TStaticText
  353. Left = 111
  354. Top = 96
  355. Width = 74
  356. Height = 17
  357. AutoSize = False
  358. BorderStyle = sbsSingle
  359. TabOrder = 8
  360. end
  361. object StaticText6: TStaticText
  362. Left = 184
  363. Top = 96
  364. Width = 105
  365. Height = 17
  366. AutoSize = False
  367. BorderStyle = sbsSingle
  368. Caption = '&#194;&#241;&#229;&#227;&#238; &#237;&#224; &#239;&#229;&#240;&#229;&#228;&#224;&#247;&#243;:'
  369. TabOrder = 9
  370. end
  371. object AllSizeSText: TStaticText
  372. Left = 287
  373. Top = 96
  374. Width = 74
  375. Height = 17
  376. AutoSize = False
  377. BorderStyle = sbsSingle
  378. TabOrder = 10
  379. end
  380. object StaticText7: TStaticText
  381. Left = 184
  382. Top = 112
  383. Width = 105
  384. Height = 17
  385. AutoSize = False
  386. BorderStyle = sbsSingle
  387. Caption = '&#206;&#241;&#242;&#224;&#235;&#238;&#241;&#252; &#226;&#240;&#229;&#236;&#229;&#237;&#232;:'
  388. TabOrder = 11
  389. end
  390. object RestOfTimeSText: TStaticText
  391. Left = 287
  392. Top = 112
  393. Width = 74
  394. Height = 15
  395. AutoSize = False
  396. BorderStyle = sbsSingle
  397. TabOrder = 12
  398. end
  399. object StaticText3: TStaticText
  400. Left = 184
  401. Top = 126
  402. Width = 104
  403. Height = 17
  404. AutoSize = False
  405. BorderStyle = sbsSingle
  406. Caption = '&#209;&#238;&#241;&#242;&#238;&#255;&#237;&#232;&#229;:'
  407. TabOrder = 5
  408. end
  409. object FTPClient: TIdFTP
  410. OnStatus = FTPClientStatus
  411. MaxLineAction = maException
  412. ReadTimeout = 0
  413. OnWork = FTPClientWork
  414. OnWorkBegin = FTPClientWorkBegin
  415. OnWorkEnd = FTPClientWorkEnd
  416. ProxySettings.ProxyType = fpcmNone
  417. ProxySettings.Port = 0
  418. Left = 8
  419. Top = 149
  420. end
  421. object AntiFreeze: TIdAntiFreeze
  422. Left = 40
  423. Top = 149
  424. end
  425. object GuardTimer: TTimer
  426. Enabled = False
  427. Interval = 30000
  428. OnTimer = GuardTimerTimer
  429. Left = 76
  430. Top = 149
  431. end
  432. end
  433.  
  434. *)
  435.  
  436.  
  437.  


Ответ отправил: DNK (статус: Студент)
Время отправки: 28 октября 2009, 08:24


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

Всего сообщений: 2; последнее сообщение — 4 марта 2010, 11:51; участников в обсуждении: 1.
DNK

DNK (статус: Студент), 28 октября 2009, 09:16 [#1]:

Примечание к ответу:
Форма, отображающая процесс загрузки, не модальная. Прежде чем вызывать процедуру для главной формы надо сделать Enabled := false, а после отработки Enabled := true. Я тогда только начинал работать с Delphi и выкручивался как мог, а потом переделывать что работает не стал.
"Digital Networked Knight"
DNK

DNK (статус: Студент), 4 марта 2010, 11:51 [#2]:

Поскольку появились люди, которым этот вопрос стал интересен, собираюсь сделать статью.

Пока скриншот окна:


Скриншот
"Digital Networked Knight"

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