{******************************************************************************* Unit: main.pas contains Form_Main *******************************************************************************} {******************************************************************************* LazUpdater runs SVN Update/Checkout, Make and Strip for FPC and Lazarus. Copyright (C) 2010 Ingo Steiniger This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, see . *******************************************************************************} unit main; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, IniFiles, LCLType, Menus, ComCtrls, Grids, Buttons, Process, defaulttranslator, LCLIntf {$ifdef WINDOWS} ,registry{$endif WINDOWS}; type { TForm_Main } TForm_Main = class(TForm) Btn_Start: TBitBtn; Btn_Stop: TBitBtn; Btn_Log: TBitBtn; Btn_About: TBitBtn; Btn_AppPath: TButton; Btn_BinFPC: TButton; Btn_BinLazBuild: TButton; Btn_BinMake: TButton; Btn_BinSVN: TButton; Btn_FpcCfg: TButton; Btn_FpcGetDir: TButton; Btn_FpcInstDir: TButton; Btn_LazGetDir: TButton; Btn_Out: TBitBtn; Btn_ppclnk: TButton; Btn_ProfDel: TButton; Btn_ProfSaveAs: TBitBtn; Btn_Send: TButton; ChBo_Async: TCheckBox; ChBo_FpcDoInst: TCheckBox; ChBo_FpcDoMake: TCheckBox; ChBo_FpcDoUpd: TCheckBox; ChBo_FpcFMake: TCheckBox; ChBo_LazDoMake: TCheckBox; ChBo_LazDoStrip: TCheckBox; ChBo_LazDoUpd: TCheckBox; ChBo_LazFMake: TCheckBox; ChBo_LazFMake2: TCheckBox; ChBo_LazBuild: TCheckBox; CoBo_Prof: TComboBox; Edit_LazBuildOpt: TEdit; Edit_BinFPC: TEdit; Edit_BinLazBuild: TEdit; Edit_BinMake: TEdit; Edit_BinSVN: TEdit; Edit_FpcInstDir: TEdit; Edit_FpcInstOpt: TEdit; Edit_FpcMakeOpt: TEdit; Edit_FpcSvnOpt: TEdit; Edit_FpcUpdDir: TEdit; Edit_FpcURL: TEdit; Edit_LazMakeOpt: TEdit; Edit_LazUpdDir: TEdit; Edit_LazUpdOpt: TEdit; Edit_LazURL: TEdit; Edit_Send: TEdit; GrBo_Action: TGroupBox; GrBo_bins: TGroupBox; GrBo_FpcCfg: TGroupBox; GrBo_FpcInst: TGroupBox; GrBo_FpcMake: TGroupBox; GrBo_FpcSvn: TGroupBox; GrBo_Input: TGroupBox; GrBo_LazMake: TGroupBox; GrBo_LazStrip: TGroupBox; GrBo_LazSVN: TGroupBox; GrBo_Out: TGroupBox; GrBo_Over: TGroupBox; Image1: TImage; Label1: TLabel; Label10: TLabel; Label11: TLabel; Label12: TLabel; Label13: TLabel; Label14: TLabel; Label15: TLabel; Label16: TLabel; Label17: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; Label5: TLabel; Label6: TLabel; Lab_FpcCurVer: TLabel; Lab_LazCurVer: TLabel; Lab_LazmakeOpt: TLabel; Memo_Out: TMemo; MenIt_Copy: TMenuItem; MenIt_Wrap: TMenuItem; MenuItem1: TMenuItem; OpenDi: TOpenDialog; PageControl1: TPageControl; PopMen_Out: TPopupMenu; SaveDi: TSaveDialog; SelDirDi: TSelectDirectoryDialog; StrGd_Over: TStringGrid; Page_Main: TTabSheet; Page_FPC: TTabSheet; Page_Laz: TTabSheet; Page_Tools: TTabSheet; procedure Btn_AboutClick(Sender: TObject); procedure Btn_AppPathClick(Sender: TObject); procedure Btn_BinFPCClick(Sender: TObject); procedure Btn_BinLazBuildClick(Sender: TObject); procedure Btn_FpcGetDirClick(Sender: TObject); procedure Btn_FpcInstDirClick(Sender: TObject); procedure Btn_LazGetDirClick(Sender: TObject); procedure Btn_LogClick(Sender: TObject); procedure Btn_BinMakeClick(Sender: TObject); procedure Btn_ProfDelClick(Sender: TObject); procedure Btn_ProfSaveAsClick(Sender: TObject); procedure Btn_SendClick(Sender: TObject); procedure Btn_StartClick(Sender: TObject); procedure Btn_StopClick(Sender: TObject); procedure Btn_FpcCfgClick(Sender: TObject); procedure Btn_BinSVNClick(Sender: TObject); procedure Btn_ppclnkClick(Sender: TObject); procedure ChBo_AsyncChange(Sender: TObject); procedure ChBo_FpcDoInstChange(Sender: TObject); procedure CoBo_ProfChange(Sender: TObject); procedure Edit_BinLazBuildChange(Sender: TObject); procedure Edit_BinFPCChange(Sender: TObject); procedure Edit_BinMakeChange(Sender: TObject); procedure Edit_BinSVNChange(Sender: TObject); procedure Edit_FpcInstDirChange(Sender: TObject); procedure FormClose(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Image1Click(Sender: TObject); procedure Memo_OutChange(Sender: TObject); procedure MenIt_CopyClick(Sender: TObject); procedure MenIt_WrapClick(Sender: TObject); procedure Btn_OutClick(Sender: TObject); procedure StrGd_OverPrepareCanvas(sender: TObject; aCol, aRow: Integer; aState: TGridDrawState); private { private declarations } ExtBin:String; //file extension of an executeable binary CurrentProfileName:String; FUseAsync:Boolean; //Helperfunctions procedure LUUpdateProcessonPushData(aData:String); procedure myWriteLn(Output:String); procedure InitOver(); procedure UpdOver(); procedure setBinaries(); function getFpcInfo():Boolean; function callProcess(WorkingDir, Command:String):Integer; function createSymLinks():Boolean; //Profile procedure LoadProfile(Profilename:String); procedure SaveProfile(Profilename:String); //FPC function FpcDoSVNUpdate():Boolean; function FpcDoSVNCheckout():Boolean; function FpcDoMake():Boolean; function FpcDoInst():Boolean; function FpcShowLog():Boolean; //Lazarus function LazDoSVNUpdate():Boolean; function LazDoSVNCheckout():Boolean; function LazDoMake():Boolean; function LazDoStrip():Boolean; function LazShowLog():Boolean; function MakeLazBuild():Boolean; public { public declarations } // AppDir:String; //Directory of this application end; var Form_Main: TForm_Main; implementation uses NewProf, fpccfg, helper, fselect_fpccfg, gvars, about; {$R *.lfm} { TForm_Main } var myINI:TINIFile; FpcOldVer, LazOldVer, FpcNewVer, LazNewVer, Output:String; BinSVN, BinMake, BinFPC, BinLazBuild:String; stopFpc, stopLaz, doWarn:Boolean; LUStatusName:Array[tsToDo..tsUnchanged] of String; LUTask:array[tnUFPC..tnSLaz] of TLUTask; LUUpdateProcess:TLUUpdateProcess; AProcess:TProcess; {$I lutasks.inc} {$I luprofiles.inc} {$I lutools.inc} {******************************************************************************* Helperfunction: get version of FPC *******************************************************************************} function TForm_Main.getFpcInfo():Boolean; begin Result:=True; FUseAsync:=False; SilentOut:=True; //Version of FPC if callProcess('', BinFPC+' -iW')=0 then begin LUFpcInfo.Version:=Output; end else begin Result:=False; end; //TargetOS if callProcess('', BinFPC+' -iTO')=0 then begin LUFpcInfo.OS:=Output; end else begin Result:=False; end; //TargetCPU if callProcess('', BinFPC+' -iTP')=0 then begin LUFpcInfo.CPU:=Output; end else begin Result:=False; end; SilentOut:=False; FUseAsync:=ChBo_Async.Checked; end; {******************************************************************************* Helperfunction: update Overview *******************************************************************************} procedure TForm_Main.UpdOver(); var myIndex, i:Integer; LUTaskNum:TLUTaskNum; begin //clear fields for i:=1 to StrGd_Over.RowCount-1 do begin StrGd_Over.Cells[0, i]:=''; StrGd_Over.Cells[1, i]:=''; end; //fill fields myIndex:=1; for LUTaskNum:=tnUFPC to tnSLaz do begin if LUTask[LUTaskNum].Activated then begin StrGd_Over.Cells[0, myIndex]:=LUTask[LUTaskNum].Name; StrGd_Over.Cells[1, myIndex]:=LUStatusName[LUTask[LUTaskNum].Status]; inc(myIndex); end; end; StrGd_Over.Refresh; end; procedure TForm_Main.setBinaries(); begin //showMessage(FindDefaultExecutablePath('fpc')); //set to default if (trim(Edit_BinSVN.Text)='') or not FileExists(Edit_BinSVN.Text) or DirectoryExists(Edit_BinSVN.Text) then BinSVN:=FindDefaultExecutablePath('svn') else BinSVN:=Edit_BinSVN.Text; if (trim(Edit_BinMake.Text)='') or not FileExists(Edit_BinMake.Text) or DirectoryExists(Edit_BinMake.Text) then BinMake:=FindDefaultExecutablePath('make') else BinMake:=Edit_BinMake.Text; if (trim(Edit_BinFPC.Text)='') or not FileExists(Edit_BinFPC.Text) or DirectoryExists(Edit_BinFPC.Text) then BinFPC:=FindDefaultExecutablePath('fpc') else BinFPC:=Edit_BinFPC.Text; //LazBuild isn't in PATH so can't be found by FindDefaultExecutablePath() //so we have to move to the directory of Lazarus and call it there if (trim(Edit_BinLazBuild.Text)='') or not FileExists(Edit_BinLazBuild.Text) or DirectoryExists(Edit_BinLazBuild.Text) then {$ifdef UNIX} BinLazBuild:='./lazbuild' {$else UNIX} BinLazBuild:='lazbuild'+ExtBin {$endif UNIX} else BinLazBuild:=Edit_BinLazBuild.Text; end; {******************************************************************************* Helperfunction: initalise Overview *******************************************************************************} procedure TForm_Main.InitOver(); var s:String; TaskNum:TLUTaskNum; begin //***get revisions s:=Edit_FpcUpdDir.Text; s:=getCurSvnVer(s); Lab_FpcCurVer.Caption:=s; if StrToInt(s)=0 then begin Lab_FpcCurVer.Font.Color:=clRed; end else begin Lab_FpcCurVer.Font.Color:=clWindowText; end; s:=Edit_LazUpdDir.Text; s:=getCurSvnVer(s); Lab_LazCurVer.Caption:=s; if StrToInt(s)=0 then begin Lab_LazCurVer.Font.Color:=clRed; end else begin Lab_LazCurVer.Font.Color:=clWindowText; end; //***Enable/Disable controles //Fpc Edit_FpcUpdDir.Enabled:=ChBo_FpcDoUpd.Checked; Btn_FpcGetDir.Enabled:=ChBo_FpcDoUpd.Checked; Edit_FpcURL.Enabled:=ChBo_FpcDoUpd.Checked and (StrToInt(Lab_FpcCurVer.Caption)=0); Edit_FpcSvnOpt.Enabled:=ChBo_FpcDoUpd.Checked; ChBo_FpcDoMake.Enabled:=ChBo_FpcDoUpd.Checked; ChBo_FpcFMake.Enabled:=ChBo_FpcDoMake.Checked and ChBo_FpcDoUpd.Checked; Edit_FpcMakeOpt.Enabled:=ChBo_FpcDoMake.Checked and ChBo_FpcDoUpd.Checked; ChBo_FpcDoInst.Enabled:=ChBo_FpcDoMake.Checked and ChBo_FpcDoUpd.Checked; Edit_FpcInstDir.Enabled:=ChBo_FpcDoInst.Checked and ChBo_FpcDoMake.Checked and ChBo_FpcDoUpd.Checked; Btn_FpcInstDir.Enabled:=ChBo_FpcDoInst.Checked and ChBo_FpcDoMake.Checked and ChBo_FpcDoUpd.Checked; Edit_FpcInstOpt.Enabled:=ChBo_FpcDoInst.Checked and ChBo_FpcDoMake.Checked and ChBo_FpcDoUpd.Checked; //Lazarus Edit_LazUpdDir.Enabled:=ChBo_LazDoUpd.Checked; Btn_LazGetDir.Enabled:=ChBo_LazDoUpd.Checked; Edit_LazURL.Enabled:=ChBo_LazDoUpd.Checked and (StrToInt(Lab_LazCurVer.Caption)=0); Edit_LazUpdOpt.Enabled:=ChBo_LazDoUpd.Checked; ChBo_LazDoMake.Enabled:=ChBo_LazDoUpd.Checked; ChBo_LazFMake.Enabled:=ChBo_LazDoMake.Checked and ChBo_LazDoUpd.Checked; ChBo_LazFMake2.Enabled:=ChBo_LazDoMake.Checked and ChBo_LazDoUpd.Checked and not ChBo_LazFMake.Checked; ChBo_LazBuild.Enabled:=ChBo_LazDoMake.Checked and ChBo_LazDoUpd.Checked; Edit_LazBuildOpt.Enabled:=ChBo_LazDoMake.Checked and ChBo_LazDoUpd.Checked and ChBo_LazBuild.Checked; Edit_LazMakeOpt.Enabled:=ChBo_LazDoMake.Checked and ChBo_LazDoUpd.Checked; ChBo_LazDoStrip.Enabled:=ChBo_LazDoMake.Checked and ChBo_LazDoUpd.Checked; //***set Name and Status TaskNum:=tnUFPC; if (StrToInt(Lab_FpcCurVer.Caption)=0) then begin LUTask[TaskNum].Name:=rsCheckoutFPC; end else begin LUTask[TaskNum].Name:=rsUpdateFPC; end; LUTask[TaskNum].Status:=tsToDo; TaskNum:=tnMFPC; if ChBo_FpcFMake.Checked then begin LUTask[TaskNum].Name:=rsMakeFPCForce; end else begin LUTask[TaskNum].Name:=rsMakeFPC; end; LUTask[TaskNum].Status:=tsToDo; TaskNum:=tnIFPC; LUTask[TaskNum].Name:=rsInstallFPC; LUTask[TaskNum].Status:=tsToDo; TaskNum:=tnULaz; if (StrToInt(Lab_LazCurVer.Caption)=0) then begin LUTask[TaskNum].Name:=rsCheckoutLaza; end else begin LUTask[TaskNum].Name:=rsUpdateLazaru; end; LUTask[TaskNum].Status:=tsToDo; TaskNum:=tnMLazB; LUTask[TaskNum].Name:=rsBuildIDEWith; LUTask[TaskNum].Status:=tsToDo; TaskNum:=tnMLaz; if ChBo_LazFMake.Checked then begin LUTask[TaskNum].Name:=rsMakeLazarusF; end else begin if ChBo_LazFMake2.Checked then begin LUTask[TaskNum].Name:=rsMakeLazarusF2; end else begin LUTask[TaskNum].Name:=rsMakeLazarus; end; end; LUTask[TaskNum].Status:=tsToDo; TaskNum:=tnSLaz; LUTask[TaskNum].Name:=rsStripLazarus; LUTask[TaskNum].Status:=tsToDo; //***set activation TaskNum:=tnUFPC; if ChBo_FpcDoUpd.Checked then begin LUTask[TaskNum].Activated:=True; end else begin LUTask[TaskNum].Activated:=False; end; TaskNum:=tnMFPC; if ChBo_FpcDoMake.Checked and ChBo_FpcDoMake.Enabled then begin LUTask[TaskNum].Activated:=True; end else begin LUTask[TaskNum].Activated:=False; end; TaskNum:=tnIFPC; if ChBo_FpcDoInst.Checked and ChBo_FpcDoInst.Enabled then begin LUTask[TaskNum].Activated:=True; end else begin LUTask[TaskNum].Activated:=False; end; TaskNum:=tnULaz; if ChBo_LazDoUpd.Checked then begin LUTask[TaskNum].Activated:=True; end else begin LUTask[TaskNum].Activated:=False; end; TaskNum:=tnMLazB; if ChBo_LazBuild.Checked and ChBo_LazBuild.Enabled then begin LUTask[TaskNum].Activated:=True; end else begin LUTask[TaskNum].Activated:=False; end; TaskNum:=tnMLaz; if ChBo_LazDoMake.Checked and ChBo_LazDoMake.Enabled then begin LUTask[TaskNum].Activated:=True; end else begin LUTask[TaskNum].Activated:=False; end; TaskNum:=tnSLaz; if ChBo_LazDoStrip.Checked and ChBo_LazDoStrip.Enabled then begin LUTask[TaskNum].Activated:=True; end else begin LUTask[TaskNum].Activated:=False; end; UpdOver; end; {******************************************************************************* Core-function: Create object to run command and get the output or use TProcess and get output *******************************************************************************} function TForm_Main.callProcess(WorkingDir, Command:String):Integer; const READ_BYTES = 2048; var n: LongInt; s, Buffer:String; // LastProcessMessages:TDateTime; begin if not SilentOut then begin //Some Output myWriteLn('cd '+WorkingDir); myWriteLn(Command); end; if FUseAsync then //***Use TAsyncProcess (helper.pas)*** begin try LUUpdateProcess:=TLUUpdateProcess.create; LUUpdateProcess.CommandLine:=Command; LUUpdateProcess.WorkingDir:=WorkingDir; LUUpdateProcess.OnPushData:=@LUUpdateProcessonPushData; Result:=LUUpdateProcess.run; finally LUUpdateProcess.Free; end; end else //***Use TProcess** begin //1st: change dir if not (WorkingDir='') then begin ForceDirectories(WorkingDir); //ensure WorkingDir exists ChDir(WorkingDir); end; //2nd: prepare and start TProcess AProcess:=TProcess.Create(nil); AProcess.CommandLine:=Command; AProcess.Options:=[poUsePipes,poStderrToOutPut]; AProcess.ShowWindow:=swoHIDE; AProcess.Priority:=ppHigh; try AProcess.Execute; except MessageDlg(Format(rsErrorExecuti, [Command, #10]), mtError, [mbOK], 0); end; //init buffer Buffer:=''; s:=''; OutPut:=''; //3rd: get output while AProcess.Running do begin //try read Setlength(s, READ_BYTES); n := AProcess.Output.Read(s[1], READ_BYTES); setlength(s, n); if n > 0 then //got any data? begin Buffer:=Buffer+s; while Pos(LineEnding,Buffer)>0 do begin if SilentOut then begin OutPut:=Output+copy(Buffer, 1, Pos(LineEnding, Buffer)-1); end else begin Memo_Out.Lines.Append(copy(Buffer, 1, Pos(LineEnding, Buffer)-1)); Application.ProcessMessages; end; delete(Buffer, 1, Pos(LineEnding, Buffer)-1+length(LineEnding)); end; n:=0; s:=''; end else begin sleep(100); end; end; //get last output repeat if n > 0 then //got any data? begin Buffer:=Buffer+s; while Pos(LineEnding,Buffer)>0 do begin if SilentOut then begin OutPut:=Output+copy(Buffer, 1, Pos(LineEnding, Buffer)-1); end else begin Memo_Out.Lines.Append(copy(Buffer, 1, Pos(LineEnding, Buffer)-1)); Application.ProcessMessages; end; delete(Buffer, 1, Pos(LineEnding, Buffer)-1+length(LineEnding)); end; n:=0; s:=''; end else sleep(100); //try read Setlength(s, length(s)+READ_BYTES); n := AProcess.Output.Read(s[length(s)-READ_BYTES+1], READ_BYTES); setlength(s, length(s)-READ_BYTES+n); until n <= 0; //get Exitcode Result:=AProcess.ExitStatus; AProcess.Free; end; end; {******************************************************************************* Helperfunction: write one line to output *******************************************************************************} procedure TForm_Main.myWriteLn(Output:String); begin Memo_Out.Lines.Append('[LazUpdater] '+Output); Application.ProcessMessages; end; {******************************************************************************* calls svn log *******************************************************************************} //FPC function TForm_Main.FpcShowLog():Boolean; var myExit:Integer; begin Result:=True; FuseAsync:=False; //some output myWriteLn(rsLogForFPC); myExit:=callProcess(Edit_FpcUpdDir.Text, BinSVN+' log -r'+FpcNewVer+':'+IntToStr(StrToInt(FpcOldVer))); if myExit in [0,1] then begin myWriteLn(rsEndOfLogForF); end else begin myWriteLn('svn Error: '+IntToStr(myExit)); Result:=False; end; FUseAsync:=ChBo_Async.Checked; end; //Lazarus function TForm_Main.LazShowLog():Boolean; var myExit:Integer; begin Result:=True; FUseAsync:=False; //some output myWriteLn(rsLogForLazaru); myExit:=callProcess(Edit_LazUpdDir.Text, BinSVN+' log -r'+LazNewVer+':'+IntToStr(StrToInt(LazOldVer))); if myExit in [0,1] then begin myWriteLn(rsEndOfLogForL); end else begin myWriteLn('svn Error: '+IntToStr(myExit)); Result:=False; end; FUseAsync:=ChBo_Async.Checked; end; {******************************************************************************* Send Message to Process - Not really tested with TProcess yet. TAsyncProcess works fine. *******************************************************************************} procedure TForm_Main.Btn_SendClick(Sender: TObject); var Buffer:String; begin if ChBo_Async.Checked then if LUUpdateProcess<>nil then begin LUUpdateProcess.SendData(Edit_Send.Text+LineEnding); myWriteLn(Edit_Send.Text); Edit_Send.Clear; end else if AProcess<>nil then begin Buffer:=Edit_Send.Text+LineEnding; AProcess.Input.Write(Buffer[1], length(Buffer)); myWriteLn(Edit_Send.Text); Edit_Send.Clear; end; end; {******************************************************************************* Button "Show Log" *******************************************************************************} procedure TForm_Main.Btn_LogClick(Sender: TObject); begin if ChBo_FpcDoUpd.Checked then begin if (FpcOldVer<>FpcNewVer) then begin if (StrToInt(FpcNewVer)-StrToInt(FpcOldVer))>100 then begin if MessageDlg(Format(rsThereAreMore, [#10]), mtWarning, [mbYes, mbNo], 0 )=mrYes then begin FpcShowLog; end; end else begin //less then 100 diffs FpcShowLog; end; end; end; if ChBo_LazDoUpd.Checked then begin if (LazOldVer<>LazNewVer) then begin if (StrToInt(LazNewVer)-StrToInt(LazOldVer))>100 then begin if MessageDlg(Format(rsThereAreMore2, [#10]), mtWarning, [mbYes, mbNo], 0)=mrYes then begin LazShowLog; end; end else begin //less then 100 diffs LazShowLog; end; end; end; end; {******************************************************************************* open Open-/SelectDirectoryDialog *******************************************************************************} procedure TForm_Main.Btn_LazGetDirClick(Sender: TObject); begin if SelDirDi.Execute then Edit_LazUpdDir.Text:=SelDirDi.FileName; end; procedure TForm_Main.Btn_FpcGetDirClick(Sender: TObject); begin if SelDirDi.Execute then Edit_FpcUpdDir.Text:=SelDirDi.FileName; end; procedure TForm_Main.Btn_FpcInstDirClick(Sender: TObject); begin if SelDirDi.Execute then Edit_FpcInstDir.Text:=SelDirDi.FileName; end; procedure TForm_Main.Btn_BinSVNClick(Sender: TObject); begin if OpenDi.Execute then Edit_BinSVN.Text:=OpenDi.FileName; setBinaries; end; procedure TForm_Main.Btn_BinMakeClick(Sender: TObject); begin if OpenDi.Execute then Edit_BinMake.Text:=OpenDi.FileName; setBinaries; end; procedure TForm_Main.Btn_BinLazBuildClick(Sender: TObject); begin if OpenDi.Execute then Edit_BinLazBuild.Text:=OpenDi.FileName; setBinaries; end; procedure TForm_Main.Btn_BinFPCClick(Sender: TObject); begin if OpenDi.Execute then Edit_BinFPC.Text:=OpenDi.FileName; setBinaries; end; {******************************************************************************* Warning of Alpha-Feature *******************************************************************************} procedure TForm_Main.ChBo_AsyncChange(Sender: TObject); begin if ChBo_Async.Checked and doWarn then begin if MessageDlg(Format(rsWarningThisF, [#10]), mtWarning, [mbYes, mbNo], 0)= mrNo then begin ChBo_Async.Checked:=False; end; end; FUseAsync:=ChBo_Async.Checked; GrBo_Input.Visible:=ChBo_Async.Checked; end; {******************************************************************************* show about *******************************************************************************} procedure TForm_Main.Btn_AboutClick(Sender: TObject); begin Form_About.ShowModal; end; {******************************************************************************* Button to start the update (whole order of Tasks is managed here) *******************************************************************************} procedure TForm_Main.Btn_StartClick(Sender: TObject); var FpcDoCo, LazDoCo, FpcMakeDone:Boolean; StartTime, EndTime:TTime; //it's teatime //***a subfunction for better readability procedure CheckOptions(); begin //do Update? if not ChBo_FpcDoUpd.Checked then begin StopFPC:=True; end; //valid Path for fpc-src? if not StopFPC then begin if not CheckPath(Edit_FpcUpdDir.Text) then begin StopFPC:=True; StopLaz:=True; MessageDlg(rsErrorPleaseC, mtError, [mbOK], 0); end; end; //valid Path to install fpc? if not StopFPC then begin if ChBo_FpcDoInst.Checked and (not CheckPath(Edit_FpcInstDir.Text)) and (Edit_FpcInstDir.Text<>'') then begin StopFPC:=True; StopLaz:=True; MessageDlg(rsErrorPleaseC2, mtError, [mbOK], 0); end; end; //Update or Checkout? if not StopFPC then begin //check for Directory if DirectoryExists(Edit_FpcUpdDir.Text) then begin //check for former Updates/CheckOuts if not DirectoryExists(setPathDelim(Edit_FpcUpdDir.Text)+'.svn') then begin //No .svn directory found! Do a checkout? if MessageDlg(Format(rsNoSVNFilesFo, [Edit_FpcUpdDir.Text, #10]), mtWarning, [mbYes, mbNo], 0)=mrYes then begin FpcDoCo:=True; //valid URL for Fpc? if not checkURL(Edit_FpcURL.Text) then begin StopFPC:=True; StopLaz:=True; MessageDlg(rsErrorPleaseC3, mtError, [mbOK], 0); end; end else //don't do svn co begin StopFPC:=True; StopLaz:=True; myWriteLn(rsCheckOutAbor); LUTask[tnUFPC].Status:=tsSkipped; end; end; end else begin //Directory not found! create it an do a checkout? if MessageDlg(Format(rsTheDirectory, [Edit_FpcUpdDir.Text]), mtWarning, [ mbYes, mbNo], 0)=mrYes then begin FpcDoCo:=True; //valid URL for Fpc? if not checkURL(Edit_FpcURL.Text) then begin StopFPC:=True; StopLaz:=True; MessageDlg(rsErrorPleaseC4, mtError, [mbOK], 0); end; end else begin //don't do svn co StopFPC:=True; StopLaz:=True; myWriteLn(rsCheckOutAbor); LUTask[tnUFPC].Status:=tsSkipped; end; end; end; //Do Update? if not ChBo_LazDoUpd.Checked then begin StopLaz:=True; end; //valid Path for Lazarus? if not StopLaz then begin if not CheckPath(Edit_LazUpdDir.Text) then begin StopFPC:=True; StopLaz:=True; MessageDlg(rsErrorPleaseC5, mtError, [mbOK], 0); end; end; //Laz Update or Checkout? if not StopLaz then begin //check for Directory if DirectoryExists(Edit_LazUpdDir.Text) then begin //check for former Updates/CheckOuts if not DirectoryExists(setPathDelim(Edit_LazUpdDir.Text)+'.svn') then begin //No .svn directory found! Do a checkout? if MessageDlg(Format(rsNoSVNFilesFo2, [Edit_LazUpdDir.Text, #10]), mtWarning, [mbYes, mbNo], 0)=mrYes then begin LazDoCo:=True; //valid URL for Lazarus? if not checkURL(Edit_LazURL.Text) then begin StopLaz:=True; MessageDlg(rsErrorPleaseC6, mtError, [mbOK], 0); end; end else //don't do svn co begin StopLaz:=True; StopLaz:=True; myWriteLn(rsCheckOutAbor); LUTask[tnULaz].Status:=tsSkipped; end; end; end else begin //Directory not found! create it an do a checkout? if MessageDlg(Format(rsTheDirectory2, [Edit_LazUpdDir.Text]), mtWarning, [ mbYes, mbNo], 0)=mrYes then begin LazDoCo:=True; //valid URL for Lazarus? if not checkURL(Edit_LazURL.Text) then begin StopLaz:=True; MessageDlg(rsErrorPleaseC7, mtError, [mbOK], 0); end; end else begin //don't do svn co StopLaz:=True; StopLaz:=True; myWriteLn(rsCheckOutAbor); LUTask[tnULaz].Status:=tsSkipped; end; end; end; //Lazarus closed? if (not stopLaz) and (not LazDoCo) then //no question for stopped process and checkout begin if MessageDlg(Format(rsLazarusMustB, [LineEnding]), mtConfirmation, [mbYes, mbNo], 0)=mrNo then begin StopFPC:=True; StopLaz:=True; myWriteLn(rsLazarusNotCl); end; end; end; //***main precedure begin //init vars FpcOldVer:=''; FpcNewVer:=''; LazOldVer:=''; LazNewVer:=''; stopFpc:=False; stopLaz:=False; FpcDoCo:=False; LazDoCo:=False; FpcMakeDone:=False; //prepare some components InitOver; Memo_Out.Clear; //save current profile myWriteLn(rsSavingProfil); SaveProfile(CoBo_Prof.Text); //some output myWriteLn('Version: '+myVersion); //ensure user can't do stupid things Page_Fpc.Enabled:=False; Page_Laz.Enabled:=False; Page_Tools.Enabled:=False; Btn_Start.Enabled:=False; Btn_About.Enabled:=False; Btn_Out.Enabled:=False; Btn_Log.Enabled:=False; CoBo_Prof.Enabled:=False; Btn_ProfSaveAs.Enabled:=False; Btn_ProfDel.Enabled:=False; Btn_Stop.Enabled:=True; if GrBo_Input.Visible then begin GrBo_Input.Enabled:=True; Edit_Send.SetFocus; end; //check options CheckOptions; StartTime:=Now; myWriteLn(Format(rsStartedOnAt, [DateToStr(StartTime), TimeToStr(StartTime)]) ); //***FPC Update/Checkout if not stopFpc then begin //***Update if not FPCDoCo then begin if not FpcDoSVNUpdate then begin //update failed if FpcNewVer<>FpcOldVer then begin StopLaz:=True; StopFPC:=True; // MessageDlg('Error while doing "svn up". Read output for more information!', mtError, [mbOK], 0); end; end; //Same version as before? if FpcNewVer=FpcOldVer then begin LUTask[tnUFPC].Status:=tsUnchanged; UpdOver; myWriteLn(rsNoUpdateFoun); //force "make"? if ChBo_FpcFMake.Checked then begin //force make myWriteLn(rsForcingMake); end else begin //don't force make StopFPC:=True end; end; //***Checkout end else begin if not FpcDoSVNCheckout then begin StopFPC:=True; StopLaz:=True; // MessageDlg('Error while doing "svn co". Read output for more information!', mtError, [mbOK], 0); end; end; end else begin if LUTask[tnUFPC].Activated then LUTask[tnUFPC].Status:=tsSkipped; end; //***FPC Make if not stopFpc then begin if ChBo_FpcDoMake.Checked and ChBo_FpcDoUpd.Checked then begin //start make if not FpcDoMake then begin StopFPC:=True; StopLaz:=True; // MessageDlg('Error while doing "make". Read output for more information!', mtError, [mbOK], 0); end; end; end else begin if LUTask[tnMFPC].Activated then LUTask[tnMFPC].Status:=tsSkipped; //Status=skipped end; //***FPC Make Install if not stopFpc then begin if ChBo_FPCDoInst.Checked and ChBo_FpcDoMake.Checked and ChBo_FpcDoUpd.Checked then begin if not FpcDoInst then begin StopFPC:=True; StopLaz:=True; // MessageDlg('Error while doing "make install". Read output for more information!', mtError, [mbOK], 0); end else begin //Fpc installed normal FpcMakeDone:=True; {$ifdef UNIX} if FPCDoCo then createSymLinks; {$endif UNIX} end; end; end else begin if LUTask[tnIFPC].Activated then LUTask[tnIFPC].Status:=tsSkipped; end; //Lazarus Update/Checkout if not stopLaz then begin //***Update if not LazDoCo then begin if not LazDoSVNUpdate then begin //update failed if LazNewVer<>LazOldVer then begin //real error StopLaz:=True; // MessageDlg('Error while doing "svn up". Read output for more information!', mtError, [mbOK], 0); end; end; //Same version as before? if LazNewVer=LazOldVer then begin LUTask[tnULaz].Status:=tsUnchanged; UpdOver; myWriteLn(rsNoUpdateFoun); //force "make"? only needed for update if ChBo_LazFMake.Checked or (ChBo_LazFMake2.Checked and fpcMakeDone) then begin //force make myWriteLn(rsForcingMake); end else begin //don't force make StopLaz:=True; end; end; //***Checkout end else begin //start svn checkout if not LazDoSVNCheckout then begin StopLaz:=True; // MessageDlg('Error while doing "svn co". Read output for more information!', mtError, [mbOK], 0); end; end; end else begin if LUTask[tnULaz].Activated then LUTask[tnULaz].Status:=tsSkipped; end; //**Lazarus Make if not stopLaz then begin if ChBo_LazDoMake.Checked and ChBo_LazDoUpd.Checked then begin //startmake if not LazDoMake then begin StopLaz:=True; // MessageDlg('Error while doing "make". Read output for more information!', mtError, [mbOK], 0); end; end; end else begin if LUTask[tnMLaz].Activated then LUTask[tnMLaz].Status:=tsSkipped; end; //***build IDE with LazBuild if not stopLaz then begin if ChBo_LazBuild.Checked and ChBo_LazBuild.Enabled then begin if not MakeLazBuild then stopLaz:=True; end; end else begin if LUTask[tnMLazB].Activated then LUTask[tnMLazB].Status:=tsSkipped; end; //***Lazarus Strip if not stopLaz then begin if ChBo_LazDoStrip.Checked and ChBo_LazDoMake.Checked and ChBo_LazDoUpd.Checked then begin if not LazDoStrip then begin StopLaz:=True; myWriteLn(rsErrorWhileDo); end; end; end else begin if LUTask[tnSLaz].Activated then LUTask[tnSLaz].Status:=tsSkipped; end; UpdOver; //activate options Page_Fpc.Enabled:=True; Page_Laz.Enabled:=True; page_Tools.Enabled:=True; Btn_Start.Enabled:=True; Btn_About.Enabled:=True; CoBo_Prof.Enabled:=True; Btn_ProfSaveAs.Enabled:=True; Btn_ProfDel.Enabled:=True; Btn_Out.Enabled:=Memo_Out.Lines.Count>0; Btn_Log.Enabled:=(FpcOldVer<>FpcNewVer) or (LazOldVer<>LazNewVer); //disable some actions Btn_Stop.Enabled:=False; if GrBo_Input.Visible then GrBo_Input.Enabled:=False; EndTime:=Now; myWriteLn(Format(rsFinishedOnAt, [DateToStr(EndTime), TimeToStr(EndTime)])); myWriteLn(Format(rsTimeNeeded, [TimeToStr(EndTime-StartTime)])); end; {******************************************************************************* Button Stop process *******************************************************************************} procedure TForm_Main.Btn_StopClick(Sender: TObject); begin if ChBo_Async.Checked then begin if LUUpdateProcess<>nil then begin if MessageDlg(Format(rsThisWonTStop, [LineEnding]), mtWarning, [mbYes, mbNo], 0)=mrYes then begin LUUpdateProcess.Stop; myWriteLn(rsProcessStopp); StopLaz:=True; StopFPC:=True; end; end; end else begin if AProcess.Running then begin if MessageDlg(rsDoYouReallyW, mtWarning, [mbYes, mbNo], 0)=mrYes then begin AProcess.Terminate(666); myWriteLn(rsProcessStopp); StopLaz:=True; StopFPC:=True; end; end; end; end; {******************************************************************************* OnChange of CheckBoxes (used by all checkboxes and edit fields to source directories) *******************************************************************************} procedure TForm_Main.ChBo_FpcDoInstChange(Sender: TObject); begin InitOver; end; {******************************************************************************* OnClose *******************************************************************************} procedure TForm_Main.FormClose(Sender: TObject); var i:Integer; begin //save common options and properties myINI:=TINIFile.Create(LUConfigFile); //-Window myINI.WriteInteger('Window', 'Left', Left); myINI.WriteInteger('Window', 'Top', Top); myINI.WriteInteger('Window', 'Width', Width); myINI.WriteInteger('Window', 'Height', Height); //-Output myINI.WriteBool('Output', 'Wrap', MenIt_Wrap.Checked); if ActivateAsync then myINI.WriteBool('Output', 'useAsync', ChBo_Async.Checked); //-Profiles myINI.WriteString('Profile', 'Name', CoBo_Prof.Text); myINI.EraseSection('ProfileNames'); for i:=1 to CoBo_prof.Items.Count-1 do begin MyINI.WriteString('ProfileNames', IntToStr(i), CoBo_Prof.Items.Strings[i]); end; myINI.Free; SaveProfile(CoBo_Prof.Text); end; {******************************************************************************* OnCreate *******************************************************************************} procedure TForm_Main.FormCreate(Sender: TObject); var mySL:TStringList; i:Integer; begin Caption:=myVersion; ActivateAsync:=False; for i:=1 to ParamCount do begin if LowerCase(Paramstr(i))='-async' then ActivateAsync:=True; end; DefaultFormatSettings.ShortDateFormat:='yyyy-mm-dd'; DefaultFormatSettings.DateSeparator:='-'; // ShortDateFormat:='yyyy-mm-dd'; // DateSeparator:='-'; //get Userdirectory HomeDir:=GetUserDir; //Fill in the default values SilentOut:=False; FpcOldVer:=''; FpcNewVer:=''; LazOldVer:=''; LazNewVer:=''; CoBo_Prof.Text:='default'; Edit_FpcURL.Text:='http://svn.freepascal.org/svn/fpc/trunk'; Edit_LazURL.Text:='http://svn.freepascal.org/svn/lazarus/trunk'; {$ifdef WINDOWS} ExtBin:='.exe'; Edit_FpcUpdDir.Text:='C:\Development\Fpc\Source\'; Edit_FpcInstDir.Text:='C:\Development\Fpc\'; Edit_LazUpdDir.Text:='C:\Development\Lazarus\'; Btn_ppclnk.Visible:=False; {$else WINDOWS} ExtBin:=''; Edit_FpcUpdDir.Text:=setPathDelim(HomeDir)+'Development/Fpc/Source/'; Edit_FpcInstDir.Text:=setPathDelim(HomeDir)+'Development/Fpc/'; Edit_LazUpdDir.Text:=setPathDelim(HomeDir)+'Development/Lazarus/'; {$endif WINDOWS} //set config file LUConfigDir:=GetAppConfigDir(false); ForceDirectories(LUConfigDir); LUConfigFile:=setPathDelim(LUConfigDir)+'LazUpdater.ini'; //existing old configfile and not existing new configfile --> copy old configfile if FileExists(setPathDelim(ExtractFilePath(ParamStr(0)))+'LazUpdater.ini') and not FileExists(setPathDelim(GetAppConfigDir(false))+'LazUpdater.ini') then begin CopyFile(setPathDelim(ExtractFilePath(ParamStr(0)))+'LazUpdater.ini', setPathDelim(GetAppConfigDir(false))+'LazUpdater.ini'); end; //read common options and properties if FileExists(LUConfigFile) then begin myINI:=TINIFile.Create(LUConfigFile); //-Window Left:=myINI.ReadInteger('Window', 'Left', 0); Top:=myINI.ReadInteger('Window', 'Top', 0); Width:=myINI.ReadInteger('Window', 'Width', 600); Height:=myINI.ReadInteger('Window', 'Height', 500); //-Output MenIt_Wrap.Checked:=myINI.ReadBool('Output', 'Wrap', True); if Activateasync then ChBo_Async.Checked:=myINI.ReadBool('Output', 'useAsync', False); //-List of profiles if myINI.SectionExists('ProfileNames') then begin mySL:=TStringList.Create; myINI.ReadSectionValues('Profilenames', mySL); for i:=0 to mySL.Count-1 do begin CoBo_Prof.Items.Add(copy(mySL[i],Pos('=', mySL[i])+1, length(mySL[i]))); end; mySL.Free; end; //last profile CoBo_Prof.ItemIndex:=CoBo_Prof.Items.IndexOf(myINI.ReadString('Profile', 'Name', 'default')); myINI.Free; //load last profile LoadProfile(CoBo_Prof.Text); end else begin MessageDlg(Format(rsFirstStartDe, [LineEnding]), mtInformation, [mbOK], 0); end; //set to the right state Btn_Out.Enabled:=Memo_Out.Lines.Count>0; Btn_Stop.Enabled:=False; Btn_Log.Enabled:=(FpcOldVer<>FpcNewVer) and (LazOldVer<>LazNewVer); Memo_Out.WordWrap:=MenIt_Wrap.Checked; //prepare strings of overview LUStatusName[tsToDo]:=rsToDo; LUStatusName[tsInProgress]:=rsInProgress; LUStatusName[tsDone]:=rsDone; LUStatusName[tsError]:=rsERROR; LUStatusName[tsSkipped]:=rsSkipped; LUStatusName[tsUnchanged]:=rsUnchanged; InitOver; Memo_out.DoubleBuffered:=True; PageControl1.ActivePage:=Page_Main; //just to be sure ChBo_Async.Visible:=ActivateAsync; GrBo_Input.Visible:=ChBo_Async.Checked; end; procedure TForm_Main.Image1Click(Sender: TObject); begin OpenURL('http://forge.lazarusforum.de/projects/show/lazupdater'); end; {******************************************************************************* Event of Memo_Out *******************************************************************************} procedure TForm_Main.Memo_OutChange(Sender: TObject); begin Memo_Out.SelStart:=length(Memo_Out.Text); end; {******************************************************************************* Popupmenu of Memo_Out *******************************************************************************} procedure TForm_Main.MenIt_CopyClick(Sender: TObject); begin Memo_Out.CopyToClipboard; end; procedure TForm_Main.MenIt_WrapClick(Sender: TObject); begin Memo_Out.WordWrap:=MenIt_Wrap.Checked; end; {******************************************************************************* Button Save Logfile *******************************************************************************} procedure TForm_Main.Btn_OutClick(Sender: TObject); begin SaveDi.FileName:='Output_'+DateToStr(now)+'.txt'; if SaveDi.Execute then begin Memo_Out.Lines.SaveToFile(SaveDi.FileName); end; end; {******************************************************************************* change color in Stringgrid *******************************************************************************} procedure TForm_Main.StrGd_OverPrepareCanvas(sender: TObject; aCol, aRow: Integer; aState: TGridDrawState); var j:Integer; i:TLUTaskNum; begin //don't show a "not used"-hint aCol:=aCol; aState:=aState; Sender:=Sender; j:=0; for i:=tnUFPC to tnSLaz do begin if LUTask[i].Activated then begin inc(j); //Find current Task if (j)=aRow then begin //choose color depending on status case LUTask[i].Status of tsToDo : StrGd_Over.Canvas.Font.Color:=clBlack; tsInProgress : StrGd_Over.Canvas.Font.Color:=clBlue; tsDone : StrGd_Over.Canvas.Font.Color:=clGreen; tsError : StrGd_Over.Canvas.Font.Color:=clRed; tsSkipped : StrGd_Over.Canvas.Font.Color:=clGray; tsUnchanged : StrGd_Over.Canvas.Font.Color:=clOlive; end; end; end; end; end; //pipe Data from TAsyncProcess to Output procedure TForm_Main.LUUpdateProcessonPushData(aData: String); begin if SilentOut then begin Output:=aData; end else begin Memo_Out.Append(aData); end; end; end.