1  {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21  Author: Balázs Székely
22  Abstract:
23    Implementation of the package downloader class.
24 }
25 unit opkman_downloader;
26 
27 {$mode objfpc}{$H+}
28 
29 interface
30 
31 uses
32   Classes, SysUtils, fpjson, LazIDEIntf, md5,
33   // OpkMan
34   opkman_common, opkman_serializablepackages, opkman_const, opkman_options,
35   {$IF FPC_FULLVERSION>=30200}fphttpclient, opensslsockets{$ELSE}opkman_httpclient{$ENDIF};
36 
37 type
38   TDownloadType = (dtJSON, dtPackage, dtUpdate);
39   TErrorType = (etNone, etConfig, etTimeOut, etHTTPClient);
40   TOnTimer = TNotifyEvent;
41   TOnJSONProgress = TNotifyEvent;
42   TOnJSONDownloadCompleted = procedure(Sender: TObject; AJSON: TJSONStringType; AErrTyp: TErrorType; const AErrMsg: String = '') of object;
43   TOnWriteStream = procedure(Sender: TObject; APos: Int64) of object;
44   TOnPackageDownloadProgress = procedure(Sender: TObject; AFrom, ATo: String; ACnt, ATotCnt: Integer; ACurPos, ACurSize, ATotPos, ATotSize: Int64;
45     AElapsed, ARemaining, ASpeed: LongInt) of object;
46   TOnPackageDownloadError = procedure(Sender: TObject; APackageName: String; const AErrMsg: String = '') of object;
47   TOnPackageDownloadCompleted = TNotifyEvent;
48   TOnPackageUpdateProgress = procedure(Sender: TObject; AUPackageName, AUPackageURL: String; ACnt, ATotCnt: Integer; AUTyp: Integer; AUErrMsg: String) of object;
49   TOnPackageUpdateCompleted = procedure(Sender: TObject; AUSuccess: Boolean) of object;
50 
51   { TDownloadStream }
52 
53   TDownloadStream = class(TStream)
54   private
55     FOnWriteStream: TOnWriteStream;
56     FStream: TStream;
57   public
58     constructor Create(AStream: TStream);
59     destructor Destroy; override;
Readnull60     function Read(var Buffer; Count: LongInt): LongInt; override;
Writenull61     function Write(const Buffer; Count: LongInt): LongInt; override;
Seeknull62     function Seek(Offset: LongInt; Origin: Word): LongInt; override;
63     procedure DoProgress;
64   published
65     property OnWriteStream: TOnWriteStream read FOnWriteStream write FOnWriteStream;
66   end;
67 
68   { TThreadDownload }
69 
70   TThreadDownload = class(TThread)
71   private
72     FHTTPClient: TFPHTTPClient;
73     FOnJSONComplete: TOnJSONDownloadCompleted;
74     FOnJSONProgress: TNotifyEvent;
75     FRemoteJSONFile: String;
76     FErrMsg: String;
77     FDownloadType: TDownloadType;
78     FErrTyp: TErrorType;
79     FMS: TMemoryStream;
80     FFrom: String;
81     FTo: String;
82     FCnt: Integer;
83     FTotCnt: Integer;
84     FCurPos: Int64;
85     FCurSize: Int64;
86     FTotPos: Int64;
87     FTotPosTmp: Int64;
88     FTotSize: Int64;
89     FRemaining: Integer;
90     FSpeed: Integer;
91     FStartTime: QWord;
92     FElapsed: QWord;
93     FTick: Qword;
94     FNeedToBreak: Boolean;
95     FDownloadTo: String;
96     FUPackageName: String;
97     FUPackageURL: String;
98     FUTyp: Integer;
99     FUErrMsg: String;
100     FUSuccess: Boolean;
101     FSilent: Boolean;
102     FOnPackageDownloadProgress: TOnPackageDownloadProgress;
103     FOnPackageDownloadError: TOnPackageDownloadError;
104     FOnPackageDownloadCompleted: TOnPackageDownloadCompleted;
105     FOnPackageUpdateProgress: TOnPackageUpdateProgress;
106     FOnPackageUpdateCompleted: TOnPackageUpdateCompleted;
GetUpdateSizenull107     function GetUpdateSize(const AURL: String; var AErrMsg: String): Int64;
108     procedure DoReceivedUpdateSize(Sender: TObject; const ContentLength, {%H-}CurrentPos: int64);
109     procedure DoOnJSONProgress;
110     procedure DoOnJSONDownloadCompleted;
111     procedure DoOnWriteStream(Sender: TObject; APos: Int64);
112     procedure DoOnPackageDownloadProgress;
113     procedure DoOnPackageDownloadError;
114     procedure DoOnPackageDownloadCompleted;
115     procedure DoOnPackageUpdateProgress;
116     procedure DoOnPackageUpdateCompleted;
117   protected
118     procedure Execute; override;
119   public
120     constructor Create;
121     destructor Destroy; override;
122     procedure DownloadJSON(const ATimeOut: Integer = -1; const ASilent: Boolean = False);
123     procedure DownloadPackages(const ADownloadTo: String);
124     procedure UpdatePackages(const ADownloadTo: String);
125   published
126     property OnJSONProgress: TNotifyEvent read FOnJSONProgress write FOnJSONProgress;
127     property OnJSONDownloadCompleted: TOnJSONDownloadCompleted read FOnJSONComplete write FOnJSONComplete;
128     property OnPackageDownloadCompleted: TOnPackageDownloadCompleted read FOnPackageDownloadCompleted write FOnPackageDownloadCompleted;
129     property OnPackageDownloadError: TOnPackageDownloadError read FOnPackageDownloadError write FOnPackageDownloadError;
130     property OnPackageDownloadProgress: TOnPackageDownloadProgress read FOnPackageDownloadProgress write FOnPackageDownloadProgress;
131     property OnPackageUpdateProgress: TOnPackageUpdateProgress read FOnPackageUpdateProgress write FOnPackageUpdateProgress;
132     property OnPackageUpdateCompleted: TOnPackageUpdateCompleted read FOnPackageUpdateCompleted write FOnPackageUpdateCompleted;
133     property NeedToBreak: Boolean read FNeedToBreak write FNeedToBreak;
134   end;
135 
136   { TPackageDownloader }
137 
138   TPackageDownloader = class
139   private
140     FJSON: TJSONStringType;
141     FDownload: TThreadDownload;
142     FRemoteRepository: String;
143     FLastError: String;
144     FDownloadingJSON: Boolean;
145     FSilent: Boolean;
146     FOnJSONProgress: TNotifyEvent;
147     FOnJSONDownloadCompleted: TOnJSONDownloadCompleted;
148     FOnPackageDownloadProgress: TOnPackageDownloadProgress;
149     FOnPackageDownloadError: TOnPackageDownloadError;
150     FOnPackageDownloadCompleted: TOnPackageDownloadCompleted;
151     FOnPackageUpdateProgress: TOnPackageUpdateProgress;
152     FOnPackageUpdateCompleted: TOnPackageUpdateCompleted;
153     procedure DoOnJSONProgress(Sender: TObject);
154     procedure DoOnJSONDownloadCompleted(Sender: TObject; AJSON: TJSONStringType; AErrTyp: TErrorType; const AErrMsg: String = '');
155     procedure DoOnPackageDownloadProgress(Sender: TObject; AFrom, ATo: String; ACnt, ATotCnt: Integer;
156       ACurPos, ACurSize, ATotPos, ATotSize: Int64; AElapsed, ARemaining, ASpeed: LongInt);
157     procedure DoOnPackageDownloadError(Sender: TObject; APackageName: String; const AErrMsg: String = '');
158     procedure DoOnPackageDownloadCompleted(Sender: TObject);
159     procedure DoOnPackageUpdateProgress(Sender: TObject; AUPackageName, AUPackageURL: String; ACnt, ATotCnt: Integer; AUTyp: Integer; AUErrMsg: String);
160     procedure DoOnPackageUpdateCompleted(Sender: TObject; AUSuccess: Boolean);
161     procedure DoOnTerminate(Sender: TObject);
162   public
163     constructor Create(const ARemoteRepository: String);
164     destructor Destroy; override;
165     procedure DownloadJSON(const ATimeOut: Integer = -1; const ASilent: Boolean = False);
166     procedure DownloadPackages(const ADownloadTo: String);
167     procedure UpdatePackages(const ADownloadTo: String);
168     procedure Cancel;
169   published
170     property RemoteRepository: String read FRemoteRepository write FRemoteRepository;
171     property LastError: String read FLastError write FLastError;
172     property DownloadingJSON: Boolean read FDownloadingJSON;
173     property JSON: TJSONStringType read FJSON;
174     property OnJSONProgress: TNotifyEvent read FOnJSONProgress write FOnJSONProgress;
175     property OnJSONDownloadCompleted: TOnJSONDownloadCompleted read FOnJSONDownloadCompleted write FOnJSONDownloadCompleted;
176     property OnPackageDownloadProgress: TOnPackageDownloadProgress read FOnPackageDownloadProgress write FOnPackageDownloadProgress;
177     property OnPackageDownloadError: TOnPackageDownloadError read FOnPackageDownloadError write FOnPackageDownloadError;
178     property OnPackageDownloadCompleted: TOnPackageDownloadCompleted read FOnPackageDownloadCompleted write FOnPackageDownloadCompleted;
179     property OnPackageUpdateProgress: TOnPackageUpdateProgress read FOnPackageUpdateProgress write FOnPackageUpdateProgress;
180     property OnPackageUpdateCompleted: TOnPackageUpdateCompleted read FOnPackageUpdateCompleted write FOnPackageUpdateCompleted;
181   end;
182 
183 var
184   PackageDownloader: TPackageDownloader = nil;
185 
186 implementation
187 
188 { TDownloadStream }
189 constructor TDownloadStream.Create(AStream: TStream);
190 begin
191   inherited Create;
192   FStream := AStream;
193   FStream.Position := 0;
194 end;
195 
196 destructor TDownloadStream.Destroy;
197 begin
198   FStream.Free;
199   inherited Destroy;
200 end;
201 
Readnull202 function TDownloadStream.Read(var Buffer; Count: LongInt): LongInt;
203 begin
204   Result := FStream.Read(Buffer, Count);
205 end;
206 
Writenull207 function TDownloadStream.Write(const Buffer; Count: LongInt): LongInt;
208 begin
209   Result := FStream.Write(Buffer, Count);
210   DoProgress;
211 end;
212 
TDownloadStream.Seeknull213 function TDownloadStream.Seek(Offset: LongInt; Origin: Word): LongInt;
214 begin
215   Result := FStream.Seek(Offset, Origin);
216 end;
217 
218 procedure TDownloadStream.DoProgress;
219 begin
220   if Assigned(FOnWriteStream) then
221     FOnWriteStream(Self, Self.Position);
222 end;
223 
224 { TThreadDownload }
225 
226 procedure TThreadDownload.DoOnPackageDownloadProgress;
227 begin
228   if Assigned(FOnPackageDownloadProgress) then
229     FOnPackageDownloadProgress(Self, FFrom, FTo, FCnt, FTotCnt, FCurPos, FCurSize, FTotPosTmp, FTotSize, FElapsed, FRemaining, FSpeed);
230 end;
231 
232 procedure TThreadDownload.DoOnPackageDownloadError;
233 begin
234   if Assigned(FOnPackageDownloadError) then
235     FOnPackageDownloadError(Self, ExtractFileName(FTo), FErrMsg);
236 end;
237 
238 procedure TThreadDownload.DoOnPackageDownloadCompleted;
239 begin
240   if Assigned(FOnPackageDownloadCompleted) then
241     FOnPackageDownloadCompleted(Self);
242 end;
243 
244 procedure TThreadDownload.DoOnPackageUpdateProgress;
245 begin
246   if Assigned(FOnPackageUpdateProgress) then
247     FOnPackageUpdateProgress(Self, FUPackageName, FUPackageURL, FCnt, FTotcnt, FUTyp, FUErrMsg);
248 end;
249 
250 procedure TThreadDownload.DoOnPackageUpdateCompleted;
251 begin
252   if Assigned(FOnPackageUpdateCompleted) then
253     FOnPackageUpdateCompleted(Self, FUSuccess);
254 end;
255 
256 procedure TThreadDownload.DoOnJSONDownloadCompleted;
257 var
258   JSON: TJSONStringType = '';
259   JSONFile: String;
260 begin
261   if Assigned(FOnJSONComplete) then
262   begin
263     if (FErrTyp = etNone) or (FMS.Size > 0) then
264     begin
265       SetLength(JSON, FMS.Size);
266       FMS.Read(Pointer(JSON)^, Length(JSON));
267       JSONFile := ExtractFilePath(LocalRepositoryConfigFile) + 'packagelist' + '_' + MD5Print(MD5String(Options.RemoteRepository[Options.ActiveRepositoryIndex])) + '.json';
268       FMS.Position := 0;
269       FMS.SaveToFile(JSONFile);
270       SerializablePackages.JSONToPackages(JSON);
271       FOnJSONComplete(Self, JSON, FErrTyp, '');
272     end
273     else
274       FOnJSONComplete(Self, '', FErrTyp, FErrMsg);
275   end;
276 end;
277 
278 
279 procedure TThreadDownload.DoOnJSONProgress;
280 begin
281   if FSilent then
282     Exit;
283   if Assigned(FOnJSONProgress) then
284     FOnJSONProgress(Self);
285 end;
286 
287 procedure TThreadDownload.DoOnWriteStream(Sender: TObject; APos: Int64);
288 begin
289   FElapsed := GetTickCount64 - FStartTime;
290   if FElapsed < 1000 then
291     Exit;
292   FElapsed := FElapsed div 1000;
293   FCurPos := APos;
294   FTotPosTmp := FTotPos + APos;
295   FSpeed := Round(FTotPosTmp/FElapsed);
296   if FSpeed > 0 then
297     FRemaining := Round((FTotSize - FTotPosTmp)/FSpeed);
298   if FElapsed >= FTick + 1 then
299   begin
300     FTick := FElapsed;
301     Synchronize(@DoOnPackageDownloadProgress);
302   end;
303   Sleep(5);
304 end;
305 
306 procedure TThreadDownload.Execute;
307 var
308   I: Integer;
309   DS: TDownloadStream;
310   UpdateSize: Int64;
311   UpdCnt: Integer;
312 begin
313   Sleep(50);
314   FErrMsg := '';
315   FErrTyp := etNone;
316   if FDownloadType = dtJSON then
317   begin
318     if not FNeedToBreak then
319       Synchronize(@DoOnJSONProgress);
320     if FRemoteJSONFile <> cRemoteJSONFile then
321     begin
322       try
323         FHTTPClient.Get(FRemoteJSONFile, FMS);
324         if FMS.Size > 0 then
325           FMS.Position := 0;
326       except
327         on E: Exception do
328         begin
329           FErrMsg := E.Message;
330           FErrTyp := etHTTPClient;
331         end;
332       end;
333     end
334     else
335     begin
336       FErrTyp := etConfig;
337       FErrMsg := rsMainFrm_rsMessageNoRepository0;
338     end;
339     if not FNeedToBreak then
340       Synchronize(@DoOnJSONDownloadCompleted)
341   end
342   else if FDownloadType = dtPackage then //download from repository
343   begin
344     FCnt := 0;
345     FStartTime := GetTickCount64;
346     for I := 0 to SerializablePackages.Count - 1 do
347     begin
348       if NeedToBreak then
349         Break;
350       if SerializablePackages.Items[I].IsDownloadable then
351       begin
352         Inc(FCnt);
353         FFrom := Options.RemoteRepository[Options.ActiveRepositoryIndex] + SerializablePackages.Items[I].RepositoryFileName;
354         FTo := FDownloadTo + SerializablePackages.Items[I].RepositoryFileName;
355         FCurSize := SerializablePackages.Items[I].RepositoryFileSize;
356         DS := TDownloadStream.Create(TFileStream.Create(FTo, fmCreate));
357         try
358           DS.FOnWriteStream := @DoOnWriteStream;
359           try
360             FHTTPClient.HTTPMethod('GET', FFrom, DS, [200]);
361             SerializablePackages.Items[I].ChangePackageStates(ctAdd, psDownloaded);
362           except
363             on E: Exception do
364             begin
365               FErrMsg := E.Message;
366               FErrTyp := etHTTPClient;
367               SerializablePackages.Items[I].ChangePackageStates(ctRemove, psDownloaded);
368               SerializablePackages.Items[I].ChangePackageStates(ctAdd, psError);
369               Synchronize(@DoOnPackageDownloadError);
370             end;
371           end;
372         finally
373           DS.Free
374         end;
375         if psError in  SerializablePackages.Items[I].PackageStates then
376           DeleteFile(FTo);
377         FTotPos := FTotPos + FCurSize;
378       end;
379     end;
380     if (FNeedToBreak) then
381       DeleteFile(FTo)
382     else
383       Synchronize(@DoOnPackageDownloadCompleted);
384   end
385   else if FDownloadType = dtUpdate then //download from external link
386   begin
387     FCnt := 0;
388     UpdCnt := 0;
389     FStartTime := GetTickCount64;
390     for I := 0 to SerializablePackages.Count - 1 do
391     begin
392       if FNeedToBreak then
393         Break;
394       if (SerializablePackages.Items[I].Checked) then
395       begin
396         Inc(FCnt);
397         FUpackageName := SerializablePackages.Items[I].Name;
398         if SerializablePackages.Items[I].IsDependencyPackage then
399           FUPackageURL := Options.RemoteRepository[Options.ActiveRepositoryIndex] + SerializablePackages.Items[I].RepositoryFileName
400         else
401           FUPackageURL := SerializablePackages.Items[I].DownloadZipURL;
402         FUTyp := 0;
403         Synchronize(@DoOnPackageUpdateProgress);
404         UpdateSize := GetUpdateSize(FUPackageURL, FUErrMsg);
405         if UpdateSize > -1 then
406         begin
407           if UpdateSize = 0 then
408             UpdateSize := SerializablePackages.Items[I].RepositoryFileSize;
409           FUTyp := 1;
410           Synchronize(@DoOnPackageUpdateProgress);
411           Inc(UpdCnt);
412           SerializablePackages.Items[I].UpdateSize := UpdateSize;
413           FTotSize := FTotSize + UpdateSize;
414         end
415         else
416         begin
417           FUTyp := 2;
418           Synchronize(@DoOnPackageUpdateProgress);
419           SerializablePackages.Items[I].UpdateSize := -1;
420           SerializablePackages.Items[I].ChangePackageStates(ctAdd, psError);
421         end;
422       end;
423     end;
424     if FNeedToBreak then
425       Exit;
426     if (UpdCnt = 0) then
427     begin
428       FUSuccess := False;
429       Synchronize(@DoOnPackageUpdateCompleted);
430     end
431     else
432     begin
433       FUSuccess := True;
434       Synchronize(@DoOnPackageUpdateCompleted);
435       FCnt := 0;
436       FTotCnt := UpdCnt;
437       for I := 0 to SerializablePackages.Count - 1 do
438       begin
439         if NeedToBreak then
440           Break;
441         if (SerializablePackages.Items[I].Checked) and (SerializablePackages.Items[I].UpdateSize > -1) and (not (psError in  SerializablePackages.Items[I].PackageStates)) then
442         begin
443           Inc(FCnt);
444           if SerializablePackages.Items[I].IsDependencyPackage then
445             FFrom := Options.RemoteRepository[Options.ActiveRepositoryIndex] + SerializablePackages.Items[I].RepositoryFileName
446           else
447             FFrom := FixProtocol(SerializablePackages.Items[I].DownloadZipURL);
448           FTo := FDownloadTo + SerializablePackages.Items[I].RepositoryFileName;
449           FCurSize := SerializablePackages.Items[I].UpdateSize;
450           DS := TDownloadStream.Create(TFileStream.Create(FTo, fmCreate));
451           try
452             DS.FOnWriteStream := @DoOnWriteStream;
453             try
454               FHTTPClient.AllowRedirect := True;
455               FHTTPClient.HTTPMethod('GET', FFrom, DS, []);
456             except
457             end;
458             if FHTTPClient.ResponseStatusCode <> 200 then
459             begin
460               FErrMsg := IntToStr(FHTTPClient.ResponseStatusCode);
461               FErrTyp := etHTTPClient;
462               SerializablePackages.Items[I].ChangePackageStates(ctRemove, psDownloaded);
463               SerializablePackages.Items[I].ChangePackageStates(ctAdd, psError);
464               Synchronize(@DoOnPackageDownloadError);
465             end
466             else
467               SerializablePackages.Items[I].ChangePackageStates(ctAdd, psDownloaded);
468           finally
469             DS.Free
470           end;
471           if psError in  SerializablePackages.Items[I].PackageStates then
472             DeleteFile(FTo);
473           FTotPos := FTotPos + FCurSize;
474         end;
475       end;
476       if (FNeedToBreak) then
477         DeleteFile(FTo)
478       else
479         Synchronize(@DoOnPackageDownloadCompleted);
480     end;
481   end;
482 end;
483 
484 constructor TThreadDownload.Create;
485 begin
486   inherited Create(True);
487   FreeOnTerminate := True;
488   FMS := TMemoryStream.Create;
489   FHTTPClient := TFPHTTPClient.Create(nil);
490   if Options.ProxyEnabled then
491   begin
492     FHTTPClient.Proxy.Host:= Options.ProxyServer;
493     FHTTPClient.Proxy.Port:= Options.ProxyPort;
494     FHTTPClient.Proxy.UserName:= Options.ProxyUser;
495     FHTTPClient.Proxy.Password:= Options.ProxyPassword;
496   end;
497 end;
498 
499 destructor TThreadDownload.Destroy;
500 begin
501   FHTTPClient.Free;
502   FMS.Free;
503   inherited Destroy;
504 end;
505 
506 procedure TThreadDownload.DownloadJSON(const ATimeOut: Integer = -1;
507   const ASilent: Boolean = False);
508 begin
509   FRemoteJSONFile := Options.RemoteRepository[Options.ActiveRepositoryIndex] + cRemoteJSONFile;
510   FDownloadType := dtJSON;
511   FSilent := ASilent;
512   if Assigned(LazarusIDE) and LazarusIDE.IDEStarted and not LazarusIDE.IDEIsClosing then
513     Start;
514 end;
515 
516 procedure TThreadDownload.DownloadPackages(const ADownloadTo: String);
517 var
518   I: Integer;
519 begin
520   FDownloadType := dtPackage;
521   FDownloadTo := ADownloadTo;
522   FTotCnt := 0;
523   FTotSize := 0;
524   for I := 0 to SerializablePackages.Count - 1 do
525   begin
526     if SerializablePackages.Items[I].IsDownloadable then
527     begin
528       Inc(FTotCnt);
529       FTotSize := FTotSize + SerializablePackages.Items[I].RepositoryFileSize;
530     end;
531   end;
532   if Assigned(LazarusIDE) and LazarusIDE.IDEStarted and not LazarusIDE.IDEIsClosing then
533     Start;
534 end;
535 
536 procedure TThreadDownload.DoReceivedUpdateSize(Sender: TObject;
537   const ContentLength, CurrentPos: int64);
538 begin
539   if ContentLength > 0 then
540     Abort;
541 end;
542 
GetUpdateSizenull543 function TThreadDownload.GetUpdateSize(const AURL: String; var AErrMsg: String): Int64;
544 var
545   SS: TStringStream;
546   HttpClient: TFPHTTPClient;
547   URL: String;
548 begin
549   Result := -1;
550   AErrMsg := '';
551   SS := TStringStream.Create('');
552   try
553     URL := FixProtocol(AURL);
554     HttpClient := TFPHTTPClient.Create(nil);
555     if Options.ProxyEnabled then
556       begin
557         HTTPClient.Proxy.Host:= Options.ProxyServer;
558         HTTPClient.Proxy.Port:= Options.ProxyPort;
559         HTTPClient.Proxy.UserName:= Options.ProxyUser;
560         HTTPClient.Proxy.Password:= Options.ProxyPassword;
561       end;
562 
563     try
564       HttpClient.OnDataReceived := @DoReceivedUpdateSize;
565       HttpClient.AllowRedirect := True;
566       HttpClient.ResponseHeaders.NameValueSeparator := ':';
567       try
568         HttpClient.HTTPMethod('GET', URL, SS, []);
569       except
570       end;
571       if HttpClient.ResponseStatusCode = 200 then
572         Result := StrToIntDef(HttpClient.ResponseHeaders.Values['CONTENT-LENGTH'], 0)
573       else
574         AErrMsg := 'Error code: ' + IntToStr(HttpClient.ResponseStatusCode);
575     finally
576       HttpClient.Free;
577     end;
578   finally
579     SS.Free
580   end;
581 end;
582 
583 procedure TThreadDownload.UpdatePackages(const ADownloadTo: String);
584 var
585   I: Integer;
586 begin
587   FDownloadTo := ADownloadTo;
588   FDownloadType := dtUpdate;
589   FTotCnt := 0;
590   FTotSize := 0;
591   for I := 0 to SerializablePackages.Count - 1 do
592     if (SerializablePackages.Items[I].Checked) then
593       Inc(FTotCnt);
594   if (Assigned(LazarusIDE) and LazarusIDE.IDEStarted and (not LazarusIDE.IDEIsClosing)) then
595     Start;
596 end;
597 
598 { TPackageDownloader}
599 
600 procedure TPackageDownloader.DoOnPackageDownloadProgress(Sender: TObject; AFrom, ATo: String;
601   ACnt, ATotCnt: Integer; ACurPos, ACurSize, ATotPos, ATotSize: Int64;
602   AElapsed, ARemaining, ASpeed: LongInt);
603 begin
604   if Assigned(FOnPackageDownloadProgress) then
605     FOnPackageDownloadProgress(Self, AFrom, ATo, ACnt, ATotCnt, ACurPos, ACurSize, ATotPos, ATotSize, AElapsed, ARemaining, ASpeed);
606 end;
607 
608 procedure TPackageDownloader.DoOnPackageDownloadError(Sender: TObject;
609   APackageName: String; const AErrMsg: String);
610 begin
611   if Assigned(FOnPackageDownloadError) then
612     FOnPackageDownloadError(Self, APackageName, AErrMsg);
613 end;
614 
615 procedure TPackageDownloader.DoOnPackageDownloadCompleted(Sender: TObject);
616 begin
617   if Assigned(FOnPackageDownloadCompleted) then
618     FOnPackageDownloadCompleted(Sender);
619 end;
620 
621 procedure TPackageDownloader.DoOnPackageUpdateProgress(Sender: TObject; AUPackageName,
622   AUPackageURL: String; ACnt, ATotCnt: Integer; AUTyp: Integer; AUErrMsg: String);
623 begin
624   if Assigned(FOnPackageUpdateProgress) then
625     FOnPackageUpdateProgress(Self, AUPackageName, AUPackageURL, ACnt, ATotCnt, AUTyp, AUErrMsg);
626 end;
627 
628 procedure TPackageDownloader.DoOnPackageUpdateCompleted(Sender: TObject;
629   AUSuccess: Boolean);
630 begin
631   if Assigned(FOnPackageUpdateCompleted) then
632     FOnPackageUpdateCompleted(Self, AUSuccess);
633 end;
634 
635 procedure TPackageDownloader.DoOnJSONProgress(Sender: TObject);
636 begin
637   if Assigned(FOnJSONProgress) then
638     FOnJSONProgress(Self);
639 end;
640 
641 procedure TPackageDownloader.DoOnJSONDownloadCompleted(Sender: TObject;
642   AJSON: TJSONStringType; AErrTyp: TErrorType; const AErrMsg: String);
643 begin
644   if not FSilent then
645   begin
646     FJSON := AJSON;
647     if Assigned(FOnJSONDownloadCompleted) then
648       FOnJSONDownloadCompleted(Self, AJSON, AErrTyp, AErrMsg);
649   end;
650   FDownloadingJSON := False;
651 end;
652 
653 constructor TPackageDownloader.Create(const ARemoteRepository: String);
654 begin
655   FRemoteRepository := ARemoteRepository;
656   if (Length(FRemoteRepository) > 0) and (not IsPathDelimiter(FRemoteRepository, Length(FRemoteRepository))) then
657     FRemoteRepository := FRemoteRepository + '/';
658 end;
659 
660 destructor TPackageDownloader.Destroy;
661 begin
662 {  if Assigned(FDownload) then
663     FDownload.Terminate;}
664   inherited Destroy;
665 end;
666 
667 procedure TPackageDownloader.DownloadJSON(const ATimeOut: Integer = -1;
668   const ASilent: Boolean = False);
669 begin
670   FDownloadingJSON := True;
671   FSilent := ASilent;
672   FDownload := TThreadDownload.Create;
673   FDownload.OnJSONProgress := @DoOnJSONProgress;
674   FDownload.OnJSONDownloadCompleted := @DoOnJSONDownloadCompleted;
675   FDownload.OnTerminate := @DoOnTerminate;
676   FDownload.DownloadJSON(ATimeOut, ASilent);
677 end;
678 
679 procedure TPackageDownloader.DownloadPackages(const ADownloadTo: String);
680 begin
681   FDownload := TThreadDownload.Create;
682   FDownload.OnPackageDownloadProgress := @DoOnPackageDownloadProgress;
683   FDownload.OnPackageDownloadError := @DoOnPackageDownloadError;
684   FDownload.OnPackageDownloadCompleted := @DoOnPackageDownloadCompleted;
685   FDownload.OnTerminate := @DoOnTerminate;
686   FDownload.DownloadPackages(ADownloadTo);
687 end;
688 
689 procedure TPackageDownloader.UpdatePackages(const ADownloadTo: String);
690 begin
691   FDownload := TThreadDownload.Create;
692   FDownload.OnPackageDownloadProgress := @DoOnPackageDownloadProgress;
693   FDownload.OnPackageDownloadError := @DoOnPackageDownloadError;
694   FDownload.OnPackageDownloadCompleted := @DoOnPackageDownloadCompleted;
695   FDownload.OnPackageUpdateProgress := @DoOnPackageUpdateProgress;
696   FDownload.OnPackageUpdateCompleted := @DoOnPackageUpdateCompleted;
697   FDownload.OnTerminate := @DoOnTerminate;
698   FDownload.UpdatePackages(ADownloadTo);
699 end;
700 
701 procedure TPackageDownloader.Cancel;
702 begin
703   if Assigned(FDownload) then
704   begin
705     FDownload.FHTTPClient.Terminate;
706     FDownload.NeedToBreak := True;
707   end;
708 end;
709 
710 procedure TPackageDownloader.DoOnTerminate(Sender: TObject);
711 begin
712   FDownload := nil;
713 end;
714 
715 
716 end.
717 
718