Componentes.Terceros.jcl/official/1.100/devtools/PackagesCheck/MainForm.pas

525 lines
20 KiB
ObjectPascal

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: MainForm.pas, released on 2006-02-20.
The Initial Developer of the Original Code is Florent Ouchet [ouchet dott florent att laposte dott net]
Portions created by Florent Ouchet are Copyright (C) 2006 Florent Ouchet.
All Rights Reserved.
Contributor(s):
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
Known Issues:
-----------------------------------------------------------------------------}
// $Id: MainForm.pas 10610 2006-05-19 13:35:08Z elahn $
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls,
JvSimpleXml, TargetInfo, JvComponentBase, JvDualList;
type
TPackageCheckForm = class(TForm)
ButtonTargetDefines: TButton;
StatusBar: TStatusBar;
ComboBoxModel: TComboBox;
LabelModel: TLabel;
MemoMessages: TMemo;
JvDualListDialogSelect: TJvDualListDialog;
ButtonGo: TButton;
CheckBoxCLX: TCheckBox;
CheckBoxHaltOnError: TCheckBox;
procedure ButtonTargetDefinesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ButtonGoClick(Sender: TObject);
private
FXMLFileName: string;
FTargetsInfo: TTargetsInfo;
FSettings: TJvSimpleXml;
FPGSettings: TJvSimpleXml;
public
end;
var
PackageCheckForm: TPackageCheckForm;
implementation
{$R *.dfm}
uses
DefineForm, UsesParser,
JclFileUtils, JclStrings,
PackageInformation;
procedure TPackageCheckForm.ButtonGoClick(Sender: TObject);
var
PackageList, TargetList, AliasList: TStringList;
PackagePath: string;
function IsIncluded(TargetName: string; Tokens: string): Boolean;
var
IndexToken, IndexAlias: Integer;
TokenStrings: TStringList;
begin
if Tokens = 'all' then
begin
Result := True;
Exit;
end;
TokenStrings := TStringList.Create;
try
TokenStrings.CaseSensitive := False;
TokenStrings.QuoteChar := '"';
TokenStrings.Delimiter := ',';
TokenStrings.DelimitedText := Tokens;
for IndexToken := 0 to TokenStrings.Count - 1 do
begin
IndexAlias := AliasList.IndexOfName(TokenStrings.Strings[IndexToken]);
if IndexAlias >= 0 then
TokenStrings.Strings[IndexToken] := Copy(AliasList[IndexAlias], Length(TokenStrings.Strings[IndexToken]) + 2, MaxInt);
end;
Tokens := TokenStrings.DelimitedText;
Tokens := StrRemoveChars(Tokens, ['"']);
TokenStrings.DelimitedText := Tokens;
for IndexToken := 0 to TokenStrings.Count - 1 do
if TargetList.IndexOf(TokenStrings.Strings[IndexToken]) = -1 then
MemoMessages.Lines.Add(Format('Unknown targetname %s', [TokenStrings.Strings[IndexToken]]));
Result := TokenStrings.IndexOf(TargetName) >= 0;
finally
TokenStrings.Free;
end;
end;
procedure BuildRequireList(const PackageInfo: TPackageXmlInfo;
const TargetName: string; RequiredList: TStringList);
var
IndexRequire: Integer;
ARequiredPackage: TRequiredPackage;
IndexJVCLPackage: Integer;
begin
for IndexRequire := 0 to PackageInfo.RequireCount - 1 do
begin
ARequiredPackage := PackageInfo.Requires[IndexRequire];
if IsIncluded(TargetName, ARequiredPackage.Targets.CommaText) then
begin
if RequiredList.IndexOf(ARequiredPackage.Name) = -1 then
RequiredList.Add(ARequiredPackage.Name);
IndexJVCLPackage := PackageList.IndexOf(ARequiredPackage.Name);
if IndexJVCLPackage >= 0 then
BuildRequireList(TPackageXmlInfo(PackageList.Objects[IndexJVCLPackage]),
TargetName, RequiredList);
end;
end;
end;
procedure CheckPackageTarget(const PackageInfo: TPackageXmlInfo;
const TargetName: string);
var
KnownUnits, IncludeDirs, PackageUsesList, DefinedSymbols, DependencyList: TStringList;
IndexTarget, IndexRequire, IndexContained, IndexUnit, IndexJVCLPackage,
IndexTargetPackage, IndexInclude, NbContained: Integer;
ARequiredPackage: TRequiredPackage;
AContainedFile: TContainedFile;
ATargetInfo: TTargetInfo;
BPackageInfo: TPackageXmlInfo;
ATargetPackage: TTargetPackage;
AUsesParser: TUsesParser;
UnitFileName, RequiredPackageName: string;
RequiredPackageUsed: Boolean;
begin
StatusBar.SimpleText := Format('Checking package %s for target %s', [PackageInfo.Name, TargetName]);
IndexTarget := FTargetsInfo.IndexOf(TargetName);
if IndexTarget >= 0 then
ATargetInfo := FTargetsInfo.Infos[IndexTarget]
else
ATargetInfo := nil;
KnownUnits := TStringList.Create;
KnownUnits.CaseSensitive := False;
IncludeDirs := TStringList.Create;
IncludeDirs.CaseSensitive := False;
PackageUsesList := TStringList.Create;
PackageUsesList.CaseSensitive := False;
DefinedSymbols := TStringList.Create;
DefinedSymbols.CaseSensitive := False;
DependencyList := TStringList.Create;
DependencyList.CaseSensitive := False;
try
// build list of required packages for dependency
for IndexRequire := 0 to PackageInfo.RequireCount - 1 do
begin
ARequiredPackage := PackageInfo.Requires[IndexRequire];
IndexJVCLPackage := PackageList.IndexOf(ARequiredPackage.Name);
if IsIncluded(TargetName, ARequiredPackage.Targets.CommaText)
and (IndexJVCLPackage >= 0) then
BuildRequireList(TPackageXmlInfo(PackageList.Objects[IndexJVCLPackage]),
TargetName, DependencyList);
end;
// check that all required packages are part of the current package
for IndexContained := 0 to DependencyList.Count - 1 do
begin
RequiredPackageName := DependencyList.Strings[IndexContained];
RequiredPackageUsed := False;
for IndexRequire := 0 to PackageInfo.RequireCount - 1 do
begin
ARequiredPackage := PackageInfo.Requires[IndexRequire];
if SameText(RequiredPackageName, ARequiredPackage.Name)
and IsIncluded(TargetName, ARequiredPackage.Targets.CommaText) then
begin
RequiredPackageUsed := True;
Break;
end;
end;
//if not RequiredPackageUsed then
// MemoMessages.Lines.Add(Format('Package %s need package %s for dependency', [PackageInfo.Name, RequiredPackageName]));
end;
// build list of unit contained in required packages
for IndexRequire := 0 to PackageInfo.RequireCount - 1 do
begin
ARequiredPackage := PackageInfo.Requires[IndexRequire];
if IsIncluded(TargetName, ARequiredPackage.Targets.CommaText) then
begin
IndexJVCLPackage := PackageList.IndexOf(ARequiredPackage.Name);
if IndexJVCLPackage >= 0 then
begin
// package is found in the jvcl
BPackageInfo := TPackageXmlInfo(PackageList.Objects[IndexJVCLPackage]);
for IndexUnit := 0 to BPackageInfo.ContainCount - 1 do
begin
AContainedFile := BPackageInfo.Contains[IndexUnit];
if SameText(ExtractFileExt(AContainedFile.Name), '.pas')
and IsIncluded(TargetName, AContainedFile.Targets.CommaText) then
KnownUnits.AddObject(PathExtractFileNameNoExt(AContainedFile.Name), TObject(IndexRequire));
end;
end
else if Assigned(ATargetInfo) then
begin
IndexTargetPackage := ATargetInfo.IndexOf(ARequiredPackage.Name);
if IndexTargetPackage >= 0 then
begin
// package is found in the dependencies (rtl, vcl, jcl...)
ATargetPackage := ATargetInfo.Packages[IndexTargetPackage];
for IndexUnit := 0 to ATargetPackage.UnitCount - 1 do
KnownUnits.AddObject(ATargetPackage.Units[IndexUnit], TObject(IndexRequire));
end
else
MemoMessages.Lines.Add(Format('Processing package %s for target %s, unable to find required package %s',
[PackageInfo.Name, TargetName, ARequiredPackage.Name]));
end
else
MemoMessages.Lines.Add(Format('Processing package %s for target %s, unable to find required package %s',
[PackageInfo.Name, TargetName, ARequiredPackage.Name]));
end;
end;
// add unit contained in this package
for IndexUnit := 0 to PackageInfo.ContainCount - 1 do
begin
AContainedFile := PackageInfo.Contains[IndexUnit];
if SameText(ExtractFileExt(AContainedFile.Name), '.pas')
and IsIncluded(TargetName, AContainedFile.Targets.CommaText) then
KnownUnits.AddObject(PathExtractFileNameNoExt(AContainedFile.Name), TObject(-1));
end;
DefinedSymbols.Clear;
IncludeDirs.Clear;
if Assigned(ATargetInfo) then
begin
DefinedSymbols.Assign(ATargetInfo.Defines);
for IndexInclude := 0 to ATargetInfo.IncludeDirs.Count - 1 do
if PathIsAbsolute(ATargetInfo.IncludeDirs.Strings[IndexInclude]) then
IncludeDirs.Add(ATargetInfo.IncludeDirs.Strings[IndexInclude])
else
IncludeDirs.Add(PathCanonicalize(PackagePath + TargetName + '\' + ATargetInfo.IncludeDirs.Strings[IndexInclude]));
end;
// parse all contained units and check for unsatisfied uses
AUsesParser := TUsesParser.Create;
try
NbContained := 0;
for IndexContained := 0 to PackageInfo.ContainCount - 1 do
begin
AContainedFile := PackageInfo.Contains[IndexContained];
if IsIncluded(TargetName, AContainedFile.Targets.CommaText) then
begin
UnitFileName := AContainedFile.Name;
StatusBar.SimpleText := Format('Parsing unit %s of package %s for target %s',
[PathExtractFileNameNoExt(UnitFileName), PackageInfo.Name, TargetName]);
if SameText(ExtractFileExt(UnitFileName), '.pas') then
begin
Inc(NbContained);
UnitFileName := Format('%s%s\%s', [PackagePath, TargetName, UnitFileName]);
UnitFileName := PathCanonicalize(UnitFileName);
if AUsesParser.LoadFromFile(UnitFileName) then
begin
AUsesParser.Defines := DefinedSymbols;
AUsesParser.IncludeDirs := IncludeDirs;
AUsesParser.UsesList.Clear;
if AUsesParser.ParseUses then
begin
for IndexUnit := 0 to AUsesParser.UsesList.Count - 1 do
if KnownUnits.IndexOf(AUsesParser.UsesList.Strings[IndexUnit]) < 0 then
MemoMessages.Lines.Add(Format('Parsing unit %s: unable to find unit %s of package %s for target %s', [PathExtractFileNameNoExt(UnitFileName), AUsesParser.UsesList.Strings[IndexUnit], PackageInfo.Name, TargetName]));
PackageUsesList.AddStrings(AUsesParser.UsesList);
end
else
MemoMessages.Lines.Add(Format('Unable to parse unit %s of package %s for target %s', [PathExtractFileNameNoExt(UnitFileName), PackageInfo.Name, TargetName]));
end
else
MemoMessages.Lines.Add(Format('Processing package %s for target %s, unable to locate file %s', [PackageInfo.Name, TargetName, UnitFileName]));
end;
end;
end;
finally
AUsesParser.Free;
end;
// find required packages that were not used and not needed for dependency
if NbContained > 0 then
for IndexRequire := 0 to PackageInfo.RequireCount - 1 do
begin
ARequiredPackage := PackageInfo.Requires[IndexRequire];
if (DependencyList.IndexOf(ARequiredPackage.Name) = -1)
and IsIncluded(TargetName, ARequiredPackage.Targets.CommaText) then
begin
RequiredPackageUsed := False;
for IndexUnit := 0 to KnownUnits.Count - 1 do
if Integer(KnownUnits.Objects[IndexUnit]) = IndexRequire then
begin
RequiredPackageUsed := RequiredPackageUsed or (PackageUsesList.IndexOf(KnownUnits.Strings[IndexUnit]) >= 0);
if RequiredPackageUsed then
Break;
end;
if not RequiredPackageUsed then
MemoMessages.Lines.Add(Format('Package %s on target %s doesn''t use any unit of package %s', [PackageInfo.Name,TargetName,PackageInfo.Requires[IndexRequire].Name]));
end;
end;
finally
KnownUnits.Free;
IncludeDirs.Free;
PackageUsesList.Free;
DefinedSymbols.Free;
DependencyList.Free;
end;
end;
procedure CheckPackage(const PackageInfo: TPackageXmlInfo);
var
IndexTarget: Integer;
TargetName: string;
IsClx: Boolean;
begin
if (MemoMessages.Lines.Count <> 0) and CheckBoxHaltOnError.Checked then
Exit;
for IndexTarget := 0 to TargetList.Count - 1 do
begin
TargetName := TargetList.Strings[IndexTarget];
IsClx := TargetList.Objects[IndexTarget] <> nil;
if (not IsClx) or CheckBoxCLX.Checked then
CheckPackageTarget(PackageInfo, TargetName);
end;
end;
var
IndexPackage, IndexTarget, IndexAlias, IndexList: Integer;
ModelsNode, ModelNode, TargetsNode, TargetNode, AliasesNode, AliasNode,
GUINode, SelectedPackageNode: TJvSimpleXMLElem;
APackageXmlInfo: TPackageXmlInfo;
PackageName: string;
IsClx: Boolean;
PersonalProperty, IsClxProperty: TJvSimpleXMLProp;
begin
if ComboBoxModel.ItemIndex < 0 then
Exit;
MemoMessages.Clear;
ModelsNode := FPGSettings.Root.Items.ItemNamed['MODELS'];
ModelNode := ModelsNode.Items.Item[ComboboxModel.ItemIndex];
PackagePath := PathAddSeparator(ExtractFilePath(Application.ExeName))
+ ModelNode.Properties.ItemNamed['PACKAGES'].Value;
PackagePath := PathAddSeparator(PathCanonicalize(PackagePath));
GUINode := FSettings.Root.Items.ItemNamed['GUI'];
SelectedPackageNode := GUINode.Items.ItemNamed['SELECTED'];
PackageList := TStringList.Create;
PackageList.CaseSensitive := False;
TargetList := TStringList.Create;
TargetList.CaseSensitive := False;
AliasList := TStringList.Create;
AliasList.CaseSensitive := False;
try
TargetsNode := ModelNode.Items.ItemNamed['TARGETS'];
for IndexTarget := 0 to TargetsNode.Items.Count - 1 do
begin
TargetNode := TargetsNode.Items.Item[IndexTarget];
IsClxProperty := TargetNode.Properties.ItemNamed['ISCLX'];
IsClx := Assigned(IsClxProperty) and (IsClxProperty.IntValue = 1);
IndexList := TargetList.Add(TargetNode.Properties.ItemNamed['NAME'].Value);
if IsClx then
TargetList.Objects[IndexList] := TObject(1);
PersonalProperty := TargetNode.Properties.ItemNamed['PNAME'];
if Assigned(PersonalProperty) then
begin
IndexList := TargetList.Add(PersonalProperty.Value);
if IsClx then
TargetList.Objects[IndexList] := TObject(1);
end;
end;
AliasesNode := ModelNode.Items.ItemNamed['ALIASES'];
for IndexAlias := 0 to AliasesNode.Items.Count - 1 do
begin
AliasNode := AliasesNode.Items.Item[IndexAlias];
AliasList.Values[AliasNode.Properties.ItemNamed['NAME'].Value] := AliasNode.Properties.ItemNamed['VALUE'].Value;
end;
JvDualListDialogSelect.List1.Clear;
JvDualListDialogSelect.List2.Clear;
BuildFileList(PackagePath + 'xml\*.xml', faAnyFile and not faDirectory, PackageList);
for IndexPackage := 0 to PackageList.Count - 1 do
begin
APackageXmlInfo := TPackageXmlInfo.Create(PackagePath + 'xml\' + PackageList.Strings[IndexPackage]);
PackageList.Objects[IndexPackage] := APackageXmlInfo;
PackageName := APackageXmlInfo.Name;
PackageList.Strings[IndexPackage] := PackageName;
if SelectedPackageNode.Properties.ItemNamed[PackageName].IntValue <> -1 then
JvDualListDialogSelect.List1.Add(PackageName)
else
JvDualListDialogSelect.List2.Add(PackageName);
end;
if not JvDualListDialogSelect.Execute then
Abort;
SelectedPackageNode.Properties.Clear;
for IndexPackage := 0 to PackageList.Count - 1 do
begin
PackageName := PackageList.Strings[IndexPackage];
if JvDualListDialogSelect.List1.IndexOf(PackageName) >= 0 then
begin
SelectedPackageNode.Properties.Add(PackageName, 1);
CheckPackage(TPackageXmlInfo(PackageList.Objects[IndexPackage]));
end;
end;
for IndexPackage := 0 to PackageList.Count - 1 do
PackageList.Objects[IndexPackage].Free;
finally
PackageList.Free;
TargetList.Free;
AliasList.Free;
end;
StatusBar.SimpleText := 'Done.';
end;
procedure TPackageCheckForm.ButtonTargetDefinesClick(Sender: TObject);
var
DefForm: TDefForm;
begin
DefForm := TDefForm.Create(Self);
try
DefForm.Execute(FTargetsInfo);
finally
DefForm.Free;
end;
end;
procedure TPackageCheckForm.FormCreate(Sender: TObject);
var
ModelsNode, GUINode, FormNode, TargetsNode: TJvSimpleXMLElem;
Index: Integer;
begin
FXMLFileName := ChangeFileExt(Application.ExeName, '.xml');
FSettings := TJvSimpleXML.Create(Self);
if FileExists(FXMLFileName) then
FSettings.LoadFromFile(FXMLFileName)
else
FSettings.Root.Name := 'PACKAGECHECK';
FSettings.Options := FSettings.Options + [sxoAutoCreate];
GUINode := FSettings.Root.Items.ItemNamed['GUI'];
TargetsNode := FSettings.Root.Items.ItemNamed['TARGETS'];
FTargetsInfo := TTargetsInfo.Create;
FTargetsInfo.LoadFromXMLElem(TargetsNode);
FPGSettings := TJvSimpleXML.Create(Self);
FPGSettings.LoadFromFile(PathAddSeparator(ExtractFilePath(Application.ExeName)) + 'PGEdit.xml');
FPGSettings.Options := FPGSettings.Options - [sxoAutoCreate];
ComboBoxModel.Items.Clear;
ModelsNode := FPGSettings.Root.Items.ItemNamed['MODELS'];
for Index := 0 to ModelsNode.Items.Count - 1 do
ComboBoxModel.Items.Add(ModelsNode.Items.Item[Index].Properties.ItemNamed['NAME'].Value);
ComboBoxModel.ItemIndex := ComboBoxModel.Items.IndexOf(GuiNode.Items.ItemNamed['MODEL'].Value);
FormNode := GuiNode.Items.ItemNamed['FORM'];
SetBounds(FormNode.Properties.IntValue('LEFT', Left),
FormNode.Properties.IntValue('TOP', Top),
FormNode.Properties.IntValue('WIDTH', Width),
FormNode.Properties.IntValue('HEIGHT', Height));
CheckBoxCLX.Checked := GUINode.Items.ItemNamed['CLX'].Properties.ItemNamed['ENABLED'].BoolValue;
CheckBoxHaltOnError.Checked := GUINode.Items.ItemNamed['HALT'].Properties.ItemNamed['ENABLED'].BoolValue;
end;
procedure TPackageCheckForm.FormDestroy(Sender: TObject);
var
GUINode, TargetsNode, FormNode: TJvSimpleXMLElem;
begin
GUINode := FSettings.Root.Items.ItemNamed['GUI'];
GUINode.Items.ItemNamed['MODEL'].Value := ComboBoxModel.Text;
FormNode := GuiNode.Items.ItemNamed['FORM'];
FormNode.Properties.ItemNamed['LEFT'].IntValue := Left;
FormNode.Properties.ItemNamed['TOP'].IntValue := Top;
FormNode.Properties.ItemNamed['WIDTH'].IntValue := Width;
FormNode.Properties.ItemNamed['HEIGHT'].IntValue := Height;
GUINode.Items.ItemNamed['CLX'].Properties.ItemNamed['ENABLED'].BoolValue := CheckBoxCLX.Checked;
GUINode.Items.ItemNamed['HALT'].Properties.ItemNamed['ENABLED'].BoolValue := CheckBoxHaltOnError.Checked;
TargetsNode := FSettings.Root.Items.ItemNamed['TARGETS'];
TargetsNode.Items.Clear;
FTargetsInfo.SaveToXMLElem(TargetsNode);
FTargetsInfo.Free;
FSettings.SaveToFile(FXMLFileName);
FSettings.Free;
FPGSettings.Free; // we don't save changes in the package generator config file
end;
end.