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