mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-10 18:58:16 +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:
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_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
|
||||||
|
@ -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"/>
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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';
|
||||||
|
@ -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;
|
||||||
|
@ -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;
|
||||||
|
@ -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.
|
||||||
|
@ -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
|
||||||
|
@ -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;
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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;
|
||||||
|
@ -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
|
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;
|
||||||
|
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user