Opkman: Prevent memory leaks(step1) + other changes

- remove threaded timer to prevent memory leaks
- calculate download/extract speed with different method
- restructure the update thread
- prevent IDE freeze
- change repository names to "Official repository" and "Third party repository"
- make the unintuitive "Install" button intuitive again
- make install process faster

git-svn-id: trunk@59405 -

.gitattributes

@@ -3725,7 +3725,6 @@ components/onlinepackagemanager/opkman_showhint.lfm -text svneol=native#plain/te
 components/onlinepackagemanager/opkman_showhint.pas svneol=native#text/pascal
 components/onlinepackagemanager/opkman_showhintbase.lfm -text svneol=native#plain/text
 components/onlinepackagemanager/opkman_showhintbase.pas svneol=native#text/pascal
-components/onlinepackagemanager/opkman_timer.pas svneol=native#text/pascal
 components/onlinepackagemanager/opkman_updates.pas svneol=native#text/pascal
 components/onlinepackagemanager/opkman_uploader.pas svneol=native#text/pascal
 components/onlinepackagemanager/opkman_visualtree.pas svneol=native#text/pascal

components/onlinepackagemanager/onlinepackagemanager.lpk

@@ -25,7 +25,7 @@
 For more info please visit: http://wiki.freepascal.org/Online_Package_Manager"/>
     <License Value="GPL"/>
     <Version Major="1" Release="1" Build="2"/>
-    <Files Count="29">
+    <Files Count="28">
       <Item1>
         <Filename Value="onlinepackagemanagerintf.pas"/>
         <HasRegisterProc Value="True"/>
@@ -71,83 +71,79 @@ For more info please visit: http://wiki.freepascal.org/Online_Package_Manager"/>
         <UnitName Value="opkman_zipper"/>
       </Item10>
       <Item11>
-        <Filename Value="opkman_timer.pas"/>
-        <UnitName Value="opkman_timer"/>
-      </Item11>
-      <Item12>
         <Filename Value="opkman_installer.pas"/>
         <UnitName Value="opkman_installer"/>
-      </Item12>
+      </Item11>
-      <Item13>
+      <Item12>
         <Filename Value="opkman_packagelistfrm.pas"/>
         <UnitName Value="opkman_packagelistfrm"/>
         <ResourceBaseClass Value="Form"/>
-      </Item13>
+      </Item12>
-      <Item14>
+      <Item13>
         <Filename Value="opkman_options.pas"/>
         <UnitName Value="opkman_options"/>
-      </Item14>
+      </Item13>
-      <Item15>
+      <Item14>
         <Filename Value="opkman_createrepositorypackagefrm.pas"/>
         <UnitName Value="opkman_createrepositorypackagefrm"/>
         <ResourceBaseClass Value="Form"/>
-      </Item15>
+      </Item14>
-      <Item16>
+      <Item15>
         <Filename Value="opkman_categoriesfrm.pas"/>
         <UnitName Value="opkman_categoriesfrm"/>
-      </Item16>
+      </Item15>
-      <Item17>
+      <Item16>
         <Filename Value="opkman_packagedetailsfrm.pas"/>
         <UnitName Value="opkman_packagedetailsfrm"/>
-      </Item17>
+      </Item16>
-      <Item18>
+      <Item17>
         <Filename Value="opkman_updates.pas"/>
         <UnitName Value="opkman_updates"/>
-      </Item18>
+      </Item17>
-      <Item19>
+      <Item18>
         <Filename Value="opkman_createjsonforupdatesfrm.pas"/>
         <UnitName Value="opkman_createjsonforupdatesfrm"/>
-      </Item19>
+      </Item18>
-      <Item20>
+      <Item19>
         <Filename Value="opkman_uploader.pas"/>
         <UnitName Value="opkman_uploader"/>
-      </Item20>
+      </Item19>
-      <Item21>
+      <Item20>
         <Filename Value="opkman_repositories.pas"/>
         <UnitName Value="opkman_repositories"/>
-      </Item21>
+      </Item20>
-      <Item22>
+      <Item21>
         <Filename Value="opkman_createrepositoryfrm.pas"/>
         <UnitName Value="opkman_createrepositoryfrm"/>
-      </Item22>
+      </Item21>
-      <Item23>
+      <Item22>
         <Filename Value="opkman_repositorydetailsfrm.pas"/>
         <UnitName Value="opkman_repositorydetailsfrm"/>
-      </Item23>
+      </Item22>
-      <Item24>
+      <Item23>
         <Filename Value="opkman_addrepositorypackagefrm.pas"/>
         <UnitName Value="opkman_addrepositorypackagefrm"/>
-      </Item24>
+      </Item23>
-      <Item25>
+      <Item24>
         <Filename Value="opkman_intf.pas"/>
         <UnitName Value="opkman_intf"/>
-      </Item25>
+      </Item24>
-      <Item26>
+      <Item25>
         <Filename Value="opkman_intf_packagelistfrm.pas"/>
         <UnitName Value="opkman_intf_packagelistfrm"/>
-      </Item26>
+      </Item25>
-      <Item27>
+      <Item26>
         <Filename Value="opkman_showhint.pas"/>
         <UnitName Value="opkman_showhint"/>
-      </Item27>
+      </Item26>
-      <Item28>
+      <Item27>
         <Filename Value="opkman_showhintbase.pas"/>
         <UnitName Value="opkman_showhintbase"/>
-      </Item28>
+      </Item27>
-      <Item29>
+      <Item28>
         <Filename Value="opkman_colorsfrm.pas"/>
         <UnitName Value="opkman_colorsfrm"/>
-      </Item29>
+      </Item28>
     </Files>
     <i18n>
       <EnableI18N Value="True"/>

components/onlinepackagemanager/onlinepackagemanager.pas

@@ -10,14 +10,13 @@ interface
 uses
   onlinepackagemanagerintf, opkman_mainfrm, opkman_optionsfrm, opkman_const, 
   opkman_visualtree, opkman_serializablepackages, opkman_downloader, 
