excmagic.pas

一个异常处理的类

            DialogBoxParam( HInstance, MakeIntResource(2000), Application.Handle,  @TDSDialogProc, Longint(@DlgParams) );
          {$ENDIF}
          end;
      end;

    // clear context pointer for next exception !!!!
    // PtrContext := nil;

  finally
    LeaveCriticalSection(ExcMagicLock);
  end;
end;
{$STACKFRAMES OFF}

procedure TDSAppShowException(E: Exception); register;
begin
  try
    EnterCriticalSection(ExcMagicLock);
  {$IFDEF EXCMAGIC_DEBUG}
    DebugMsg( '--> Application.ShowException' );
  {$ENDIF}
    TDSShowException( ExceptObject, ExceptAddr );
  finally
    LeaveCriticalSection(ExcMagicLock);
  end;
end;

// ---------------------------------------------------------------------------

constructor TExcMagic.Create;
begin
  if Assigned(ExceptionHook) then
    raise EExcMagicError.Create( SOnlyOneAllowed );

  inherited Create;

  FEnabled        := False;
  FLogFile        := ExtractFilePath(ParamStr(0)) + SDefaultLog;
  FLogEnabled     := True;
  FIcon           := nil;
  FLogHandled     := False;
  FOptions        := [ excDlgCallStack, excDlgRegisters, excShowDialog ];
  FMaxCallStack      := 100;
  FSuppressRecursion := True;

  FCustomTab      := SDefaultCustom;

  FCallStack         := TExcCallStack.Create;
  FCallStackStrings  := TStringList.Create;
  FContextStrings    := TStringList.Create;
  FCustomInfoStrings := TStringList.Create;

  FModules := TList.Create;
  // Add main application to modules list
  FModules.Add( TModuleDebugInfo.Create(GetModuleName(HInstance),HInstance) );
end;

destructor  TExcMagic.Destroy;
begin
  while FModules.Count > 0 do
    begin
      {$IFDEF EXCMAGIC_DEBUG}
        with TModuleDebugInfo(FModules.Items[0]) do
          DebugFmt( '  module :%.8X %s', [FInstance,FName] );
      {$ENDIF}
      TModuleDebugInfo(FModules.Items[0]).Free;
      FModules.Delete(0);
    end;
  FModules.Free;

  FCustomInfoStrings.Free;
  FCallStackStrings.Free;
  FContextStrings.Free;
  FCallStack.Free;

  inherited Destroy;
end;

function  TExcMagic.GetExcMagicAbout: String;
begin
  Result := ExcMagicAbout;
end;

function  TExcMagic.GetExcMagicVersion: String;
begin
  Result := ExcMagicVersion;
end;

function TExcMagic.GetContext: TContext;
begin
  Result := _ExcContext;
end;

function TExcMagic.GetExceptionRec: TExceptionRecord;
begin
  Result := _ExcRecord;
end;

function TExcMagic.GetExceptionInfo: TExceptionMessageInfo;
begin
  Result := _ExcMsgInfo;
end;

procedure TExcMagic.SetEnabled( Value: Boolean );
begin
  if FEnabled <> Value then
    begin
      FEnabled := Value;

      if Value then
        begin
          WriteMem( ErrorMessageAddr, @NewBytesMessage, SizeOf(NewBytesMessage) );
          WriteMem( ShowErrorAddr, @NewBytesShow, SizeOf(NewBytesShow) );
          WriteMem( ExceptionHandlerAddr, @NewBytesExcHandler, SizeOf(NewBytesExcHandler) );
          WriteMem( HandleAnyExceptAddr, @NewBytesHandleAny, SizeOf(NewBytesHandleAny) );
          WriteMem( HandleOnExceptAddr,  @NewBytesHandleOn,  SizeOf(NewBytesHandleOn)  );
          WriteMem( HandleAutoExceptAddr, @NewBytesHandleAuto, SizeOf(NewBytesHandleAuto) );
          {$IFDEF EXCMAGIC_GUI}
          WriteMem( AppShowExceptionAddr, @NewBytesAppShow, SizeOf(NewBytesAppShow) );
          {$ENDIF}

          //SwitchMagicHandler( True );
        end
      else
        begin
          WriteMem( ErrorMessageAddr, @OldBytesMessage, SizeOf(OldBytesMessage) );
          WriteMem( ShowErrorAddr, @OldBytesShow, SizeOf(OldBytesShow) );
          WriteMem( ExceptionHandlerAddr, @OldBytesExcHandler, SizeOf(OldBytesExcHandler) );
          WriteMem( HandleAnyExceptAddr, @OldBytesHandleAny, SizeOf(OldBytesHandleAny) );
          WriteMem( HandleOnExceptAddr,  @OldBytesHandleOn,  SizeOf(OldBytesHandleOn)  );
          WriteMem( HandleAutoExceptAddr, @OldBytesHandleAuto, SizeOf(OldBytesHandleAuto) );
          {$IFDEF EXCMAGIC_GUI}
          WriteMem( AppShowExceptionAddr, @OldBytesAppShow, SizeOf(OldBytesAppShow) );
          {$ENDIF}

          //SwitchMagicHandler( False );
        end;
    end;
