unit GenerateTargets; {$I jvcl.inc} interface uses Contnrs, Classes, JclSimpleXml; type TTarget = class (TObject) private FName : string; FDir : string; FPName : string; FPDir : string; FEnv : string; FVer : string; FDefines: TStringList; FPathSep: string; FIsCLX : Boolean; FIsBDS : Boolean; FIsDotNet: Boolean; function GetDir: string; function GetEnv: string; function GetPDir: string; function GetVer: string; public constructor Create(Node : TJclSimpleXmlElem); overload; destructor Destroy; override; property Name : string read FName; property Dir : string read GetDir; property PName : string read FPName; property PDir : string read GetPDir; property Env : string read GetEnv; property Ver : string read GetVer; property Defines: TStringList read FDefines; property PathSep: string read FPathSep; property IsCLX : Boolean read FIsCLX; property IsBDS : Boolean read FIsBDS; property IsDotNet : Boolean read FIsDotNet; end; TTargetList = class (TObjectList) private function GetItemsByName(name: string): TTarget; function GetItems(index: integer): TTarget; procedure SetItems(index: integer; const Value: TTarget); public constructor Create(Node : TJclSimpleXmlElem); overload; procedure EnumerateTargets(targets : TStrings); property Items[index : integer] : TTarget read GetItems write SetItems; property ItemsByName[name : string] : TTarget read GetItemsByName; default; end; implementation uses SysUtils, {$IFNDEF COMPILER12_UP} JvJCLUtils, {$ENDIF ~COMPILER12_UP} JclBase, JclStrings; { TTarget } constructor TTarget.Create(Node: TJclSimpleXmlElem); begin inherited Create; FName := AnsiLowerCase(Node.Properties.ItemNamed['name'].Value); if Assigned(Node.Properties.ItemNamed['dir']) then FDir := Node.Properties.ItemNamed['dir'].Value; if Assigned(Node.Properties.ItemNamed['pname']) then FPName := AnsiLowerCase(Node.Properties.ItemNamed['pname'].Value); if Assigned(Node.Properties.ItemNamed['pdir']) then FPDir := Node.Properties.ItemNamed['pdir'].Value; if Assigned(Node.Properties.ItemNamed['env']) then FEnv := AnsiUpperCase(Node.Properties.ItemNamed['env'].Value); if Assigned(Node.Properties.ItemNamed['ver']) then FVer := AnsiLowerCase(Node.Properties.ItemNamed['ver'].Value); FDefines := TStringList.Create; if Assigned(Node.Properties.ItemNamed['defines']) then StrToStrings(Node.Properties.ItemNamed['defines'].Value, ',', FDefines, False); FPathSep := '\'; if Assigned(Node.Properties.ItemNamed['pathsep']) then FPathSep := Node.Properties.ItemNamed['pathsep'].Value; FIsCLX := False; if Assigned(Node.Properties.ItemNamed['IsCLX']) then FIsCLX := Node.Properties.ItemNamed['IsCLX'].BoolValue; FIsBDS := False; if Assigned(Node.Properties.ItemNamed['IsBDS']) then FIsBDS := Node.Properties.ItemNamed['IsBDS'].BoolValue; FIsDotNet := False; if Assigned(Node.Properties.ItemNamed['IsDotNet']) then FIsDotNet := Node.Properties.ItemNamed['IsDotNet'].BoolValue; end; destructor TTarget.Destroy; begin FDefines.Free; inherited Destroy; end; function TTarget.GetDir: string; begin if FDir <> '' then Result := FDir else Result := Name; end; function TTarget.GetEnv: string; var I: Integer; begin if FEnv <> '' then Result := FEnv else if Length(Name) > 1 then begin I := 1; while (I < Length(Name)) and not CharInSet(Name[I], ['0'..'9']) do Inc(I); if CharInSet(Name[I], ['0'..'9']) then Dec(I); Result := AnsiUpperCase(Copy(Name,1,I)); end else Result := ''; end; function TTarget.GetPDir: string; begin if FPDir <> '' then Result := FPDir else Result := FPName; end; function TTarget.GetVer: string; var Start, I : Integer; begin if FVer <> '' then Result := FVer else if Length(Name)>1 then begin Start := 2; while (Start < Length(Name)) and not CharInSet(Name[Start], ['0'..'9']) do Inc(Start); I := Start; while (I < Length(Name)) and CharInSet(Name[I], ['0'..'9']) do Inc(I); if I < Length(name) then Dec(I); Result := AnsiLowerCase(Copy(Name, Start, I-Start+1)); end else Result := ''; end; { TTargetList } constructor TTargetList.Create(Node: TJclSimpleXmlElem); var i : integer; begin inherited Create(True); if Assigned(Node) then for i := 0 to Node.Items.Count - 1 do Add(TTarget.Create(Node.Items[i])); end; procedure TTargetList.EnumerateTargets(targets: TStrings); var i : integer; begin targets.clear; for i := 0 to Count - 1 do targets.Add(Items[I].Name); end; function TTargetList.GetItems(index: integer): TTarget; begin Result := TTarget(inherited Items[index]); end; function TTargetList.GetItemsByName(name: string): TTarget; var i : integer; begin Result := nil; for i := 0 to Count - 1 do if SameText(TTarget(Items[i]).Name, name) then begin Result := TTarget(Items[i]); Break; end; end; procedure TTargetList.SetItems(index: integer; const Value: TTarget); begin inherited Items[index] := Value; end; end.