-  opkman_common, opkman_progressfrm, opkman_zipper, opkman_timer, 
+  opkman_common, opkman_progressfrm, opkman_zipper, opkman_installer, 
-  opkman_installer, opkman_packagelistfrm, opkman_options, 
+  opkman_packagelistfrm, opkman_options, opkman_createrepositorypackagefrm, 
-  opkman_createrepositorypackagefrm, opkman_categoriesfrm, 
+  opkman_categoriesfrm, opkman_packagedetailsfrm, opkman_updates, 
-  opkman_packagedetailsfrm, opkman_updates, opkman_createjsonforupdatesfrm, 
+  opkman_createjsonforupdatesfrm, opkman_uploader, opkman_repositories, 
-  opkman_uploader, opkman_repositories, opkman_createrepositoryfrm, 
+  opkman_createrepositoryfrm, opkman_repositorydetailsfrm, 
-  opkman_repositorydetailsfrm, opkman_addrepositorypackagefrm, opkman_intf, 
+  opkman_addrepositorypackagefrm, opkman_intf, opkman_intf_packagelistfrm, 
-  opkman_intf_packagelistfrm, opkman_showhint, opkman_showhintbase, 
+  opkman_showhint, opkman_showhintbase, opkman_colorsfrm, LazarusPackageIntf;
-  opkman_colorsfrm, LazarusPackageIntf;
 
 implementation
 

components/onlinepackagemanager/opkman_const.pas

@@ -166,8 +166,8 @@ resourcestring
   rsMainFrm_TBOptions_Hint = 'Show options dialog';
   rsMainFrm_TBHelp_Caption = 'Help';
   rsMainFrm_TBHelp_Hint = 'Help (' + cHelpPage + ')';
-  rsMainFrm_miFromRepository = 'From repository';
+  rsMainFrm_miFromRepository = 'From official repository';
-  rsMainFrm_miFromExternalSource = 'From external source';
+  rsMainFrm_miFromExternalSource = 'From third party repository';
   rsMainFrm_miCreateRepositoryPackage = 'Create repository package';
   rsMainFrm_miCreateJSONForUpdates = 'Create JSON for updates';
   rsMainFrm_miCreateRepository = 'Create private repository';

components/onlinepackagemanager/opkman_downloader.pas

@@ -33,7 +33,7 @@ interface
 uses
   Classes, SysUtils, fpjson, LazIDEIntf,
   // OpkMan
-  opkman_timer, opkman_common, opkman_serializablepackages, opkman_const, opkman_options,
+  opkman_common, opkman_serializablepackages, opkman_const, opkman_options,
   {$IFDEF FPC311}fphttpclient{$ELSE}opkman_httpclient{$ENDIF};
 
 type
@@ -88,10 +88,10 @@ type
     FTotPos: Int64;
     FTotPosTmp: Int64;
     FTotSize: Int64;
-    FElapsed: Integer;
     FRemaining: Integer;
     FSpeed: Integer;
-    FTimer: TThreadTimer;
+    FStartTime: QWord;
+    FElapsed: QWord;
     FNeedToBreak: Boolean;
     FDownloadTo: String;
     FUPackageName: String;
@@ -107,7 +107,6 @@ type
     FOnPackageUpdateCompleted: TOnPackageUpdateCompleted;
     function GetUpdateSize(const AURL: String; var AErrMsg: String): Int64;
     procedure DoReceivedUpdateSize(Sender: TObject; const ContentLength, {%H-}CurrentPos: int64);
-    procedure DoOnTimer(Sender: TObject);
     procedure DoOnJSONProgress;
     procedure DoOnJSONDownloadCompleted;
     procedure DoOnWriteStream(Sender: TObject; APos: Int64);
@@ -272,27 +271,6 @@ begin
   end;
 end;
 
-procedure TThreadDownload.DoOnTimer(Sender: TObject);
-begin
-  if FDownloadType = dtJSON then
-  begin
-    FHTTPClient.Terminate;
-    FErrMsg := rsMainFrm_rsMessageError2;
-    FErrTyp := etTimeOut;
-    if Assigned(FTimer) then
-      FTimer.StopTimer;
-    TThreadTimer(Sender).Synchronize(@DoOnJSONDownloadCompleted);
-    //Synchronize(@DoOnJSONDownloadCompleted);
-    FOnJSONComplete := nil;
-  end
-  else if (FDownloadType = dtPackage) or (FDownloadType = dtUpdate) then
-  begin
-    Inc(FElapsed);
-    FSpeed := Round(FTotPosTmp/FElapsed);
-    if FSpeed > 0 then
-      FRemaining := Round((FTotSize - FTotPosTmp)/FSpeed);
-  end;
-end;
 
 procedure TThreadDownload.DoOnJSONProgress;
 begin
@@ -304,8 +282,15 @@ end;
 
 procedure TThreadDownload.DoOnWriteStream(Sender: TObject; APos: Int64);
 begin
+  FElapsed := GetTickCount64 - FStartTime;
+  if FElapsed < 1000 then
+    Exit;
+  FElapsed := FElapsed div 1000;
   FCurPos := APos;
   FTotPosTmp := FTotPos + APos;
+  FSpeed := Round(FTotPosTmp/FElapsed);
+  if FSpeed > 0 then
+    FRemaining := Round((FTotSize - FTotPosTmp)/FSpeed);
   Synchronize(@DoOnPackageDownloadProgress);
   Sleep(5);
 end;
@@ -317,10 +302,12 @@ var
   UpdateSize: Int64;
   UpdCnt: Integer;
 begin
+  Sleep(50);
   FErrMsg := '';
   FErrTyp := etNone;
   if FDownloadType = dtJSON then //JSON
   begin
+    if not FNeedToBreak then
       Synchronize(@DoOnJSONProgress);
     if FRemoteJSONFile <> cRemoteJSONFile then
     begin
@@ -341,14 +328,13 @@ begin
       FErrTyp := etConfig;
       FErrMsg := rsMainFrm_rsMessageNoRepository0;
     end;