end;

function  TExcMagic.UnMangle( Source: String; IsDelphi: Boolean ): String;
var
  Dest: array[0..2048] of Char;
begin
  _UnMangle( PChar(Source), Dest, SizeOf(Dest), nil, nil, False, IsDelphi );
  Result := Dest;
end;

function  TExcMagic.FindDebugModule( Address: Pointer ): TModuleDebugInfo;
var
  i: Integer;
  Info: TMemoryBasicInformation;
  Temp: array[0..MAX_PATH] of Char;
begin
  Result := nil;
  for i := 0 to FModules.Count-1 do
    if TModuleDebugInfo(FModules.Items[i]).IsInCode( Address ) then
      begin
        Result := TModuleDebugInfo(FModules.Items[i]);
        Break;
      end;
  if Result = nil then // create new TModuleDebugInfo
    begin
      VirtualQuery(Address, Info, sizeof(Info));
      if (Info.State and MEM_COMMIT) <> 0 then
        begin
          // return NIL if module already in list
          for i := 0 to FModules.Count-1 do
            if TModuleDebugInfo(FModules.Items[i]).FInstance = THandle(Info.AllocationBase) then Exit;

          if GetModuleFilename(THandle(Info.AllocationBase), Temp, SizeOf(Temp)) <> 0 then
            begin
              Result := TModuleDebugInfo.Create( Temp, THandle(Info.AllocationBase) );
              FModules.Add( Result );
            end;
        end;
    end;
end;

function  TExcMagic.GetAddressSourceInfo( Address: Pointer;
                                        var ModuleDebugInfo: TModuleDebugInfo;
                                        var ModuleName: String;
                                        var FileName: String;
                                        var ProcName: String;
                                        var LineNumber: Integer ): Boolean;
var
  FileNameIndex,ModuleNameIndex,ProcNameIndex: Integer;
begin
  Result     := False;
  ModuleName := '';
  FileName   := '';
  ProcName   := '';
  LineNumber := -1;
  ModuleDebugInfo := FindDebugModule( Address );
  if ModuleDebugInfo <> nil then
    begin
      ModuleDebugInfo.SourceLine( Address, FileNameIndex, LineNumber );
      ModuleDebugInfo.ProcName( Address, ModuleNameIndex, ProcNameIndex );
      ModuleName := ModuleDebugInfo.Names[ModuleNameIndex];
      FileName   := ModuleDebugInfo.Names[FileNameIndex];
      ProcName   := UnMangle( ModuleDebugInfo.Names[ProcNameIndex], ModuleDebugInfo.IsDelphiModule );
      Result     := True;
    end;
end;

function  TExcMagic.GetSourceInfo( var ModuleDebugInfo: TModuleDebugInfo;
                                   var ModuleName: String;
                                   var FileName: String;
                                   var ProcName: String;
                                   var LineNumber: Integer ): Boolean; stdcall;
var
  Address: Pointer;
begin
  asm
        mov     eax,[ebp+4]     // get return address
        mov     Address,eax
  end;
  Result := GetAddressSourceInfo( Address, ModuleDebugInfo, ModuleName, FileName, ProcName, LineNumber );
end;

function  TExcMagic.GetAddressSourceInfoRec( Address: Pointer ): TSourceInfo;
begin
  GetAddressSourceInfo( Address,
              Result.ModuleDebugInfo,
              Result.ModuleName,
              Result.FileName,
              Result.ProcName,
              Result.LineNumber );
end;

function  TExcMagic.GetSourceInfoRec: TSourceInfo; stdcall;
var
  Address: Pointer;
begin
  asm
        mov     eax,[ebp+4]     // get return address
        mov     Address,eax
  end;
  GetAddressSourceInfo( Address,
              Result.ModuleDebugInfo,
              Result.ModuleName,
              Result.FileName,
              Result.ProcName,
              Result.LineNumber );
end;


procedure TExcMagic.DumpContext( StrList: TStringList );
var
  S: String;
  i: Integer;
  Code: array[0..15] of Byte;
  Stck: array[0..19] of LongWord;
