root/trunk/Wizards/NewCollection/frame_NCWDownload.pas

Show revision log
 
393438
1
{******************************************************************************}



2
{                                                                              }



3
{ MyHomeLib                                                                    }



4
{                                                                              }



5
{ Version 0.9                                                                  }



6
{ 20.08.2008                                                                   }



7
{ Copyright (c) Aleksey Penkov  alex.penkov@gmail.com                          }



8
{                                                                              }



9
{ @author Nick Rymanov nrymanov@gmail.com                                      }



10
{                                                                              }



11
{******************************************************************************}



12



13
{ TODO -oNickR -cBug : использовать настройки прокси при закачке файла. Сейчас они устанавливаются в коде самого визарда. }



14



1
unit frame_NCWDownload;
15
unit frame_NCWDownload;



2
16



3
interface
17
interface


...
...
5
uses
19
uses



6
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
20
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,



7
  Dialogs, frame_InteriorPageBase, StdCtrls, ExtCtrls, ComCtrls,
21
  Dialogs, frame_InteriorPageBase, StdCtrls, ExtCtrls, ComCtrls,



8
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, RzPrgres;
22
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;



9
23



10
type
24
type



11
  TframeNCWDownload = class(TInteriorPageBase)
25
  TframeNCWDownload = class(TInteriorPageBase)



12
    HTTP: TIdHTTP;
26
    HTTP: TIdHTTP;



13
    lblS1: TLabel;
27
    lblStatus: TLabel;



14
    Bar: TRzProgressBar;
28
    Bar: TProgressBar;



15
29



30
    procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);



31
    procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);



32
    procedure HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);



16
33



17



18
    procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;



19
      AWorkCountMax: Int64);



20
    procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode;



21
      AWorkCount: Int64);



22
    procedure HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);



23
  private
34
  private



24
    { Private declarations }
35
    FDownloadSize : Int64;



25
    FDownloadSize : Extended;



26
    FStartDate : TDateTime;
36
    FStartDate : TDateTime;



27
    FTerminated: Boolean;
37
    FTerminated: Boolean;



38



28
  public
39
  public



29
    function Activate(LoadData: Boolean): Boolean; override;
40
    function Activate(LoadData: Boolean): Boolean; override;



30
    function Deactivate(CheckData: Boolean): Boolean; override;
41
    function Deactivate(CheckData: Boolean): Boolean; override;


...
...
43
  unit_Settings,
54
  unit_Settings,



44
  unit_NCWParams,
55
  unit_NCWParams,



45
  frm_NCWizard;
56
  frm_NCWizard;



57



46
{$R *.dfm}
58
{$R *.dfm}



47
59



48
{ TframeNCWDownload }
60
{ TframeNCWDownload }



49
61



50
function TframeNCWDownload.Activate(LoadData: Boolean): Boolean;
62
function TframeNCWDownload.Activate(LoadData: Boolean): Boolean;



51
begin
63
begin



52
  lblS1.Caption := 'Подключение ...';
64
  lblStatus.Caption := 'Подключение ...';



53
  Bar.Percent := 0;
65
  Bar.Position := 0;



66



67
  Result := True;



54
end;
68
end;



55
69



56
function TframeNCWDownload.Deactivate(CheckData: Boolean): Boolean;
70
function TframeNCWDownload.Deactivate(CheckData: Boolean): Boolean;



57
begin
71
begin



58
  //--------------------------------
72
  Result := True;



59
end;
73
end;



60
74



61
procedure TframeNCWDownload.Download;
75
procedure TframeNCWDownload.Download;



62
var
76
var



63
  Responce: TMemoryStream;
77
  Responce: TMemoryStream;



64
begin
78
begin



79
  FTerminated := False;



80
  Responce := TMemoryStream.Create;



65
  try
81
  try



66
    FTerminated := False;



67
    Responce := TMemoryStream.Create;



68
    HTTP.Get(FPParams^.INPXUrl, Responce);
82
    HTTP.Get(FPParams^.INPXUrl, Responce);



69
    if not FTerminated then
83
    if not FTerminated then



70
    begin
84
    begin


...
...
76
  end;
90
  end;



77
end;
91
end;



78
92



79
procedure TframeNCWDownload.HTTPWork(ASender: TObject; AWorkMode: TWorkMode;
93
procedure TframeNCWDownload.HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);



80
  AWorkCount: Int64);
94
begin



95
  Bar.Position := 0;



96
  FDownloadSize := AWorkCountMax;



97
  FStartDate := Now;



98
end;



99



100
procedure TframeNCWDownload.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);



81
var
101
var



82
  ElapsedTime: Cardinal;
102
  ElapsedTime: Cardinal;



83
  KB : extended;
103
  KB : Int64;



84
begin
104
begin



85
  KB := AWorkCount / 1024;
105
  KB := AWorkCount div 1024;



86
106



87
  if FDownloadSize <> 0 then
107
  if FDownloadSize <> 0 then



88
    Bar.Percent:= round(KB / FDownloadSize * 100);
108
    Bar.Position := AWorkCount * 100 div FDownloadSize;



89
109



90
  ElapsedTime := SecondsBetween(Now, FStartDate);
110
  ElapsedTime := SecondsBetween(Now, FStartDate);



91
  if ElapsedTime > 0 then
111
  if ElapsedTime > 0 then



92
  begin
112
  begin



93
    lblS1.Caption := Format('Загружено  %d  из  %d кб (%n кб/с)', [round(KB), round(FDownloadSize), KB / ElapsedTime]);
113
    { TODO -oNickR -cRefactoring : создать и использовать во всех подобных местах FormatSize функцию }



114
    lblStatus.Caption := Format(



115
      'Загружено %d из %d кб (%n кб/с)',



116
      [KB, FDownloadSize div 1024, KB / ElapsedTime]



117
    );



94
  end;
118
  end;



95
  Application.ProcessMessages;
119
  Application.ProcessMessages;



96
end;
120
end;



97
121



98
procedure TframeNCWDownload.HTTPWorkBegin(ASender: TObject;



99
  AWorkMode: TWorkMode; AWorkCountMax: Int64);



100
begin



101
  Bar.Percent := 0;



102
  FDownloadSize := AWorkCountMax / 1024;



103
  FStartDate := Now;



104
end;



105



106
procedure TframeNCWDownload.HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
122
procedure TframeNCWDownload.HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);



107
begin
123
begin



108
  lblS1.Caption := 'Загрузка завершена';
124
  lblStatus.Caption := 'Загрузка завершена';



109
  Application.ProcessMessages;
125
  Application.ProcessMessages;



110
end;
126
end;



111
127