-    if Assigned(FTimer) and FTimer.Enabled then
-      FTimer.StopTimer;
     if not FNeedToBreak then
-      Synchronize(@DoOnJSONDownloadCompleted);
+      Synchronize(@DoOnJSONDownloadCompleted)
   end
   else if FDownloadType = dtPackage then //download from repository
   begin
     FCnt := 0;
+    FStartTime := GetTickCount64;
     for I := 0 to SerializablePackages.Count - 1 do
     begin
       if NeedToBreak then
@@ -392,6 +378,7 @@ begin
   begin
     FCnt := 0;
     UpdCnt := 0;
+    FStartTime := GetTickCount64;
     for I := 0 to SerializablePackages.Count - 1 do
     begin
       if FNeedToBreak then
@@ -434,8 +421,6 @@ begin
     begin
       FUSuccess := True;
       Synchronize(@DoOnPackageUpdateCompleted);
-      if Assigned(FTimer) then
-        FTimer.Enabled := True;
       FCnt := 0;
       FTotCnt := UpdCnt;
       for I := 0 to SerializablePackages.Count - 1 do
@@ -487,7 +472,6 @@ constructor TThreadDownload.Create;
 begin
   inherited Create(True);
   FreeOnTerminate := True;
-  FTimer := nil;
   FMS := TMemoryStream.Create;
   FHTTPClient := TFPHTTPClient.Create(nil);
   if Options.ProxyEnabled then
@@ -501,13 +485,6 @@ end;
 
 destructor TThreadDownload.Destroy;
 begin
-  if Assigned(FTimer) then
-  begin
-    if FTimer.Enabled then
-      FTimer.StopTimer;
-    FTimer.Terminate;
-    FTimer.WaitFor;
-  end;
   FHTTPClient.Free;
   FMS.Free;
   inherited Destroy;
@@ -520,14 +497,8 @@ begin
   FDownloadType := dtJSON;
   FSilent := ASilent;
   if Assigned(LazarusIDE) and LazarusIDE.IDEStarted and not LazarusIDE.IDEIsClosing then
-  begin
-    FTimer := TThreadTimer.Create;
-    FTimer.Interval := ATimeOut;
-    FTimer.OnTimer := @DoOnTimer;
-    FTimer.StartTimer;
     Start;
 end;
-end;
 
 procedure TThreadDownload.DownloadPackages(const ADownloadTo: String);
 var
@@ -546,13 +517,8 @@ begin
     end;
   end;
   if Assigned(LazarusIDE) and LazarusIDE.IDEStarted and not LazarusIDE.IDEIsClosing then
-  begin
-    FTimer := TThreadTimer.Create;
-    FTimer.OnTimer := @DoOnTimer;
-    FTimer.StartTimer;
     Start;
 end;
-end;
 
 procedure TThreadDownload.DoReceivedUpdateSize(Sender: TObject;
   const ContentLength, CurrentPos: int64);
@@ -613,14 +579,8 @@ begin
     if (SerializablePackages.Items[I].Checked) and (Trim(SerializablePackages.Items[I].DownloadZipURL) <> '') then
       Inc(FTotCnt);
   if (Assigned(LazarusIDE) and LazarusIDE.IDEStarted and (not LazarusIDE.IDEIsClosing)) then
-  begin
-    FTimer := TThreadTimer.Create;
-    FTimer.OnTimer := @DoOnTimer;
-    FTimer.StartTimer;
-    FTimer.Enabled := False;
     Start;
 end;
-end;
 
 { TPackageDownloader}
 
@@ -686,6 +646,8 @@ end;
 
 destructor TPackageDownloader.Destroy;
 begin
+{  if Assigned(FDownload) then
+    FDownload.Terminate;}
   inherited Destroy;
 end;
 
@@ -725,8 +687,6 @@ begin
   if Assigned(FDownload) then
   begin
     FDownload.FHTTPClient.Terminate;
-    if Assigned(FDownload.FTimer) then
-      FDownload.FTimer.StopTimer;
     FDownload.NeedToBreak := True;
   end;
 end;

components/onlinepackagemanager/opkman_installer.pas

@@ -200,7 +200,7 @@ begin
   if Assigned(FOnPackageInstallProgress) then
     FOnPackageInstallProgress(Self, FCnt, FTotCnt, FFileName, AInstallMessage);
   if AInstallMessage <> imPackageCompleted then