begin
  StrList.Clear;
  with _ExcContext do
    begin
      StrList.Add( 'Registers:' );
      StrList.Add( Format( 'EAX = %.8X  CS = %.4X  EIP = %.8X  Flags = %.8X', [eax, segcs, eip, eflags] ) );
      StrList.Add( Format( 'EBX = %.8X  SS = %.4X  ESP = %.8X    EBP = %.8X', [ebx, segss, esp, ebp] ) );
      StrList.Add( Format( 'ECX = %.8X  DS = %.4X  ESI = %.8X    FS  = %.4X', [ecx, segds, esi, segfs] ) );
      StrList.Add( Format( 'EDX = %.8X  ES = %.4X  EDI = %.8X    GS  = %.4X', [edx, seges, edi, seggs] ) );

      // dump 16 bytes of code
      if ReadMem( Pointer(eip), @Code, SizeOf(Code) ) then
        begin
          StrList.Add( 'Code at CS:EIP' );
          S := '';
          for i := 0 to 15 do S := S + Format( '%.2X ', [ Code[i] ] );
          StrList.Add( S );
        end;

      // dump 16 dwords from stack
      if ReadMem( Pointer(esp), @Stck, SizeOf(Stck) div SizeOf(Stck[0]) ) then
        begin
          StrList.Add( 'Stack:' );
          i := 0;
          while i < 20 do
            begin
              StrList.Add( Format( '%.8X %.8X %.8X %.8X %.8X ',
                      [ Stck[i],Stck[i+1],Stck[i+2],Stck[i+3],Stck[i+4] ]) );
              Inc(i,5);
            end;
        end;
    end;
end;

const
  cDelphiException    = $0EEDFADE;
  cDelphiReRaise      = $0EEDFADF;
  cDelphiExcept       = $0EEDFAE0;
  cDelphiFinally      = $0EEDFAE1;
  cDelphiTerminate    = $0EEDFAE2;
  cDelphiUnhandled    = $0EEDFAE3;
  cNonDelphiException = $0EEDFAE4;
  cDelphiExitFinally  = $0EEDFAE5;
  cCppException       = $0EEFFACE;
  //
  cDelphiExcMask      = $0EEDFA00;

procedure TExcMagic.DumpAll;
var
  E_EBP: Longword;
  E_Addr: Pointer;
begin
    if (_ExcRecord.ExceptionCode and cDelphiExcMask) = cDelphiExcMask then
      begin
        E_EBP  := _ExcRecord.ExceptEBP;
        E_Addr := _ExcRecord.ExceptAddr;
      end
    else { OS exception }
      begin
        E_EBP  := _ExcContext.EBP;
        E_Addr := _ExcRecord.ExceptionAddress;
      end;
    CallStack.GenerateFromAddr( E_Addr, E_EBP, FMaxCallStack, FSuppressRecursion );
    CallStack.Dump( FCallStackStrings );
    DumpContext( FContextStrings );
end;

const
  CRLF: Word = $0A0D;
  HDRLINE = '---------------------------';

procedure TExcMagic.Log( Text: PChar; WithHeader: Boolean );
var
  HLog: THandle;
  S: String;
  Written: DWORD;
begin
  if FLogEnabled and (FLogFile <> '') then
    begin
      HLog := CreateFile( PChar(FLogFile), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
      if HLog <> INVALID_HANDLE_VALUE then
        begin
          SetFilePointer( HLog, 0, nil, FILE_END );
          if WithHeader then
            begin
              S := HDRLINE + LocalTimeStr + HDRLINE + #13#10;
              WriteFile( HLog, S[1], Length(S), Written, nil);
            end;
          WriteFile( HLog, Text^, StrLen(Text), Written, nil);
          WriteFile( HLog, CRLF, SizeOf(CRLF), Written, nil);
          CloseHandle( HLog );
        end;
    end;
end;

procedure TExcMagic.LogExceptionData( Buffer: PChar; BufLen: Integer );
var
  HLog: THandle;
  S: String;
  Written: DWORD;
begin
  if FLogEnabled then
    if Assigned(FOnExceptionLog) then
      FOnExceptionLog( Buffer, BufLen, FCallStackStrings, FContextStrings, FCustomInfoStrings )
    else
      if FLogFile <> '' then
        begin
          HLog := CreateFile( PChar(FLogFile), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
          if HLog <> INVALID_HANDLE_VALUE then
            begin
              SetFilePointer( HLog, 0, nil, FILE_END );
              S := HDRLINE + LocalTimeStr + HDRLINE + #13#10;
              WriteFile( HLog, S[1], Length(S), Written, nil);
              WriteFile( HLog, Buffer^, BufLen, Written, nil);
              WriteFile( HLog, CRLF, SizeOf(CRLF), Written, nil);
              // write call stack
              WriteFile( HLog, CRLF, SizeOf(CRLF), Written, nil);
              WriteFile( HLog, PChar(FCallStackStrings.Text)^,
                         Length(FCallStackStrings.Text), Written, nil );
              // write registers
              WriteFile( HLog, CRLF, SizeOf(CRLF), Written, nil);
              WriteFile( HLog, PChar(FContextStrings.Text)^,
                         Length(FContextStrings.Text), Written, nil );