Delphi - обработка исключений в собственном конструкторе после его создания

После того, как вы ввели оператор raise, есть только два способа избежать возникновения этого исключения:

• Сначала поднимите что-нибудь еще. Из конструктора исключения, которое вот-вот будет создано, вы можете сначала создать и вызвать другое исключение. Это позволит избежать попадания в вашу программу первого оператора raise.

• Завершите поток, чтобы ничего не запускалось. Вы можете сделать это разными способами, включая ExitThread, Halt и ExitProcess, которые в данном контексте в значительной степени эквивалентны. Ваша программа больше не будет работать, но, по крайней мере, вы предотвратили создание этого исключения!

Ни один из них не решит проблему, которую вы пытаетесь решить, но они будут делать то, о чем вы просили в своем вопросе. Суть в том, что все, что вы пытаетесь сделать, подавление исключения после того, как вы уже инициировали механизм создания исключения, - это неправильный подход. Вы не можете снять звонок, и вы не можете сделать исключение.

Чтобы остановить распространение исключения, нужно поймать его с помощью except. Обратите внимание, что вы пишете except не там, где вы вызываете исключение, а в том месте, где вы хотите, чтобы оно прекратило распространение.

Однако вам, вероятно, не следует останавливать исключение, созданное внутри конструктора, от распространения за пределы этого конструктора. Если вы это сделаете, ваш объект может быть частично построен.

Я считаю, что правильным решением вашей проблемы является, как говорили многие другие, создание исключений, когда вы сталкиваетесь с ошибками, и позволять им перемещаться до обработчика исключений высокого уровня.

Когда создается экземпляр TMyErrorClass, он не знает, будет он raised или нет. Вы просите разорвать причинно-следственную связь такого фундаментального вопроса, как обработка языковых исключений. Я никогда не буду помещать это в производственный код, потому что это будет бомба замедленного действия. Наслаждайтесь (написано на Delphi 6):

type
  TMyClass = class(TObject)
  public
    Name: string;
    constructor Create;
  end;

type
  REArguments = array[0..100] of DWORD;
  PREArguments = ^REArguments;

type
  TRaiseExceptionProc = procedure (dwExceptionCode, dwExceptionFlags, nNumberOfArguments: DWORD; lpArguments: PREArguments); stdcall;

var
  RaiseExceptionProc_Old: TRaiseExceptionProc;

procedure MyRaiseException(dwExceptionCode, dwExceptionFlags, nNumberOfArguments: DWORD; lpArguments: PREArguments); stdcall;
var
  raisedObject: TObject;
begin
  if @RaiseExceptionProc_Old <> nil then
  begin
    RaiseExceptionProc := @RaiseExceptionProc_Old;
    RaiseExceptionProc_Old := nil;

    raisedObject := Pointer(lpArguments^[1]);
    if raisedObject is TMyClass then
    begin
      raisedObject.Free;
    end
    else
    begin
      TRaiseExceptionProc(RaiseExceptionProc)(dwExceptionCode, dwExceptionFlags, nNumberOfArguments, lpArguments);
    end;
  end;
end;

constructor TMyClass.Create;
begin
  inherited;
  Name := 'MyClass';
  RaiseExceptionProc_Old := RaiseExceptionProc;
  RaiseExceptionProc := @MyRaiseException;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  raise TMyClass.Create;
  ShowMessage('Continue without interruption.');
end;

Я знаю, что это некрасиво для всех, но хотел поделиться. Код не изменяет класс исключения, это похоже на глобальный обработчик исключений, за исключением того, что он не вызывается, выполнение будет продолжаться, как если бы ничего не произошло:

 
procedure TestException(dwExceptionCode, dwExceptionFlags,
    nNumberOfArguments: DWORD; lpArguments: PDWORD); stdcall;
var
  Arg: array of DWORD absolute lpArguments;
begin
{$IFDEF DEBUG}
  if (nNumberOfArguments > 1) and Assigned(lpArguments) and
      (TObject(Arg[1]).ClassName = TMyErrorClass.ClassName) then begin
    ShowMessage('Test');
    TObject(Arg[1]).Free;
    Exit;
  end;
{$ENDIF}
  windows.RaiseException(dwExceptionCode, dwExceptionFlags,
                            nNumberOfArguments, lpArguments);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RaiseExceptionProc := @TestException;
  ..

Протестировано только с 32bit и D2007, понятия не имею, будет ли работать иначе.

Используйте Application.OnicException поведение обработки исключений на верхнем уровне вашего приложения. Например:

Application.OnException := MainForm.DefaultExceptionHandler;

procedure TMainForm.DefaultExceptionHandler (Sender : TObject; E : Exception);

begin
{$IfDef DEBUG}
ShowMessage (E.Message);
{$EndIf}
end;

ИМХО, продолжать нормальный поток управления после исключения - плохая идея.