mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-28 10:24:26 +02:00
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
parent
450f82294e
commit
01a1baa804
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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>
|
||||
<Item13>
|
||||
</Item11>
|
||||
<Item12>
|
||||
<Filename Value="opkman_packagelistfrm.pas"/>
|
||||
<UnitName Value="opkman_packagelistfrm"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Item13>
|
||||
<Item14>
|
||||
</Item12>
|
||||
<Item13>
|
||||
<Filename Value="opkman_options.pas"/>
|
||||
<UnitName Value="opkman_options"/>
|
||||
</Item14>
|
||||
<Item15>
|
||||
</Item13>
|
||||
<Item14>
|
||||
<Filename Value="opkman_createrepositorypackagefrm.pas"/>
|
||||
<UnitName Value="opkman_createrepositorypackagefrm"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Item15>
|
||||
<Item16>
|
||||
</Item14>
|
||||
<Item15>
|
||||
<Filename Value="opkman_categoriesfrm.pas"/>
|
||||
<UnitName Value="opkman_categoriesfrm"/>
|
||||
</Item16>
|
||||
<Item17>
|
||||
</Item15>
|
||||
<Item16>
|
||||
<Filename Value="opkman_packagedetailsfrm.pas"/>
|
||||
<UnitName Value="opkman_packagedetailsfrm"/>
|
||||
</Item17>
|
||||
<Item18>
|
||||
</Item16>
|
||||
<Item17>
|
||||
<Filename Value="opkman_updates.pas"/>
|
||||
<UnitName Value="opkman_updates"/>
|
||||
</Item18>
|
||||
<Item19>
|
||||
</Item17>
|
||||
<Item18>
|
||||
<Filename Value="opkman_createjsonforupdatesfrm.pas"/>
|
||||
<UnitName Value="opkman_createjsonforupdatesfrm"/>
|
||||
</Item19>
|
||||
<Item20>
|
||||
</Item18>
|
||||
<Item19>
|
||||
<Filename Value="opkman_uploader.pas"/>
|
||||
<UnitName Value="opkman_uploader"/>
|
||||
</Item20>
|
||||
<Item21>
|
||||
</Item19>
|
||||
<Item20>
|
||||
<Filename Value="opkman_repositories.pas"/>
|
||||
<UnitName Value="opkman_repositories"/>
|
||||
</Item21>
|
||||
<Item22>
|
||||
</Item20>
|
||||
<Item21>
|
||||
<Filename Value="opkman_createrepositoryfrm.pas"/>
|
||||
<UnitName Value="opkman_createrepositoryfrm"/>
|
||||
</Item22>
|
||||
<Item23>
|
||||
</Item21>
|
||||
<Item22>
|
||||
<Filename Value="opkman_repositorydetailsfrm.pas"/>
|
||||
<UnitName Value="opkman_repositorydetailsfrm"/>
|
||||
</Item23>
|
||||
<Item24>
|
||||
</Item22>
|
||||
<Item23>
|
||||
<Filename Value="opkman_addrepositorypackagefrm.pas"/>
|
||||
<UnitName Value="opkman_addrepositorypackagefrm"/>
|
||||
</Item24>
|
||||
<Item25>
|
||||
</Item23>
|
||||
<Item24>
|
||||
<Filename Value="opkman_intf.pas"/>
|
||||
<UnitName Value="opkman_intf"/>
|
||||
</Item25>
|
||||
<Item26>
|
||||
</Item24>
|
||||
<Item25>
|
||||
<Filename Value="opkman_intf_packagelistfrm.pas"/>
|
||||
<UnitName Value="opkman_intf_packagelistfrm"/>
|
||||
</Item26>
|
||||
<Item27>
|
||||
</Item25>
|
||||
<Item26>
|
||||
<Filename Value="opkman_showhint.pas"/>
|
||||
<UnitName Value="opkman_showhint"/>
|
||||
</Item27>
|
||||
<Item28>
|
||||
</Item26>
|
||||
<Item27>
|
||||
<Filename Value="opkman_showhintbase.pas"/>
|
||||
<UnitName Value="opkman_showhintbase"/>
|
||||
</Item28>
|
||||
<Item29>
|
||||
</Item27>
|
||||
<Item28>
|
||||
<Filename Value="opkman_colorsfrm.pas"/>
|
||||
<UnitName Value="opkman_colorsfrm"/>
|
||||
</Item29>
|
||||
</Item28>
|
||||
</Files>
|
||||
<i18n>
|
||||
<EnableI18N Value="True"/>
|
||||
|
||||
@ -10,22 +10,21 @@ interface
|
||||
uses
|
||||
onlinepackagemanagerintf, opkman_mainfrm, opkman_optionsfrm, opkman_const,
|
||||
opkman_visualtree, opkman_serializablepackages, opkman_downloader,
|
||||
opkman_common, opkman_progressfrm, opkman_zipper, opkman_timer,
|
||||
opkman_installer, opkman_packagelistfrm, opkman_options,
|
||||
opkman_createrepositorypackagefrm, opkman_categoriesfrm,
|
||||
opkman_packagedetailsfrm, opkman_updates, opkman_createjsonforupdatesfrm,
|
||||
opkman_uploader, opkman_repositories, opkman_createrepositoryfrm,
|
||||
opkman_repositorydetailsfrm, opkman_addrepositorypackagefrm, opkman_intf,
|
||||
opkman_intf_packagelistfrm, opkman_showhint, opkman_showhintbase,
|
||||
opkman_colorsfrm, LazarusPackageIntf;
|
||||
opkman_common, opkman_progressfrm, opkman_zipper, opkman_installer,
|
||||
opkman_packagelistfrm, opkman_options, opkman_createrepositorypackagefrm,
|
||||
opkman_categoriesfrm, opkman_packagedetailsfrm, opkman_updates,
|
||||
opkman_createjsonforupdatesfrm, opkman_uploader, opkman_repositories,
|
||||
opkman_createrepositoryfrm, opkman_repositorydetailsfrm,
|
||||
opkman_addrepositorypackagefrm, opkman_intf, opkman_intf_packagelistfrm,
|
||||
opkman_showhint, opkman_showhintbase, opkman_colorsfrm, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('onlinepackagemanagerintf', @onlinepackagemanagerintf.Register);
|
||||
RegisterUnit('onlinepackagemanagerintf', @ onlinepackagemanagerintf.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('OnlinePackageManager', @Register);
|
||||
RegisterPackage('OnlinePackageManager', @ Register);
|
||||
end.
|
||||
|
||||
@ -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_miFromExternalSource = 'From external source';
|
||||
rsMainFrm_miFromRepository = 'From official repository';
|
||||
rsMainFrm_miFromExternalSource = 'From third party repository';
|
||||
rsMainFrm_miCreateRepositoryPackage = 'Create repository package';
|
||||
rsMainFrm_miCreateJSONForUpdates = 'Create JSON for updates';
|
||||
rsMainFrm_miCreateRepository = 'Create private repository';
|
||||
|
||||
@ -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,11 +302,13 @@ var
|
||||
UpdateSize: Int64;
|
||||
UpdCnt: Integer;
|
||||
begin
|
||||
Sleep(50);
|
||||
FErrMsg := '';
|
||||
FErrTyp := etNone;
|
||||
if FDownloadType = dtJSON then //JSON
|
||||
begin
|
||||
Synchronize(@DoOnJSONProgress);
|
||||
if not FNeedToBreak then
|
||||
Synchronize(@DoOnJSONProgress);
|
||||
if FRemoteJSONFile <> cRemoteJSONFile then
|
||||
begin
|
||||
try
|
||||
@ -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,13 +497,7 @@ 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);
|
||||
@ -546,12 +517,7 @@ 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;
|
||||
@ -613,13 +579,7 @@ 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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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 DoWaitForIDE(Sender: TObject);
|
||||
procedure DoOnTimer(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;
|
||||
FWaitForIDE.Interval := 100;
|
||||
FWaitForIDE.OnTimer := @DoWaitForIDE;
|
||||
FWaitForIDE.StartTimer;
|
||||
FTimer := TTimer.Create(nil);
|
||||
FTimer.Interval := 50;
|
||||
FTimer.OnTimer := @DoOnTimer;
|
||||
FTimer.Enabled := True;
|
||||
end;
|
||||
|
||||
destructor TOPMInterfaceEx.Destroy;
|
||||
begin
|
||||
if (PackageDownloader<>nil) and PackageDownloader.DownloadingJSON then
|
||||
PackageDownloader.Cancel;
|
||||
FWaitForIDE.StopTimer;
|
||||
FWaitForIDE.Terminate;
|
||||
FWaitForIDE.WaitFor;
|
||||
FTimer.Free;
|
||||
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;
|
||||
FWaitForIDE.Interval := 5000;
|
||||
FWaitForIDE.StartTimer;
|
||||
FTimer.Enabled := False;
|
||||
FTimer.Interval := 5000;
|
||||
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,41 +191,36 @@ 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
|
||||
PkgLinks.ClearOnlineLinks;
|
||||
FPackageLinks.Clear;
|
||||
for I := 0 to SerializablePackages.Count - 1 do
|
||||
begin
|
||||
MetaPackage := SerializablePackages.Items[I];
|
||||
for J := 0 to MetaPackage.LazarusPackages.Count - 1 do
|
||||
begin
|
||||
MetaPackage := SerializablePackages.Items[I];
|
||||
for J := 0 to MetaPackage.LazarusPackages.Count - 1 do
|
||||
LazPackage := TLazarusPackage(MetaPackage.LazarusPackages.Items[J]);
|
||||
FileName := Options.LocalRepositoryPackagesExpanded + MetaPackage.PackageBaseDir + LazPackage.PackageRelativePath + LazPackage.Name;
|
||||
Name := StringReplace(LazPackage.Name, '.lpk', '', [rfReplaceAll, rfIgnoreCase]);
|
||||
URL := Options.RemoteRepository[Options.ActiveRepositoryIndex] + MetaPackage.RepositoryFileName;
|
||||
PackageLink := FindOnlineLink(Name);
|
||||
if PackageLink = nil then
|
||||
begin
|
||||
LazPackage := TLazarusPackage(MetaPackage.LazarusPackages.Items[J]);
|
||||
FileName := Options.LocalRepositoryPackagesExpanded + MetaPackage.PackageBaseDir + LazPackage.PackageRelativePath + LazPackage.Name;
|
||||
Name := StringReplace(LazPackage.Name, '.lpk', '', [rfReplaceAll, rfIgnoreCase]);
|
||||
URL := Options.RemoteRepository[Options.ActiveRepositoryIndex] + MetaPackage.RepositoryFileName;
|
||||
PackageLink := FindOnlineLink(Name);
|
||||
if PackageLink = nil then
|
||||
PackageLink := PkgLinks.AddOnlineLink(FileName, Name, URL);
|
||||
if PackageLink <> nil then
|
||||
begin
|
||||
PackageLink := PkgLinks.AddOnlineLink(FileName, Name, URL);
|
||||
if PackageLink <> nil then
|
||||
begin
|
||||
PackageLink.Version.Assign(LazPackage.Version);
|
||||
PackageLink.PackageType := LazPackage.PackageType;
|
||||
PackageLink.OPMFileDate := MetaPackage.RepositoryDate;
|
||||
PackageLink.Author := LazPackage.Author;
|
||||
PackageLink.Description := LazPackage.Description;
|
||||
PackageLink.License := LazPackage.License;
|
||||
FPackageLinks.Add(PackageLink);
|
||||
end;
|
||||
PackageLink.Version.Assign(LazPackage.Version);
|
||||
PackageLink.PackageType := LazPackage.PackageType;
|
||||
PackageLink.OPMFileDate := MetaPackage.RepositoryDate;
|
||||
PackageLink.Author := LazPackage.Author;
|
||||
PackageLink.Description := LazPackage.Description;
|
||||
PackageLink.License := LazPackage.License;
|
||||
FPackageLinks.Add(PackageLink);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FBusyUpdating := False;
|
||||
end;
|
||||
if (Assigned(OnPackageListAvailable)) then
|
||||
OnPackageListAvailable(Self);
|
||||
end;
|
||||
|
||||
procedure TOPMInterfaceEx.AddToDownloadList(const AName: String);
|
||||
@ -537,4 +544,10 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOPMInterfaceEx.DoHandleException(Sender: TObject; E: Exception);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,19 +308,14 @@ begin
|
||||
ProgressFrm := TProgressFrm.Create(MainFrm);
|
||||
try
|
||||
PackageUnzipper := TPackageUnzipper.Create;
|
||||
try
|
||||
ProgressFrm.SetupControls(1);
|
||||
PackageUnzipper.OnZipProgress := @ProgressFrm.DoOnZipProgress;
|
||||
PackageUnzipper.OnZipError := @ProgressFrm.DoOnZipError;
|
||||
PackageUnzipper.OnZipCompleted := @ProgressFrm.DoOnZipCompleted;
|
||||
PackageUnzipper.StartUnZip(ASrcDir, ADstDir, AIsUpdate);
|
||||
Result := ProgressFrm.ShowModal;
|
||||
if Result = mrOk then
|
||||
ADoOpen := ProgressFrm.cbExtractOpen.Checked;
|
||||
finally
|
||||
if Assigned(PackageUnzipper) then
|
||||
PackageUnzipper := nil;
|
||||
end;
|
||||
ProgressFrm.SetupControls(1);
|
||||
PackageUnzipper.OnZipProgress := @ProgressFrm.DoOnZipProgress;
|
||||
PackageUnzipper.OnZipError := @ProgressFrm.DoOnZipError;
|
||||
PackageUnzipper.OnZipCompleted := @ProgressFrm.DoOnZipCompleted;
|
||||
PackageUnzipper.StartUnZip(ASrcDir, ADstDir, AIsUpdate);
|
||||
Result := ProgressFrm.ShowModal;
|
||||
if Result = mrOk then
|
||||
ADoOpen := ProgressFrm.cbExtractOpen.Checked;
|
||||
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);
|
||||
try
|
||||
CreateRepositoryPackagesFrm.SetType(0);
|
||||
CreateRepositoryPackagesFrm.ShowModal;
|
||||
finally
|
||||
CreateRepositoryPackagesFrm.Free;
|
||||
end;
|
||||
tbCreateClick(tbCreate);
|
||||
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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -223,14 +223,17 @@ begin
|
||||
else
|
||||
lbReceived.Caption := rsProgressFrm_lbReceived_Caption0 + ' ' + FormatSize(ACurPos) + ' / ' + rsProgressFrm_Caption5;
|
||||
lbReceived.Update;
|
||||
pb.Position := Round((ACurPos/ACurSize) * 100);
|
||||
if ACurSize > 0 then
|
||||
pb.Position := Round((ACurPos/ACurSize) * 100);
|
||||
pb.Update;
|
||||
lbReceivedTotal.Caption := rsProgressFrm_lbReceivedTotal_Caption0 + ' ' + FormatSize(ATotPos) + ' / ' + FormatSize(ATotSize);
|
||||
lbReceivedTotal.Update;
|
||||
pbTotal.Position := Round((ATotPos/ATotSize) * 100);
|
||||
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;
|
||||
pb.Position := Round((ACurPos/ACurSize) * 100);
|
||||
if ACurSize > 0 then
|
||||
pb.Position := Round((ACurPos/ACurSize) * 100);
|
||||
pb.Update;
|
||||
lbReceivedTotal.Caption := rsProgressFrm_lbReceivedTotal_Caption1 + ' ' + FormatSize(ATotPos) + ' / ' + FormatSize(ATotSize);
|
||||
lbReceivedTotal.Update;
|
||||
pbTotal.Position := Round((ATotPos/ATotSize) * 100);
|
||||
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;
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
DeStreamer.JSONToObject(AJSON, Self);
|
||||
Result := True;
|
||||
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 (GetTickCount64 - FTime > FInterval) then
|
||||
begin
|
||||
FTime := GetTickCount64;
|
||||
if IsTimeToUpdate then
|
||||
CheckForUpdates;
|
||||
end;
|
||||
if FNeedToBreak then
|
||||
Break;
|
||||
Sleep(50);
|
||||
if (GetTickCount64 - FTime > FInterval)then
|
||||
begin
|
||||
FTime := GetTickCount64;
|
||||
if (IsTimeToUpdate) then
|
||||
begin
|
||||
CheckForUpdates;
|
||||
if (not FNeedToBreak) and Assigned(VisualTree) then
|
||||
Synchronize(@VisualTree.UpdatePackageUStatus)
|
||||
end;
|
||||
end;
|
||||
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;
|
||||
|
||||
@ -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
|
||||
DeleteDirectory(DelDir, False)
|
||||
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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user