home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 February / Chip_2004-02_cd1.bin / zkuste / konfig / download / msic / D6 / MSI_ExceptionStack.pas < prev    next >
Pascal/Delphi Source File  |  2003-11-06  |  8KB  |  267 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         MiTeC System Information Component            }
  4. {                Exception Stack                        }
  5. {           version 8.5 for Delphi 5,6,7                }
  6. {                                                       }
  7. {       Copyright ⌐ 1997,2003 Michal Mutl               }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. {$INCLUDE MITEC_DEF.INC}
  13.  
  14.  
  15. unit MSI_ExceptionStack;
  16.  
  17. interface
  18.  
  19. uses
  20.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  21.   Dialogs, ComCtrls, StdCtrls, ExtCtrls;
  22.  
  23. type
  24.   TMSIC_ErrorRecord = record
  25.     Classname,
  26.     Text,
  27.     Module,
  28.     Sender: ShortString;
  29.     Address: Pointer;
  30.     Code: Integer;
  31.   end;
  32.   TMSIC_ErrorStack = array of TMSIC_ErrorRecord;
  33.  
  34.   TdlgExceptionStack = class(TForm)
  35.     Panel7: TPanel;
  36.     Panel10: TPanel;
  37.     bOK: TButton;
  38.     ClientPanel: TPanel;
  39.     List: TListView;
  40.     Panel1: TPanel;
  41.     AppIcon: TImage;
  42.     Image1: TImage;
  43.     Bevel1: TBevel;
  44.     lApplication: TLabel;
  45.     lMSIC: TLabel;
  46.     Memo: TMemo;
  47.     Splitter1: TSplitter;
  48.     Button1: TButton;
  49.     LogPanel: TPanel;
  50.     eLog: TEdit;
  51.     procedure FormCreate(Sender: TObject);
  52.     procedure FormDestroy(Sender: TObject);
  53.     procedure ListSelectItem(Sender: TObject; Item: TListItem;
  54.       Selected: Boolean);
  55.     procedure Button1Click(Sender: TObject);
  56.   private
  57.     FErrorStack: TMSIC_ErrorStack;
  58.     FExceptObj: Exception;
  59.     FPrevOnException: TExceptionEvent;
  60.   public
  61.     procedure ExceptionHandler(Sender: TObject; E: Exception);
  62.   end;
  63.  
  64. procedure ErrorIntercept;
  65. procedure ErrorRelease;
  66. procedure ShowExceptionStack;
  67.  
  68. var
  69.   dlgExceptionStack: TdlgExceptionStack;
  70.  
  71. resourcestring
  72.   rsErrorMessage = '%s'#13#10#13#10+
  73.                    'Code: 0x%x'#13#10+
  74.                    'Class: %s'#13#10+
  75.                    'Module: %s'#13#10+
  76.                    'Address: 0x%p'#13#10+
  77.                    'Sender: %s'#13#10#13#10+
  78.                    'Call Stack:'#13#10'%s';
  79.  
  80.  
  81. implementation
  82.  
  83. uses {$IFDEF ERROR_INTERCEPT} MiTeC_Journal, {$ENDIF} MiTeC_Routines, MSI_Common;
  84.  
  85. {$R *.dfm}
  86.  
  87. procedure ErrorIntercept;
  88. begin
  89.   ErrorRelease;
  90.   dlgExceptionStack:=TdlgExceptionStack.Create(Application);
  91. end;
  92.  
  93. procedure ErrorRelease;
  94. begin
  95.   try
  96.     dlgExceptionStack.Free;
  97.   except
  98.     dlgExceptionStack:=nil;
  99.   end;
  100. end;
  101.  
  102. procedure ShowExceptionStack;
  103. begin
  104.   if dlgExceptionStack<>nil then
  105.     dlgExceptionStack.ShowModal;
  106. end;
  107.  
  108. { TdlgExceptionStack }
  109.  
  110. procedure TdlgExceptionStack.ExceptionHandler(Sender: TObject;
  111.   E: Exception);
  112. {$IFDEF ERROR_INTERCEPT}
  113. var
  114.   i: Integer;
  115.   s,cs: string;
  116.   er: TMSIC_ErrorRecord;
  117.   tr: TMSIC_TraceRecord;
  118. {$ENDIF}
  119. begin
  120. {$IFDEF ERROR_INTERCEPT}
  121.   if (FExceptObj=nil) and not Application.Terminated then begin
  122.     FExceptObj:=E;
  123.     tr:=GetTrace;
  124.     er.Sender:=GetObjectFullName(Sender);
  125.     er.Classname:=E.ClassName;
  126.     er.Text:=E.message;
  127.     er.Address:=ExceptAddr;
  128.     ErrorInfo(er.Address,er.Module);
  129.     er.Code:=0;
  130.     if E is EInOutError then
  131.       er.Code:=EInOutError(E).ErrorCode
  132.     else
  133.       {if E is EOleException then
  134.         er.Code:=EOleException(E).ErrorCode;
  135.       else
  136.         if E is EOleSysError then
  137.           er.Code:=EOleSysError(E).ErrorCode
  138.         else}
  139.           if E is EExternalException then
  140.             er.Code:=EExternalException(E).ExceptionRecord^.ExceptionCode
  141.           else
  142.             {$IFDEF D6PLUS}
  143.             if E is EOSError then
  144.               er.Code:=EOSError(E).ErrorCode;
  145.             {$ELSE}
  146.             if E is EWin32Error then
  147.               er.Code:=EWin32Error(E).ErrorCode;
  148.             {$ENDIF}
  149.  
  150.     SetLength(FErrorStack,Length(FErrorStack)+1);
  151.     FErrorStack[High(FErrorStack)]:=er;
  152.     cs:='';
  153.     for i:=High(TraceStack) downto 0 do
  154.       cs:=cs+Format('%s.%s'#13#10,[TraceStack[i].ObjectName,TraceStack[i].FunctionName]);
  155.     s:=Format(rsErrorMessage,[er.Text,
  156.                               er.Code,
  157.                               er.Classname,
  158.                               er.Module,
  159.                               er.Address,
  160.                               er.Sender,
  161.                               cs]);
  162.     if emJournal in tr.ExceptionModes then begin
  163.       if not Assigned(Journal) then
  164.         InitializeJournal;
  165.       with Journal do begin
  166.         WriteEventFmt('%s',[er.Text],elError);
  167.         WriteEvent('ERROR DATA',elBegin);
  168.         WriteEventFmt('Class: %s',[er.Classname],elData);
  169.         WriteEventFmt('Code: 0x%x',[er.Code],elData);
  170.         WriteEventFmt('Module: %s',[er.Module],elData);
  171.         WriteEventFmt('Address: 0x%p',[er.Address],elData);
  172.         WriteEventFmt('Sender: %s',[er.Sender],elData);
  173.         WriteEvent('Call Stack',elBegin);
  174.         for i:=High(TraceStack) downto 0 do
  175.           WriteEventFmt('%s.%s',[TraceStack[i].ObjectName,TraceStack[i].FunctionName],elData);
  176.         WriteEvent('',elEnd);
  177.         WriteEvent('',elEnd);
  178.       end;
  179.     end;
  180.     if emDefault in tr.ExceptionModes then begin
  181.       if Assigned(FPrevOnException) then
  182.         FPrevOnException(Sender,E)
  183.       else
  184.         if NewStyleControls then
  185.           Application.ShowException(E)
  186.         else
  187.           MessageBox(Handle,PChar(E.Message),'',MB_ICONERROR or MB_OK);
  188.     end;
  189.     if emExceptionStack in tr.ExceptionModes then begin
  190.       if not IsConsole then begin
  191.         Application.NormalizeTopMosts;
  192.         try
  193.           with List.Items.Insert(0) do begin
  194.             Caption:=Datetimetostr(now);
  195.             SubItems.Add(er.Classname);
  196.             SubItems.Add(Format('0x%x',[er.Code]));
  197.             SubItems.Add(er.Text);
  198.             SubItems.Add(s);
  199.           end;
  200.           List.Selected:=List.Items[0];
  201.           List.Selected.MakeVisible(False);
  202.           LogPanel.Visible:=emJournal in tr.ExceptionModes;
  203.           if Journal<>nil then
  204.             eLog.Text:=Journal.FileName;
  205.           ShowModal;
  206.         finally
  207.           FExceptObj:=nil;
  208.           Application.RestoreTopMosts;
  209.         end;
  210.       end else
  211.         Writeln(s);
  212.     end;
  213.   end else
  214.     if NewStyleControls then
  215.       Application.ShowException(E)
  216.     else
  217.       MessageBox(Handle,PChar(E.Message),'',MB_ICONERROR or MB_OK);
  218.   SetLength(TraceStack,0);
  219. {$ELSE}
  220.   FPrevOnException(Sender,E);
  221. {$ENDIF}
  222. end;
  223.  
  224.  
  225. procedure TdlgExceptionStack.FormCreate(Sender: TObject);
  226. var
  227.   s: string;
  228. begin
  229.   FPrevOnException:=nil;
  230.   SetLength(FErrorStack,0);
  231.   FPrevOnException:=Application.OnException;
  232.   Application.OnException:=ExceptionHandler;
  233.   AppIcon.Picture.Icon.Handle:=Application.Icon.Handle;
  234.   s:=FileversionInfo.Description;
  235.   if Trim(s)='' then
  236.     s:=ExtractFilename(ParamStr(0));
  237.   lApplication.Caption:=Format('%s %s',[s,FileversionInfo.Version]);
  238.   lMSIC.Caption:=Format('%s %s',[cCompName,cVersion]);
  239. end;
  240.  
  241. procedure TdlgExceptionStack.FormDestroy(Sender: TObject);
  242. begin
  243.   SetLength(FErrorStack,0);
  244.   Application.OnException:=FPrevOnException;
  245. end;
  246.  
  247. procedure TdlgExceptionStack.ListSelectItem(Sender: TObject;
  248.   Item: TListItem; Selected: Boolean);
  249. begin
  250.   if Assigned(Item) then
  251.     Memo.Lines.Text:=Item.SubItems[Item.SubItems.Count-1]
  252.   else
  253.     Memo.Lines.Clear;
  254. end;
  255.  
  256. procedure TdlgExceptionStack.Button1Click(Sender: TObject);
  257. begin
  258.   List.Items.Clear;
  259.   Memo.Lines.Clear;
  260. end;
  261.  
  262. initialization
  263.   dlgExceptionStack:=nil;
  264. finalization
  265.   ErrorRelease;
  266. end.
  267.