306 lines
9.3 KiB
ObjectPascal
306 lines
9.3 KiB
ObjectPascal
{
|
|
********************************************************************************
|
|
|
|
SPackGui
|
|
Copyright (C) 2013 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
|
Copyright (C) <date> <add your name and mail address here>
|
|
|
|
http://www.geoffray-levasseur.org/
|
|
http://0.tuxfamilly.org/
|
|
|
|
This software is governed by the CeCILL license under French law and
|
|
abiding by the rules of distribution of free software. You can use,
|
|
modify and/ or redistribute the software under the terms of the CeCILL
|
|
license as circulated by CEA, CNRS and INRIA at the following URL
|
|
"http://www.cecill.info".
|
|
|
|
As a counterpart to the access to the source code and rights to copy,
|
|
modify and redistribute granted by the license, users are provided only
|
|
with a limited warranty and the software's author, the holder of the
|
|
economic rights, and the successive licensors have only limited
|
|
liability.
|
|
|
|
In this respect, the user's attention is drawn to the risks associated
|
|
with loading, using, modifying and/or developing or reproducing the
|
|
software by the user in light of its specific status of free software,
|
|
that may mean that it is complicated to manipulate, and that also
|
|
therefore means that it is reserved for developers and experienced
|
|
professionals having in-depth computer knowledge. Users are therefore
|
|
encouraged to load and test the software's suitability as regards their
|
|
requirements in conditions enabling the security of their systems and/or
|
|
data to be ensured and, more generally, to use and operate it in the
|
|
same conditions as regards security.
|
|
|
|
The fact that you are presently reading this means that you have had
|
|
knowledge of the CeCILL license and that you accept its terms.
|
|
|
|
********************************************************************************
|
|
|
|
Description:
|
|
form showing packages details
|
|
|
|
********************************************************************************
|
|
}
|
|
unit frmPackageProperty;
|
|
|
|
{$include ../common/defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
|
Buttons, ComCtrls;
|
|
|
|
type
|
|
|
|
{ TfPackageProperty }
|
|
|
|
TfPackageProperty = class(TForm)
|
|
btnDebianPatchTracker: TButton;
|
|
btnGetFileSizes: TBitBtn;
|
|
btnGoogle: TButton;
|
|
btnLFS: TButton;
|
|
btnArch: TButton;
|
|
btnDebianPackages: TButton;
|
|
btnSlackware: TButton;
|
|
btnWikipedia: TButton;
|
|
btnGentoo: TButton;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
Label4: TLabel;
|
|
Label5: TLabel;
|
|
Label6: TLabel;
|
|
Label7: TLabel;
|
|
Label8: TLabel;
|
|
lbCategory: TLabel;
|
|
lbDescription: TLabel;
|
|
lbInstalledSize: TLabel;
|
|
lbPackageSize: TLabel;
|
|
lbState1: TLabel;
|
|
lbVersion: TLabel;
|
|
lbState: TLabel;
|
|
lbPackageName: TLabel;
|
|
btnClose: TBitBtn;
|
|
lvVersionList: TListView;
|
|
lvFileList: TListView;
|
|
pcMain: TPageControl;
|
|
tsMore: TTabSheet;
|
|
tsFileList: TTabSheet;
|
|
tsProperties: TTabSheet;
|
|
procedure btnArchClick(Sender: TObject);
|
|
procedure btnDebianPackagesClick(Sender: TObject);
|
|
procedure btnDebianPatchTrackerClick(Sender: TObject);
|
|
procedure btnGentooClick(Sender: TObject);
|
|
procedure btnGetFileSizesClick(Sender: TObject);
|
|
procedure btnCloseClick(Sender: TObject);
|
|
procedure btnGoogleClick(Sender: TObject);
|
|
procedure btnLFSClick(Sender: TObject);
|
|
procedure btnSlackwareClick(Sender: TObject);
|
|
procedure btnWikipediaClick(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
procedure FormCreate(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
public
|
|
{ public declarations }
|
|
procedure LoadPackageInfo(const S: string);
|
|
end;
|
|
|
|
var
|
|
fPackageProperty: TfPackageProperty;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses
|
|
uSpackPackage, frmMain, uCommon, uIconManager, uDebug, uStrings, uDownload,
|
|
uUtils, BaseUnix;
|
|
|
|
{ TfPackageProperty }
|
|
|
|
procedure TfPackageProperty.LoadPackageInfo(const S: string);
|
|
var
|
|
I, J, Def, Inst: Integer;
|
|
LI: TListItem;
|
|
Available: Boolean;
|
|
FName: string;
|
|
Dwl: TDownloader;
|
|
FList: TStringList;
|
|
Pkg: TSPackPackage;
|
|
begin
|
|
PrintLnDbg(Format(rsInfoShowingPackageInfo, [S]), vlLow);
|
|
Available := False;
|
|
Pkg := fMain.PackageList.GetPkgFromName(S);
|
|
lbPackageName.Caption := Pkg.Name;
|
|
lbDescription.Caption := Pkg.Desc;
|
|
lbCategory.Caption := Pkg.Cat;
|
|
Inst := Pkg.GetInstalled;
|
|
Def := Pkg.GetDefaultVer;
|
|
if Inst <> 0 then
|
|
begin
|
|
lbVersion.Caption := Pkg.Alternatives[Inst].Version + '-' +
|
|
IntToStr(Pkg.Alternatives[Inst].Build);
|
|
lbInstalledSize.Caption := DispSize(Pkg.InstSize);
|
|
lbPackageSize.Caption := DispSize(Pkg.Alternatives[Inst].Size);
|
|
FList := Pkg.LoadFileList(fMain.PackageList.InstPackageDir);
|
|
for I := 0 to FList.Count - 1 do
|
|
begin
|
|
if FList[I] = './' then
|
|
Continue;
|
|
FName := FList[I];
|
|
if FName[1] <> '/' then
|
|
FName := '/' + FName;
|
|
LI := lvFileList.Items.Add;
|
|
LI.Caption := FName;
|
|
end;
|
|
FList.Free;
|
|
end else
|
|
lbDescription.Caption := rsDescNotInstalledPackage;
|
|
for I := 1 to MaxPackAlt do
|
|
if (not Pkg.Alternatives[I].Installed) and
|
|
(Pkg.Alternatives[I].Version <> '') then
|
|
begin
|
|
Available := True;
|
|
LI := lvVersionList.Items.Add;
|
|
for J := 0 to slRepoList.Count - 1 do
|
|
if Pos(Pkg.Alternatives[I].SourceAddress, slRepoList[J]) <> 0 then
|
|
LI.Caption := Copy(slRepoList[J], 1, Pos('=', slRepoList[J]) - 1);
|
|
LI.SubItems.Add(Pkg.Alternatives[I].Version + '-' +
|
|
IntToStr(Pkg.Alternatives[I].Build));
|
|
LI.SubItems.Add(DispSize(Pkg.Alternatives[I].Size));
|
|
LI.SubItems.Add(Pkg.Alternatives[I].SourceAddress);
|
|
if (Pos(sHttpPrefix, Pkg.Alternatives[I].SourceAddress) <> 0) or
|
|
(Pos(sFtpPrefix, Pkg.Alternatives[I].SourceAddress) <> 0) then
|
|
begin
|
|
Dwl := TDownloader.Create;
|
|
Dwl.URL := Pkg.Alternatives[I].SourceAddress + '/' + Pkg.Cat + '/' +
|
|
Pkg.Name + '-' + Pkg.Alternatives[I].Version + '-' + sArch + '-' +
|
|
IntToStr(Pkg.Alternatives[I].Build) + LowerCase(rsSpackExt);
|
|
if bUnitsAreDecimal then
|
|
LI.SubItems[1] := DispSize(Dwl.FileSize)
|
|
else
|
|
LI.SubItems[1] := DispSize(Dwl.FileSize);
|
|
Dwl.Free;
|
|
end else
|
|
LI.SubItems.Add(DispSize(Pkg.Alternatives[I].Size));
|
|
end;
|
|
if psInstalled in Pkg.State then
|
|
lbState.Caption := rsStateInstalled
|
|
else
|
|
begin
|
|
lbState.Caption := rsStateNotInstalled;
|
|
lbState1.Caption := ''; //overload upgradable status
|
|
end;
|
|
if Available then
|
|
lbState.Caption := lbState.Caption + ', ' + rsStateAvailable;
|
|
if psDeprecated in Pkg.State then
|
|
lbState1.Caption := rsStateDeprecated
|
|
else
|
|
if psUpdatable in Pkg.State then
|
|
lbState1.Caption := Format(rsStateUpgradable,
|
|
[Pkg.Alternatives[Pkg.GetDefaultVer].Version]);
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnCloseClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnGoogleClick(Sender: TObject);
|
|
begin
|
|
OpenURL(Format(rsGoogleSearch, [lbPackageName.Caption]));
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnLFSClick(Sender: TObject);
|
|
begin
|
|
OpenURL(rsLFSSearch + lbPackageName.Caption);
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnSlackwareClick(Sender: TObject);
|
|
begin
|
|
OpenURL(Format(rsSlackwareSearch, [lbPackageName.Caption]));
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnWikipediaClick(Sender: TObject);
|
|
begin
|
|
OpenURL(Format(rsWikipediaSearch, [lbPackageName.Caption]));
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnDebianPackagesClick(Sender: TObject);
|
|
begin
|
|
OpenURL(Format(rsDebianSearch, [lbPackageName.Caption]));
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnDebianPatchTrackerClick(Sender: TObject);
|
|
begin
|
|
OpenURL(Format(rsDebianPatchTracker, [lbPackageName.Caption]));
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnGentooClick(Sender: TObject);
|
|
begin
|
|
OpenURL(Format(rsGentooSearch, [lbPackageName.Caption]));
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnArchClick(Sender: TObject);
|
|
begin
|
|
OpenURL(Format(rsArchSearch, [lbPackageName.Caption]));
|
|
end;
|
|
|
|
procedure TfPackageProperty.FormClose(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
begin
|
|
try
|
|
SaveWindowGeometry(Self);
|
|
except
|
|
PrintLnDbg(rsErrorCannotSaveConf, vlLow);
|
|
end;
|
|
end;
|
|
|
|
procedure TfPackageProperty.btnGetFileSizesClick(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
FStat: stat;
|
|
begin
|
|
for I := 0 to lvFileList.Items.Count - 1 do
|
|
begin
|
|
if lvFileList.Items[I].SubItems.Count = 0 then
|
|
lvFileList.Items[I].SubItems.Add('');
|
|
if FileExists(lvFileList.Items[I].Caption) then
|
|
begin
|
|
FpStat(lvFileList.Items[I].Caption, FStat);
|
|
if FStat.st_mode = S_IFLNK then
|
|
lvFileList.Items[I].SubItems[0] := rsSymlink
|
|
else
|
|
if (FStat.st_mode = S_IFDIR) or
|
|
(DirectoryExists(lvFileList.Items[I].Caption)) then
|
|
lvFileList.Items[I].SubItems[0] := rsDirectory
|
|
else
|
|
lvFileList.Items[I].SubItems[0] := DispSize(FileSize(lvFileList.Items[I].Caption));
|
|
end else
|
|
lvFileList.Items[I].SubItems[0] := rsNotFound;
|
|
Application.ProcessMessages;
|
|
end;
|
|
end;
|
|
|
|
procedure TfPackageProperty.FormCreate(Sender: TObject);
|
|
begin
|
|
pcMain.ActivePageIndex := 0;
|
|
btnClose.Tag := icClose;
|
|
btnGetFileSizes.Tag := icRefresh;
|
|
LoadWindowGeometry(Self);
|
|
InitBtnGlyphs(Self);
|
|
lbPackageName.Caption := rsUnknowPackage;
|
|
lbDescription.Caption := '';
|
|
lbState.Caption := rsStateNotInstalled;
|
|
lbVersion.Caption := rsStateNotInstalled;
|
|
lbPackageSize.Caption := DispSize(0);
|
|
lbInstalledSize.Caption := DispSize(0);
|
|
lbState1.Caption := '';
|
|
end;
|
|
|
|
|
|
end.
|
|
|