mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-01 01:12:42 +02:00
411 lines
12 KiB
ObjectPascal
411 lines
12 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Balázs Székely
|
|
Abstract:
|
|
Common functions, procedures.
|
|
}
|
|
unit opkman_common;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Dialogs, Forms, Controls, LazIDEIntf, LazFileUtils, contnrs,
|
|
opkman_const;
|
|
|
|
type
|
|
TPackageAction = (paDownloadTo, paInstall, paUpdate);
|
|
|
|
TPackageData = class(TObject)
|
|
FName: String;
|
|
FPackageBaseDir: String;
|
|
FPackageRelativePath: String;
|
|
FFullPath: String;
|
|
end;
|
|
|
|
const
|
|
MaxCategories = 27;
|
|
Categories: array[0..MaxCategories - 1] of String = (
|
|
rsMainFrm_VSTText_PackageCategory0,
|
|
rsMainFrm_VSTText_PackageCategory1,
|
|
rsMainFrm_VSTText_PackageCategory2,
|
|
rsMainFrm_VSTText_PackageCategory3,
|
|
rsMainFrm_VSTText_PackageCategory4,
|
|
rsMainFrm_VSTText_PackageCategory5,
|
|
rsMainFrm_VSTText_PackageCategory6,
|
|
rsMainFrm_VSTText_PackageCategory7,
|
|
rsMainFrm_VSTText_PackageCategory8,
|
|
rsMainFrm_VSTText_PackageCategory9,
|
|
rsMainFrm_VSTText_PackageCategory10,
|
|
rsMainFrm_VSTText_PackageCategory11,
|
|
rsMainFrm_VSTText_PackageCategory12,
|
|
rsMainFrm_VSTText_PackageCategory13,
|
|
rsMainFrm_VSTText_PackageCategory14,
|
|
rsMainFrm_VSTText_PackageCategory15,
|
|
rsMainFrm_VSTText_PackageCategory16,
|
|
rsMainFrm_VSTText_PackageCategory17,
|
|
rsMainFrm_VSTText_PackageCategory18,
|
|
rsMainFrm_VSTText_PackageCategory19,
|
|
rsMainFrm_VSTText_PackageCategory20,
|
|
rsMainFrm_VSTText_PackageCategory21,
|
|
rsMainFrm_VSTText_PackageCategory22,
|
|
rsMainFrm_VSTText_PackageCategory23,
|
|
rsMainFrm_VSTText_PackageCategory24,
|
|
rsMainFrm_VSTText_PackageCategory25,
|
|
rsMainFrm_VSTText_PackageCategory26);
|
|
|
|
//needed for localized filter, since the JSON contains only english text
|
|
CategoriesEng: array[0..MaxCategories - 1] of String = (
|
|
'Charts and Graphs',
|
|
'Cryptography',
|
|
'DataControls',
|
|
'Date and Time',
|
|
'Dialogs',
|
|
'Edit and Memos',
|
|
'Files and Drives',
|
|
'GUIContainers',
|
|
'Graphics',
|
|
'Grids',
|
|
'Indicators and Gauges',
|
|
'Labels',
|
|
'LazIDEPlugins',
|
|
'List and Combo Boxes',
|
|
'ListViews and TreeViews',
|
|
'Menus',
|
|
'Multimedia',
|
|
'Networking',
|
|
'Panels',
|
|
'Reporting',
|
|
'Science',
|
|
'Security',
|
|
'Shapes',
|
|
'Sizers and Scrollers',
|
|
'System',
|
|
'Tabbed Components',
|
|
'Other');
|
|
|
|
var
|
|
LocalRepositoryConfigFile: String;
|
|
LocalRepositoryUpdatesFile: String;
|
|
PackageAction: TPackageAction;
|
|
InstallPackageList: TObjectList;
|
|
|
|
function MessageDlgEx(const AMsg: String; ADlgType: TMsgDlgType; AButtons:
|
|
TMsgDlgButtons; AParent: TForm): TModalResult;
|
|
procedure InitLocalRepository;
|
|
function SecToHourAndMin(const ASec: LongInt): String;
|
|
function FormatSize(Size: Int64): String;
|
|
function FormatSpeed(Speed: LongInt): String;
|
|
function GetDirSize(const ADirName: String; var AFileCnt, ADirCnt: Integer): Int64;
|
|
procedure FindPackages(const ADirName: String; APackageList: TStrings);
|
|
procedure FindAllFilesEx(const ADirName: String; AFileList: TStrings);
|
|
function FixProtocol(const AURL: String): String;
|
|
|
|
implementation
|
|
uses opkman_options;
|
|
|
|
function MessageDlgEx(const AMsg: string; ADlgType: TMsgDlgType;
|
|
AButtons: TMsgDlgButtons; AParent: TForm): TModalResult;
|
|
var
|
|
MsgFrm: TForm;
|
|
begin
|
|
MsgFrm := CreateMessageDialog(AMsg, ADlgType, AButtons);
|
|
try
|
|
MsgFrm.Position := poDefaultSizeOnly;
|
|
MsgFrm.FormStyle := fsSystemStayOnTop;
|
|
MsgFrm.Left := AParent.Left + (AParent.Width - MsgFrm.Width) div 2;
|
|
MsgFrm.Top := AParent.Top + (AParent.Height - MsgFrm.Height) div 2;
|
|
Result := MsgFrm.ShowModal;
|
|
finally
|
|
MsgFrm.Free
|
|
end;
|
|
end;
|
|
|
|
procedure InitLocalRepository;
|
|
var
|
|
LocalRepo, LocalRepoConfig: String;
|
|
begin
|
|
LocalRepo := AppendPathDelim(AppendPathDelim(LazarusIDE.GetPrimaryConfigPath) + cLocalRepository);
|
|
if not DirectoryExistsUTF8(LocalRepo) then
|
|
CreateDirUTF8(LocalRepo);
|
|
|
|
LocalRepoConfig := AppendPathDelim(LocalRepo + cLocalRepositoryConfig);
|
|
if not DirectoryExists(LocalRepoConfig) then
|
|
CreateDirUTF8(LocalRepoConfig);
|
|
LocalRepositoryConfigFile := LocalRepoConfig + cLocalRepositoryConfigFile;
|
|
LocalRepositoryUpdatesFile := LocalRepoConfig + cLocalRepositoryUpdatesFile;
|
|
end;
|
|
|
|
function SecToHourAndMin(const ASec: LongInt): String;
|
|
var
|
|
Hour, Min, Sec: LongInt;
|
|
begin
|
|
Hour := Trunc(ASec/3600);
|
|
Min := Trunc((ASec - Hour*3600)/60);
|
|
Sec := ASec - Hour*3600 - 60*Min;
|
|
Result := IntToStr(Hour) + 'h: ' + IntToStr(Min) + 'm: ' + IntToStr(Sec) + 's';
|
|
end;
|
|
|
|
function FormatSize(Size: Int64): String;
|
|
const
|
|
KB = 1024;
|
|
MB = 1024 * KB;
|
|
GB = 1024 * MB;
|
|
begin
|
|
if Size < KB then
|
|
Result := FormatFloat('#,##0 Bytes', Size)
|
|
else if Size < MB then
|
|
Result := FormatFloat('#,##0.0 KB', Size / KB)
|
|
else if Size < GB then
|
|
Result := FormatFloat('#,##0.0 MB', Size / MB)
|
|
else
|
|
Result := FormatFloat('#,##0.0 GB', Size / GB);
|
|
end;
|
|
|
|
function FormatSpeed(Speed: LongInt): String;
|
|
const
|
|
KB = 1024;
|
|
MB = 1024 * KB;
|
|
GB = 1024 * MB;
|
|
begin
|
|
if Speed < KB then
|
|
Result := FormatFloat('#,##0 bits/s', Speed)
|
|
else if Speed < MB then
|
|
Result := FormatFloat('#,##0.0 kB/s', Speed / KB)
|
|
else if Speed < GB then
|
|
Result := FormatFloat('#,##0.0 MB/s', Speed / MB)
|
|
else
|
|
Result := FormatFloat('#,##0.0 GB/s', Speed / GB);
|
|
end;
|
|
|
|
function GetDirSize(const ADirName: String; var AFileCnt, ADirCnt: Integer): Int64;
|
|
var
|
|
DirSize: Int64;
|
|
|
|
procedure GetSize(const ADirName: String);
|
|
var
|
|
SR: TSearchRec;
|
|
DirName: String;
|
|
begin
|
|
DirName := AppendPathDelim(ADirName);
|
|
if FindFirst(DirName + '*', faAnyFile - faDirectory, SR) = 0 then
|
|
begin
|
|
try
|
|
repeat
|
|
Inc(AFileCnt);
|
|
DirSize:= DirSize + SR.Size;
|
|
until FindNext(SR) <> 0;
|
|
finally
|
|
FindClose(SR);
|
|
end;
|
|
end;
|
|
if FindFirst(DirName + '*', faAnyFile, SR) = 0 then
|
|
begin
|
|
try
|
|
repeat
|
|
if ((SR.Attr and faDirectory) <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
|
|
begin
|
|
Inc(ADirCnt);
|
|
GetSize(DirName + SR.Name);
|
|
end;
|
|
until FindNext(SR) <> 0;
|
|
finally
|
|
FindClose(SR);
|
|
end;
|
|
end;
|
|
end;
|
|
begin
|
|
DirSize := 0;
|
|
AFileCnt := 0;
|
|
ADirCnt := 0;
|
|
GetSize(ADirName);
|
|
Result := DirSize;
|
|
end;
|
|
|
|
procedure FindPackages(const ADirName: String; APackageList: TStrings);
|
|
var
|
|
BaseDir, BasePath: String;
|
|
|
|
procedure FindFiles(const ADirName: String);
|
|
var
|
|
SR: TSearchRec;
|
|
Path: String;
|
|
PackageData: TPackageData;
|
|
begin
|
|
Path := AppendPathDelim(ADirName);
|
|
if FindFirst(Path + '*', faAnyFile - faDirectory, SR) = 0 then
|
|
begin
|
|
try
|
|
repeat
|
|
if UpperCase(ExtractFileExt(SR.Name)) = UpperCase('.lpk') then
|
|
begin
|
|
PackageData := TPackageData.Create;
|
|
PackageData.FName := SR.Name;
|
|
PackageData.FPackageBaseDir := BaseDir;
|
|
PackageData.FPackageRelativePath := StringReplace(Path, BasePath, '', [rfIgnoreCase, rfReplaceAll]);
|
|
if Trim(PackageData.FPackageRelativePath) <> '' then
|
|
begin
|
|
if PackageData.FPackageRelativePath[Length(PackageData.FPackageRelativePath)] = PathDelim then
|
|
PackageData.FPackageRelativePath := Copy(PackageData.FPackageRelativePath, 1, Length(PackageData.FPackageRelativePath) - 1);
|
|
PackageData.FPackageRelativePath := PackageData.FPackageRelativePath;
|
|
end;
|
|
PackageData.FFullPath := Path + SR.Name;
|
|
APackageList.AddObject(PackageData.FName, PackageData);
|
|
end;
|
|
until FindNext(SR) <> 0;
|
|
finally
|
|
FindClose(SR);
|
|
end;
|
|
end;
|
|
|
|
if FindFirst(Path + '*', faAnyFile, SR) = 0 then
|
|
begin
|
|
try
|
|
repeat
|
|
if ((SR.Attr and faDirectory) <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
|
|
FindFiles(Path + SR.Name);
|
|
until FindNext(SR) <> 0;
|
|
finally
|
|
FindClose(SR);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
BasePath := AppendPathDelim(ADirName);
|
|
if ADirName[Length(ADirName)] = PathDelim then
|
|
BaseDir := ExtractFileName(Copy(ADirName, 1, Length(ADirName) - 1))
|
|
else
|
|
BaseDir := ExtractFileName(ADirName);
|
|
FindFiles(ADirName);
|
|
end;
|
|
|
|
procedure FindAllFilesEx(const ADirName: String; AFileList: TStrings);
|
|
var
|
|
SLExcludedFiles: TStringList;
|
|
SLExcludedFolders: TStringList;
|
|
|
|
function IsAllowed(const AName: String; const AIsDir: Boolean): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := True;
|
|
if not AIsDir then
|
|
begin
|
|
for I := 0 to SLExcludedFiles.Count - 1 do
|
|
begin
|
|
if UpperCase(SLExcludedFiles.Strings[I]) = UpperCase(ExtractFileExt(AName)) then
|
|
begin
|
|
Result := False;
|
|
Break;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
for I := 0 to SLExcludedFolders.Count - 1 do
|
|
if UpperCase(SLExcludedFolders.Strings[I]) = UpperCase(AName) then
|
|
begin
|
|
Result := False;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure FindFiles(const ADirName: String);
|
|
var
|
|
SR: TSearchRec;
|
|
Path: String;
|
|
begin
|
|
Path := AppendPathDelim(ADirName);
|
|
if FindFirst(Path + '*', faAnyFile - faDirectory, SR) = 0 then
|
|
begin
|
|
try
|
|
repeat
|
|
if IsAllowed(SR.Name, False) then
|
|
AFileList.Add(Path + SR.Name);
|
|
until FindNext(SR) <> 0;
|
|
finally
|
|
FindClose(SR);
|
|
end;
|
|
end;
|
|
|
|
if FindFirst(Path + '*', faAnyFile, SR) = 0 then
|
|
begin
|
|
try
|
|
repeat
|
|
if ((SR.Attr and faDirectory) <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
|
|
if IsAllowed(SR.Name, True) then
|
|
FindFiles(Path + SR.Name);
|
|
until FindNext(SR) <> 0;
|
|
finally
|
|
FindClose(SR);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
I, P: Integer;
|
|
Ext: String;
|
|
begin
|
|
SLExcludedFiles := TStringList.Create;
|
|
try
|
|
SLExcludedFiles.Delimiter := ',';
|
|
SLExcludedFiles.StrictDelimiter := True;
|
|
SLExcludedFiles.DelimitedText := Options.ExcludedFiles;
|
|
for I := 0 to SLExcludedFiles.Count - 1 do
|
|
begin
|
|
P := Pos('*.', SLExcludedFiles.Strings[I]);
|
|
if P > 0 then
|
|
begin
|
|
Ext := Copy(SLExcludedFiles.Strings[I], 2, Length(SLExcludedFiles.Strings[I]));
|
|
if Trim(Ext) = '.' then
|
|
Ext := '';
|
|
end
|
|
else
|
|
Ext := '.' + SLExcludedFiles.Strings[I];
|
|
SLExcludedFiles.Strings[I] := Ext;
|
|
end;
|
|
SLExcludedFolders := TStringList.Create;
|
|
try
|
|
SLExcludedFolders.Delimiter := ',';
|
|
SLExcludedFolders.StrictDelimiter := True;
|
|
SLExcludedFolders.DelimitedText := Options.ExcludedFolders;
|
|
FindFiles(ADirName);
|
|
finally
|
|
SLExcludedFolders.Free;
|
|
end;
|
|
finally
|
|
SLExcludedFiles.Free;
|
|
end;
|
|
end;
|
|
|
|
function FixProtocol(const AURL: String): String;
|
|
begin
|
|
Result := AURL;
|
|
if (Pos('http://', Result) = 0) and (Pos('https://', Result) = 0) then
|
|
Result := 'https://' + Result;
|
|
end;
|
|
|
|
end.
|
|
|