{----------------------------------------------------------------------------- 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: Compile.pas, released on 2004-03-29. The Initial Developer of the Original Code is Andreas Hausladen (Andreas dott Hausladen att gmx dott de) Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen. 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: Compile.pas 11324 2007-06-17 13:43:09Z obones $ unit Compile; {$I jvcl.inc} {$I windowsonly.inc} interface uses Windows, SysUtils, Classes, CapExec, JVCLData, DelphiData, GenerateUtils, PackageUtils, Intf, PackageInformation, ConditionParser, JvVCL5Utils, JVCLVer; type TProgressKind = ( pkTarget, // progress of all targets pkProject, // |- progress of the parts of one target compilation pkResource, // |- progress of the resource compilation pkPackage, // |- progress of the package compilation pkOther // |- progress for copy/delete and other things ); TTargetProgressEvent = procedure(Sender: TObject; Current: TTargetConfig; Position, Max: Integer) of object; TPackageProgressEvent = procedure(Sender: TObject; Current: TPackageTarget; const Text: string; Position, Max: Integer) of object; TResourceProgressEvent = procedure(Sender: TObject; const Text: string; Position, Max: Integer) of object; TProjectProgressEvent = TResourceProgressEvent; TProgressEvent = procedure(Sender: TObject; const Text: string; Position, Max: Integer; Kind: TProgressKind) of object; TCompiler = class(TObject) private FData: TJVCLData; FCurrentProjectGroup: TProjectGroup; FAborted: Boolean; FOutput: TStrings; FCount: Integer; FPkgCount: Integer; // number of packages to compile FPkgIndex: Integer; FResCount: Integer; FResIndex: Integer; FOnCaptureLine: TCaptureLine; FOnTargetProgress: TTargetProgressEvent; FOnPackageProgress: TPackageProgressEvent; FOnResourceProgress: TResourceProgressEvent; FOnProjectProgress: TProjectProgressEvent; FOnProgress: TProgressEvent; FOnIdle: TNotifyEvent; FAbortReason: string; function IsPackageUsed(ProjectGroup: TProjectGroup; RequiredPackage: TRequiredPackage): Boolean; function IsFileUsed(ProjectGroup: TProjectGroup; ContainedFile: TContainedFile): Boolean; procedure SortProjectGroup(Group: TProjectGroup; List: TList); protected function Dcc32(TargetConfig: ITargetConfig; Project: TPackageTarget; const DccOpt: string; DebugUnits: Boolean; Files, ObjFiles: TStrings): Integer; function Bcc32(TargetConfig: ITargetConfig; Project: TPackageTarget; const BccOpt: string; DebugUnits: Boolean; Files: TStrings; ObjFiles: TStrings): Integer; function Ilink32(TargetConfig: ITargetConfig; Project: TPackageTarget; const IlinkOpt: string; DebugUnits: Boolean; ObjFiles, LibFiles, ResFiles: TStrings): Integer; function Tlib(TargetConfig: ITargetConfig; Project: TPackageTarget; const TlibOpt: string; DebugUnits: Boolean; ObjFiles: TStrings): Integer; function Make(TargetConfig: ITargetConfig; Args: string; CaptureLine: TCaptureLine; StartDir: string = ''): Integer; function CompileCppPackage(TargetConfig: ITargetConfig; Project: TPackageTarget; const DccOpt, BccOpt, IlinkOpt: string; DebugUnits: Boolean): Integer; function CompileDelphiPackage(TargetConfig: ITargetConfig; Project: TPackageTarget; const DccOpt: string; DebugUnits: Boolean): Integer; function WriteDcc32Cfg(const Directory: string; TargetConfig: ITargetConfig; const DccOpt: string; DebugUnits: Boolean): string; // returns the dcc32.cfg filename procedure DoIdle(Sender: TObject); procedure LinkMapFile(TargetConfig: ITargetConfig; Project: TPackageTarget; DebugUnits: Boolean); procedure CaptureLine(const Line: string; var Aborted: Boolean); virtual; procedure CaptureLineClean(const Line: string; var Aborted: Boolean); virtual; procedure CaptureLineGetCompileCount(const Line: string; var Aborted: Boolean); procedure CaptureLinePackageCompilation(const Line: string; var Aborted: Boolean); procedure CaptureLineResourceCompilation(const Line: string; var Aborted: Boolean); procedure CaptureStatusLineDcc32(const Line: string; var Aborted: Boolean); procedure DoTargetProgress(Current: TTargetConfig; Position, Max: Integer); virtual; procedure DoProjectProgress(const Text: string; Position, Max: Integer); virtual; procedure DoResourceProgress(const Text: string; Position, Max: Integer); virtual; procedure DoPackageProgress(Current: TPackageTarget; const Text: string; Position, Max: Integer); virtual; procedure DoProgress(const Text: string; Position, Max: Integer; Kind: TProgressKind); virtual; // DoProgress is called by every DoXxxProgress method function CompileProjectGroup(ProjectGroup: TProjectGroup; DebugUnits: Boolean): Boolean; function GenerateResources(TargetConfig: ITargetConfig): Boolean; function DeleteFormDataFiles(ProjectGroup: TProjectGroup): Boolean; function CopyFormDataFiles(ProjectGroup: TProjectGroup; DebugUnits: Boolean): Boolean; function IsCondition(const Condition: string; TargetConfig: ITargetConfig): Boolean; function GeneratePackages(const Group, Targets, PackagesPath: string): Boolean; overload; function GenerateAllPackages: Boolean; overload; function CompileTarget(TargetConfig: TTargetConfig; PackageGroupKind: TPackageGroupKind): Boolean; public constructor Create(AData: TJVCLData); destructor Destroy; override; function IsDcc32BugDangerous: Boolean; function Compile: Boolean; procedure Abort; // abort compile process property AbortReason: string read FAbortReason write FAbortReason; property Data: TJVCLData read FData; property Output: TStrings read FOutput; property OnCaptureLine: TCaptureLine read FOnCaptureLine write FOnCaptureLine; property OnTargetProgress: TTargetProgressEvent read FOnTargetProgress write FOnTargetProgress; property OnPackageProgress: TPackageProgressEvent read FOnPackageProgress write FOnPackageProgress; property OnResourceProgress: TResourceProgressEvent read FOnResourceProgress write FOnResourceProgress; property OnProjectProgress: TProjectProgressEvent read FOnProjectProgress write FOnProjectProgress; property OnProgress: TProgressEvent read FOnProgress write FOnProgress; property OnIdle: TNotifyEvent read FOnIdle write FOnIdle; end; const ProjectMaxProgress = 3; MaxDcc32PathLen = 80; var Compiler: TCompiler = nil; resourcestring RsPackagesAreUpToDate = 'Packages are up to date'; implementation uses CmdLineUtils, JvConsts, Utils, Core; resourcestring RsGeneratingTemplates = 'Generating templates...'; RsGeneratingPackages = 'Generating packages...'; RsGeneratingResources = 'Generating resources...'; RsCompilingPackages = 'Compiling packages...'; RsPostCompilationOperations = 'Post-compilation operations...'; RsCopyingFiles = 'Copying files...'; RsCopyingFile = 'Copying %s'; RsFinished = 'Finished.'; RsAbortedByUser = 'Aborted by User'; RsErrorLoadingPackageGeneratorConfigFile = 'Error loading devtools\bin\pgEdit.xml'; RsErrorGeneratingPackages = 'Error while generating packages for %s'; RsErrorGeneratingTemplates = 'Error while generating templates.'; RsErrorCompilingResources = 'Error while compiling resources.'; RsErrorGeneratingTemplatesForDir = 'Error generating templates for the %s directory.'; RsErrorCompilingPackages = 'An error occured while compiling the packages.'; // this must not be the doubt of the installer RsErrorLinkingMapFiles = 'An error occured while linking the map files into binaries.'; RsErrorDeletingMapFiles = 'An error occured while deleting the map files after the linking.'; RsCommandNotFound = 'Command could not be executed.'#10#10#10'Cmdline: %s'#10#0'Start directory: %s'; const sGeneratePackages = '[Generating: Packages]'; // do not localize sLinkingMapFiles = '[Linking: map files]'; // do not localize const CommonDependencyFiles: array[0..5] of string = ( 'jvcl.inc', 'jvclbase.inc', 'jvcl%t.inc', 'jedi.inc', 'linuxonly.inc', 'windowsonly.inc' ); function CutPersEdition(const Edition: string): string; var i: Integer; begin Result := Edition; for i := 2 to Length(Result) do if not (Result[i] in ['0'..'9']) then begin Result := Copy(Result, 1, i - 1); Exit; end; end; function ReplaceTargetMacros(const S: string; TargetConfig: ITargetConfig): string; var ps: Integer; begin Result := S; ps := Pos('%t', Result); if ps > 0 then begin Delete(Result, ps, 2); Insert(Format('%s%d', [LowerCase(TargetConfig.Target.TargetType), TargetConfig.Target.Version]), Result, ps); end; end; { TCompiler } constructor TCompiler.Create(AData: TJVCLData); begin inherited Create; FData := AData; FOutput := TStringList.Create; CaptureStatusLine := CaptureStatusLineDcc32; end; destructor TCompiler.Destroy; begin CaptureStatusLine := nil; FOutput.Free; inherited Destroy; end; procedure TCompiler.DoTargetProgress(Current: TTargetConfig; Position, Max: Integer); begin if Assigned(FOnTargetProgress) then FOnTargetProgress(Self, Current, Position, Max); DoProgress(Current.Target.DisplayName, Position, Max, pkTarget); end; procedure TCompiler.DoProjectProgress(const Text: string; Position, Max: Integer); begin if Assigned(FOnProjectProgress) then FOnProjectProgress(Self, Text, Position, Max); DoProgress(Text, Position, Max, pkProject); end; procedure TCompiler.DoResourceProgress(const Text: string; Position, Max: Integer); begin if Assigned(FOnResourceProgress) then FOnResourceProgress(Self, Text, Position, Max); DoProgress(Text, Position, Max, pkResource); end; procedure TCompiler.DoPackageProgress(Current: TPackageTarget; const Text: string; Position, Max: Integer); begin if Assigned(FOnPackageProgress) then FOnPackageProgress(Self, Current, Text, Position, Max); DoProgress(Text, Position, Max, pkPackage); end; procedure TCompiler.DoProgress(const Text: string; Position, Max: Integer; Kind: TProgressKind); begin if Assigned(FOnProgress) then FOnProgress(Self, Text, Position, Max, Kind); end; procedure TCompiler.CaptureLine(const Line: string; var Aborted: Boolean); begin FOutput.Add(Line); if Assigned(FOnCaptureLine) then FOnCaptureLine(Line, FAborted); //Aborted := FAborted; end; procedure TCompiler.CaptureLineClean(const Line: string; var Aborted: Boolean); begin if StartsWith('[', Line) then CaptureLine(Line, Aborted); end; procedure TCompiler.CaptureLineGetCompileCount(const Line: string; var Aborted: Boolean); begin if StartsWith(Trim(Line), 'echo [Compiling: ', True) then Inc(FCount) else if (Line <> '') and (Line[1] <> #9) then CaptureLine(Line, FAborted); //Aborted := FAborted; end; procedure TCompiler.CaptureLinePackageCompilation(const Line: string; var Aborted: Boolean); var S: string; i: Integer; begin CaptureLine(Line, Aborted); if (Line <> '') and (Line[1] = '[') then begin if StartsWith(Line, '[Compiling: ', True) then begin Inc(FPkgIndex); S := Trim(Copy(Line, 13, Length(Line) - 13)); for i := 0 to FCurrentProjectGroup.Count - 1 do if CompareText(FCurrentProjectGroup.Packages[i].TargetName, S) = 0 then begin S := S + ' (' + FCurrentProjectGroup.Packages[i].Info.Description + ')'; DoPackageProgress(FCurrentProjectGroup.Packages[i], S, FPkgIndex - 1, FPkgCount); Exit; end; DoPackageProgress(nil, S, FPkgIndex, FPkgCount); end; end; end; procedure TCompiler.CaptureLineResourceCompilation(const Line: string; var Aborted: Boolean); var S: string; begin CaptureLine(Line, Aborted); if (Line <> '') and (Line[1] = '[') then begin if StartsWith(Line, '[Compiling: ', True) then begin Inc(FResIndex); S := Trim(Copy(Line, 15, Length(Line) - 15)); DoResourceProgress(S, FResIndex, FResCount); end; end; end; procedure TCompiler.CaptureStatusLineDcc32(const Line: string; var Aborted: Boolean); begin CaptureLine(Line, Aborted); end; procedure TCompiler.Abort; begin FAborted := True; end; procedure WriteMsg(const Text: string); // used by TCompiler.GeneratePackages begin Compiler.CaptureLine(Text, Compiler.FAborted); end; procedure TCompiler.DoIdle(Sender: TObject); begin if Assigned(FOnIdle) then FOnIdle(Self); end; /// /// Make calls the make.exe of the given TargetConfig. If the StartDir is empty /// the JVCLPackageDir\bin directory is used. If the command could not be /// executed a message dialog is shown with the complete command line. Returns /// the ExitCode of the last/failed command. /// function TCompiler.Make(TargetConfig: ITargetConfig; Args: string; CaptureLine: TCaptureLine; StartDir: string): Integer; begin if StartDir = '' then StartDir := Data.JVCLPackagesDir + '\bin'; if Data.IgnoreMakeErrors then Args := Trim('-i ' + Args); if Data.Verbose then begin // output command line if Assigned(CaptureLine) then CaptureLine(#1 + '"' + TargetConfig.Target.Make + '" ' + Args, FAborted); end; Result := CaptureExecute('"' + TargetConfig.Target.Make + '"', Args, StartDir, CaptureLine, DoIdle, False, TargetConfig.GetPathEnvVar); if Result < 0 then // command not found MessageBox(0, PChar(Format(RsCommandNotFound, ['"' + TargetConfig.Target.Make + '"' + Args, StartDir])), 'JVCL Installer', MB_OK or MB_ICONERROR); end; /// /// WriteDcc32Cfg() writes the dcc32.cfg file to the directory /// function TCompiler.WriteDcc32Cfg(const Directory: string; TargetConfig: ITargetConfig; const DccOpt: string; DebugUnits: Boolean): string; var Lines: TStrings; SearchPaths, S: string; i: Integer; OutDirs: TOutputDirs; begin OutDirs := TargetConfig.GetOutputDirs(DebugUnits); Lines := TStringList.Create; try // opts Lines.Add(DccOpt); // default paths SearchPaths := TargetConfig.Target.ExpandDirMacros( TargetConfig.Target.RootLibDir + ';' + TargetConfig.Target.RootLibDir + PathDelim + 'obj;' + TargetConfig.JclDcpDir + ';' + TargetConfig.JclDcuDir + ';' + OutDirs.DcpDir + ';' + OutDirs.UnitOutDir ); Lines.Add('-U"' + SearchPaths + ';' + TargetConfig.JVCLDir + PathDelim + 'Common' + '"'); Lines.Add('-I"' + SearchPaths + ';' + TargetConfig.JVCLDir + PathDelim + 'Common' + '"'); Lines.Add('-R"' + SearchPaths + ';' + TargetConfig.JVCLDir + PathDelim + 'Resources' + '"'); Lines.Add('-O"' + SearchPaths + '"'); // search paths SearchPaths := ''; with TargetConfig do for i := 0 to TargetConfig.Target.SearchPaths.Count - 1 do begin S := ExcludeTrailingPathDelimiter(Target.ExpandDirMacros(Target.SearchPaths[i])); if DirectoryExists(S) then begin if SearchPaths <> '' then SearchPaths := SearchPaths + ';' + S else SearchPaths := S; end; end; Lines.Add('-U"' + SearchPaths + '"'); Lines.Add('-I"' + SearchPaths + '"'); Lines.Add('-R"' + SearchPaths + '"'); Lines.Add('-O"' + SearchPaths + '"'); // output directories Lines.Add('-LE"' + OutDirs.BplDir + '"'); // .exe output Lines.Add('-LN"' + OutDirs.DcpDir + '"'); // .dcp output Lines.Add('-N0"' + OutDirs.UnitOutDir + '"'); // .dcu output Lines.Add('-N1"' + OutDirs.HppDir + '"'); // .hpp output if TargetConfig.Target.IsBDS then Lines.Add('-NH"' + OutDirs.HppDir + '"'); // .hpp output Lines.Add('-N2"' + OutDirs.UnitOutDir + '"'); // .obj output if TargetConfig.Target.IsBDS then Lines.Add('-NO"' + OutDirs.UnitOutDir + '"'); // .obj output Lines.Add('-NB"' + OutDirs.DcpDir + '"'); // .bpi output { dcc32.exe crashes if the path is too long } if IsDcc32BugDangerous then Lines.Add('-Q'); if TargetConfig.Target.IsPersonal then Lines.Add('-DDelphiPersonalEdition'); Result := Directory + '\dcc32.cfg'; Lines.SaveToFile(Result); finally Lines.Free; end; end; /// /// Dcc32() compiles a Delphi.Win32 package. If the command could not be /// executed a message dialog is shown with the complete command line. Returns /// the ExitCode of the last/failed command. /// function TCompiler.Dcc32(TargetConfig: ITargetConfig; Project: TPackageTarget; const DccOpt: string; DebugUnits: Boolean; Files, ObjFiles: TStrings): Integer; const MaxCmdLineLength = 2048 - 1; var Dcc32Cfg, PrjFilename: string; Filename, Args, CmdLine, S: string; OutDirs: TOutputDirs; begin OutDirs := TargetConfig.GetOutputDirs(DebugUnits); PrjFilename := Project.SourceDir + PathDelim + ExtractFileName(Project.SourceName); if Files.Count > 0 then Dcc32Cfg := WriteDcc32Cfg(ExtractFileDir(PrjFilename), TargetConfig, DccOpt, DebugUnits); CmdLine := ''; Result := 0; try // collect files, limited by the MaxCmdLineLength while Files.Count > 0 do begin if FAborted then Break; Filename := Files[0]; if Pos(' ', Filename) > 0 then S := ' "' + Filename + '"' else S := ' ' + Filename; Files.Delete(0); CmdLine := '"' + TargetConfig.Target.Dcc32 + '"' + S; Args := S; while Files.Count > 0 do begin Filename := Files[0]; if Pos(' ', Filename) > 0 then S := ' "' + Filename + '"' else S := ' ' + Filename; if Length(CmdLine + S) > MaxCmdLineLength then Break; CmdLine := CmdLine + S; Files.Delete(0); if Assigned(ObjFiles) then ObjFiles.Add(OutDirs.UnitOutDir + PathDelim + ChangeFileExt(ExtractFileName(Filename), '.obj')); end; if Data.Verbose then begin // output command line CaptureLinePackageCompilation(#1 + CmdLine, FAborted); end; Result := CaptureExecute('"' + TargetConfig.Target.Dcc32 + '"', Args, ExtractFileDir(PrjFilename), CaptureLinePackageCompilation, DoIdle, False, TargetConfig.GetPathEnvVar); if Result <> 0 then Break; end; finally if not CmdOptions.KeepFiles then DeleteFile(Dcc32Cfg); end; if Result < 0 then // command not found MessageBox(0, PChar(Format(RsCommandNotFound, [CmdLine, ExtractFileDir(PrjFilename)])), 'JVCL Installer', MB_OK or MB_ICONERROR); end; /// /// Bcc32() compiles C++ files. It adds the compiled .obj file names to ObjFiles /// If the command could not be executed a message dialog is shown with the /// complete command line. Returns the ExitCode of the last/failed command. /// function TCompiler.Bcc32(TargetConfig: ITargetConfig; Project: TPackageTarget; const BccOpt: string; DebugUnits: Boolean; Files: TStrings; ObjFiles: TStrings): Integer; var Lines: TStrings; i: Integer; RspFilename: string; ObjFilename: string; NothingToDo: Boolean; ObjAge: Integer; CsmAge: Integer; OutDirs: TOutputDirs; begin Result := 0; OutDirs := TargetConfig.GetOutputDirs(DebugUnits); RspFilename := Project.SourceDir + PathDelim + ChangeFileExt(ExtractFileName(Project.SourceName), '.@@@'); CsmAge := FileAgeEx(Format('%s\lib\vcl%d0.csm', [TargetConfig.Target.RootDir, TargetConfig.Target.Version])); NothingToDo := True; Lines := TStringList.Create; try Lines.Add(BccOpt); Lines.Add(Format('-I"%s\include;%s\include\vcl"', [TargetConfig.Target.RootDir, TargetConfig.Target.RootDir])); if DebugUnits then Lines.Add('-D_DEBUG -y -v'); Lines.Add('-D_RTLDLL;NO_STRICT;USEPACKAGES'); if TargetConfig.Target.IsPersonal then Lines.Add('-DDelphiPersonalEdition'); Lines.Add(Format('-O2 -H="%s\lib\vcl%d0.csm" -Hu -Vx -Ve -r -a8 -b- -k- -vi- -c -tWM', [TargetConfig.Target.RootDir, TargetConfig.Target.Version])); Lines.Add('-n"' + OutDirs.UnitOutDir + '"'); // add files for i := 0 to Files.Count - 1 do begin ObjFilename := OutDirs.UnitOutDir + PathDelim + ExtractFileName(ChangeFileExt(Files[i], '.obj')); ObjAge := FileAgeEx(ObjFilename); if Assigned(ObjFiles) then ObjFiles.AddObject(ObjFilename, TObject(ObjAge)); if not TargetConfig.AutoDependencies or (ObjAge < CsmAge) or (ObjAge < FileAgeEx(ExtractFilePath(RspFilename) + Files[i])) then begin Lines.Add('"' + Files[i] + '"'); NothingToDo := False; end; end; if NothingToDo then begin Exit; end; Lines.SaveToFile(RspFilename); finally Lines.Free; end; if Data.Verbose then begin // output command line CaptureLinePackageCompilation(#1 + '"' + TargetConfig.Target.Bcc32 + '" @' + ExtractFileName(RspFilename), FAborted); end; try Result := CaptureExecute('"' + TargetConfig.Target.Bcc32 + '"', '@' + ExtractFileName(RspFilename), ExtractFileDir(RspFilename), CaptureLinePackageCompilation, DoIdle, False, TargetConfig.GetPathEnvVar); finally if not CmdOptions.KeepFiles then DeleteFile(RspFilename); end; if Result < 0 then // command not found MessageBox(0, PChar(Format(RsCommandNotFound, ['"' + TargetConfig.Target.Bcc32 + '" @' + ExtractFileName(RspFilename), ExtractFileDir(RspFilename)])), 'JVCL Installer', MB_OK or MB_ICONERROR); end; /// /// Ilink32() links .obj, .lib and .res files. If the command could not be /// executed a message dialog is shown with the complete command line. Returns /// the ExitCode of the last/failed command. /// function TCompiler.Ilink32(TargetConfig: ITargetConfig; Project: TPackageTarget; const IlinkOpt: string; DebugUnits: Boolean; ObjFiles, LibFiles, ResFiles: TStrings): Integer; var Lines: TStrings; RspFilename: string; OutDirs: TOutputDirs; begin OutDirs := TargetConfig.GetOutputDirs(DebugUnits); RspFilename := Project.SourceDir + PathDelim + ChangeFileExt(ExtractFileName(Project.SourceName), '.@@@'); Lines := TStringList.Create; try Lines.Add(IlinkOpt + ' +'); if DebugUnits then Lines.Add(Format('-L"%s\lib\debug" +', [TargetConfig.Target.RootDir])) else Lines.Add(Format('-L"%s\lib\release" +', [TargetConfig.Target.RootDir])); Lines.Add(Format('-L"%s\lib\obj;%s\lib" +', [TargetConfig.Target.RootDir, TargetConfig.Target.RootDir])); Lines.Add(Format('-I"%s" +', [OutDirs.UnitOutDir])); // intermediate output dir Lines.Add(Format('-j"%s" +', [OutDirs.UnitOutDir])); // .obj search path Lines.Add(Format('-D"%s" +', [Project.Info.Description])); Lines.Add(Format('-L"%s\common;%s\Resources;%s\design;%s\run" +', // resource files [TargetConfig.JVCLDir, TargetConfig.JVCLDir, TargetConfig.JVCLDir, TargetConfig.JVCLDir])); if DebugUnits then Lines.Add('-v +'); if not TargetConfig.GenerateMapFiles then Lines.Add('-x +'); Lines.Add('-aa -Tpp -Gn -Gl -Gi +'); if Project.Info.XmlInfo.ImageBase <> '' then Lines.Add('-b:0x' + Project.Info.XmlInfo.ImageBase + ' +'); case Project.Info.ProjectType of ptPackageRun: Lines.Add('-Gpr +'); ptPackageDesign: Lines.Add('-Gpd +'); ptPackage: ; ptLibrary: ; ptProgram: ; end; Lines.Add(Format('-L"%s;%s" -l"%s" +', [TargetConfig.JCLDcpDir, OutDirs.DcpDir, OutDirs.DcpDir])); // add .obj files Lines.Add(ConcatPaths(ObjFiles, ' ') + ', +'); Lines.Add('"' + OutDirs.BplDir + PathDelim + Project.TargetName + '", +'); Lines.Add('"' + OutDirs.BplDir + PathDelim + ChangeFileExt(Project.TargetName, '.map') + '", +'); Lines.Add(ConcatPaths(LibFiles, ' ') + ',, +'); Lines.Add(ConcatPaths(ResFiles, ' ')); Lines.SaveToFile(RspFilename); finally Lines.Free; end; if Data.Verbose then begin // output command line CaptureLinePackageCompilation(#1 + '"' + TargetConfig.Target.Ilink32 + '" @' + ExtractFileName(RspFilename), FAborted); end; try Result := CaptureExecute('"' + TargetConfig.Target.Ilink32 + '"', '@' + ExtractFileName(RspFilename), ExtractFileDir(RspFilename), CaptureLinePackageCompilation, DoIdle, False, TargetConfig.GetPathEnvVar); finally if not CmdOptions.KeepFiles then DeleteFile(RspFilename); end; if Result < 0 then // command not found MessageBox(0, PChar(Format(RsCommandNotFound, ['"' + TargetConfig.Target.Ilink32 + '" @' + ExtractFileName(RspFilename), ExtractFileDir(RspFilename)])), 'JVCL Installer', MB_OK or MB_ICONERROR); end; /// /// Tlib() creates a .lib file. If the command could not be executed a message /// dialog is shown with the complete command line. Returns the ExitCode of the /// last/failed command. /// function TCompiler.Tlib(TargetConfig: ITargetConfig; Project: TPackageTarget; const TlibOpt: string; DebugUnits: Boolean; ObjFiles: TStrings): Integer; var Lines: TStrings; RspFilename: string; LibFilename: string; OutDirs: TOutputDirs; begin OutDirs := TargetConfig.GetOutputDirs(DebugUnits); RspFilename := Project.SourceDir + PathDelim + ChangeFileExt(ExtractFileName(Project.SourceName), '.@@@'); LibFilename := OutDirs.DcpDir + PathDelim + ChangeFileExt(ExtractFileName(Project.SourceName), '.lib'); DeleteFile(LibFilename); Lines := TStringList.Create; try Lines.Add(TLibOpt + ' &'); // add .obj files if ObjFiles.Count > 0 then Lines.Add(' +"' + ConcatPaths(ObjFiles, '" &'#13#10 + ' +"') + '"'); Lines.SaveToFile(RspFilename); finally Lines.Free; end; if Data.Verbose then begin // output command line CaptureLinePackageCompilation(#1 + '"' + TargetConfig.Target.Tlib + '" "' + LibFilename + '" @' + ExtractFileName(RspFilename), FAborted); end; try Result := CaptureExecute('"' + TargetConfig.Target.Tlib + '"', '"' + LibFilename + '" @' + ExtractFileName(RspFilename), ExtractFileDir(RspFilename), CaptureLinePackageCompilation, DoIdle, False, TargetConfig.GetPathEnvVar); finally if not CmdOptions.KeepFiles then DeleteFile(RspFilename); end; if Result < 0 then // command not found MessageBox(0, PChar(Format(RsCommandNotFound, ['"' + TargetConfig.Target.TLib + '" "' + LibFilename + '" @' + ExtractFileName(RspFilename), ExtractFileDir(RspFilename)])), 'JVCL Installer', MB_OK or MB_ICONERROR); end; /// /// CompileCppPackage() compiles a BCB.Win32 package. If one of the commands /// could not be executed a message dialog is shown with the complete command /// line of the failed command. Returns the ExitCode of the last/failed command. /// function TCompiler.CompileCppPackage(TargetConfig: ITargetConfig; Project: TPackageTarget; const DccOpt, BccOpt, IlinkOpt: string; DebugUnits: Boolean): Integer; var PrjFilename, PkgFilename, ResFilename: string; PasFiles, CppFiles, ObjFiles, LibFiles, ResFiles: TStrings; i, ObjAge, OldestObjAge, AgeIndex: Integer; BplFilename, DcpFilename, ObjFilename: string; BplAge, DcpAge, LibAge, BpiAge: Integer; Changed: Boolean; OutDirs: TOutputDirs; begin OutDirs := TargetConfig.GetOutputDirs(DebugUnits); PrjFilename := Project.SourceDir + PathDelim + ExtractFileName(Project.SourceName); BplFilename := OutDirs.BplDir + PathDelim + Project.TargetName; DcpFilename := OutDirs.DcpDir + PathDelim + Project.DcpName; BplAge := FileAgeEx(BplFilename); DcpAge := FileAgeEx(DcpFilename); LibAge := FileAgeEx(ChangeFileExt(DcpFilename, '.lib')); BpiAge := FileAgeEx(ChangeFileExt(DcpFilename, '.bpi')); PasFiles := nil; CppFiles := nil; ObjFiles := nil; LibFiles := nil; ResFiles := nil; try PasFiles := TStringList.Create; CppFiles := TStringList.Create; ObjFiles := TStringList.Create; LibFiles := TStringList.Create; ResFiles := TStringList.Create; CppFiles.Add(ChangeFileExt(PrjFilename, '.cpp')); // .cpp ResFiles.Add(ChangeFileExt(PrjFilename, '.res')); // .res for i := 0 to Project.ContainCount - 1 do begin if IsFileUsed(Project.Owner, Project.Contains[i]) then begin PasFiles.Add(Project.Contains[i].Name); if Project.Contains[i].FormName <> '' then begin ResFilename := ChangeFileExt(Project.Contains[i].Name, '.xfm'); if not FileExists(ResFilename) then ResFilename := ChangeFileExt(Project.Contains[i].Name, '.dfm'); ResFiles.Add(ResFilename); end; end; end; ObjFiles.Add('c0pkg32.obj'); for i := 0 to Project.RequireCount - 1 do begin if IsPackageUsed(Project.Owner, Project.Requires[i]) then begin // obtain DCP filename { TODO : Change this if the .dcp filename convention changes } PkgFilename := ChangeFileExt(Project.Requires[i].GetBplName(Project.Owner), ''); ObjFiles.Add(PkgFilename + '.bpi'); end; end; ObjFiles.Add('Memmgr.lib'); ObjFiles.Add('sysinit.obj'); LibFiles.Add('import32.lib'); LibFiles.Add('cp32mti.lib'); // add additional .lib files if TargetConfig.Target.Version = 5 then LibFiles.AddStrings(Project.Info.XmlInfo.C5Libs) else if TargetConfig.Target.Version = 6 then LibFiles.AddStrings(Project.Info.XmlInfo.C6Libs) else if TargetConfig.Target.Version = 10 then // not used LibFiles.AddStrings(Project.Info.XmlInfo.C10Libs); AgeIndex := ObjFiles.Count; // add .pas.obj files OldestObjAge := 0; for i := 0 to PasFiles.Count - 1 do begin ObjFilename := OutDirs.UnitOutDir + PathDelim + ChangeFileExt(ExtractFileName(PasFiles[i]), '.obj'); if TargetConfig.AutoDependencies then ObjAge := FileAgeEx(ObjFilename) else ObjAge := -1; ObjFiles.AddObject(ObjFilename, TObject(ObjAge)); if ObjAge > OldestObjAge then OldestObjAge := ObjAge; end; // compile Delphi files (creates only .dcu, .obj and .hpp files) Result := CompileDelphiPackage(TargetConfig, Project, DccOpt + ' -JPHNE --BCB', DebugUnits); if Result <> 0 then Exit; Changed := not TargetConfig.AutoDependencies or HaveFilesChanged(ObjFiles, AgeIndex) or (DcpAge < OldestObjAge); if Changed then begin // compile Delphi package (only modified) to get .dcp file (.bpl is also created) // Note: in order to be REALLY safe, we should also pass --BCB here to get the // compiler in BCB mode and ensure that should a unit be recompiled, it is in the // same state as it was when the dcu/obj/hpp files were created. However, this // does not work with BCB5, as it won't generate the dcp file with --BCB. Defining // BCB via -DBCB is also not working here. So we have to "hope" the compiler // is intelligent enough to see that it just needs to pack the dcu files into // the final dcp file. Result := CompileDelphiPackage(TargetConfig, Project, StringReplace(' ' + DccOpt + ' ', ' -B ', '', [rfReplaceAll]), DebugUnits); if Result <> 0 then Exit; end; { Delete the dcc32 generated .lsp file which is not used at all. } DeleteFile(Project.SourceDir + PathDelim + ExtractFileName(ChangeFileExt(Project.SourceName, '.lsp'))); AgeIndex := ObjFiles.Count; // compile C++ files Result := Bcc32(TargetConfig, Project, BccOpt, DebugUnits, CppFiles, ObjFiles); if Result <> 0 then Exit; Changed := not TargetConfig.AutoDependencies or HaveFilesChanged(ObjFiles, AgeIndex) or (BplAge < OldestObjAge) or (LibAge < OldestObjAge) or (BpiAge < OldestObjAge); if Changed then begin // link files (create .lib, .bpi and .bpl) Result := Ilink32(TargetConfig, Project, IlinkOpt, DebugUnits, ObjFiles, LibFiles, ResFiles); if Result <> 0 then Exit; end; finally PasFiles.Free; CppFiles.Free; ObjFiles.Free; LibFiles.Free; ResFiles.Free; end; end; /// /// CompileDelphiPackage() compiles a Delphi.Win32 package. If one of the commands /// could not be executed a message dialog is shown with the complete command /// line of the failed command. Returns the ExitCode of the last/failed command. /// function TCompiler.CompileDelphiPackage(TargetConfig: ITargetConfig; Project: TPackageTarget; const DccOpt: string; DebugUnits: Boolean): Integer; var Files: TStrings; i: Integer; DcpAge, FormAge, PasAge, DcuAge, BplAge: Integer; PrjFilename: string; Filename: string; Changed: Boolean; OutDirs: TOutputDirs; begin OutDirs := TargetConfig.GetOutputDirs(DebugUnits); Result := 0; PrjFilename := Project.SourceDir + PathDelim + ExtractFileName(Project.SourceName); DcpAge := FileAgeEx(OutDirs.DcpDir + PathDelim + Project.DcpName); BplAge := FileAgeEx(OutDirs.BplDir + PathDelim + Project.TargetName); // .dpk/.bpk Changed := not TargetConfig.AutoDependencies or (DcpAge < FileAgeEx(PrjFilename)) or (DcpAge < FileAgeEx(ChangeFileExt(PrjFilename, '.res'))) or (DcpAge > BplAge); // this happens if the .dcp is not for the .bpl if DcpAge > BplAge then DcpAge := BplAge; // compile units that are newer than the bpl if the bpl is older than the dcp if not Changed then begin for i := 0 to High(CommonDependencyFiles) do if DcpAge < FileAgeEx(TargetConfig.JVCLDir + '\common\' + ReplaceTargetMacros(CommonDependencyFiles[i], TargetConfig)) then begin Changed := True; Break; end; end; if not Changed then begin // required JVCL package for i := 0 to Project.JvDependencies.Count - 1 do begin if IsPackageUsed(Project.Owner, Project.JvDependenciesReqPkg[i]) then begin Filename := OutDirs.DcpDir + PathDelim + TargetConfig.VersionedJVCLXmlDcp(Project.JvDependenciesReqPkg[i].Name); if FileAgeEx(Filename) > DcpAge then begin Changed := True; Break; end; end; end; end; if not Changed then begin // required JCL package for i := 0 to Project.JclDependencies.Count - 1 do begin if IsPackageUsed(Project.Owner, Project.JclDependenciesReqPkg[i]) then begin Filename := TargetConfig.JclBplDir + PathDelim + TargetConfig.VersionedJclDcp(Project.JclDependenciesReqPkg[i].Name); if FileAgeEx(Filename) > DcpAge then begin Changed := True; Break; end; end; end; end; if not Changed then begin // files for i := 0 to Project.ContainCount - 1 do begin if IsFileUsed(Project.Owner, Project.Contains[i]) then begin // .pas PasAge := FileAgeEx(Project.SourceDir + PathDelim + Project.Contains[i].Name); DcuAge := FileAgeEx(OutDirs.UnitOutDir + PathDelim + ChangeFileExt(ExtractFileName(Project.Contains[i].Name), '.dcu')); if (PasAge > DcuAge) or (DcpAge < PasAge) then begin Changed := True; Break; end; // .dfm/.xfm if Project.Contains[i].FormName <> '' then begin FormAge := FileAgeEx(ChangeFileExt(Project.SourceDir + PathDelim + Project.Contains[i].Name, '.dfm')); if FormAge = -1 then FormAge := FileAgeEx(ChangeFileExt(Project.SourceDir + PathDelim + Project.Contains[i].Name, '.xfm')); if (FormAge <> -1) and (DcpAge < FormAge) then begin Changed := True; Break; end; end; end; end; end; if Changed then begin Files := TStringList.Create; try Files.Add(ExtractFileName(ChangeFileExt(Project.SourceName, '.dpk'))); // force .dpk Result := Dcc32(TargetConfig, Project, DccOpt, DebugUnits, Files, nil); finally Files.Free; end; end; end; /// /// GeneratePackages generates the packages in /// PackagesPath for the Group (JVCL) for the Targets (comma separated /// pg.exe target list). /// function TCompiler.GeneratePackages(const Group, Targets, PackagesPath: string): Boolean; var ErrMsg: string; List, TargetList: TStrings; begin Result := False; CaptureLine(sGeneratePackages, FAborted); if FAborted then begin AbortReason := RsAbortedByUser; Exit; end; try if not LoadConfig(Data.JVCLDir + '\' + sPackageGeneratorFile, Group, ErrMsg) then begin CaptureLine(ErrMsg, FAborted); AbortReason := RsErrorLoadingPackageGeneratorConfigFile; Exit; end; except on E: Exception do begin AbortReason := RsErrorLoadingPackageGeneratorConfigFile + #10#10 + E.Message; Exit; end; end; List := TStringList.Create; TargetList := TStringList.Create; try TargetList.CommaText := Targets; ExpandTargetsNoPerso(TargetList); EnumeratePackages(PackagesPath, List); if not Generate(List, TargetList, WriteMsg, Data.JVCLDir + '\' + sPackageGeneratorFile, Group, ErrMsg, PackagesPath, '', '', Data.JVCLDir + '\common\jvcl%t.inc') then begin CaptureLine(ErrMsg, FAborted); AbortReason := Format(RsErrorGeneratingPackages, [TargetList.CommaText]); Exit; end; finally List.Free; TargetList.Free; end; if FAborted then begin AbortReason := RsAbortedByUser; Exit; end; Result := True; end; /// /// GenerateAllPackages generates all JVCL packages /// function TCompiler.GenerateAllPackages: Boolean; begin Result := GeneratePackages('JVCL', 'all', Data.JVCLPackagesDir); end; /// /// Compile() prepares for compiling and decides if the VCL or CLX framework /// should be compiled. /// function TCompiler.Compile: Boolean; var i, Index: Integer; Frameworks, Count: Integer; TargetConfigs: array of TTargetConfig; SysInfo: string; begin Result := True; FAborted := False; SysInfo := ''; case Win32Platform of VER_PLATFORM_WIN32_WINDOWS: begin case Win32MinorVersion of 0..9: SysInfo := 'Windows 95'; 10..89: SysInfo := 'Windows 98'; 90: SysInfo := 'Windows ME'; end; end; VER_PLATFORM_WIN32_NT: begin case Win32MajorVersion of 4: SysInfo := 'Windows NT4'; 5: begin case Win32MinorVersion of 0: SysInfo := 'Windows 2000'; 1: SysInfo := 'Windows XP'; end; end; end; end; end; if SysInfo <> '' then begin SysInfo := #1 + SysInfo + Format(' %s (%d.%d.%d)', [Win32CSDVersion, Win32MajorVersion, Win32MinorVersion, Win32BuildNumber]); CaptureLine(SysInfo, FAborted); CaptureLine('', FAborted); end; CaptureLine(Format('JVCL %d.%d.%d.%d', [JVCLVersionMajor, JVCLVersionMinor, JVCLVersionRelease, JVCLVersionBuild]), FAborted); CaptureLine('', FAborted); AbortReason := ''; // read target configs that should be compiled Count := 0; Frameworks := 0; SetLength(TargetConfigs, Data.Targets.Count); for i := 0 to High(TargetConfigs) do begin if Data.TargetConfig[i].InstallJVCL then begin TargetConfigs[Count] := Data.TargetConfig[i]; Inc(Count); if pkVCL in Data.TargetConfig[i].InstallMode then Inc(Frameworks); if pkCLX in Data.TargetConfig[i].InstallMode then Inc(Frameworks); end; end; SetLength(TargetConfigs, Count); // compile all selected targets Index := 0; for i := 0 to Count - 1 do begin DoTargetProgress(TargetConfigs[i], Index, Frameworks); if pkVCL in TargetConfigs[i].InstallMode then begin Result := CompileTarget(TargetConfigs[i], pkVCL); if not Result then Break; Inc(Index); end; DoTargetProgress(TargetConfigs[i], Index, Frameworks); if pkClx in TargetConfigs[i].InstallMode then begin Result := CompileTarget(TargetConfigs[i], pkCLX); if not Result then Break; Inc(Index); end; DoTargetProgress(TargetConfigs[i], Index, Frameworks); end; end; /// /// CompileTarget starts CompileProjectGroup for all sub targets of the /// given target IDE. /// function TCompiler.CompileTarget(TargetConfig: TTargetConfig; PackageGroupKind: TPackageGroupKind): Boolean; var //ObjFiles: TStrings; //i: Integer; Aborted: Boolean; DoClx: Boolean; begin DoClx := PackageGroupKind = pkClx; Result := True; Aborted := False; FOutput.Clear; // VCL if Result and (pkVCL in TargetConfig.InstallMode) and not DoClx then begin if not TargetConfig.DeveloperInstall then begin // debug units if TargetConfig.Target.SupportsPersonalities([persDelphi]) and TargetConfig.DebugUnits then Result := CompileProjectGroup( TargetConfig.Frameworks.Items[TargetConfig.Target.IsPersonal, pkVCL], True); end; if Result then // compile Result := CompileProjectGroup( TargetConfig.Frameworks.Items[TargetConfig.Target.IsPersonal, pkVCL], False); if Result then CaptureLine('[Finished JVCL for VCL installation]', Aborted); // do not localize end; // CLX if Result and (pkClx in TargetConfig.InstallMode) and DoClx then begin if not FileExists(TargetConfig.BplDir + '\clxdesigner.dcp') then begin // Delphi 7 has no clxdesigner.dcp so we compile it from Delphi's property // editor source. CaptureExecute(Data.JVCLPackagesDir + '\bin\MakeClxDesigner.bat', '', Data.JVCLPackagesDir + '\bin', CaptureLine, nil, False); end; if not TargetConfig.DeveloperInstall then begin // debug units if TargetConfig.Target.SupportsPersonalities([persDelphi]) and TargetConfig.DebugUnits then Result := CompileProjectGroup( TargetConfig.Frameworks.Items[TargetConfig.Target.IsPersonal, pkClx], True); end; if Result then // compile Result := CompileProjectGroup( TargetConfig.Frameworks.Items[TargetConfig.Target.IsPersonal, pkClx], False); if Result then CaptureLine('[Finished JVCL for CLX installation]', Aborted); // do not localize end; end; /// /// GenerateResources starts the make file for the resource file compilation. /// function TCompiler.GenerateResources(TargetConfig: ITargetConfig): Boolean; begin Result := False; // get number of resources to compile FCount := 0; if Make(TargetConfig, '-f makefile.mak -n', CaptureLineGetCompileCount, TargetConfig.JVCLDir + '\images') <> 0 then begin AbortReason := RsErrorCompilingResources; Exit; end; // update FResCount with the number of resources that MAKE will compile FResCount := FCount; FResIndex := 0; if FCount > 0 then begin DoResourceProgress('', 0, FResCount); // generate .res and .dcr files if Make(TargetConfig, '-f makefile.mak', CaptureLineResourceCompilation, TargetConfig.JVCLDir + '\images') <> 0 then begin AbortReason := RsErrorCompilingResources; Exit; end; DoResourceProgress('', FResCount, FResCount); end; if FAborted then begin AbortReason := RsAbortedByUser; Exit; end; Result := True; end; /// /// DeleteFormDataFiles deletes the .dfm, .xfm files from the lib-path. /// function TCompiler.DeleteFormDataFiles(ProjectGroup: TProjectGroup): Boolean; var Files: TStrings; i: Integer; Dir: string; begin Result := True; Files := TStringList.Create; try Dir := ProjectGroup.TargetConfig.UnitOutDir; FindFiles(Dir, '*.*', False, Files, ['.dfm', '.xfm']); for i := 0 to Files.Count - 1 do DeleteFile(Files[i]); finally Files.Free; end; end; /// /// CopyFormDataFiles copies the .dfm, .xfm files to the lib-path. /// This function is only called for non developer installations. /// function TCompiler.CopyFormDataFiles(ProjectGroup: TProjectGroup; DebugUnits: Boolean): Boolean; var Files: TStrings; i: Integer; Dir, DestDir, DestFile, DebugDestDir: string; begin Result := True; Files := TStringList.Create; try {**}DoProgress('', 0, 100, pkOther); DestDir := ProjectGroup.TargetConfig.UnitOutDir; DebugDestDir := ProjectGroup.TargetConfig.DebugUnitOutDir; if ProjectGroup.IsVCLX then begin Dir := ProjectGroup.TargetConfig.JVCLDir + PathDelim + 'qrun'; FindFiles(Dir, '*.xfm', False, Files, ['.xfm']); end else begin Dir := ProjectGroup.TargetConfig.JVCLDir + PathDelim + 'run'; FindFiles(Dir, '*.dfm', False, Files, ['.dfm']); end; CaptureLine(RsCopyingFiles, FAborted); for i := 0 to Files.Count - 1 do begin DestFile := DestDir + PathDelim + ExtractFileName(Files[i]); if FileAgeEx(Files[i]) > FileAgeEx(DestFile) then begin {**} DoProgress(ExtractFileName(Files[i]), i, Files.Count, pkOther); CopyFile(PChar(Files[i]), PChar(DestFile), False); end; if DebugUnits then begin DestFile := DebugDestDir + PathDelim + ExtractFileName(Files[i]); if FileAgeEx(Files[i]) > FileAgeEx(DestFile) then CopyFile(PChar(Files[i]), PChar(DestFile), False); end; end; {**}DoProgress('', 0, Files.Count, pkOther); finally Files.Free; end; end; function GetWindowsDir: string; begin SetLength(Result, MAX_PATH); SetLength(Result, GetWindowsDirectory(PChar(Result), Length(Result))); end; function GetSystemDir: string; begin SetLength(Result, MAX_PATH); SetLength(Result, GetSystemDirectory(PChar(Result), Length(Result))); end; procedure TCompiler.SortProjectGroup(Group: TProjectGroup; List: TList); procedure SortProject(Project: TPackageTarget; var ProjectIndex: Integer); var ReqProjectIndex: Integer; ReqPackage: TRequiredPackage; ReqProject: TPackageTarget; ListIndex: Integer; begin for ReqProjectIndex := 0 to Project.RequireCount - 1 do begin ReqPackage := Project.Requires[ReqProjectIndex]; if IsPackageUsed(Group, ReqPackage) then begin // Two cases: the required project is not in the list so we need to add, // or it's already there and not in front so we need to move it. // In both cases, we need to sort the moved/added package recursively // and increment the ProjectIndex only after the recursive sort is done // so that packages required by the current required package are put // in front of it as well. ReqProject := Group.FindPackageByXmlName(ReqPackage.Name); if Assigned(ReqProject) then begin ListIndex := List.IndexOf(ReqProject); if ListIndex = -1 then begin List.Insert(ProjectIndex, ReqProject); SortProject(ReqProject, ProjectIndex); Inc(ProjectIndex); end else if ListIndex > ProjectIndex then begin List.Move(ListIndex, ProjectIndex); SortProject(ReqProject, ProjectIndex); Inc(ProjectIndex); end; end; end; end; end; var CurProject: TPackageTarget; CurProjectIndex: Integer; begin // Add all projects to be compiled into list. for CurProjectIndex := 0 to Group.Count - 1 do if Group[CurProjectIndex].Compile then List.Add(Group[CurProjectIndex]); // Sort according to dependency list: // For each package that must be compiled, put those it requires in front // of it, and this recursively. CurProjectIndex := 0; while CurProjectIndex < List.Count do begin CurProject := List[CurProjectIndex]; SortProject(CurProject, CurProjectIndex); Inc(CurProjectIndex); end; end; /// /// CompileProjectGroup starts the make file for the templates, starts the /// packages generator, calls the GenerateResource method and compiles all /// selected packages of the project group. /// function TCompiler.CompileProjectGroup(ProjectGroup: TProjectGroup; DebugUnits: Boolean): Boolean; var AProjectIndex, i: Integer; TargetConfig: ITargetConfig; DccOpt: string; Edition, JVCLPackagesDir: string; Files: TStrings; ProjectOrder: TList; Project: TPackageTarget; DebugProgress: string; function GetProjectIndex: Integer; begin Result := AProjectIndex; Inc(AProjectIndex); end; begin Result := False; if FAborted then Exit; DebugProgress := ''; if DebugUnits then DebugProgress := ' (Debug)'; FCurrentProjectGroup := ProjectGroup; try TargetConfig := ProjectGroup.TargetConfig; { remove current JVCL but keep the "Installation tag" valid } TargetConfig.DeinstallJVCL(nil, nil, {RealUninstall:=}False); // obtain information for progress bar FPkgCount := 0; for i := 0 to ProjectGroup.Count - 1 do if ProjectGroup.Packages[i].Compile then Inc(FPkgCount); FPkgIndex := 0; Edition := TargetConfig.TargetSymbol; if ProjectGroup.IsVCLX then Edition := Edition + 'clx'; JVCLPackagesDir := TargetConfig.JVCLPackagesDir; DccOpt := '-M'; // make modified units, output 'never build' DCPs if TargetConfig.Build then DccOpt := DccOpt + ' -B'; if TargetConfig.GenerateMapFiles then DccOpt := DccOpt + ' -GD'; if TargetConfig.Target.IsBDS and (persBCB in TargetConfig.Target.SupportedPersonalities) then // Dual packages, bpi and lib files for BDS 2006 DccOpt := DccOpt + ' -JL'; // for BCB 5/6 the -JPHNE is set during compilation if not DebugUnits and not TargetConfig.DeveloperInstall then DccOpt := DccOpt + ' -DJVCL_NO_DEBUGINFO'; if DebugUnits then begin ForceDirectoriesEx(TargetConfig.DebugUnitOutDir); ForceDirectoriesEx(TargetConfig.DebugBplDir); ForceDirectoriesEx(TargetConfig.DebugDcpDir); ForceDirectoriesEx(TargetConfig.DebugHppDir); end; { Create include directory if necessary } if TargetConfig.Target.SupportsPersonalities([persBCB]) then ForceDirectoriesEx(TargetConfig.Target.ExpandDirMacros(TargetConfig.HppDir)); // ***************************************************************** {**}DoProjectProgress(RsGeneratingPackages + DebugProgress, GetProjectIndex, ProjectMaxProgress); // generate the packages and .cfg files if not GeneratePackages('JVCL', CutPersEdition(Edition), TargetConfig.JVCLPackagesDir) then Exit; // AbortReason is set in GeneratePackages // ***************************************************************** {**}{DoProjectProgress(RsGeneratingResources, GetProjectIndex, ProjectMaxProgress); if not GenerateResources(TargetConfig) then Exit; // AbortReason is set in GenerateResources} // ***************************************************************** {**}DoProjectProgress(RsCompilingPackages + DebugProgress, GetProjectIndex, ProjectMaxProgress); { Remove .dfm/.xfm files from the lib directory so the compiler takes the correct one and we do not have unused files in the lib directory. } DeleteFormDataFiles(ProjectGroup); Files := TStringList.Create; try { .bpl and .dcp files meight be at the wrong location. So delete them from wrong locations. } TargetConfig.GetPackageBinariesForDeletion(Files); for i := 0 to Files.Count - 1 do if not StartsWith(Files[i], TargetConfig.BplDir + PathDelim, False) and not StartsWith(Files[i], TargetConfig.DcpDir + PathDelim, False) then begin if TargetConfig.DebugUnits then begin if StartsWith(Files[i], TargetConfig.DebugBplDir + PathDelim, False) and StartsWith(Files[i], TargetConfig.DebugDcpDir + PathDelim, False) then Continue; end; DeleteFile(Files[i]); end; finally Files.Free; end; { Now compile the packages } DoPackageProgress(nil, '', 0, FPkgCount); ProjectOrder := TList.Create; try SortProjectGroup(ProjectGroup, ProjectOrder); if ProjectOrder.Count > 0 then CaptureLinePackageCompilation('[Compiling: Packages]', FAborted); for i := 0 to ProjectOrder.Count - 1 do begin Project := ProjectOrder[i]; CaptureLinePackageCompilation('[Compiling: ' + Project.TargetName + ']', FAborted); if TargetConfig.Target.IsBCB and not TargetConfig.Target.IsBDS then begin if CompileCppPackage(TargetConfig, Project, DccOpt, '', '', DebugUnits) <> 0 then begin if FAborted then Exit; AbortReason := RsErrorCompilingPackages; Exit; end; end else begin { Create .dcp and .bpl } if CompileDelphiPackage(TargetConfig, Project, DccOpt, DebugUnits) <> 0 then begin if FAborted then Exit; AbortReason := RsErrorCompilingPackages; Exit; end; end; if FAborted then Exit; end; finally ProjectOrder.Free; end; DoPackageProgress(nil, '', FPkgCount, FPkgCount); // ***************************************************************** {**}DoProjectProgress(RsPostCompilationOperations + DebugProgress, GetProjectIndex, ProjectMaxProgress); if TargetConfig.GenerateMapFiles and (TargetConfig.LinkMapFiles or TargetConfig.CreateJdbgFiles) then begin CaptureLine(sLinkingMapFiles, FAborted); for i := 0 to ProjectGroup.Count - 1 do if ProjectGroup.Packages[i].Compile then LinkMapFile(TargetConfig, ProjectGroup.Packages[i], DebugUnits); end; // ***************************************************************** if not ProjectGroup.TargetConfig.DeveloperInstall {or (TargetConfig.Target.SupportsPersonalities([persBCB], True))} then // only BCB begin {**} DoProjectProgress(RsCopyingFiles + DebugProgress, GetProjectIndex, ProjectMaxProgress); { The .dfm/.xfm files are deleted from the lib directory in the resource generation section in this method. The files are only copied for a non-developer installation and for BCB. } CopyFormDataFiles(ProjectGroup, DebugUnits); end else {**} GetProjectIndex; // increase progress if not FAborted then begin if TargetConfig.CleanPalettes then TargetConfig.CleanJVCLPalette(False); TargetConfig.RegisterToIDE; end; finally {**}DoProjectProgress(RsFinished, ProjectMaxProgress, ProjectMaxProgress); FCurrentProjectGroup := nil; end; Result := True; end; function TCompiler.IsFileUsed(ProjectGroup: TProjectGroup; ContainedFile: TContainedFile): Boolean; begin Result := ContainedFile.IsUsedByTarget(ProjectGroup.TargetConfig.TargetSymbol) and IsCondition(ContainedFile.Condition, ProjectGroup.TargetConfig); end; function TCompiler.IsPackageUsed(ProjectGroup: TProjectGroup; RequiredPackage: TRequiredPackage): Boolean; begin Result := RequiredPackage.IsRequiredByTarget(ProjectGroup.TargetConfig.TargetSymbol) and IsCondition(RequiredPackage.Condition, ProjectGroup.TargetConfig); end; procedure TCompiler.LinkMapFile(TargetConfig: ITargetConfig; Project: TPackageTarget; DebugUnits: Boolean); var BplFilename, MapFilename: string; MapFileSize, JclDebugDataSize: Integer; OutDirs: TOutputDirs; begin OutDirs := TargetConfig.GetOutputDirs(DebugUnits); BplFileName := OutDirs.BplDir + PathDelim + Project.TargetName; MapFileName := ChangeFileExt(BplFileName, '.map'); if FileExists(BplFilename) and FileExists(MapFileName) then begin CaptureLine(Format('Linking %s inside %s', [ExtractFileName(MapFileName), ExtractFileName(BplFileName)]), FAborted); if TargetConfig.LinkMapFiles and not TargetConfig.LinkMapFile(BplFileName, MapFileName, MapFileSize, JclDebugDataSize) then begin CaptureLine(Format('Error: Unable to link %s', [ExtractFileName(MapFileName)]), FAborted); AbortReason := RsErrorLinkingMapFiles; Exit; end; if TargetConfig.CreateJdbgFiles and not TargetConfig.CompressMapFileToJdbg(MapFileName) then begin CaptureLine(Format('Error: Unable to link %s', [ExtractFileName(MapFileName)]), FAborted); AbortReason := RsErrorLinkingMapFiles; Exit; end; if TargetConfig.DeleteMapFiles then begin CaptureLine(Format('Deleting file %s', [ExtractFileName(MapFileName)]), FAborted); if not DeleteFile(MapFileName) then begin CaptureLine(Format('Error: Unable to delete %s', [MapFileName]), FAborted); AbortReason := RsErrorDeletingMapFiles; Exit; end; end; end; end; type { TListConditionParser searches for the idents in the List. If an ident is in the list the ident is returned as True. } TListConditionParser = class(TConditionParser) private FTargetConfig: ITargetConfig; protected procedure MissingRightParenthesis; override; function GetIdentValue(const Ident: String): Boolean; override; public constructor Create(ATargetConfig: ITargetConfig); end; function TCompiler.IsCondition(const Condition: string; TargetConfig: ITargetConfig): Boolean; var Parser: TListConditionParser; begin Result := True; if Condition <> '' then begin Parser := TListConditionParser.Create(TargetConfig); try Result := Parser.Parse(Condition); finally Parser.Free; end; end; end; function TCompiler.IsDcc32BugDangerous: Boolean; begin Result := Length(Data.JVCLDir) > MaxDcc32PathLen; end; { TListConditionParser } constructor TListConditionParser.Create(ATargetConfig: ITargetConfig); begin inherited Create; FTargetConfig := ATargetConfig; end; function TListConditionParser.GetIdentValue(const Ident: String): Boolean; begin Result := FTargetConfig.JVCLConfig.Enabled[Ident]; end; procedure TListConditionParser.MissingRightParenthesis; begin raise Exception.Create('Missing ")" in conditional expression'); end; end.