unit Main;

interface

procedure Register;

implementation

uses
  ToolsAPI,
  TlHelp32,
  SysUtils,
  Windows,
  PsAPI,
  Vcl.Dialogs,
  UITypes;

type
  TCompileNotifier = class(TInterfacedObject, IOTAIDENotifier, IOTAIDENotifier50)
  public
    procedure AfterCompile(Succeeded: Boolean); overload;
    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
    procedure FileNotification(NotifyCode: TOTAFileNotification;
      const FileName: string; var Cancel: Boolean);
    procedure AfterSave;
    procedure BeforeSave;
    procedure Destroyed;
    procedure Modified;
    procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean;
      var Cancel: Boolean); overload;
    procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload;
  end;

var
  notifier: Integer;

procedure Register;
begin
  notifier := (BorlandIDEServices as IOTAServices).AddNotifier(TCompileNotifier.Create);
end;

procedure Unregister;
begin
  (BorlandIDEServices as IOTAServices).RemoveNotifier(notifier);
end;

function GetFullFileName(processId: Cardinal): string;
var
  process: THandle;
  path: array[0..MAX_PATH - 1] of Char;
begin
  process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, processId);
  if process <> 0 then
  try
    if GetModuleFileNameEx(process, 0, path, MAX_PATH) <> 0 then
      Exit(path);
  finally
    CloseHandle(process);
  end;
  Result := '';
end;

function TerminateProcess(const exeFileName: string): Boolean;
const
  PROCESS_TERMINATE = $0001;
var
  snapshot: THandle;
  entry: TProcessEntry32;
  canContinue: Boolean;
begin
  Result := False;
  snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    entry.dwSize := SizeOf(entry);
    canContinue := Process32First(snapshot, entry);
    while canContinue do
    begin
      if SameText(GetFullFileName(entry.th32ProcessID), exeFileName) then
        if MessageDlg('Process is still running - do you want to stop it?',
          mtConfirmation, mbYesNo, 0) = mrYes then
          Result := Windows.TerminateProcess(
            OpenProcess(PROCESS_TERMINATE, False, entry.th32ProcessID), 0);
      canContinue := Process32Next(snapshot, entry);
    end;
  finally
    CloseHandle(snapshot);
  end;
end;

{ TCompileNotifier }

procedure TCompileNotifier.AfterCompile(Succeeded: Boolean);
begin
end;

procedure TCompileNotifier.AfterCompile(Succeeded, IsCodeInsight: Boolean);
begin

end;

procedure TCompileNotifier.AfterSave;
begin
end;

procedure TCompileNotifier.BeforeCompile(const Project: IOTAProject;
  var Cancel: Boolean);
begin
end;

procedure TCompileNotifier.BeforeCompile(const Project: IOTAProject;
  IsCodeInsight: Boolean; var Cancel: Boolean);
begin
  if not IsCodeInsight and Assigned(Project)
    and Assigned(Project.ProjectOptions) then
    TerminateProcess(Project.ProjectOptions.TargetName);
end;

procedure TCompileNotifier.BeforeSave;
begin
end;

procedure TCompileNotifier.Destroyed;
begin
end;

procedure TCompileNotifier.FileNotification(NotifyCode: TOTAFileNotification;
  const FileName: string; var Cancel: Boolean);
begin
end;

procedure TCompileNotifier.Modified;
begin
end;

initialization

finalization
  Unregister;

end.