Текущий архив: 2013.03.22;
Скачать: CL | DM;

Вниз

Перехватить любой Exception и подменить текст   Найти похожие ветки 

← →
DevilDevil ©   (2012-11-25 02:55) [0]

Стоит у меня задача детализировать ошибку. Откуда я буду брать информацию для детализации - дело моё. Меня интересует в теории как можно перехватить возникновения Exception-а и подменить текст. Причём чтобы и из-под IDE текст подменился, вне IDE. Хотя бы в Windows

Стал копать. Набрёл на функцию RaiseExceptionProc, находящуюся в модуле System. В целом это указатель на виндусовую функцию RaiseException. Но можно временно подменить указатель на мою функцию с перевызовом системной функции.

Ok. Пол дела сделано. Остаётся вопрос:
как подменить текст ошибки ?
т.е. где он хранится.

этот метод отмёл, потому что из-под IDE будет вызываться двойной Exception, вместо одинарного
try

except
 on E: Exception do
 begin
   // bla-bla
   raise {bla-bla};
 end;
end;

---

← →
DevilDevil ©   (2012-11-25 02:56) [1]

*Причём чтобы и из-под IDE текст подменился, и вне IDE (показывался пользователю в красном окне)

---

← →
Дмитрий С ©   (2012-11-25 03:07) [2]

поправь реализацию Exception  и перекомпилируй генофонд:)

---

← →
DevilDevil ©   (2012-11-25 03:10) [3]

> Дмитрий С ©   (25.11.12 03:07) [2]

идея... но не прокатит в моём случае

---

← →
брат Птибурдукова   (2012-11-25 10:33) [4]

unit System;
...
ExceptProc: Pointer;    { Unhandled exception handler }
 ErrorProc: procedure (ErrorCode: Byte; ErrorAddr: Pointer);     { Error handler procedure }
{$IFDEF MSWINDOWS}
 ExceptClsProc: Pointer; { Map an OS Exception to a Delphi class reference }
 ExceptObjProc: Pointer; { Map an OS Exception to a Delphi class instance }
{$IF defined(CPU386)}
 RaiseExceptionProc: Pointer;
{$ELSE}
 RaiseExceptionProc: TRaiseExceptionProc;
{$IFEND}
 RTLUnwindProc: Pointer;
{$ENDIF MSWINDOWS}
 RaiseExceptObjProc: Pointer; { notify of the raise of an exception object }
 ExceptionAcquired: Pointer; { notification that a given exception object has been "acquired" (C++)}
 ExceptionClass: TClass; { Exception base class (must be Exception) }
 SafeCallErrorProc: TSafeCallErrorProc; { Safecall error handler }
 AssertErrorProc: TAssertErrorProc; { Assertion error handler }
 ExitProcessProc: procedure; { Hook to be called just before the process actually exits }
 AbstractErrorProc: procedure; { Abstract method error handler }

Попробуй поколупаться тут.


> вне IDE (показывался пользователю в красном окне)
Попробуй TApplicationEvents.OnException

---

← →
DevilDevil ©   (2012-11-25 13:51) [5]

> брат Птибурдукова   (25.11.12 10:33) [4]

если вызвать Raise Exception.Create("") будет перевызов _RaiseException
и в нём никаких полей не заполняется, только вызов RaiseExceptionProc, о которой я говорил

---

← →
DevilDevil ©   (2012-11-25 14:02) [6]

*_RaiseExcept

---

← →
Дмитрий С ©   (2012-11-25 19:19) [7]

Решил придумать извращенный способ, в итоге придумал нормальный:

var
 LastRaiseObjProc: Pointer;

procedure EP(Obj: PExceptionRecord);
begin
 Exception(Obj.ExceptObject).Message := Exception(Obj.ExceptObject).Message + ":)";
 TRaiseExceptObjProc(LastRaiseObjProc)(Obj);
end;

// test
begin
 LastRaiseObjProc := RaiseExceptObjProc;
 RaiseExceptObjProc := @EP;
 raise Exception.Create("qwe");
end;

---

← →
Дмитрий С ©   (2012-11-25 21:30) [8]

Хотя это немного не то.

Взять, например код
I:=0;
I:=1/I;

Ставим бряк на все Exception.Create(...);

Запускаем. И видим, что сначала происходит отображение ошибки среды, а потом, только после Continue - создается Exception для его raising-а. Следовательно, поправить текст для среды ты никак не сможешь.

---

← →
DevilDevil ©   (2012-11-26 00:53) [9]

> Следовательно, поправить текст для среды ты никак не сможешь.

