compiler.pas

delphi 写的delphi的程序 Handel is a free, standalone development tool created with Delphi 3 that enable

unit compiler;

interface

uses Classes, SysUtils, Windows, Forms, Dialogs, Messages, Controls;

function Compile(const ProjName, Option:string):Boolean;
function CompileFile(const FileName, Option:string):Boolean;
function CompileAndInformation(const Option:string):Boolean;

implementation

uses utype, uconst, utils, uoptions, MainForm;

// Check whether resource file exists or not
function CheckResourceFile: Boolean;
var
  ResName:string;
begin
   Result := False;
   ResName:= GetNetFileName(ProjectInfo.ProjectName);
   ResName:= Format('%s%s.res',[ProjectInfo.ProjectPath, ResName]);
   Result := FileExists(ResName);
end;

procedure MakeResourceFile;
// Make default project resource file(default.res in Handel directory)
var
  ResName,Path:string;
begin
   ResName:= GetNetFileName(ProjectInfo.ProjectName);
   ResName:= Format('%s.res',[ResName]);
   Path   := ProjectInfo.ProjectPath;
   ResName:= AppendSlash(Path) + ResName;
   CopyFile(PChar(FilePath + 'default.res'), PChar(ResName), True);
end;

function ExecuteProcess(const ProcessName, Options, Parameter:string):Boolean;
// 橇肺技胶甫 积己窍绊, 橇肺技胶啊 场朝 锭鳖瘤 措扁茄促.
var
   StartInfo:TStartupInfo;
   ProcessInfo:TProcessInformation;
   dwExitCode:DWord;
begin
  Result:=True;
  dwExitCode:= STILL_ACTIVE;
  FillChar(StartInfo, SizeOf(TStartupInfo), #0);
  FillChar(ProcessInfo, SizeOf(TProcessInformation), #0);
  StartInfo.cb := SizeOf(StartInfo);
  StartInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartInfo.wShowWindow:= SW_SHOW;
  CreateProcess( nil,
                 PChar(ProcessName + ' ' + Options + ' ' + Parameter),
                 nil,
                 nil,
                 False,
                 {CREATE_NEW_CONSOLE or} NORMAL_PRIORITY_CLASS,
                 nil,
                 nil,
                 StartInfo,
                 ProcessInfo );
  WaitForInputIdle(GetCurrentProcess(), INFINITE);
  if ProcessInfo.hProcess <> 0 then
  begin
     while (dwExitCode = STILL_ACTIVE) do
     begin
        WaitForSingleObject(ProcessInfo.hProcess,1000);
        GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode);
     end;
  end;
end;

function CompileFile(const FileName, Option:string):Boolean;
// Compile a unit or project file
var
  S1,S2,BatchFile:string;
  SaveResp:Integer;
  P:PChar;
begin
  Result:= True;
  if not FileExists(CompilerName) then
  begin
     MessageDlg('Can not find complier! Check Compiler Path' + #10#13 + CompilerName,
                mtError, [mbOK], 0);
     with TOptions.Create(Application) do
     begin
         PageControl1.ActivePage:= PrefPage;
         ShowModal;
         Free;
     end;
     Result:= False;
     Exit;
  end;
  if ExtractFileExt(FileName) = '.dpr' then
  begin
    if not CheckResourceFile then MakeResourceFile;
  end;
  if (ProjectInfo.ProjectState = psChange) then
  begin
     SaveResp := MessageDlg(Format('Save Change to %s?',
              [ExtractFileName(ProjectInfo.ProjectName)]), mtWarning, mbYesNoCancel, 0);
     if SaveResp=idYes then FMainForm.SaveProject(ProjectInfo.ProjectName);
  end;
  Screen.Cursor:= crHourGlass;
  S1:= CompilerName;
  S2:= FileName;
  SetLength(S1,Length(CompilerName));
  GetShortPathName(PChar(CompilerName),PChar(S1),Length(S1));
  SetLength(S2,Length(FileName));
  GetShortPathName(PChar(FileName),PChar(S2),Length(S2));
  BatchFile:= Format('%s %s', [CompilerName, FileName]);
  ExecuteProcess(BatchFile , Option ,S2);
  Screen.Cursor:= crDefault;
end;

function Compile(const ProjName, Option:string):Boolean;
// Compile active project (Option:compile option /B:Build All /M:Modified Only)
var
  S1,S2,BatchFile:string;
  List:TStringList;
  SaveResp:Integer;
  P:PChar;

  procedure MakeBatchFile;
  var
    List:TStringList;
  begin
     List:= TStringList.Create;
     List.Add(S1 + ' %1 %2');
     List.Add('PAUSE');
     List.SaveToFile(BatchFile);
     List.Free;
  end;

begin
  Result:= True;
  BatchFile:= FilePath + 'execute.bat';
  if not FileExists(CompilerName) then
  begin
     MessageDlg('Can not find complier! Check Compiler Path' + #10#13 + CompilerName,
                mtError, [mbOK], 0);
     with TOptions.Create(Application) do
     begin
         PageControl1.ActivePage:= PrefPage;
         ShowModal;
         Free;
     end;
     Result:= False;
     Exit;
  end;
  if (ProjectInfo.ProjectState = psChange) then
  begin
     SaveResp := MessageDlg(Format('Save Change to %s?',
              [ExtractFileName(ProjectInfo.ProjectName)]), mtWarning, mbYesNoCancel, 0);
     if SaveResp=idYes then FMainForm.SaveProject(ProjectInfo.ProjectName);
  end;
  if not CheckResourceFile then MakeResourceFile;
  Screen.Cursor:= crHourGlass;
  S1:= CompilerName;
  S2:= ProjName;
  SetLength(S1,Length(CompilerName));
  GetShortPathName(PChar(CompilerName),PChar(S1),Length(S1));
  SetLength(S2,Length(ProjName));
  GetShortPathName(PChar(ProjName),PChar(S2),Length(S2));
  {if not FileExists(BatchFile) then }MakeBatchFile;
  ExecuteProcess(BatchFile , Option ,S2);
  Screen.Cursor:= crDefault;
end;

function CompileAndInformation(const Option:string):Boolean;
// Compile project, then display compile result
begin
   Result:= True;
   Compile(ProjectInfo.ProjectName, Option);
  //CreateShowModal(TCompile);
end;

end.