-    Sleep(1000);
+    Sleep(50);
 end;
 
 procedure TPackageInstaller.DoOnPackageInstallError(const AInstallMessage: TInstallMessage;
@@ -222,7 +222,7 @@ begin
   ALazarusPkg.PackageStates := ALazarusPkg.PackageStates + [psError];
   if Assigned(FOnPackageInstallError) then
     FOnPackageInstallError(Self, FFileName, ErrMsg);
-  Sleep(1000);
+  Sleep(50);
 end;
 
 procedure TPackageInstaller.Execute;

components/onlinepackagemanager/opkman_intf.pas

@@ -29,11 +29,12 @@ unit opkman_intf;
 interface
 
 uses
-  Classes, SysUtils, Forms, Dialogs, Controls, contnrs, fpjson,
+  Classes, SysUtils, Forms, Dialogs, Controls, contnrs, fpjson, ExtCtrls, md5,
+  dateutils,
   // IdeIntf
   LazIDEIntf, PackageIntf, PackageLinkIntf, PackageDependencyIntf, IDECommands,
   // OPM
-  opkman_timer, opkman_downloader, opkman_serializablepackages, opkman_installer;
+  opkman_downloader, opkman_serializablepackages, opkman_installer, opkman_updates;
 
 type
 
@@ -45,15 +46,16 @@ type
     FPackagesToInstall: TObjectList;
     FPackageDependecies: TObjectList;
     FPackageLinks: TObjectList;
-    FWaitForIDE: TThreadTimer;
+    FTimer: TTimer;
     FNeedToInit: Boolean;
-    FBusyUpdating: Boolean;
+    procedure DoOnTimer(Sender: TObject);
-    procedure DoWaitForIDE(Sender: TObject);
     procedure DoUpdatePackageLinks(Sender: TObject);
+    procedure DoOnIDEClose(Sender: TObject);
     procedure InitOPM;
     procedure SynchronizePackages;
     procedure AddToDownloadList(const AName: String);
     procedure AddToInstallList(const AName: String);
+    procedure DoHandleException(Sender: TObject; E: Exception);
     function Download(const ADstDir: String): TModalResult;
     function Extract(const ASrcDir, ADstDir: String; const AIsUpdate: Boolean = False): TModalResult;
     function Install(var AInstallStatus: TInstallStatus; var ANeedToRebuild: Boolean): TModalResult;
@@ -78,24 +80,21 @@ uses opkman_common, opkman_options, opkman_const, opkman_progressfrm, opkman_zip
 
 constructor TOPMInterfaceEx.Create;
 begin
+  Application.AddOnExceptionHandler(@DoHandleException);
   FPackageLinks := TObjectList.Create(False);
   FPackagesToDownload := TObjectList.Create(False);
   FPackagesToInstall := TObjectList.Create(False);
   FPackageDependecies := TObjectList.Create(False);
   FNeedToInit := True;
-  FWaitForIDE := TThreadTimer.Create;
+  FTimer := TTimer.Create(nil);
-  FWaitForIDE.Interval := 100;
+  FTimer.Interval := 50;
-  FWaitForIDE.OnTimer := @DoWaitForIDE;
+  FTimer.OnTimer := @DoOnTimer;
-  FWaitForIDE.StartTimer;
+  FTimer.Enabled := True;
 end;
 
 destructor TOPMInterfaceEx.Destroy;
 begin
-  if (PackageDownloader<>nil) and PackageDownloader.DownloadingJSON then
+  FTimer.Free;
-    PackageDownloader.Cancel;
-  FWaitForIDE.StopTimer;
-  FWaitForIDE.Terminate;
-  FWaitForIDE.WaitFor;
   FPackageLinks.Clear;
   FPackageLinks.Free;
   FPackagesToDownload.Clear;
@@ -111,30 +110,43 @@ begin
   inherited Destroy;
 end;
 
-procedure TOPMInterfaceEx.DoWaitForIDE(Sender: TObject);
+procedure TOPMInterfaceEx.DoOnIDEClose(Sender: TObject);
 begin
-  if Assigned(LazarusIDE) and Assigned(PackageEditingInterface) then
+  if Assigned(Updates) then
+  begin
+    Updates.StopUpdate;
+    Updates.Terminate;
+    Sleep(100);
+  end;
+end;
+
+
+procedure TOPMInterfaceEx.DoOnTimer(Sender: TObject);
+var
+  FileName: String;
+begin
+  if Assigned(LazarusIDE) and Assigned(PackageEditingInterface) and (not LazarusIDE.IDEIsClosing) then
   begin
     if FNeedToInit then
     begin
       InitOPM;
       FNeedToInit := False;
-      FWaitForIDE.StopTimer;
+      FTimer.Enabled := False;
-      FWaitForIDE.Interval := 5000;
+      FTimer.Interval := 5000;
-      FWaitForIDE.StartTimer;
+      FTimer.Enabled := True;
     end
     else
     begin
-      if (FPackageLinks.Count = 0) then
+      FTimer.Enabled := False;
+      if (not LazarusIDE.IDEIsClosing) then
       begin
-        if (not PackageDownloader.DownloadingJSON) and (not Application.Terminated) then
+        if Options.CheckForUpdates <> 5 then
           PackageDownloader.DownloadJSON(Options.ConTimeOut*1000, True);
-        Exit;
+        LazarusIDE.AddHandlerOnIDEClose(@DoOnIDEClose);
+        FileName := Format(LocalRepositoryUpdatesFile, [MD5Print(MD5String(Options.RemoteRepository[Options.ActiveRepositoryIndex]))]);
+        Updates := TUpdates.Create(FileName);
+        Updates.StartUpdate;
       end;
-      if (not Application.terminated) then
-        if (not FBusyUpdating) then
-          if (Assigned(OnPackageListAvailable)) then
-            OnPackageListAvailable(Self);
     end;
   end;
 end;
@@ -179,10 +191,6 @@ var
   PackageLink: TPackageLink;
   FileName, Name, URL: String;
 begin
-  if FBusyUpdating then
-    Exit;
-  FBusyUpdating := True;
-  try
   PkgLinks.ClearOnlineLinks;
   FPackageLinks.Clear;
   for I := 0 to SerializablePackages.Count - 1 do
@@ -211,9 +219,8 @@ begin
       end;
     end;
   end;
-  finally
+  if (Assigned(OnPackageListAvailable)) then
-    FBusyUpdating := False;
+     OnPackageListAvailable(Self);
-  end;
 end;
 
 procedure TOPMInterfaceEx.AddToDownloadList(const AName: String);
@@ -537,4 +544,10 @@ begin
   end;
 end;
 
+procedure TOPMInterfaceEx.DoHandleException(Sender: TObject; E: Exception);
+begin
+  //
+end;
+
+
 end.

components/onlinepackagemanager/opkman_mainfrm.lfm

@@ -15,6 +15,7 @@ object MainFrm: TMainFrm
   OnKeyPress = FormKeyPress
   OnShow = FormShow
   Position = poScreenCenter
+  LCLVersion = '2.1.0.0'
   object pnMain: TPanel
     Left = 0
     Height = 580
@@ -432,6 +433,7 @@ object MainFrm: TMainFrm
         Caption = 'Create'
         DropdownMenu = pmCreate
         ImageIndex = 7
+        OnClick = tbCreateClick
         ParentShowHint = False
         ShowHint = True
         Style = tbsDropDown

components/onlinepackagemanager/opkman_mainfrm.pas

@@ -29,19 +29,19 @@ unit opkman_mainfrm;
 interface
 
 uses
-  Classes, SysUtils, fpjson, md5, Graphics, VirtualTrees,
+  Classes, SysUtils, fpjson, Graphics, VirtualTrees,
   // LCL
   Forms, Controls, Dialogs, StdCtrls, ExtCtrls, Buttons, Menus, ComCtrls, Clipbrd,
   LCLIntf, LCLVersion, LCLProc,
   // LazUtils
-  LazFileUtils,
+  LazFileUtils, LazIDEIntf,
   // IdeIntf
   IDECommands, PackageIntf,
   // OpkMan
-  opkman_downloader, opkman_installer,
+  opkman_downloader, opkman_installer, opkman_updates,
   opkman_serializablepackages, opkman_visualtree, opkman_const, opkman_common,
   opkman_progressfrm, opkman_zipper, opkman_packagelistfrm, opkman_options,
-  opkman_optionsfrm, opkman_createrepositorypackagefrm, opkman_updates,
+  opkman_optionsfrm, opkman_createrepositorypackagefrm,
   opkman_createjsonforupdatesfrm, opkman_createrepositoryfrm;
 
 type
@@ -127,6 +127,7 @@ type
     procedure miSaveToFileClick(Sender: TObject);
     procedure pnToolBarResize(Sender: TObject);
     procedure tbCleanUpClick(Sender: TObject);
+    procedure tbCreateClick(Sender: TObject);
     procedure tbDownloadClick(Sender: TObject);
     procedure tbHelpClick(Sender: TObject);
     procedure tbInstallClick(Sender: TObject);
@@ -163,15 +164,12 @@ type
     procedure DoOnJSONProgress(Sender: TObject);
     procedure DoOnJSONDownloadCompleted(Sender: TObject; AJSON: TJSONStringType; AErrTyp: TErrorType; const AErrMsg: String = '');
     procedure DoOnProcessJSON(Sender: TObject);
-    procedure DoOnUpdate(Sender: TObject);
     procedure DoDeactivate(Sender: TObject);
     function IsSomethingChecked(const AResolveDependencies: Boolean = True): Boolean;
     function Download(const ADstDir: String; var ADoExtract: Boolean): TModalResult;
     function Extract(const ASrcDir, ADstDir: String; var ADoOpen: Boolean; const AIsUpdate: Boolean = False): TModalResult;
     function Install(var AInstallStatus: TInstallStatus; var ANeedToRebuild: Boolean): TModalResult;
     function UpdateP(const ADstDir: String; var ADoExtract: Boolean): TModalResult;
-    procedure StartUpdates;
-    procedure StopUpdates;
     procedure Rebuild;
     function CheckDstDir(const ADstDir: String): Boolean;
   public
@@ -198,31 +196,6 @@ begin
   FHintTimeOut := Application.HintHidePause;
   Application.HintHidePause := 1000000;
   Application.AddOnDeactivateHandler(@DoDeactivate, False);
- {$IF LCL_FULLVERSION >= 1070000}
-  tbInstall.Style := tbsButtonDrop;
-  tbCreate.Style := tbsButtonDrop;
- {$ENDIF}
-end;
-
-procedure TMainFrm.StartUpdates;
-var
-  FileName: String;
-begin
-  FileName := Format(LocalRepositoryUpdatesFile, [MD5Print(MD5String(Options.RemoteRepository[Options.ActiveRepositoryIndex]))]);
-  Updates := TUpdates.Create(FileName);
-  Updates.OnUpdate := @DoOnUpdate;
-  Updates.StartUpdate;
-end;
-
-procedure TMainFrm.StopUpdates;
-begin
-  if Assigned(Updates) then
-  begin
-    Updates.StopUpdate;
-    Updates.Terminate;
-    Updates.WaitFor;
-    Updates := nil;
-  end;
 end;
 
 procedure TMainFrm.FormDestroy(Sender: TObject);
@@ -230,9 +203,9 @@ begin
   SerializablePackages.OnProcessJSON := nil;
   PackageDownloader.OnJSONProgress := nil;
   PackageDownloader.OnJSONDownloadCompleted := nil;
-  StopUpdates;
   Application.RemoveOnDeactivateHandler(@DoDeactivate);
   VisualTree.Free;
+  VisualTree := nil;
   Application.HintHidePause := FHintTimeOut;
 end;
 
@@ -250,9 +223,6 @@ begin
     SetupColors;
     GetPackageList;
   end
-  else
-    if not Application.Terminated then
-      StartUpdates;
 end;
 
 procedure TMainFrm.GetPackageList(const ARepositoryHasChanged: Boolean = False);
@@ -268,7 +238,6 @@ begin
     SetupMessage(rsMainFrm_rsMessageChangingRepository);
     Sleep(1500);
   end;
-  StopUpdates;
   SetupMessage(rsMainFrm_rsMessageDownload);
   PackageDownloader.DownloadJSON(Options.ConTimeOut*1000);
 end;
@@ -339,7 +308,6 @@ begin
   ProgressFrm := TProgressFrm.Create(MainFrm);
   try
     PackageUnzipper := TPackageUnzipper.Create;
-    try
     ProgressFrm.SetupControls(1);
     PackageUnzipper.OnZipProgress := @ProgressFrm.DoOnZipProgress;
     PackageUnzipper.OnZipError := @ProgressFrm.DoOnZipError;
@@ -348,10 +316,6 @@ begin
     Result := ProgressFrm.ShowModal;
     if Result = mrOk then
       ADoOpen := ProgressFrm.cbExtractOpen.Checked;
-    finally
-      if Assigned(PackageUnzipper) then
-        PackageUnzipper := nil;
-    end;
  finally
    ProgressFrm.Free;
  end;
@@ -413,10 +377,12 @@ begin
           Exit;
         end;
         VisualTree.PopulateTree;
+        if Assigned (Updates) then
+          Updates.StartUpdate(True);
+        VisualTree.UpdatePackageUStatus;
         EnableDisableControls(True);
         SetupMessage;
         mJSON.Text := AJSON;
-        StartUpdates;
         cbAll.Checked := False;
         Caption := rsLazarusPackageManager + ' ' + SerializablePackages.QuickStatistics;
       end;
@@ -449,11 +415,6 @@ begin
   Application.ProcessMessages;
 end;
 
-procedure TMainFrm.DoOnUpdate(Sender: TObject);
-begin
-  VisualTree.UpdatePackageUStatus;
-end;
-
 procedure TMainFrm.DoDeactivate(Sender: TObject);
 begin
   if Assigned(VisualTree.ShowHintFrm) then
@@ -704,7 +665,6 @@ begin
 
   if CanGo then
   begin
-    StopUpdates;
     Options.LastDownloadDir := DstDir;
     Options.Changed := True;
     PackageAction := paDownloadTo;
@@ -726,7 +686,6 @@ begin
     end;
   end;
   SerializablePackages.RemoveErrorState;
-  StartUpdates;
 end;
 
 procedure TMainFrm.Rebuild;
@@ -768,7 +727,6 @@ begin
     if MessageDlgEx(rsMainFrm_PackageUpdateWarning, mtConfirmation, [mbYes, mbNo], Self) <> mrYes then
       Exit;
 
-    StopUpdates;
     PackageAction := paUpdate;
     VisualTree.UpdatePackageStates;
     if SerializablePackages.DownloadCount > 0 then
@@ -809,10 +767,7 @@ begin
     end;
   end;
   if not NeedToRebuild then
-  begin
     SerializablePackages.RemoveErrorState;
-    StartUpdates;
-  end;
 end;
 
 procedure TMainFrm.tbUninstallClick(Sender: TObject);
@@ -874,7 +829,6 @@ begin
    end;
 
   NeedToRebuild := False;
-  StopUpdates;
   for I := 0 to SerializablePackages.Count - 1 do
   begin
     for J := 0 to SerializablePackages.Items[I].LazarusPackages.Count - 1 do
@@ -899,7 +853,6 @@ begin
               begin
                 NeedToRebuild := False;
                 MessageDlgEx(Format(rsMainFrm_rsUninstall_Error, [LazarusPackage.Name]), mtError, [mbOk], Self);
-                StartUpdates;
                 Exit;
               end
               else
@@ -940,7 +893,6 @@ begin
 
   if CanGo then
   begin
-    StopUpdates;
     PackageAction := paInstall;
     VisualTree.UpdatePackageStates;
     if SerializablePackages.DownloadCount > 0 then
@@ -980,10 +932,7 @@ begin
     end;
   end;
   if not NeedToRebuild then
-  begin
     SerializablePackages.RemoveErrorState;
-    StartUpdates;
-  end;
 end;
 
 procedure TMainFrm.miFromRepositoryClick(Sender: TObject);
@@ -1019,6 +968,17 @@ begin
   end;
 end;
 
+procedure TMainFrm.tbCreateClick(Sender: TObject);
+begin
+  CreateRepositoryPackagesFrm := TCreateRepositoryPackagesFrm.Create(MainFrm);
+  try
+    CreateRepositoryPackagesFrm.SetType(0);
+    CreateRepositoryPackagesFrm.ShowModal;
+  finally
+    CreateRepositoryPackagesFrm.Free;
+  end;
+end;
+
 procedure TMainFrm.pnToolBarResize(Sender: TObject);
 var
   I: Integer;
@@ -1038,13 +998,7 @@ end;
 
 procedure TMainFrm.miCreateRepositoryPackageClick(Sender: TObject);
 begin
-  CreateRepositoryPackagesFrm := TCreateRepositoryPackagesFrm.Create(MainFrm);
+  tbCreateClick(tbCreate);
-  try
-    CreateRepositoryPackagesFrm.SetType(0);
-    CreateRepositoryPackagesFrm.ShowModal;
-  finally
-    CreateRepositoryPackagesFrm.Free;
-  end;
 end;
 
 procedure TMainFrm.miCreateJSONForUpdatesClick(Sender: TObject);
@@ -1266,7 +1220,6 @@ procedure TMainFrm.miJSONShowClick(Sender: TObject);
 begin
   if not mJSON.Visible then
   begin
-    StopUpdates;
     EnableDisableControls(False);
     mJSON.Visible := True;
     mJSON.BringToFront;
@@ -1276,7 +1229,6 @@ begin
     mJSON.SendToBack;
     mJSON.Visible := False;
     EnableDisableControls(True);
-    StartUpdates;
   end;
 end;
 

components/onlinepackagemanager/opkman_progressfrm.lfm

@@ -17,7 +17,7 @@ object ProgressFrm: TProgressFrm
   OnShow = FormShow
   PopupMode = pmExplicit
   Position = poOwnerFormCenter
-  LCLVersion = '1.9.0.0'
+  LCLVersion = '2.1.0.0'
   object pnLabels: TPanel
     Left = 0
     Height = 249

components/onlinepackagemanager/opkman_progressfrm.pas

@@ -223,14 +223,17 @@ begin
   else
     lbReceived.Caption := rsProgressFrm_lbReceived_Caption0 + '  ' + FormatSize(ACurPos) + ' / ' + rsProgressFrm_Caption5;
   lbReceived.Update;
+  if ACurSize > 0 then
     pb.Position := Round((ACurPos/ACurSize) * 100);
   pb.Update;
   lbReceivedTotal.Caption := rsProgressFrm_lbReceivedTotal_Caption0 + '  ' + FormatSize(ATotPos) + ' / ' + FormatSize(ATotSize);
   lbReceivedTotal.Update;
+  if ATotSize > 0 then
     pbTotal.Position := Round((ATotPos/ATotSize) * 100);
   pbTotal.Update;
   FCnt := ACnt;
   FTotCnt := ATotCnt;
+  Application.ProcessMessages;
 end;
 
 procedure TProgressFrm.DoOnPackageDownloadError(Sender: TObject; APackageName: String;
@@ -286,14 +289,17 @@ begin
   lbRemainingData.Update;
   lbReceived.Caption := rsProgressFrm_lbReceived_Caption1 + '  ' + FormatSize(ACurPos) + ' / ' + FormatSize(ACurSize);
   lbReceived.Update;
+  if ACurSize > 0 then
     pb.Position := Round((ACurPos/ACurSize) * 100);
   pb.Update;
   lbReceivedTotal.Caption := rsProgressFrm_lbReceivedTotal_Caption1 + '  ' + FormatSize(ATotPos) + ' / ' + FormatSize(ATotSize);
   lbReceivedTotal.Update;
+  if ATotSize > 0 then
     pbTotal.Position := Round((ATotPos/ATotSize) * 100);
   pbTotal.Update;
   FCnt := ACnt;
   FTotCnt := ATotCnt;
+  Application.ProcessMessages;
 end;
 
 procedure TProgressFrm.DoOnZipError(Sender: TObject; APackageName: String; const AErrMsg: String);
@@ -464,6 +470,7 @@ begin
   end;
   Data^.FImageIndex := AUTyp;
   FVST.TopNode := Node;
+  Application.ProcessMessages;
 end;
 
 procedure TProgressFrm.DoOnPackageUpdateCompleted(Sender: TObject;

components/onlinepackagemanager/opkman_timer.pas

@@ -1,105 +0,0 @@
-{
-***************************************************************************
-*                                                                         *
-*   This source is free software; you can redistribute it and/or modify   *
-*   it under the terms of the GNU General Public License as published by  *
-*   the Free Software Foundation; either version 2 of the License, or     *
-*   (at your option) any later version.                                   *
-*                                                                         *
-*   This code is distributed in the hope that it will be useful, but      *
-*   WITHOUT ANY WARRANTY; without even the implied warranty of            *
-*   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
-*   General Public License for more details.                              *
-*                                                                         *
-*   A copy of the GNU General Public License is available on the World    *
-*   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
-*   obtain it by writing to the Free Software Foundation,                 *
-*   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
-*                                                                         *
-***************************************************************************
-
-Author: Balázs Székely
-}
-unit opkman_timer;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils;
-
-type
-   { TThreadTimer }
-   TThreadTimer = class(TThread)
-   private
-     FTime: QWORD;
-     FInterval: Cardinal;
-     FOnTimer: TNotifyEvent;
-     FEnabled: Boolean;
-     procedure DoOnTimer;
-   protected
-     procedure Execute; override;
-   public
-     constructor Create;
-     destructor Destroy; override;
-   public
-     property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
-     property Interval: Cardinal read FInterval write FInterval;
-     property Enabled: Boolean read FEnabled write FEnabled;
-     procedure StopTimer;
-     procedure StartTimer;
-   end;
-
-implementation
-
-{ TThreadTimer }
-
-constructor TThreadTimer.Create;
-begin
-  inherited Create(True);
-  FreeOnTerminate := True;
-  FInterval := 10000;
-  FEnabled := False;
-end;
-
-destructor TThreadTimer.Destroy;
-begin
-  //
-  inherited Destroy;
-end;
-
-procedure TThreadTimer.DoOnTimer;
-begin
-  if Assigned(FOnTimer) then
-    FOnTimer(Self);
-end;
-
-procedure TThreadTimer.Execute;
-begin
-  while not Terminated do
-  begin
-    Sleep(1000);
-    if (GetTickCount64 - FTime > FInterval) and FEnabled and not Terminated then
-    begin
-      FTime := GetTickCount64;
-      DoOnTimer;
-    end;
-  end;
-end;
-
-procedure TThreadTimer.StopTimer;
-begin
-  FEnabled := False;
-end;
-
-procedure TThreadTimer.StartTimer;
-begin
-  FTime := GetTickCount64;
-  FEnabled := True;
-  if Self.Suspended then
-    Start;
-end;
-
-end.
-

components/onlinepackagemanager/opkman_updates.pas

@@ -30,11 +30,11 @@ unit opkman_updates;
 interface
 
 uses
-  Classes, SysUtils, fpjson, fpjsonrtti, dateutils,
+  Classes, SysUtils, fpjson, fpjsonrtti, jsonparser, dateutils,
   // LazUtils
   Laz2_XMLCfg, LazIDEIntf,
   // OpkMan
-  opkman_serializablepackages, opkman_options, opkman_common,
+  opkman_serializablepackages, opkman_options, opkman_common, opkman_visualtree,
   {$IFDEF MSWINDOWS}
     opkman_const,
     {$IFDEF FPC311}zipper,{$ELSE}opkman_zip,{$ENDIF}
@@ -108,12 +108,11 @@ type
     FBusyUpdating: Boolean;
     FBusySaving: Boolean;
     FOpenSSLAvailable: Boolean;
-    FOnUpdate: TNotifyEvent;
     FTime: QWORD;
     FInterval: Cardinal;
     FFileName: String;
+    FStarted: Boolean;
     function GetUpdateInfo(const AURL: String; var AJSON: TJSONStringType): Boolean;
-    procedure DoOnUpdate;
     procedure Load;
     procedure Save;
     procedure AssignPackageData(AMetaPackage: TMetaPackage);
@@ -126,10 +125,8 @@ type
   public
     constructor Create(const AFileName: String);
     destructor Destroy; override;
-    procedure StartUpdate;
+    procedure StartUpdate(const AOnlyInit: Boolean = False);
     procedure StopUpdate;
-  published
-    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
   end;
 
 var
@@ -166,6 +163,20 @@ begin
   inherited Destroy;
 end;
 
+function IsValidJSON(const AJSON: TJSONStringType): Boolean;
+var
+  {%H-}JSONData: TJSONData;
+begin
+  Result := True;
+  try
+    JSONData := GetJSON(AJSON);
+    JSONData.Free;
+  except
+    on E: EJSONParser do
+      Result := False;
+  end;
+end;
+
 function TUpdatePackage.LoadFromJSON(const AJSON: TJSONStringType): Boolean;
 var
   DeStreamer: TJSONDeStreamer;
@@ -174,8 +185,11 @@ begin
   try
     Clear;
     try
+      if IsValidJSON(AJSON) then
+      begin
         DeStreamer.JSONToObject(AJSON, Self);
         Result := True;
+      end;
     except
       on E: Exception do
       begin
@@ -256,6 +270,7 @@ destructor TUpdates.Destroy;
 begin
   FHTTPClient.Free;
   FUpdatePackage.Free;
+  Updates := nil;
   inherited Destroy;
 end;
 
@@ -312,8 +327,6 @@ begin
   finally
     FXML.Free;
   end;
-  if Assigned(FOnUpdate) and (not FNeedToBreak) then
-    Synchronize(@DoOnUpdate);
 end;
 
 procedure TUpdates.Save;
@@ -505,12 +518,6 @@ begin
   end;
 end;
 
-procedure TUpdates.DoOnUpdate;
-begin
-  if Assigned(FOnUpdate) then
-    FOnUpdate(Self);
-end;
-
 procedure TUpdates.CheckForUpdates;
 var
   I: Integer;
@@ -537,8 +544,6 @@ begin
       else
         ResetPackageData(SerializablePackages.Items[I]);
     end;
-    if Assigned(FOnUpdate) and (not FNeedToBreak) then
-      Synchronize(@DoOnUpdate);
   finally
     FBusyUpdating := False;
   end;
@@ -548,21 +553,28 @@ procedure TUpdates.Execute;
 begin
   while not Terminated do
   begin
-    Sleep(1);
+    if FNeedToBreak then
+      Break;
+    Sleep(50);
     if (GetTickCount64 - FTime > FInterval)then
     begin
       FTime := GetTickCount64;
-      if IsTimeToUpdate then
+      if (IsTimeToUpdate) then
+      begin
          CheckForUpdates;
+         if (not FNeedToBreak) and Assigned(VisualTree) then
+           Synchronize(@VisualTree.UpdatePackageUStatus)
+      end;
     end;
-    if FNeedToBreak then
-      Break;
   end;
 end;
 
-procedure TUpdates.StartUpdate;
+procedure TUpdates.StartUpdate(const AOnlyInit: Boolean = False);
 begin
   Load;
+  if AOnlyInit then
+    Exit;
+  FStarted := True;
   CheckForOpenSSL;
   FTime := GetTickCount64;
   FInterval := 6000;
@@ -571,6 +583,7 @@ end;
 
 procedure TUpdates.StopUpdate;
 begin
+  FStarted := False;
   Save;
   FHTTPClient.Terminate;
   FNeedToBreak := True;

components/onlinepackagemanager/opkman_zipper.pas

@@ -35,7 +35,7 @@ uses
   // LazUtils
   FileUtil, LazFileUtils,
   // OpkMan
-  opkman_timer, opkman_serializablepackages, opkman_common,
+  opkman_serializablepackages, opkman_common,
   {$IFDEF FPC311}zipper{$ELSE}opkman_zip{$ENDIF};
 
 type
@@ -61,17 +61,16 @@ type
     FTotPos: Int64;
     FTotPosTmp: Int64;
     FTotSize: Int64;
-    FElapsed: Integer;
+    FElapsed: QWord;
+    FStartTime: QWord;
     FRemaining: Integer;
     FSpeed: Integer;
     FErrMsg: String;
     FIsUpdate: Boolean;
-    FTimer: TThreadTimer;
     FUnZipper: TUnZipper;
     FOnZipProgress: TOnZipProgress;
     FOnZipError: TOnZipError;
     FOnZipCompleted: TOnZipCompleted;
-    procedure DoOnTimer(Sender: TObject);
     procedure DoOnProgressEx(Sender : TObject; const ATotPos, {%H-}ATotSize: Int64);
     procedure DoOnZipProgress;
     procedure DoOnZipError;
@@ -146,7 +145,9 @@ var
   I: Integer;
   DelDir: String;
 begin
+  Sleep(50);
   FCnt := 0;
+  FStartTime := GetTickCount64;
   for I := 0 to SerializablePackages.Count - 1 do
   begin
     if SerializablePackages.Items[I].IsExtractable then
@@ -191,7 +192,10 @@ begin
     end;
   end;
   if (FNeedToBreak) then
+  begin
+    if DirectoryExists(DelDir) then
       DeleteDirectory(DelDir, False)
+  end
   else
   begin
     SerializablePackages.MarkRuntimePackages;
@@ -204,30 +208,27 @@ begin
   inherited Create(True);
   FreeOnTerminate := True;
   FUnZipper := TUnZipper.Create;
-  FTimer := nil;
 end;
 
 destructor TPackageUnzipper.Destroy;
 begin
-  if FTimer.Enabled then
-    FTimer.StopTimer;
-  FTimer.Terminate;
   FUnZipper.Free;
   inherited Destroy;
 end;
 
-procedure TPackageUnzipper.DoOnTimer(Sender: TObject);
-begin
-  Inc(FElapsed);
-  FSpeed := Round(FTotPosTmp/FElapsed);
-  FRemaining := Round((FTotSize - FTotPosTmp)/FSpeed);
-end;
-
 procedure TPackageUnzipper.DoOnProgressEx(Sender : TObject; const ATotPos, ATotSize: Int64);
 begin
+  FElapsed := GetTickCount64 - FStartTime;
+  if FElapsed < 1000 then
+    Exit;
+  FElapsed := FElapsed div 1000;
+
   FCurPos := ATotPos;
   FCurSize := ATotSize;
   FTotPosTmp := FTotPos + FCurPos;
+  FSpeed := Round(FTotPosTmp/FElapsed);
+  if FSpeed > 0 then
+    FRemaining := Round((FTotSize - FTotPosTmp)/FSpeed);
   Synchronize(@DoOnZipProgress);
   Sleep(5);
 end;
@@ -309,9 +310,6 @@ begin
     end;
   end;
   FStarted := True;
-  FTimer := TThreadTimer.Create;
-  FTimer.OnTimer := @DoOnTimer;
-  FTimer.StartTimer;
   Start;
 end;
 
@@ -319,8 +317,6 @@ procedure TPackageUnzipper.StopUnZip;
 begin
   if Assigned(FUnZipper) then
     FUnZipper.Terminate;
-  if Assigned(FTimer) then
-    FTimer.StopTimer;
   FNeedToBreak := True;
   FStarted := False;
 end;