я думаю экземпляр Exception можно перехватить в RaiseExceptionProc
только я ещё не понял, как

---

← →
Германн ©   (2012-11-26 02:14) [10]

> Причём чтобы и из-под IDE текст подменился

А вот для чего разумного такое надо?
Отладчик по определению должен возвращать истинные значения чего бы там ни было! Иначе это не отладчик, а злодей.

---

← →
baks   (2012-11-26 09:50) [11]

> А вот для чего разумного такое надо?

Я думаю, что это не для разумного. Данная функция даст возможность запутать пользователя показав неправильную информацию об ошибке.

> Откуда я буду брать информацию - дело мое

:)

---

← →
DevilDevil ©   (2012-11-26 10:17) [12]

> Германн ©   (26.11.12 02:14) [10]

я уже сказал в [0]
надо детализировать ошибку. прибавить к тексту дополнительную информацию

---

← →
брат Птибурдукова   (2012-11-26 10:23) [13]

> Данная функция даст возможность запутать пользователя показав
> неправильную информацию об ошибке.
Пользователю и без танцев с бубном можно выдать всё, чего пожелается.

---

← →
Baks   (2012-11-26 10:59) [14]

> Пользователю и без танцев с бубном можно выдать всё, чего
> пожелается.


Нет, не просто выдать, а подменить сообщение об ошибке.

---

← →
Rouse_ ©   (2012-11-26 11:52) [15]

Для подмены можно сделать вот такой класс:

unit uRaiseExceptionHook;

interface

uses
 Windows,
 SysUtils;

type
 TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;
 TRaiseExceptObject = procedure(P: PExceptionRecord);

 TRaiseExceptionHook = class
 private
   FRaiseExceptObjProc: TRaiseExceptObject;
   FActive: Boolean;
   FBeforeException: TExceptionEvent;
 protected
   procedure DoBeforeException(P: PExceptionRecord);
 public
   constructor Create;
   destructor Destroy; override;
   procedure SetHook(Active: Boolean);
   property OnBeforeException: TExceptionEvent read FBeforeException
     write FBeforeException;
 end;

 function RaiseExceptionHook: TRaiseExceptionHook;

implementation

var
 _RaiseExceptionHook: TRaiseExceptionHook = nil;

function RaiseExceptionHook: TRaiseExceptionHook;
begin
 if _RaiseExceptionHook = nil then
   _RaiseExceptionHook := TRaiseExceptionHook.Create;
 Result := _RaiseExceptionHook;
end;

procedure RaiseExceptObject(P: PExceptionRecord);
begin
 RaiseExceptionHook.DoBeforeException(P);
end;

{ TRaiseExceptionHook }

constructor TRaiseExceptionHook.Create;
begin
 FRaiseExceptObjProc := RaiseExceptObjProc;
end;

destructor TRaiseExceptionHook.Destroy;
begin
 SetHook(False);
 inherited;
end;

procedure TRaiseExceptionHook.DoBeforeException(P: PExceptionRecord);
begin
 if TObject(P.ExceptObject) is Exception then
   if Assigned(FBeforeException) then
     FBeforeException(Self, TObject(P.ExceptObject) as Exception);
 FRaiseExceptObjProc(P);
end;

procedure TRaiseExceptionHook.SetHook(Active: Boolean);
begin
 if FActive = Active then Exit;
 FActive := Active;
 if Active then
   RaiseExceptObjProc := @RaiseExceptObject
 else
   RaiseExceptObjProc := @FRaiseExceptObjProc;
end;

end.

ну и соответственно использование:

type
 EMyException = class(Exception);

procedure TForm1.OnBeforeException(Sender: TObject; E: Exception);
begin
 E.Message := E.Message + sLineBreak + "2";
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 RaiseExceptionHook.OnBeforeException := OnBeforeException;
 RaiseExceptionHook.SetHook(True);
 raise EMyException.Create("1");
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 RaiseExceptionHook.SetHook(False);
 raise EMyException.Create("1");
end;

---

← →
DevilDevil ©   (2012-11-26 12:25) [16]

> Rouse_ ©   (26.11.12 11:52) [15]

круто, спасибо
я тестирую в Delphi6 и Delphi7
но там нет обработчика RaiseExceptObjProc

---

← →
DevilDevil ©   (2012-11-26 12:26) [17]

Попробуйте пожалуйста у себя такой код:

{$ifdef MSWINDOWS}
var
 SYS_EXCEPTION_PROC: Pointer;

procedure ExceptionRecaller(const E: Exception);
begin
 E.Message := E.Message + #13#13"My Text!";
end;

