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 -
This commit is contained in:
balazs 2018-10-31 18:43:35 +00:00
parent 450f82294e
commit 01a1baa804
14 changed files with 234 additions and 402 deletions

1
.gitattributes vendored
View File

@ -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_showhint.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_showhintbase.lfm -text svneol=native#plain/text components/onlinepackagemanager/opkman_showhintbase.lfm -text svneol=native#plain/text
components/onlinepackagemanager/opkman_showhintbase.pas svneol=native#text/pascal 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_updates.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_uploader.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/opkman_visualtree.pas svneol=native#text/pascal

View File

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

View File

@ -10,14 +10,13 @@ interface
uses uses
onlinepackagemanagerintf, opkman_mainfrm, opkman_optionsfrm, opkman_const, onlinepackagemanagerintf, opkman_mainfrm, opkman_optionsfrm, opkman_const,
opkman_visualtree, opkman_serializablepackages, opkman_downloader, 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 implementation

View File

@ -166,8 +166,8 @@ resourcestring
rsMainFrm_TBOptions_Hint = 'Show options dialog'; rsMainFrm_TBOptions_Hint = 'Show options dialog';
rsMainFrm_TBHelp_Caption = 'Help'; rsMainFrm_TBHelp_Caption = 'Help';
rsMainFrm_TBHelp_Hint = 'Help (' + cHelpPage + ')'; 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_miCreateRepositoryPackage = 'Create repository package';
rsMainFrm_miCreateJSONForUpdates = 'Create JSON for updates'; rsMainFrm_miCreateJSONForUpdates = 'Create JSON for updates';
rsMainFrm_miCreateRepository = 'Create private repository'; rsMainFrm_miCreateRepository = 'Create private repository';

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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.

View File

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

View File

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