home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue66 / Construc / Refactor / Source / uBuildingObject.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-11-12  |  38.0 KB  |  1,028 lines
  1. unit uBuildingObject;
  2. interface
  3. uses classes, uRCBuilder, uSelectDir;
  4.  
  5. type
  6.  
  7.   TCompileNotify = Procedure(const aSourcefile, Info : string) of object;
  8.   TCompileStartNotify = Procedure(const aSourceFile, aDestFile, aErrMsg : string) of object;
  9.   TCompileEndNotify = Procedure(const aSourceFile, aDestFile, aErrMsg : string; aSuccess : boolean; alines, ahints, awarnings, aerrors, afatal : integer) of object;
  10.   TProjectNotify = Procedure(const aProjectName : string; aOK, aErr, alines, ahints, awarnings, aerrors, afatal : integer) of object;
  11.   TCompileTypeEnum = (ctRC, ctDPR, ctDLL, ctDPK);
  12.  
  13.   TCompileClass = class(tobject)
  14.     private
  15.       fResourceHandler : TResourceHandler;
  16.       fCompileType : TCompileTypeEnum;
  17.       fOptions : string;
  18.       fProjectDir : string;
  19.       fInFile, fOutFile, ferrMsg, fcmdline : string;
  20.       fsuccess : boolean;
  21.       fLines, fHints, fWarn, fErr, fFatal  : integer;
  22.       fEndTime: TdateTime;
  23.       fStartTime: TdateTime;
  24.       fResults: tstringlist;
  25.       fSummary: tstringlist;
  26.       fConfigFile : tstringlist;
  27.       fDPKOptions : tstringlist;
  28.       fDPKItself : tstringlist;
  29.       fOnCompile : TcompileNotify;
  30.       fSourceFullFileName: string;
  31.       fDestinationFullFileName: string;
  32.       fMS: word;
  33.       fSeconds: word;
  34.       fMinutes: word;
  35.       fhours: word;
  36.       fOnIconfileNotFound: TResourceHandlerMissingFileNotify;
  37.       procedure MassageResults(var alist : tstringlist);
  38.         // strip out lines in which we find a digit followed by a paranthesis 'n)' at the end of the line
  39.       procedure ProcessResults;
  40.       Procedure ProcessDPKOptions(DPKFile : string);
  41.     protected
  42.       Procedure DoCompileNotify(const info : string);
  43.     public
  44.       destructor destroy; override;
  45.       Function Execute : boolean;
  46.       Property Options : string read fOptions write fOptions;
  47.       Property InFile : string read fInfile write fInFile;
  48.       Property OutFile : string read fOutfile write fOutfile;
  49.       Property ErrMsg : string read fErrMsg write fErrMsg;
  50.       Property Success : boolean read fSuccess write fSuccess;
  51.       Property Lines : integer read fLines write fLines;
  52.       Property Hints : integer read fHints write fHints;
  53.       Property Warnings : integer read fWarn write fWarn;
  54.       Property Errors : integer read fErr write fErr;
  55.       Property Fatals : integer read fFatal write fFatal;
  56.       Property ConfigFile : tstringlist read fConfigFile write fConfigFile;
  57.       Property DPKOptions : tstringlist read fDPKOptions write fDPKOptions;
  58.       Property Results : tstringlist read fResults write fResults;
  59.       Property Summary : tstringlist read fSummary write fSummary;
  60.       Property StartTime : TdateTime read fStartTime write fStartTime;
  61.       Property EndTime : TdateTime read fEndTime write fEndTime;
  62.       Property Hours : word read fhours write fhours;
  63.       Property Minutes : word read fMinutes write fMinutes;
  64.       Property Seconds : word read fSeconds write fSeconds;
  65.       Property MilleSeconds : word read fMS write fMS;
  66.       Property CompileType : TCompileTypeEnum read fCompileType write fCompileType;
  67.       Property ProjectDir : string read fProjectDir write fProjectDir;
  68.       Property SourceFullFileName : string read fSourceFullFileName write fSourceFullFileName;
  69.       Property DestinationFullFileName : string read fDestinationFullFileName write fDestinationFullFileName;
  70.       Property OnCompile : TCompileNotify read fOnCompile write fOnCompile;
  71.       Property ResourceHandler :  TResourceHandler read fResourceHandler write fResourceHandler;
  72.       Property OnIconFileNotFound : TResourceHandlerMissingFileNotify  read fOnIconfileNotFound write fOnIconfileNotfound;
  73.     end;
  74.  
  75. TBuilderClass = class(Tcomponent)
  76.   private
  77.     fHaltNow : boolean;
  78.     fCompiler : TCompileClass;
  79.     fResourceHandler : TResourceHandler;
  80.     fProjectDir: string;
  81.     fProjectName: string;
  82.     fConfigFile: tstringlist;
  83.     fConfigWithPath : tstringlist;
  84.     fLibraryFile: tstringlist;
  85.     fProjectList: tstringlist;
  86.     fOnCompileEnd: TCompileEndNotify;
  87.     fOnCompileStart: TCompileStartNotify;
  88.     fOnCompileEvent: TCompileNotify;
  89.     fOnProjectDone: TProjectNotify;
  90.     fOnProjectStart: TCompileNotify;
  91.     fProjectResults: tstringlist;
  92.     fProjectSummary: tstringlist;
  93.     fCompileEventStash : tstringlist;
  94.     fOnProjectHalt: TCompileNotify;
  95.     fFatal: integer;
  96.     fHints: integer;
  97.     fLines: integer;
  98.     fWarn: integer;
  99.     fErr: integer;
  100.     fOKs: integer;
  101.     fErrs: integer;
  102.     fProjectStart : tdatetime;
  103.     fIncrementBuild: boolean;
  104.     fAutoIncrement: boolean;
  105.     fIncrementComment: boolean;
  106.     fNotAlreadyIncremented : boolean;
  107.     fCheckVersion : boolean;
  108.     fMinimize: boolean;
  109.     fVerInfoInVerFile : boolean;
  110.     FHaltOnError : boolean;
  111.     fDPKOptions: tstringlist;
  112.     Function SetUpProject: boolean;
  113.     procedure PrepareLibPath(var libPathList: tstringlist);
  114.     function computeprojecttime: string;
  115.     Procedure PrepareResourceFile(const aSourcePath : string);
  116.     procedure setAutoIncrement(const Value: boolean);
  117.     procedure setIncrementBuild(const Value: boolean);
  118.     procedure SaveResourceFile(const aSourcePath: string);
  119.     function DetermineCompileType: TCompileTypeEnum;
  120.         // make sure the libpath is less than 1024, or make it into multiple lines, each of which shorter than 1024
  121.   protected
  122.     Procedure doCompileEnd;
  123.     Procedure doCompileStart;
  124.     Procedure HandleCompileEvent(const aSourcefile, Info : string);
  125.     Procedure DoProjectDone;
  126.     Procedure DoProjectHalt(const info : string);
  127.     Procedure HandleResourceHandlerError(const filename, info : string);
  128.     Procedure DoAutoIncrement(const aSourcePath : string);
  129.  
  130.  
  131.   public
  132.     constructor create(aOwner : tcomponent); override;
  133.     destructor destroy; override;
  134.     function execute : boolean;
  135.     Function InitializeProject(const aProjectDir : string): boolean;
  136.     function SaveProjectSettings: boolean;
  137.     function IsIndependentRCFile(filename: string): boolean;
  138.  
  139.     Property ProjectList : tstringlist read fProjectList write fProjectList;
  140.     Property LibraryFile : tstringlist read fLibraryFile write fLibraryFile;
  141.     Property ConfigFile : tstringlist read fConfigFile write fconfigFile;
  142.     Property DPKOptions : tstringlist read fDPKOptions write fDPKOptions;
  143.     Property ProjectResults : tstringlist read fProjectResults write fProjectResults;
  144.     Property ProjectSummary : tstringlist read fProjectSummary write fProjectSummary;
  145.     Property Lines : integer read fLines write fLines;
  146.     Property Hints : integer read fHints write fHints;
  147.     Property Warnings : integer read fWarn write fWarn;
  148.     Property Errors : integer read fErr write fErr;
  149.     Property Fatals : integer read fFatal write fFatal;
  150.     Property OKs : integer read fOKs write fOKs;
  151.     Property Errs : integer read fErrs write fErrs;
  152.     Property HaltNow : boolean read fHaltNow write fHaltNow;
  153.  
  154.   published
  155.     Property ProjectName : string read fProjectName write fProjectName;
  156.     Property ProjectDir : string read fProjectDir write fProjectDir;
  157.     Property ResourceHandler : TResourceHandler read  fResourceHandler write fResourceHandler;
  158.     Property IncrementComment : boolean read fIncrementComment write fIncrementComment;
  159.     Property AutoIncrement : boolean read fAutoIncrement write setAutoIncrement;
  160.     Property MinimizeOnBuild : boolean read fMinimize write fMinimize;
  161.     Property CheckVersion : boolean read fCheckVersion write fCheckVersion;
  162.     Property ActualVerInfoInVerFile : boolean read fVerInfoInVerFile write fVerInfoInVerFile;
  163.     Property HaltOnError : boolean read FHaltOnError write FHaltOnError;
  164.  
  165.     Property OnCompileEvent : TCompileNotify read fOnCompileEvent write fOnCompileEvent;
  166.     Property OnCompileStart : TCompileStartNotify read fOnCompileStart write fOnCompileStart;
  167.     Property OnCompileEnd : TCompileEndNotify read fOnCompileEnd write fOnCompileEnd;
  168.     Property OnProjectStart : TCompileNotify read fOnProjectStart write fOnProjectStart;
  169.     Property OnProjectDone : TProjectNotify read fOnProjectDone write fOnProjectDone;
  170.     Property OnProjectHalt : TCompileNotify read fOnProjectHalt write fOnProjectHalt;
  171.   end;
  172.  
  173. const
  174.   cDPR = 'DPR';
  175.   cTotDump = 'Dump.dat';
  176.   cProjectList = 'Files.ini';
  177.   cConfig = 'Base.cfg';
  178.   cLibraryPath = 'Library.Path';
  179.   cResourceMask = 'Resource.mask';
  180.   cversion='version';
  181.   cOptions='options';
  182.   cDPKOptions='DPKOptions';
  183.   cAutoIncrement='AutoIncrement';
  184.   cIncrementComment='IncrementComment';
  185.   cCheckVersion='CheckVersion';
  186.   cMinimize='MinimizeOnBuild';
  187.   cVerInfoInVerFile='PutActualVerInfoInVerFile';
  188.   cHaltOnError='HaltOnError';
  189.  
  190.  
  191. //DONE:  make sure events firing only when needed
  192. //DONE:  test project and file versioning so that file versions used only when project version is defaulted.
  193. //DONE:  Project version overrides blanks in file version stuff
  194. //TODO -cBuilder object: add DLL processing
  195. //todo -cBuilder object: add DPK processing
  196.  
  197.  
  198. implementation
  199. uses Windows, Inifiles, FileCtrl, sysutils, forms, DOSToMemo, fincrement;//, uVersionInformation;
  200.  
  201. { TCompileClass }
  202.  
  203. destructor TCompileClass.destroy;
  204. begin
  205.   fResults.free;
  206.   fSummary.free;
  207.   fConfigFile.free;
  208.   fDPKOptions.free;
  209.   fDPKItself.free;
  210.   inherited;
  211. end;
  212.  
  213. procedure TCompileClass.DoCompileNotify(const info: string);
  214. begin
  215.   fResults.add('Compile Notify: '+info);
  216.   if assigned(fOnCompile)
  217.     then fOnCompile(fSourceFullFileName, info);
  218. end;
  219.  
  220. Function TCompileClass.Execute : boolean;
  221. var tmp : string;
  222. begin
  223.   result := true;
  224.   fResults.clear;
  225.   fSummary.clear;
  226.   Lines := 0;
  227.   Hints := 0;
  228.   Warnings := 0;
  229.   Errors := 0;
  230.   Fatals := 0;
  231.   try
  232.     chdir(fProjectDir);
  233.   except
  234.     on e:exception do begin
  235.       tmp := 'chdir to project path, '+fProjectDir+ ' failed: '+e.message;
  236.       DoCompileNotify(tmp);
  237.       result := false;
  238.       exit;
  239.       end;
  240.     end;
  241.   ForceDirectories(ExtractFilePath(fDestinationFullFileName));
  242.   try
  243.     chdir(extractFilePath(fSourceFullFileName));
  244.   except
  245.     on e:exception do begin
  246.       tmp := 'chdir to '+fSourceFullFileName+'failed: '#13#10+e.message;
  247.       DoCompileNotify(tmp);
  248.       result := false;
  249.       exit;
  250.     end;
  251.   end;
  252.   //todo: set up stuff for dll, dpk processing
  253.   //todo: handle non-version information type .res files
  254.   if fCompileType in [ctDPR, ctDPK]
  255.      then try
  256.            tmp := changeFileExt(fSourceFullFileName, '.cfg');
  257.            fConfigFile.saveToFile(tmp);
  258.            tmp := changeFileExt(fSourceFullFileName, '.res');
  259.            if not fileExists(tmp)
  260.              then begin
  261.                tmp := 'RES file missing: '+tmp;
  262.                fSummary.add(tmp);
  263.                DoCompileNotify(tmp);
  264.                //exit;
  265.                end;
  266.           if fCompileType = ctDPK
  267.             then begin
  268.              tmp := changeFileExt(fSourceFullFileName, '.dpk');
  269.              fDPKItself.loadFromFile(tmp);
  270.              ProcessDPKOptions(tmp);
  271.              end;
  272.           except
  273.             on e:exception do begin
  274.               tmp := 'Failed to replace '+tmp+' '+e.message;
  275.               fsummary.add(tmp);
  276.               DoCompileNotify(tmp);
  277.               end;
  278.           end;
  279.   tmp := ExtractFileName(fSourceFullFileName);
  280.   case fCompileType of
  281.     ctRC : fcmdline := 'BRCC32.exe -v -fo'+ChangeFileExt(tmp, '.RES')+' '+tmp;
  282.     ctDPR : fcmdline := 'DCC32.exe '+ExtractFileName(fSourceFullFileName) + ' -E'+ExtractShortPathName(ExtractFilePath(fDestinationFullFileName));//+'"' ;
  283.     ctDPK : fcmdline := 'DCC32.exe '+ExtractFileName(fSourceFullFileName) + ' -E'+ExtractShortPathName(ExtractFilePath(fDestinationFullFileName));//+'"' ;
  284.     end;
  285.   fStartTime := Now;
  286.   fSuccess :=  CreateDOSProcessRedirected(fcmdline, finfile, foutfile, ferrmsg);
  287.   ProcessResults;
  288.   fEndTime := Now;
  289.   DecodeTime(fEndTime - fstartTime, fHours, fMinutes, fSeconds, fMS);
  290.   tmp := '   Time: '+ Format('%.2f seconds', [fms / 1000.0 + fSeconds + 60 * (fMinutes + fHours * 60)]);
  291.   fResults.add(tmp);
  292.   //fSummary.add('  ');
  293.   //fResults.add(tmp);
  294.   fResults.add('Done: '+ ExtractFileName(fSourceFullFileName));
  295.   chDir(fProjectDir);
  296. end;
  297.  
  298. procedure TCompileClass.ProcessResults;
  299. var i : integer;
  300.     tmp : string;
  301. begin
  302.   fResults.LoadFromFile(foutfile);
  303.   ferrmsg := fresults[fresults.count-1];
  304.   if Not fSuccess
  305.      then fresults.insert(0, format('xxxxx>'#13#10'DCC Failed to load: '+fcmdline+ '   Error Code %d', [GetLastError])+': ' +ferrmsg)
  306.      else begin
  307.         fresults.insert(0, fcmdline);
  308.         case fCompileType of
  309.           ctDPR, ctDPK : if pos(' lines, ', ferrmsg) > 0
  310.                     then begin
  311.                        flines := StrtoInt(trim(copy(ferrmsg, 1, pos(' lines', ferrmsg))));
  312.                        //ferrmsg := 'OK '+ExtractFileName(fDestinationFullFileName)+': '+ferrmsg;
  313.                        fSuccess := true;
  314.                        end
  315.                     else begin
  316.                       if (pos('Error: ', ferrmsg) = 1)
  317.                           and
  318.                          (pos('RES', ferrmsg) <> 0)
  319.                            then fSuccess := true    // compiled without version information or icon
  320.                            else fSuccess := false;
  321.                       //ferrmsg := 'ERR '+ferrmsg;
  322.                       end;
  323.           ctRC : if pos('New File:', ferrmsg) > 0
  324.                     then begin
  325.                        flines := 1; //StrtoInt(trim(copy(errmsg, 1, pos(' lines', errmsg))));
  326.                        //ferrmsg := 'OK resource file built: '+ExtractFileName(fDestinationFullFileName);
  327.                        fSuccess := true;
  328.                        end
  329.                     else begin
  330.                       //ferrmsg := 'ERR failed to build '+ExtractFileName(fDestinationFullFileName)+' '+ferrmsg;
  331.                       fSuccess := false;
  332.                       end;
  333.           end; // case
  334.         //fSummary.add(' '+fErrMsg);
  335.         MassageResults(fresults);
  336.         fresults.add(fErrMsg);
  337.         for i := 0 to fResults.count-1 do begin
  338.           if pos('Hint:', fResults[i]) > 0
  339.             then inc(fHints);
  340.           if pos('Warning:', fResults[i]) > 0
  341.             then inc(fWarn);
  342.           if pos('Error:', fResults[i]) > 0
  343.             then inc(fErr);
  344.           if pos('Fatal:', fResults[i]) > 0
  345.             then inc(fFatal);
  346.           end;
  347.         tmp := 'Lines: '+IntToStr(flines)+ ',  Hints: '+IntToStr(Hints)+ ',  Warnings: '+IntToStr(fWarn)+',  Errors: '+IntToStr(fErr)+',   Fatal: '+IntToStr(fFatal);
  348.         if fSuccess
  349.           then tmp := 'OK: '+ExtractFileName(fDestinationFullFileName)+' '+tmp
  350.           else tmp := 'ERR: '+ExtractFileName(fDestinationFullFileName)+' '+ferrmsg+' '+tmp;
  351.         fsummary.add(tmp);
  352.         //fResults.add(tmp);
  353.         //DoCompileNotify(fErrMsg+#13#10+tmp);
  354.         end;
  355.  
  356. //  fResults.insert(0,'  ');
  357. //  fResults.insert(0,'  ');
  358. end;
  359.  
  360.  
  361. procedure TCompileClass.MassageResults(var alist : tstringlist);
  362. var i : integer;
  363.     tmp : string;
  364. begin
  365.   if fCompileType = ctRC
  366.     then begin
  367.       for i := alist.count-1 downto 0 do begin
  368.         if (pos('Lines:', alist[i]) = 1) or (pos('New File:', alist[i]) = 1)
  369.           then alist.delete(i);
  370.         end;
  371.       end
  372.     else begin
  373.       for i := alist.count-1 downto 0 do begin
  374.         tmp := trim(alist[i]);
  375.         if tmp = ''
  376.           then alist.delete(i)
  377.           else begin
  378.             system.delete(tmp, 1, length(tmp)-2);
  379.             if tmp[2] = ')'
  380.               then if tmp[1] in ['1','2','3','4','5','6','7','8','9','0']
  381.                      then alist.delete(i);
  382.             end;
  383.         end;
  384.       end;
  385. end;
  386.  
  387.  
  388.  
  389.  
  390.  
  391. procedure TCompileClass.ProcessDPKOptions(DPKFile: string);
  392. begin
  393.   // replace options found in fDPKItself with those found in fDPKOptions, then save .dpk
  394.  
  395. end;
  396.  
  397. { TBuilderClass }
  398.  
  399. constructor TBuilderClass.create(aOwner: tcomponent);
  400. begin
  401.   inherited;
  402.   fResourceHandler := TResourceHandler.create(self);
  403.   fResourceHandler.OnResourceError := HandleResourceHandlerError;
  404.   fCompiler := TCompileClass.create;
  405.   with fCompiler do begin
  406.     Results:= tstringlist.create;
  407.     Summary:= tstringlist.create;
  408.     configFile  := tstringlist.create;
  409.     fDPKOptions := tstringlist.create;
  410.     fDPKItself := tstringlist.create;
  411.     end;
  412.   fCompiler.ResourceHandler := fResourceHandler;
  413.   fProjectResults := tstringlist.create;
  414.   fProjectSummary := tstringlist.create;
  415.   fCompileEventStash := tstringlist.create;
  416.   fProjectList := tstringlist.create;
  417.   fConfigFile := tstringlist.create;
  418.   fConfigWithPath := tstringlist.create;
  419.   fLibraryFile := tstringlist.create;
  420. end;
  421.  
  422. destructor TBuilderClass.destroy;
  423. begin
  424.   fCompiler.free;
  425.   fResourceHandler.free;
  426.   fProjectResults.free;
  427.   fProjectSummary.free;
  428.   fCompileEventStash.free;
  429.   fProjectList.free;
  430.   fConfigFile.free;
  431.   fConfigWithPath.free;
  432.   fLibraryFile.free;
  433.   inherited;
  434. end;
  435.  
  436.  
  437. procedure TBuilderClass.doCompileEnd;
  438. begin
  439.  if assigned(fOnCompileEnd)
  440.    then fOnCompileEnd(fCompiler.SourceFullFileName, fCompiler.DestinationFullFileName, fCompiler.ErrMsg, fCompiler.success,
  441.                       fCompiler.lines, fCompiler.hints, fCompiler.Warnings, fCompiler.Errors, fCompiler.Fatals);
  442.  if not fCompiler.success
  443.    then DoProjectHalt(fCompiler.errMsg);
  444. end;
  445.  
  446. procedure TBuilderClass.HandleCompileEvent(const aSourcefile, Info: string);
  447. var tmp : string;
  448. begin
  449.   tmp := aSourceFile;
  450.   if trim(aSourceFile) = ''
  451.     then tmp := ExtractFileName(fCompiler.SourceFullFileName);
  452.   if assigned(fOnCompileEvent)
  453.     then fOnCompileEvent(tmp, Info);
  454.   fCompileEventStash.add('Compile Event  '+tmp+' '+info);
  455. end;
  456.  
  457. procedure TBuilderClass.doCompileStart;
  458. begin
  459.  if assigned(fOnCompileStart)
  460.     then fOnCompileStart(fCompiler.SourceFullFileName, fCompiler.DestinationFullFileName, fCompiler.ErrMsg);
  461.   ProjectResults.add(#13#10+'Start: '+fCompiler.SourceFullFileName +#13#10+'  --> '+fCompiler.DestinationFullFileName+#13#10+'   --> '+fCompiler.ErrMsg);
  462. end;
  463.  
  464. function TBuilderClass.computeprojecttime : string;
  465. var fHours, fMinutes, fSeconds, fMS : word;
  466. begin
  467.   DecodeTime(now - fprojectStart, fHours, fMinutes, fSeconds, fMS);
  468.   result := '   Time: '+ Format('%.2f seconds', [fms / 1000.0 + fSeconds + 60 * (fMinutes + fHours * 60)]);
  469. end;
  470.  
  471. procedure TBuilderClass.DoProjectDone;
  472. begin
  473.   ProjectSummary.add(#13#10+'Builder done: '+ComputeProjectTime);
  474.   ProjectSummary.add('Final result is '+IntToStr(fOKs)+' OK, '+IntToStr(fErrs)+' ERR.   Lines: '+IntToStr(flines)+ ',  Hints: '+IntToStr(fHints)+ ',  Warnings: '+IntToStr(fWarn)+',  Errors: '+IntToStr(fErr)+',   Fatal: '+IntToStr(fFatal));
  475.   if assigned(fOnProjectDone)
  476.     then fOnProjectDone(fProjectName, fOKs, fErrs, fLines, fHints, fWarn, fErr, fFatal);
  477. end;
  478.  
  479. procedure TBuilderClass.DoProjectHalt(const info : string);
  480. begin
  481.   if Assigned(fOnProjectHalt)
  482.     then fOnProjectHalt(fProjectName, info);
  483.   if FHaltOnError
  484.     then begin
  485.       //fHaltNow := true;
  486.       ProjectSummary.add(#13#10+'Project Halted: '+ComputeProjectTime);
  487.       ProjectSummary.add('ProjectHalted: '+info);
  488.       end
  489.     else ProjectSummary.add('Project would have been halted: '+info);
  490. end;
  491.  
  492. function TBUilderClass.IsIndependentRCFile(filename : string) : boolean;
  493. var i,numoccur : integer;
  494.    LookForPath : string;
  495.    found : boolean;
  496. begin
  497.  LookForPath := UpperCase(changeFileExt(filename, '.'));
  498.  numOccur := 0;
  499.  for i := 0 to fProjectList.count-1 do
  500.    if LookForPath = uppercase(changeFileExt(fProjectList.values[fProjectList.names[i]], '.'))
  501.       then inc(numOccur);
  502.  result := NumOccur = 1;
  503. end;
  504.  
  505. function TBUilderClass.DetermineCompileType :  TCompileTypeEnum;
  506. var TmpFileName : string;
  507. begin
  508.   if pos('.RC', UpperCase(fCompiler.SourceFullFileName)) <> 0
  509.     then begin
  510.        result := ctRC;
  511.        If not IsIndependentRCFile(fCompiler.SourceFullFileName)
  512.          then begin
  513.            TmpFileName := ChangefileExt(fCompiler.SourceFullFileName, '.VER');
  514.            PrepareResourceFile(TmpFileName);
  515.               if fAutoIncrement
  516.                 then DoAutoIncrement(TmpFileName);
  517.            SaveResourceFile(TmpFileName);
  518.            end;
  519.        end
  520.       else result := ctDPR
  521. end;
  522.  
  523. function TBuilderClass.execute: boolean;
  524. var i : integer;
  525.     tmp : string;
  526. begin
  527.   result := true;
  528.   try
  529.     fHaltNow := false;
  530.     fNotAlreadyIncremented := true;
  531.     fProjectResults.clear;
  532.     fProjectSummary.clear;
  533.     tmp := 'Build defined in '+fprojectDir + ' started '+FormatDateTime('ddd, dd mmm yyyy  hh:nn:ss', now)+#13#10;
  534.     fProjectStart := now;
  535.     fProjectSummary.add(tmp);
  536.     if assigned(fOnProjectStart)
  537.       then fOnProjectStart(tmp, '');
  538.     FProjectSummary.SaveToFile('started.dat');
  539.     fCompiler.InFile := SlashSep(fProjectDir,'started.dat');
  540.     fCompiler.Outfile := SlashSep(fProjectDir, cTotDump);
  541.     fCompiler.ProjectDir := fProjectDir;
  542.     fCompiler.OnCompile := HandleCompileEvent;
  543.     fCompiler.configfile.assign(fConfigWithPath);
  544.     flines := 0;
  545.     fHints := 0;
  546.     fWarn := 0;
  547.     fErr := 0;
  548.     fFatal := 0;
  549.     fOKs := 0;
  550.     fErrs := 0;
  551.     for i := 0 to fProjectList.count-1 do begin
  552.       if fHaltNow then break;
  553.       fCompileEventStash.clear;
  554.       fCompiler.DestinationFullFileName := fProjectList.names[i];
  555.       fCompiler.SourceFullFileName := fProjectList.values[fProjectList.names[i]];
  556.       fCompiler.compileType := DetermineCompileType;
  557.       fCompiler.ErrMsg := 'Compile started '+FormatDateTime('ddd, dd mmm yyyy  hh:nn:ss', now);
  558.       doCompileStart;
  559.       if fCompiler.Execute
  560.           then begin
  561.             if fCompiler.Success
  562.               then begin
  563.                 Inc(fOKs);
  564.                 if fCompiler.compiletype in [ctDPR, ctDLL, ctDPK]
  565.                   then begin
  566.                     fResourceHandler.ClearSettings;
  567.                     fResourceHandler.GetVersionInfoFromProgram(fCompiler.DestinationFullFileName);
  568.                     fCompiler.Summary.add(fResourceHandler.VersionSummary);
  569.                     fCompiler.Summary.add(' ');
  570.                     if fCheckVersion
  571.                       then begin
  572.                         fResourceHandler.ClearSettings;
  573.                         fResourceHandler.GetVersionInfoFromProgram(fCompiler.DestinationFullFileName);
  574.                         fCompiler.Results.add(fResourceHandler.DisplayRCData(' from '+fCompiler.DestinationFullFileName));
  575.                         end;
  576.                     end;
  577.                 end
  578.               else Inc(fErrs);
  579.             fLines := fLines+fCompiler.Lines;
  580.             fWarn := fWarn+fCompiler.Warnings;
  581.             fHints :=fHints+fCompiler.Hints;
  582.             fErr := fErr+fCompiler.Errors;
  583.             fFatal := fFatal+fCompiler.Fatals;
  584.             end
  585.           else begin
  586.             Inc(fErrs);
  587.             end;
  588.       DoCompileEnd; // IntToStr(OKs)+' OK, '+IntToStr(Errs)+' ERR.   Lines: '+IntToStr(Totlines)+ ',  Hints: '+IntToStr(TotHints)+ ',  Warnings: '+IntToStr(TotWarn)+',  Errors: '+IntToStr(TotErr)+',   Fatal: '+IntToStr(TotFat);
  589.       ProjectResults.addStrings(fCompiler.Results);
  590.       ProjectResults.addStrings(fCompileEventStash);
  591.       ProjectSummary.addStrings(fCompiler.Summary);
  592.       end;
  593.     DoProjectDone;
  594.     ProjectResults.insert(0, ProjectSummary.text);
  595.     ProjectResults.savetofile(cTotDump);
  596.   except
  597.     on e:exception do begin
  598.       DoProjectHalt('Exception thrown in Builder: '+e.message);
  599.       result := false;
  600.       end;
  601.   end;
  602.  
  603. end;
  604.  
  605.  
  606.  
  607. procedure TBuilderClass.PrepareLibPath(var libPathList : tstringlist);
  608. // make sure the libpath is less than 1024, or make it into multiple lines, each of which shorter than 1024
  609. var i : integer;
  610.     tmp, workChunk : string;
  611. begin
  612.   tmp := stringREplace(libPathList.text, #13#10, ';', [rfReplaceAll]);
  613.   If length(tmp) < 1023
  614.     then begin
  615.       libPathList.clear;
  616.       libPathList.add('-U"'+tmp+'"');
  617.       libPathList.add('-I"'+tmp+'"');
  618.       libPathList.add('-R"'+tmp+'"');
  619.       libPathList.add('-O"'+tmp+'"');
  620.       end
  621.     else begin
  622.       libPathList.clear;
  623.       while tmp <> '' do begin
  624.         workChunk := copy(tmp, 1, 1000);
  625.         for i := length(workCHunk) downto 1 do
  626.           if workChunk[i] = ';'
  627.             then begin
  628.                workChunk := copy(tmp, 1, i-1);
  629.                tmp := copy(tmp, i+1, 20000);
  630.                break;
  631.                end;
  632.         if trim(tmp) = ';' then tmp := '';
  633.         libPathList.add('-U"'+WorkChunk+'"');
  634.         libPathList.add('-I"'+WorkChunk+'"');
  635.         libPathList.add('-R"'+WorkChunk+'"');
  636.         libPathList.add('-O"'+WorkChunk+'"');
  637.         end;
  638.       end;
  639. end;
  640.  
  641.  
  642.  
  643. Function TBuilderClass.SetUpProject: boolean;
  644. var tmpsl : tstringlist;
  645. begin
  646.   result := true;
  647.   tmpsl := tstringlist.create;
  648.   try
  649.   try
  650.     chdir(fProjectDir);
  651.   except
  652.     on e:exception do begin
  653.       DoProjectHalt('chdir to project path, '+fProjectDir+ ' failed: '+#13#10+e.message);
  654.       DoProjectDone;
  655.       result := false;
  656.       end;
  657.     end;
  658.   if fileexists(cLibraryPath)
  659.     then fLibraryFile.loadfromfile(cLibrarypath)
  660.     else begin
  661.       Try
  662.         tmpsl.LoadFromFile(slashSep(extractFilePath(application.exename), 'Default.path'));
  663.         tmpsl.SaveToFile(SlashSep(fProjectDir, cLibraryPath));
  664.         fLibraryFile.assign(tmpsl);
  665.       except
  666.         DoProjectHalt('Could not create '+cLibraryPath);
  667.         result := false;
  668.         end;
  669.       end;
  670.   if fileexists(cResourceMask)
  671.     then fResourceHandler.Mask.loadfromfile(cResourceMask)
  672.     else begin
  673.       Try
  674.         tmpsl.LoadFromFile(slashSep(extractFilePath(application.exename), 'Default.mask'));
  675.         tmpsl.SaveToFile(SlashSep(fProjectDir, cResourceMask));
  676.         fResourceHandler.Mask.assign(tmpsl);
  677.       except
  678.         DoProjectHalt('Could not create '+cResourceMask);
  679.         result := false;
  680.         end;
  681.       end;
  682.   if fileexists(cConfig)
  683.     then fConfigFile.loadfromfile(cConfig)
  684.     else begin
  685.       try
  686.         tmpsl.LoadFromFile(slashSep(extractFilePath(application.exename), 'Default.config'));
  687.         tmpsl.SaveToFile(SlashSep(fProjectDir, cConfig));
  688.         fConfigFile.assign(tmpsl);
  689.       except
  690.         DoProjectHalt('Could not create '+cConfig);
  691.         result := false;
  692.         end;
  693.       end;
  694.   fConfigWithPath.assign(fConfigFile);
  695.   tmpsl.assign(fLibraryFile);
  696.   PrepareLibPath(tmpsl);
  697.   fConfigWithPath.addstrings(tmpsl);
  698.   fProjectList.clear;
  699.   if not FileExists(cProjectList)
  700.     then begin
  701.       try
  702.         tmpsl.LoadFromFile(slashSep(extractFilePath(application.exename), 'Default.Files'));
  703.         tmpsl.SaveToFile(SlashSep(fProjectDir, cProjectList));
  704.       except
  705.         DoProjectHalt('Could not create '+cProjectList);
  706.         result := false;
  707.         end;
  708.       end;
  709.   if FileExists(cProjectList)
  710.     then  with tinifile.create(SlashSep(fprojectdir,cProjectList)) do begin
  711.      readSectionValues(cDPR, fProjectList);
  712.      fAutoIncrement := readBool(cOptions, cAutoIncrement, false);
  713.      fIncrementComment := ReadBool(cOptions, cIncrementComment, false);
  714.      fMinimize := readBool(cOptions, cMinimize, false);
  715.      fCheckVersion := ReadBool(cOptions, cCheckVersion, false);
  716.      fVerInfoInVerFile := readbool(cOptions, cVerInfoInVerFile, false);
  717.      FHaltOnError := readbool(cOptions, cHaltOnError, false);
  718.      UpdateFile;
  719.      free;
  720.      end;
  721.   finally
  722.     tmpsl.free;
  723.     end;
  724. end;
  725.  
  726. Function TBuilderClass.InitializeProject(const aProjectDir : string): boolean;
  727. begin
  728.   result := true;
  729.   fProjectDir := aProjectdir;
  730.   try
  731.     result := ForceDirectories(fProjectDir);
  732.     chdir(fProjectDir);
  733.   except
  734.     on e:exception do begin
  735.       DoProjectHalt('chdir to project path, '+fProjectDir+ ' failed: '+e.message);
  736.       DoProjectDone;
  737.       result := false;
  738.       exit;
  739.       end;
  740.     end;
  741.   SetUpProject;
  742. end;
  743.  
  744.  
  745. function TBuilderClass.SaveProjectSettings: boolean;
  746. var i : integer;
  747. begin
  748.   result := true;
  749.   try
  750.     chdir(fProjectDir);
  751.   except
  752.     on e:exception do begin
  753.       DoProjectHalt('chdir to project path, '+fProjectDir+ ' failed: '+e.message);
  754.       DoProjectDone;
  755.       result := false;
  756.       exit;
  757.       end;
  758.     end;
  759.   fLibraryFile.SaveToFile(cLibrarypath);
  760.   fConfigFile.SaveToFile(cConfig);
  761.   with tinifile.create(SlashSep(fprojectdir,cProjectList)) do begin
  762.      EraseSection(cDPR);
  763.      for i := 0 to fProjectlist.count-1 do
  764.        writestring(cDPR, fProjectList.names[i], fProjectList.values[fProjectList.names[i]]);
  765.      writebool(cOptions, cAutoIncrement, fAutoIncrement);
  766.      writebool(cOptions, cIncrementComment, fIncrementComment);
  767.      writebool(cOptions, cCheckVersion, fCheckVersion);
  768.      writebool(cOptions, cMinimize, fMinimize);
  769.      writebool(cOptions, cVerInfoInVerFile, fVerInfoInVerFile);
  770.      writebool(cOptions, cHaltOnError, FHaltOnError);
  771.      UpdateFile;
  772.      free;
  773.      end;
  774. end;
  775.  
  776.  
  777. procedure TBuilderClass.HandleResourceHandlerError(const filename, info: string);
  778. begin
  779.   HandleCompileEvent('Resource Error: for '+filename, info);
  780.   if not fResourceHandler.Success
  781.     then DoProjectHalt('Resource Error for '+filename + ': ' + info);
  782. end;
  783.  
  784. procedure TBuilderClass.setAutoIncrement(const Value: boolean);
  785. begin
  786.   fAutoIncrement := Value;
  787. end;
  788.  
  789. procedure TBuilderClass.setIncrementBuild(const Value: boolean);
  790. begin
  791.   fIncrementBuild := Value;
  792. end;
  793.  
  794. procedure TBuilderClass.PrepareResourceFile(const aSourcePath : string);
  795. begin
  796.   fResourceHandler.PrepareResourceData(aSourcePath, SlashSep(fprojectdir,cProjectList))
  797. end;
  798.  
  799. Procedure TBuilderClass.SaveResourceFile(const aSourcePath : string);
  800. begin
  801.   if fVerInfoInVerFile
  802.     then fResourceHandler.SaveSettings(aSourcePath, 'LastCompiledWith');
  803.   fREsourceHandler.RCMaskFileName := SlashSep(fprojectdir,cResourceMask);
  804.   fResourceHandler.RCfileName := ChangeFileExt(aSourcePath, '.RC');
  805.   fResourceHandler.WriteRCFile;
  806. end;
  807.  
  808.  
  809. procedure TBuilderClass.DoAutoIncrement(const aSourcePath : string);
  810. var locFileBuild, locProductBuild : integer;
  811.     locComment : string;
  812. begin
  813.   locFileBuild := StrToInt(FResourceHandler.VersionInfo[reBuild]);
  814.   locProductBuild := StrtoInt(FResourceHandler.VersionInfo[reProductBuild]);
  815.   locComment := FresourceHandler.VersionInfo[reComments];
  816.   If fIncrementComment
  817.     then begin
  818.       SetIncrement(locFilebuild, locProductBuild, locComment);
  819.       end
  820.     else begin
  821.       inc(LocFileBuild);
  822.       inc(locProductBuild);
  823.       end;
  824.   fResourceHandler.VersionInfo[rebuild] := IntToStr(locFileBuild);
  825.   fResourceHandler.VersionInfo[reProductbuild] := IntToStr(locProductBuild);
  826. //todo  -cBuilderObject:  If no changes in files.ini or *.ver, do not save
  827.  
  828.   If fNotAlreadyIncremented
  829.     then with tinifile.create(SlashSep(fprojectdir,cProjectList)) do begin
  830.       if FResourceHandler.VersionSource[reBuild] = rsProject
  831.         then WriteString(cVersion, 'Build', fResourceHandler.VersionInfo[rebuild]);
  832.       if FResourceHandler.VersionSource[reProductBuild] = rsProject
  833.         then WriteString(cVersion, 'ProductBuild', fResourceHandler.VersionInfo[reProductBuild]);
  834.       if fIncrementComment and (FResourceHandler.VersionSource[reComments] = rsProject)
  835.         then WriteString(cVersion, 'Comments', fResourceHandler.VersionInfo[reComments]);
  836.       UpdateFile;
  837.       free;
  838.       fNotAlreadyIncremented := false;
  839.       end;
  840.   try
  841.   with tinifile.create(aSourcePath) do begin
  842.     if FResourceHandler.VersionSource[reBuild] = rsFile
  843.       then WriteString(cVersion, 'Build', fResourceHandler.VersionInfo[rebuild]);
  844.     if FResourceHandler.VersionSource[reProductBuild] = rsFile
  845.       then WriteString(cVersion, 'ProductBuild', fResourceHandler.VersionInfo[reProductBuild]);
  846.     if fIncrementComment and (FResourceHandler.VersionSource[reComments] = rsFile)
  847.       then WriteString(cVersion, 'Comments', fResourceHandler.VersionInfo[reComments]);
  848.     UpdateFile;
  849.     free;
  850.     end;
  851.   PrepareResourceFile(aSourcePath);
  852.   except
  853.     on e:exception do begin
  854.       fResourceHandler.DoFileError(asourcePath, 'Could not save: '+e.message);
  855.       end;
  856.   end;
  857. end;
  858.  
  859. end.
  860.  
  861. (*
  862.  
  863. begin
  864.   try
  865.     fHaltNow := false;
  866.     st := now;
  867.     bb_halt.enabled := true;
  868.     // in file not really needed, but easier to specify something rather than rewrite the supporting function.
  869.     InFile := extractFilePath(application.exename)+'builder.ini';
  870.     // keep the dump file in the project directory
  871.     Outfile := SlashSep(fProjectDir, cTotDump);
  872.     tmpsl := tstringlist.create;
  873.     configFile := tstringlist.create;
  874.     PathFile := tstringlist.create;
  875.     results := tstringlist.create;
  876.     summary := tstringlist.create;
  877.     summary.add('Build started '+FormatDateTime('ddd, dd mmm yyyy  hh:nn:ss', now)+#13#10);
  878.     lb_exe.itemindex := 0;
  879.     A_saveProjectExecute(Sender);
  880.     chdir(fProjectdir);
  881.     PathFile.loadfromfile('Library.path');
  882.     PrepareLibPath(Pathfile);
  883.     ConfigFile.loadfromfile('Base.cfg');
  884.     ConfigFile.addstrings(PathFile);
  885.     subLines := 0;
  886.     totlines := 0;
  887.     subHints  := 0;
  888.     totHints := 0;
  889.     subWarn := 0;
  890.     totWarn := 0;
  891.     subErr := 0;
  892.     totErr := 0;
  893.     subFat := 0;
  894.     totFat := 0;
  895.     OKs := 0;
  896.     Errs := 0;
  897.     lb_result.items.clear;
  898.     lb_result.color := clWhite;
  899.     A_viewCompilerOptionsHelp.Checked := false;
  900.     l_progress.caption := 'Starting project '+fprojectdir;
  901.     LB_exe.itemindex := 0;
  902.     for i := 0 to fexeList.count-1 do begin
  903.       if fHaltNow then break;
  904.       subLines := 0;
  905.       subHints  := 0;
  906.       subWarn := 0;
  907.       subErr := 0;
  908.       subFat := 0;
  909.       LB_exeClick(sender);
  910.       ForceDirectories(ExtractFilePath(m_destination.text));
  911.       try
  912.         chdir(extractFilePath(m_source.text));
  913.       except
  914.         on e:exception do begin
  915.           tmp := 'chdir to '+m_source.text+'failed: '#13#10+e.message;
  916.           showmessage(tmp);
  917.           summary.add(tmp);
  918.         end;
  919.       end;
  920.       //todo: set up stuff for dpk processing
  921.       //todo: test rc stuff
  922.  
  923.       tmp := changeFileExt(lb_exe.items[i], '.cfg');
  924.       try
  925.         ConfigFile.saveToFile(tmp);
  926.       except
  927.         on e:exception do begin
  928.           tmp := 'Failed to replace '+tmp+' '+e.message;
  929.           summary.add(tmp);
  930.           showmessage(tmp);
  931.           end;
  932.       end;
  933.       tmp := ExtractFileName(m_source.text);
  934.       if pos('.RC', uppercase(tmp)) > 0
  935.         then cmdline := 'BRCC32.exe -v -f'+m_destination.text+' '+tmp
  936.         else cmdline := 'DCC32.exe '+ExtractFileName(m_source.text) + ' -E'+ExtractFilePath(m_destination.text) ;
  937.       l_progress.caption := 'compiling '+ ExtractFileName(m_source.text);
  938.       Application.processMessages;
  939.       success :=  CreateDOSProcessRedirected(cmdline, infile, outfile, errmsg);
  940.       lb_result.items.LoadFromFile(outfile);
  941.       if Not Success
  942.          then lb_result.items.insert(0, format('xxxxx>'#13#10'DCC Failed to load: '+cmdline+ #13#10'   Error Code %d', [GetLastError])+#13#10+errmsg)
  943.          else begin
  944.             lb_result.items.insert(0, 'DCC started: '+cmdline);
  945.             lb_result.items.insert(0, '=====>');
  946.             errmsg := lb_result.items[lb_result.items.count-1];
  947.             if pos(' lines, ', errmsg) > 0
  948.               then begin
  949.                  totlines := totlines + StrtoInt(trim(copy(errmsg, 1, pos(' lines', errmsg))));
  950.                  errmsg := 'OK '+lb_exe.items[i]+': '+errmsg;
  951.                  Inc(Oks);
  952.                  {MOHAboutDialog1.Filename :=m_destination.text;
  953.                  MOHAboutDialog1.refresh;
  954.                  for j := 0 to MOHAboutDialog1.versionDetails.count-1 do
  955.                    lb_result.items.add(MOHAboutDialog1.VersionDetails[j]);
  956.                  }
  957.                  end
  958.               else begin
  959.                 errmsg := 'ERR '+errmsg;
  960.                 inc(errs);
  961.                 end;
  962.             tmpsl.assign(lb_result.items);
  963.             MassageResults(tmpsl);
  964.             lb_result.items.assign(tmpsl);
  965.             for j := 0 to tmpsl.count-1 do begin
  966.               if pos('Hint:', tmpsl[j]) > 0
  967.                 then inc(subHints);
  968.               if pos('Warning:', tmpsl[j]) > 0
  969.                 then inc(subWarn);
  970.               if pos('Error:', tmpsl[j]) > 0
  971.                 then inc(subErr);
  972.               if pos('Fatal:', tmpsl[j]) > 0
  973.                 then inc(subFat);
  974.               end;
  975.             TotLines := TotLines+SubLines;
  976.             TotWarn := TotWarn+SubWarn;
  977.             TotHints :=TotHints+SubHints;
  978.             TotErr := TotErr+SubErr;
  979.             TotFat := TotFat+SubFat;
  980.             tmp := IntToStr(OKs)+' OK, '+IntToStr(Errs)+' ERR.   Lines: '+IntToStr(Totlines)+ ',  Hints: '+IntToStr(TotHints)+ ',  Warnings: '+IntToStr(TotWarn)+',  Errors: '+IntToStr(TotErr)+',   Fatal: '+IntToStr(TotFat);
  981.             StatusBar1.simpleText := tmp;
  982.             Application.processMessages;
  983.             lb_result.items.insert(0, tmp);
  984.             lb_result.items.insert(0, errmsg);
  985.             lb_result.items.insert(0, '----------------------------');
  986.             summary.add(errmsg);
  987.             summary.add('   '+tmp);
  988.             summary.add(' ');
  989.             results.addstrings(lb_result.items);
  990.             end;
  991.       lb_exe.itemindex := lb_exe.itemindex + 1;
  992.       if lb_exe.itemindex = lb_exe.items.count
  993.         then break;
  994.       end;
  995.     et := now;
  996.     DecodeTime(et - st, h, m, s, ms);
  997.     tmp := 'Final result is '+IntToStr(OKs)+' OK, '+IntToStr(Errs)+' ERR.   Lines: '+IntToStr(TotLines)+ ',  Hints: '+IntToStr(TotHints)+ ',  Warnings: '+IntToStr(TotWarn)+',  Errors: '+IntToStr(TotErr)+',   Fatal: '+IntToStr(TotFat);
  998.     summary.add('  ');
  999.     summary.add(tmp);
  1000.     summary.add('   Time: '+ Format('%.2f', [ms / 1000.0 + s + 60 * (m + h * 60)]));
  1001.     StatusBar1.simpleText := tmp;
  1002.     summary.add(#13#10'details...');
  1003.     for i := summary.count-1 downto 0 do
  1004.       results.insert(0, summary[i]);
  1005. //    results.insert(0, summary.text);
  1006. //    MassageResults(results);
  1007.     lb_result.items.assign(results);
  1008.     chdir(fProjectdir);
  1009.     lb_result.items.savetofile(outfile);
  1010.     l_progress.caption := 'Memo saved to '+outfile;
  1011.   except
  1012.     on e:exception do begin
  1013.       results.Insert(0, 'Exception thrown: '+#13#10+e.message+#13#10);
  1014.       lb_result.items.assign(results);
  1015.       lb_result.items.saveToFile(outfile);
  1016.       end;
  1017.   end;
  1018.   bb_halt.enabled := false;
  1019.   results.Free;
  1020.   tmpsl.free;
  1021.   configFile.free;
  1022.   PathFile.free;
  1023.   summary.free;
  1024.  
  1025.  
  1026. end.
  1027. *)
  1028.