procedure __ExceptionRecaller;
const
 cDelphiException    = $0EEDFADE;
 cNonDelphiException = $0EEDFAE4;
 SysUtilsException: TClass = SysUtils.Exception;
asm
 cmp [esp+4], cDelphiException
 je @check_exception
 cmp [esp+4], cNonDelphiException
 je @check_exception
jmp @run_default
@check_exception:
 mov eax, [esp+24]
 mov edx, SysUtilsException
 mov eax, [eax]
 call TObject.InheritsFrom
 and eax, $ff
 jz @run_default

 mov eax, [esp+24]
 call ExceptionRecaller

@run_default:
 jmp SYS_EXCEPTION_PROC
end;

procedure InitExceptionsRoutine();
begin
 SYS_EXCEPTION_PROC := System.RaiseExceptionProc;
 System.RaiseExceptionProc := @__ExceptionRecaller; {test}
end;
{$else}
procedure InitExceptionsRoutine();
begin
 // todo ?
end;
{$endif}

procedure TForm1.Button1Click(Sender: TObject);
begin
//  PPoint(nil).X := 0;

 raise Exception.Create("dsadasd");
end;

initialization
 InitExceptionsRoutine();

---

← →
Дмитрий С ©   (2012-11-26 12:34) [18]

> Rouse_ ©   (26.11.12 11:52) [15]

Этот код не всегда сработает. Он работает только для оператора raise.
Для кода
I:=0;I:=1/I; текст он не подменит.

---

← →
Rouse_ ©   (2012-11-26 12:56) [19]

> Он работает только для оператора raise.

Ну это уже особенности реализации NotifyNonDelphiException.

---

← →
DevilDevil ©   (2012-11-26 13:05) [20]

Сварганил я такой код
проверьте пожалуйста
и в IDE, и вне IDE

procedure CopyObject(const Dest, Src: TObject); forward;

{$ifdef MSWINDOWS}
var
 SYS_EXCEPTION_PROC: Pointer;

procedure ExceptionHandler(const E: Exception);
begin
 E.Message := E.Message + #13#13"My Text!";
end;

procedure __ExceptionRecaller;
const
 cDelphiException    = $0EEDFADE;
 cNonDelphiException = $0EEDFAE4;
 SysUtilsException: TClass = SysUtils.Exception;
asm
 cmp [esp+4], cDelphiException
 je @check_exception
 cmp [esp+4], cNonDelphiException
 je @check_exception
jmp @run_default
@check_exception:
 mov eax, [esp+24]
 mov edx, SysUtilsException
 mov eax, [eax]
 call TObject.InheritsFrom
 and eax, $ff
 jz @run_default

 mov eax, [esp+24]
 call ExceptionHandler

@run_default:
 mov eax, SYS_EXCEPTION_PROC
 mov System.RaiseExceptionProc, eax
 jmp eax
end;
{$else}
 // todo ?
{$endif}

// çàïóñòèòü êàêóþ-òî ïðîöåäóðó ñ ïåðåõâàòîì Exception-à
procedure RunCode(const Proc: TProcedure);
var
 NewException: Exception;
begin
 if (System.DebugHook > 0) then
 begin
   try
     System.RaiseExceptionProc := @__ExceptionRecaller;
     Proc();
   finally
     System.RaiseExceptionProc := SYS_EXCEPTION_PROC;
   end;
 end else
 begin
   try
     Proc();
   except
     on E: Exception do
     begin
       NewException := Exception(E.ClassType.NewInstance());
       CopyObject(NewException, E);
       ExceptionHandler(NewException);
       raise NewException;
     end;
   end;
 end;
end;

procedure DoBad_1();
begin
 PPoint(nil).X := 0;
end;

