자유롭게 질의 및 응답을 할 수 있는 게시판입니다. 개발자 여러분의 답변이 큰 도움이 됩니다. 
  • 제품설치/등록 오류 문의: 설치/등록 Q&A 이용 (제품 구매 고객 한정)

Delphi 아래 Debug Error 추적 내용이 있어 다른 방법을 공유 합니다.

2016.12.06 16:05

jang 조회 수:464

본 게시판 사용시 당부 사항
* 이 게시판은 자유롭게 질문을 올리고 자발적으로 답변을 공유하는 게시판입니다.
* 어느 누구도 답변을 달아야만 하는 책임은 없습니다.
* 따라서 질문을 올리실 때에는 최대한 자세하고 정중하게 질문을 올려 주세요.
* 최대한 질문을 자세히 올려야 답변도 자세히 올라 옵니다.
* 본 질문에 답변을 주시는 여러 개발자님들께 미리 감사드립니다.
-----------------------------------------------------------------------------------------------
 

참고: // http://www.blong.com/Conferences/BorCon2002/Debugging/3188.htm

delphi7 기준 입니다.

 

type
  TAssertErrorProc = procedure (const Message, Filename: string;
    LineNumber: Integer; ErrorAddr: Pointer);

var
  AssertErrorProc   : TAssertErrorProc; { Assertion error handler }

function MakeDebugMsg(const Msg: String; ShowPIDAndTID: Boolean): String;
begin
  if ShowPIDAndTID then
    Result := Format('PID = %d ($%0:x), TID = %d ($%1:x): %s',
      [GetCurrentProcessID, GetCurrentThreadID, Msg])
  else
    Result := Msg;
end;
 
 
 
procedure InternalDebugMsg(const Msg: String);
begin
  OutputDebugString(PChar(Msg))
end;
 
procedure DebugMsg(const Msg: String;
  ShowPIDAndTID: Boolean = False); overload;
begin
  InternalDebugMsg(MakeDebugMsg(Msg, ShowPIDAndTID));
end;
 
procedure DebugMsg(const Msg: String; const Params: array of const;
  ShowPIDAndTID: Boolean = False); overload;
begin
  DebugMsg(Format(Msg, Params), ShowPIDAndTID)
end;
 
 
 
//The debug support code from DebugSupport.pas
procedure AssertErrorHandler(const Msg, Filename: string;
  LineNumber: Integer; ErrorAddr: Pointer);
begin
  //ErrorAddr is address Assert will return to
  //(i.e. instruction following call to Assert).
  //Subtract 1 from it to ensure it refers to part
  //of the Assert call, making it more appropriate
  DebugMsg('%s (%s, line %d, address $%x)',
    [Msg, Filename, LineNumber, Pred(Integer(ErrorAddr))]);
end;
 

procedure TfMain.Button1Click(Sender: TObject);
begin
  try
    Assert(False, 'Entering TestIt routine');
    //body of the interesting routine
    Assert(False, 'Exiting TestIt routine');
  except
  on e : Exception do
    begin
      ShowMessage(e.Message);
    end;
  end;
end;
 

procedure RerouteAssertions;
begin
{$ifdef Delphi6AndAbove}
  AssertErrorProc := AssertErrorHandler;
{$else}
  AssertErrorProc := @AssertErrorHandler;
{$endif}
end;
 
 
 
 
 
initialization
  RerouteAssertions;
 
 
이 게시물을
목록