495 lines
13 KiB
Plaintext
495 lines
13 KiB
Plaintext
unit FInstallList;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
|
||
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees,
|
||
Tocsg.AppInfo, System.ImageList, Vcl.ImgList, Vcl.Menus, Vcl.ExtCtrls;
|
||
|
||
type
|
||
PInstEnt = ^TInstEnt;
|
||
TInstEnt = record
|
||
Info: PInstAppEnt;
|
||
nImgIdx: Integer;
|
||
end;
|
||
|
||
PIExeEnt = ^TIExeEnt;
|
||
TIExeEnt = record
|
||
sInfo: String;
|
||
end;
|
||
|
||
TFrmInstallList = class(TFrame)
|
||
vtList: TVirtualStringTree;
|
||
imgList: TImageList;
|
||
popFun: TPopupMenu;
|
||
miRefresh: TMenuItem;
|
||
N2: TMenuItem;
|
||
miRemove: TMenuItem;
|
||
miCopyCB: TMenuItem;
|
||
N3: TMenuItem;
|
||
miFilter: TMenuItem;
|
||
miExport: TMenuItem;
|
||
SaveDialog: TSaveDialog;
|
||
vtExe: TVirtualStringTree;
|
||
Splitter1: TSplitter;
|
||
N1: TMenuItem;
|
||
miExportIcon: TMenuItem;
|
||
FileOpenDialog: TFileOpenDialog;
|
||
procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||
procedure vtListHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
|
||
procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
|
||
var HintText: string);
|
||
procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
||
procedure vtListGetImageIndexEx(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||
var Ghosted: Boolean; var ImageIndex: TImageIndex;
|
||
var ImageList: TCustomImageList);
|
||
procedure vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
|
||
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
|
||
procedure miRefreshClick(Sender: TObject);
|
||
procedure vtListContextPopup(Sender: TObject; MousePos: TPoint;
|
||
var Handled: Boolean);
|
||
procedure miRemoveClick(Sender: TObject);
|
||
procedure miCopyCBClick(Sender: TObject);
|
||
procedure miFilterClick(Sender: TObject);
|
||
procedure popFunPopup(Sender: TObject);
|
||
procedure miExportClick(Sender: TObject);
|
||
procedure vtListFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex);
|
||
procedure vtExeGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
procedure vtExeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
||
procedure vtExeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||
procedure miExportIconClick(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
FileImageList_,
|
||
FileImageListLg_: TImageList;
|
||
InstList_: TTgInstAppList;
|
||
procedure RefreshExe(pData: PInstEnt);
|
||
public
|
||
{ Public declarations }
|
||
Constructor Create(aOwner: TComponent); override;
|
||
Destructor Destroy; override;
|
||
procedure RefreshList;
|
||
end;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.Shell, VirtualTrees.Types, Tocsg.VirtualTreeViewUtil, Tocsg.Safe,
|
||
System.DateUtils, Tocsg.Strings, Define, VirtualTrees.Filter, superobject,
|
||
Tocsg.Path;
|
||
|
||
{$R *.dfm}
|
||
|
||
Constructor TFrmInstallList.Create(aOwner: TComponent);
|
||
|
||
procedure InitCtrls;
|
||
var
|
||
hSysIcons: THandle;
|
||
begin
|
||
FileImageList_ := TImageList.Create(Self);
|
||
FileImageList_.ShareImages := true;
|
||
FileImageList_.BlendColor := clHighlight;
|
||
hSysIcons := GetShellImageHandle;
|
||
if hSysIcons <> 0 then
|
||
begin
|
||
FileImageList_.Handle := hSysIcons;
|
||
vtList.Images := FileImageList_;
|
||
end;
|
||
|
||
FileImageListLg_ := TImageList.Create(Self);
|
||
FileImageListLg_.ShareImages := true;
|
||
FileImageListLg_.BlendColor := clHighlight;
|
||
hSysIcons := GetShellImageHandle(false);
|
||
if hSysIcons <> 0 then
|
||
FileImageListLg_.Handle := hSysIcons;
|
||
end;
|
||
|
||
begin
|
||
Inherited Create(aOwner);
|
||
InitCtrls;
|
||
InstList_ := TTgInstAppList.Create;
|
||
RefreshList;
|
||
end;
|
||
|
||
Destructor TFrmInstallList.Destroy;
|
||
begin
|
||
FreeAndNil(InstList_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TFrmInstallList.miRefreshClick(Sender: TObject);
|
||
begin
|
||
RefreshList;
|
||
end;
|
||
|
||
procedure TFrmInstallList.miRemoveClick(Sender: TObject);
|
||
var
|
||
pData: PInstEnt;
|
||
StrList: TStringList;
|
||
sTemp,
|
||
sParam: String;
|
||
i: Integer;
|
||
begin
|
||
pData := VT_Get1SelNodeData(vtList);
|
||
if pData = nil then
|
||
exit;
|
||
|
||
Guard(StrList, TStringList.Create);
|
||
if pData.Info.sUninstStr.Contains('.exe') then
|
||
SplitString(pData.Info.sUninstStr, '.exe', StrList)
|
||
else
|
||
SplitString(pData.Info.sUninstStr, '.EXE', StrList);
|
||
case StrList.Count of
|
||
0 :
|
||
begin
|
||
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.'), APP_TITLE, MB_ICONWARNING or MB_OK);
|
||
exit;
|
||
end;
|
||
1 : ExecutePath(pData.Info.sUninstStr);
|
||
else begin
|
||
sParam := '';
|
||
for i := 1 to StrList.Count - 1 do
|
||
begin
|
||
sTemp := StrList[i];
|
||
if StrList[i].StartsWith('" ') then
|
||
Delete(sTemp, 1, 2);
|
||
SumString(sParam, sTemp, ' ');
|
||
end;
|
||
|
||
sTemp := StrList[0] + '.exe';
|
||
if sTemp[1] = '"' then
|
||
sTemp := sTemp + '"';
|
||
ExecutePath(sTemp, sParam);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmInstallList.popFunPopup(Sender: TObject);
|
||
begin
|
||
miFilter.Checked := vtList.GetFilterEditCtrl <> nil;
|
||
end;
|
||
|
||
procedure TFrmInstallList.miCopyCBClick(Sender: TObject);
|
||
begin
|
||
if VT_CopyToClipboardSelectedInfo(vtList) = 0 then
|
||
MessageBox(Handle, PChar('Ŭ<><C5AC><EFBFBD><EFBFBD><EFBFBD>忡 <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), APP_TITLE, MB_ICONINFORMATION or MB_OK);
|
||
end;
|
||
|
||
procedure TFrmInstallList.miExportClick(Sender: TObject);
|
||
var
|
||
InstList: TTgInstAppList;
|
||
O: ISuperObject;
|
||
begin
|
||
if vtList.RootNodeCount = 0 then
|
||
begin
|
||
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD>α<CEB1> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), APP_TITLE, MB_ICONWARNING or MB_OK);
|
||
exit;
|
||
end;
|
||
|
||
SaveDialog.FileName := '';
|
||
if SaveDialog.Execute(Handle) then
|
||
begin
|
||
Guard(InstList, TTgInstAppList.Create);
|
||
InstList.UpdateInstAppList;
|
||
|
||
O := SO;
|
||
O.O['InstList'] := InstList.ToJsonObjHE;
|
||
SaveJsonObjToFile(O, SaveDialog.FileName);
|
||
MessageBox(Handle, PChar('<27><><EFBFBD>α<CEB1> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>⸦ <20>Ϸ<EFBFBD><CFB7>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), APP_TITLE, MB_ICONINFORMATION or MB_OK);
|
||
end;
|
||
end;
|
||
|
||
const
|
||
PixelsQuad = MaxInt div SizeOf(TRGBQuad) - 1;
|
||
|
||
type
|
||
TRGBAArray = Array [0..PixelsQuad - 1] of TRGBQuad;
|
||
PRGBAArray = ^TRGBAArray;
|
||
|
||
procedure TFrmInstallList.miExportIconClick(Sender: TObject);
|
||
var
|
||
pNode: PVirtualNode;
|
||
pData: PInstEnt;
|
||
bmp: TBitmap;
|
||
X, Y: Integer;
|
||
RowInOut: PRGBAArray;
|
||
begin
|
||
pNode := vtList.GetFirstSelected;
|
||
if pNode = nil then
|
||
exit;
|
||
|
||
FileOpenDialog.FileName := '';
|
||
FileOpenDialog.DefaultFolder := GetDesktopDir;
|
||
if FileOpenDialog.Execute then
|
||
begin
|
||
Guard(bmp, TBitmap.Create);
|
||
bmp.SetSize(FileImageListLg_.Width, FileImageListLg_.Height);
|
||
bmp.PixelFormat := pf32bit;
|
||
while pNode <> nil do
|
||
begin
|
||
pData := vtList.GetNodeData(pNode);
|
||
if pData.nImgIdx <> -1 then
|
||
begin
|
||
// for Y := 0 to bmp.Height - 1 do
|
||
// begin
|
||
// RowInOut := bmp.ScanLine[Y];
|
||
// for X := 0 to bmp.Width - 1 do
|
||
// RowInOut[X].rgbReserved := 0;
|
||
// end;
|
||
// bmp.AlphaFormat := afDefined;
|
||
|
||
FileImageListLg_.Draw(bmp.Canvas, 0, 0, pData.nImgIdx, true);
|
||
// bmp.AlphaFormat := afIgnored;
|
||
bmp.SaveToFile(IncludeTrailingBackslash(FileOpenDialog.FileName) + pData.Info.sName + '.bmp');
|
||
end;
|
||
pNode := vtList.GetNextSelected(pNode);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmInstallList.miFilterClick(Sender: TObject);
|
||
begin
|
||
if miFilter.Checked then
|
||
vtList.DestroyFilterEdit
|
||
else
|
||
vtList.CreateFilterEdit;
|
||
end;
|
||
|
||
procedure TFrmInstallList.RefreshList;
|
||
var
|
||
i: Integer;
|
||
pData: PInstEnt;
|
||
begin
|
||
vtList.BeginUpdate;
|
||
try
|
||
VT_Clear(vtList);
|
||
InstList_.UpdateInstAppList;
|
||
|
||
for i := 0 to InstList_.Count - 1 do
|
||
begin
|
||
pData := VT_AddChildData(vtList);
|
||
pData.Info := InstList_[i];
|
||
pData.nImgIdx := -1;
|
||
end;
|
||
VT_SortAll(vtList, 1, sdDescending);
|
||
finally
|
||
vtList.EndUpdate;
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtExeFreeNode(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode);
|
||
var
|
||
pData: PIExeEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
Finalize(pData^);
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtExeGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
begin
|
||
NodeDataSize := SizeOf(TIExeEnt);
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtExeGetText(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||
var CellText: string);
|
||
var
|
||
pData: PIExeEnt;
|
||
begin
|
||
if Column = 0 then
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
CellText := pData.sInfo;
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
|
||
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
|
||
var
|
||
pData1, pData2: PInstEnt;
|
||
begin
|
||
if Column = 1 then
|
||
begin
|
||
pData1 := Sender.GetNodeData(Node1);
|
||
pData2 := Sender.GetNodeData(Node2);
|
||
|
||
Result := CompareDateTime(pData1.Info.dtInst, pData2.Info.dtInst);
|
||
end else
|
||
Result := CompareText(vtList.Text[Node1, Column], vtList.Text[Node2, Column]);
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtListContextPopup(Sender: TObject; MousePos: TPoint;
|
||
var Handled: Boolean);
|
||
begin
|
||
miRemove.Visible := vtList.GetNodeAt(MousePos) <> nil;
|
||
miCopyCB.Visible := miRemove.Visible;
|
||
end;
|
||
|
||
procedure TFrmInstallList.RefreshExe(pData: PInstEnt);
|
||
|
||
function AddIExeInfo(pParent: PVirtualNode; sInfo: String): PVirtualNode;
|
||
var
|
||
pData: PIExeEnt;
|
||
begin
|
||
pData := VT_AddChildDataN(vtExe, Result, pParent);
|
||
pData.sInfo := sInfo;
|
||
end;
|
||
|
||
var
|
||
i, c: Integer;
|
||
pNode: PVirtualNode;
|
||
begin
|
||
vtExe.BeginUpdate;
|
||
try
|
||
VT_Clear(vtExe);
|
||
|
||
for i := 0 to pData.Info.InstExeList.Count - 1 do
|
||
begin
|
||
pNode := AddIExeInfo(nil, pData.Info.InstExeList[i].FileName);
|
||
AddIExeInfo(pNode, '<27><><EFBFBD><EFBFBD> Ƚ<><C8BD> : ' + IntToStr(pData.Info.InstExeList[i].RunCount));
|
||
for c := 0 to pData.Info.InstExeList[i].ExeDtList.Count - 1 do
|
||
AddIExeInfo(pNode, DateTimeToStr(pData.Info.InstExeList[i].ExeDtList[c]));
|
||
end;
|
||
|
||
VT_ExpandAll(vtExe, true);
|
||
finally
|
||
vtExe.EndUpdate;
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtListFocusChanged(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex);
|
||
var
|
||
pData: PInstEnt;
|
||
begin
|
||
if Node = nil then
|
||
exit;
|
||
|
||
RefreshExe(Sender.GetNodeData(Node));
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtListFreeNode(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode);
|
||
var
|
||
pData: PInstEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
Finalize(pData^);
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtListGetHint(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex;
|
||
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
|
||
begin
|
||
HintText := vtList.Text[Node, Column];
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtListGetImageIndexEx(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||
var Ghosted: Boolean; var ImageIndex: TImageIndex;
|
||
var ImageList: TCustomImageList);
|
||
var
|
||
pData: PInstEnt;
|
||
begin
|
||
case Kind of
|
||
ikNormal,
|
||
ikSelected:
|
||
begin
|
||
if Column = 2 then
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
if pData.nImgIdx = -1 then
|
||
pData.nImgIdx := GetShellImageIndex_path(pData.Info.sIconPath);
|
||
|
||
if pData.nImgIdx = 0 then
|
||
ImageList := imgList
|
||
else
|
||
ImageList := FileImageList_;
|
||
ImageIndex := pData.nImgIdx;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
begin
|
||
NodeDataSize := SizeOf(TInstEnt);
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtListGetText(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||
var CellText: string);
|
||
var
|
||
pData: PInstEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
|
||
case Column of
|
||
0 : CellText := IntToStr(Node.Index + 1);
|
||
1 : CellText := DateTimeToStr(pData.Info.dtInst);
|
||
2 : CellText := pData.Info.sName;
|
||
3 : CellText := pData.Info.sVersion;
|
||
4 : CellText := pData.Info.sPublisher;
|
||
5 : if pData.Info.InstExeList <> nil then CellText := pData.Info.InstExeList.GetExeFiles;
|
||
6 : if pData.Info.InstExeList <> nil then CellText := IntToStr(pData.Info.InstExeList.GetRunCount);
|
||
7 : CellText := pData.Info.sCopyright;
|
||
8 : CellText := pData.Info.sDescription;
|
||
9 : CellText := pData.Info.sUrlInfo;
|
||
10 : CellText := pData.Info.sInstDir;
|
||
end;
|
||
end;
|
||
|
||
procedure TFrmInstallList.vtListHeaderClick(Sender: TVTHeader;
|
||
HitInfo: TVTHeaderHitInfo);
|
||
begin
|
||
if HitInfo.Button = mbLeft then
|
||
begin
|
||
if HitInfo.Column < 0 then
|
||
exit;
|
||
|
||
with Sender, Treeview do
|
||
begin
|
||
if SortColumn > NoColumn then
|
||
Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor];
|
||
|
||
if HitInfo.Column = 0 then
|
||
SortColumn := NoColumn
|
||
else
|
||
begin
|
||
if (SortColumn = NoColumn) or (SortColumn <> HitInfo.Column) then
|
||
begin
|
||
SortColumn := HitInfo.Column;
|
||
SortDirection := sdAscending;
|
||
end else
|
||
if SortDirection = sdAscending then
|
||
SortDirection := sdDescending
|
||
else
|
||
SortDirection := sdAscending;
|
||
|
||
Columns[SortColumn].Color := $00EFEFEF;
|
||
|
||
vtList.BeginUpdate;
|
||
try
|
||
vtList.SortTree(SortColumn, SortDirection, False);
|
||
finally
|
||
vtList.EndUpdate;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
end.
|