procedure DoBad_2();
begin
 raise Exception.Create("dsadasd");
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 RunCode(@DoBad_1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 RunCode(@DoBad_2);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if (Key = VK_ESCAPE) then Close;
end;

{$ifdef fpc}
Function fpc_Copy_internal (Src, Dest, TypeInfo : Pointer) : SizeInt;[external name "FPC_COPY"];
procedure CopyRecord(const dest, source, typeinfo: ptypeinfo);
asm
 {âíèìàíèå! î÷åíü ïëîõî ðàáîòàåò â FPC !!!}
 xchg eax, edx
 jmp fpc_Copy_internal
end;
{$else}
procedure CopyRecord(const dest, source, typeinfo: ptypeinfo);
asm
 jmp System.@CopyRecord
end;
{$endif}

procedure CopyObject(const Dest, Src: TObject);
var
 InitTable: pointer;
 BaseSize, DestSize: integer;
 BaseClass, DestClass, SrcClass: TClass;
begin
 if (Dest = nil) or (Src = nil) then exit; {ïî èäåå ýêñåïøí}

 DestClass := TClass(pointer(Dest)^);
 SrcClass := TClass(pointer(Src)^);

 if (DestClass = SrcClass) then BaseClass := DestClass
 else
 if (DestClass.InheritsFrom(SrcClass)) then BaseClass := SrcClass
 else
 if (SrcClass.InheritsFrom(DestClass)) then BaseClass := DestClass
 else
 begin
   BaseClass := DestClass;

   while (BaseClass <> nil) and (not SrcClass.InheritsFrom(BaseClass)) do
   begin
     BaseClass := BaseClass.ClassParent;
   end;

   if (BaseClass = nil) then exit; {&#237;&#238; &#242;&#224;&#234;&#238;&#227;&#238; &#237;&#229; &#228;&#238;&#235;&#230;&#237;&#238; &#225;&#251;&#242;&#252;}
 end;

 // &#234;&#238;&#239;&#232;&#240;&#238;&#226;&#224;&#237;&#232;&#229;
 DestSize := BaseClass.InstanceSize;
 while (BaseClass <> TObject) do
 begin
   InitTable := PPointer(Integer(BaseClass) + vmtInitTable)^;
   if (InitTable <> nil) then
   begin
     CopyRecord(pointer(Dest), pointer(Src), InitTable);
     break;
   end;
   BaseClass := BaseClass.ClassParent;
 end;

 BaseSize := BaseClass.InstanceSize;
 if (BaseSize <> DestSize) then Move(pointer(integer(Src)+BaseSize)^, pointer(integer(Dest)+BaseSize)^, DestSize-BaseSize);
end;

initialization
 {$ifdef MSWINDOWS}
    SYS_EXCEPTION_PROC := System.RaiseExceptionProc;
 {$endif}


---

← →
Разведка   (2012-11-26 20:47) [21]

interface

Uses Windows;

function SystemErrorMessage(ErrorCode: Integer): string;
function GetSysErrorMessage(ErrorCode: Integer): String;
procedure SaveErrorMessage(DebugMsg: String);

var
 LAST_ERROR_MESSAGE : String;

implementation

procedure SaveErrorMessage(DebugMsg: String);
begin
 if DebugMsg <> "" then
   LAST_ERROR_MESSAGE := DebugMsg+" "+GetSysErrorMessage(GetLastError)
 else LAST_ERROR_MESSAGE := GetSysErrorMessage(GetLastError)
end;

{------------------------- GetSysErrorMessage ---------------------------------}
function GetSysErrorMessage(ErrorCode: Integer): String;
Var s: string;
begin
 Str(ErrorCode:0,S);
 Result:="System Error. Code: "+s+" "+SystemErrorMessage(ErrorCode)+".";
end;

{------------------------- SystemErrorMessage ---------------------------------}
function SystemErrorMessage(ErrorCode: Integer): string;
var
 Buffer : array[0..255] of Char;
 Len    : Integer;
begin
 Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS or
                      FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
                      SizeOf(Buffer), nil);
 while (Len > 0) and (Buffer[Len - 1] in [ #0..#32, "."]) do Dec(Len);
 SetString(Result, Buffer, Len);
end;
end.

Использую так:

Uses Error;
  //.......
try
 //код программы
except
  если нужно тихой цапой слить сообщение в другое окошко
  то делаем так
 
 memo1.lines.add(GetSysErrorMessage(getlasterror)) ;
 это оналог RaiseLastWin32Error,
 
end;

---

← →
DevilDevil ©   (2012-11-26 20:56) [22]

> Разведка   (26.11.12 20:47) [21]

не подходит по условиям задачи

---

← →
Rouse_ ©   (2012-11-26 21:49) [23]

> DevilDevil ©   (26.11.12 20:56) [22]

Ты кстати похоже очень вовремя появился со своим вопросом. Тут откуда не возьмись вылезла задача именно такого-же плана по работе :)
Как сглазил блин :)
Возьму твой вариант за основу и завтра более плотно потестирую на своей нагрузке, если что вылезет (хотя судя по коду не должно, на вскидку) сообщу.

---

← →
DevilDevil ©   (2012-11-26 23:11) [24]

> Rouse_ ©   (26.11.12 21:49) [23]

:)
а я эту задачу обверну завтра более сложными наворотами :)

кстати если узнаешь как реализовать под другие ОС кроме Windows - говори )

---

Страницы: 1 вся ветка

Текущий архив: 2013.03.22;
Скачать: CL | DM;

Наверх

Память: 0.55 MB
Время: 0.134 c