📄 excmagic.pas
字号:
unit ExcMagic;
{$I ExcMagicDefines.inc}
{ $D-,L-,Y-} // turn off all debug-info
{$R-} // turn off range checking
{$H+} // use huge strings
{$Q-} // OVERFLOWCHECKS OFF
(*
-----------------------------------------------------------------------------
ExceptionalMagic unit. [D3,D4,D5,CB4,CB5] version 1.51
(c)Dimus Gremyakoff,1999-2000
WEB: http://dimus.virtualave.net
e-mail: dimus@dimus.virtualave.net (russian/english)
FIDO: 2:5020/768.57
-----------------------------------------------------------------------------
*)
(*
-----------------------------------------------------------------------------
Conditional defines:
EXCMAGIC_GUI create GUI version of unit (uses Forms; intercept Application.ShowException)
EXCMAGIC_CON ...... Console .....
EXCMAGIC_DEMO create unit with some limitations
EXCMAGIC_DEBUG perform debugging output to ExcMagic.Debug
-----------------------------------------------------------------------------
*)
interface
{$IFDEF EXCMAGIC_BADCOMPILER}
Compile with Delphi 3,4,5 or Builder 4,5 !
{$ENDIF}
{$IFDEF EXCMAGIC_Delphi4plus}
uses Windows, Messages, SysUtils, Classes, CommCtrl, SysConst,
ExcMemMap, ExcUnmangle, ExcMagicUtils;
{$ELSE}
uses Windows, Messages, SysUtils, Classes, CommCtrl,
ExcMemMap, ExcUnmangle, ExcMagicUtils;
{$ENDIF}
{$IFDEF EXCMAGIC_Delphi3}
type
Longword = Longint;
PLongWord = ^Longword;
PImageDosHeader = ^TImageDosHeader;
{EXTERNALSYM _IMAGE_DOS_HEADER}
TImageDosHeader = packed record { DOS .EXE header }
e_magic: Word; { Magic number }
e_cblp: Word; { Bytes on last page of file }
e_cp: Word; { Pages in file }
e_crlc: Word; { Relocations }
e_cparhdr: Word; { Size of header in paragraphs }
e_minalloc: Word; { Minimum extra paragraphs needed }
e_maxalloc: Word; { Maximum extra paragraphs needed }
e_ss: Word; { Initial (relative) SS value }
e_sp: Word; { Initial SP value }
e_csum: Word; { Checksum }
e_ip: Word; { Initial IP value }
e_cs: Word; { Initial (relative) CS value }
e_lfarlc: Word; { File address of relocation table }
e_ovno: Word; { Overlay number }
e_res: array [0..3] of Word; { Reserved words }
e_oemid: Word; { OEM identifier (for e_oeminfo) }
e_oeminfo: Word; { OEM information; e_oemid specific}
e_res2: array [0..9] of Word; { Reserved words }
_lfanew: LongInt; { File address of new exe header }
end;
TC_ITEM = packed record
mask: UINT;
dwState: UINT;
dwStateMask: UINT;
pszText: PAnsiChar;
cchTextMax: Integer;
iImage: Integer;
lParam: LPARAM;
end;
{$ENDIF}
{$IFDEF EXCMAGIC_DEMO}
const
MAX_SRCMODULE = 3;
{$ENDIF}
type
TLongArray = array[0..0] of Longword;
PLongArray = ^TLongArray;
TLongwordArray = array[0..0] of Longword;
PLongwordArray = ^TLongwordArray;
type
TModuleDebugInfo = class;
EExcMagicError = class( Exception );
PDS_SubsectionHeader = ^TDS_SubsectionHeader;
TDS_SubsectionHeader = packed record
sshHeaderSize : Word;
sshRecordSize : Word;
sshRecordCount : Longint;
reserved: array[0..7] of Byte;
end;
TDS_SubsectionEntry = packed record
sseType: Word;
sseModIndex: Word;
sseOffset: Longword;
sseSize: Longword;
end;
TDS_SubsectionEntryArray = array[0..0] of TDS_SubsectionEntry;
PTDS_SubsectionEntryArray = ^TDS_SubsectionEntryArray;
TDS_SegmentRange = packed record
sStart,sEnd: Longword;
end;
TDS_SegmentRangeArray = array[0..0] of TDS_SegmentRange;
PTDS_SegmentRangeArray = ^TDS_SegmentRangeArray;
TDS_LineNum = packed record
LineNum : Word;
Offset : Longword;
end;
PExceptionRecord = ^TExceptionRecord;
TExceptionRecord = packed record
ExceptionCode : LongWord;
ExceptionFlags : LongWord;
OuterException : PExceptionRecord;
ExceptionAddress : Pointer;
NumberParameters : Longint;
case {IsOsException:} Boolean of
True: (ExceptionInformation : array [0..14] of Longint);
False: (
ExceptAddr: Pointer;
ExceptObject: Pointer;
ExceptEBX: LongWord;
ExceptESI: LongWord;
ExceptEDI: LongWord;
ExceptEBP: LongWord;
ExceptESP: LongWord;
);
end;
TModuleDebugInfo = class
private
FMMFile : TMMFileStream;
FName : String;
FLoaded : Boolean;
FInstance : THandle;
FPDosHdr : PImageDosHeader;
FPImgHdr : PImageNtHeaders;
//
FSignature : LongWord;
FTDSTotalSize : LongWord;
FTDSOffset : LongWord;
FTDSDataSize : LongWord;
FTDSSubdir : TDS_SubsectionHeader;
FTDSEntries : PTDS_SubsectionEntryArray;
{$IFDEF EXCMAGIC_DEMO}
FsstSrcTable : array[0..MAX_SRCMODULE-1] of TDS_SubsectionEntry;
FsstSrcCount : Integer;
{$ENDIF}
//
FNamesCount : Longint;
FNameIndexes : PLongArray; // Offsets of all names in debug file
//
function GetConvertedAddress( Address: Pointer ): Pointer;
function EntryOffset( Index: Integer ): Longword;
procedure GetModuleName( Address: Pointer; ModuleName: PChar; ModuleNameSize: Integer );
function FindProc( Address: Pointer; Module: Integer ): Integer;
function GetSourceLine( Address: Pointer; var SrcFileNameIndex,SrcLineNum: Integer ): Boolean;
function GetProcName( Address: Pointer; var ModuleNameIndex,ProcNameIndex: Integer ): Boolean;
function GetName( Index: Integer ): String;
function GetIsDelphi: Boolean;
function CreateNamesArray: Boolean;
function LoadTDS( AFileName: String ): Boolean;
function LoadTDS2: Boolean;
function LoadDebugInfo( FileName: String ): Boolean;
procedure UnLoadDebugInfo;
public
constructor Create( const FileName: String; const Inst: THandle );
destructor Destroy; override;
function IsInCode( Address: Pointer ): Boolean;
function GetLogicalAddr( Address: Pointer ): Pointer;
function SourceLine( Address: Pointer; var SrcFileNameIndex,SrcLineNum: Integer ): Boolean;
function ProcName( Address: Pointer; var ModuleNameIndex,ProcNameIndex: Integer ): Boolean;
property ModuleName: String read FName;
property Names[Index: Integer]: String read GetName;
property Loaded: Boolean read FLoaded;
property IsDelphiModule: Boolean read GetIsDelphi;
end;
TCallStackItem = packed record
DebugModule : TModuleDebugInfo;
CallAddress : Pointer;
ModuleNameIndex : Integer;
ProcNameIndex : Integer;
FileNameIndex : Integer;
FileLineNumber : Integer;
NestingLevel : Integer;
end;
PCallStackItem = ^TCallStackItem;
TExcCallStack = class( TList )
private
function GetItem(Index: Integer): PCallStackItem;
public
procedure GenerateFromAddr( Address: Pointer; RegEBP: LongWord; MaxSize: Integer; SuppressRecursion: Boolean ); stdcall;
procedure Generate( MaxSize: Integer; SuppressRecursion: Boolean ); stdcall;
procedure Clear; {$IFNDEF EXCMAGIC_Delphi3} override; {$ENDIF}
procedure Dump( StrList: TStringList );
property Items[Index: Integer]: PCallStackItem read GetItem;
end;
{ -------------------------- TExcMagic ----------------------- }
TExceptionMessageInfo = record
miMessage: String;
miModuleName: array[0..MAX_PATH] of Char;
miVirtualAddress: Pointer;
miModuleAddress: Pointer;
miModuleNameIndex: Integer;
miProcNameIndex: Integer;
miSrcNameIndex: Integer;
miSrcLineNum: Integer;
miDebugModule: TModuleDebugInfo;
end;
TExcMagicMsgProc = procedure( ExceptionObject: TObject;
MessageInfo: TExceptionMessageInfo;
Buffer: PChar;
BufferSize: Integer ) of object;
TExcMagicShowProc = procedure( Title,
ExceptionMessage: String;
CallStack,
Registers,
CustomInfo: TStringList ) of object;
TExcMagicLogProc = procedure( Buffer: PChar;
BufferSize: Integer;
CallStack,
Registers,
CustomInfo: TStringList ) of object;
TExcMagicCustomInfoProc = procedure( CustomInfo: TStringList ) of object;
TExcMagicTerminateProc = procedure( var CloseDialog: Boolean ) of object;
TExcMagicOption = ( excDlgDetailed, // show expanded dialog (Detailed)
excDlgCallStack, // show call stack
excDlgRegisters, // show registers
excDlgCustomInfo, // show additional custom info
excDlgTerminate, // show terminate button
excShowDialog // show dialog on exception
);
TExcMagicOptions = set of TExcMagicOption;
TSourceInfo = record
ModuleDebugInfo: TModuleDebugInfo;
ModuleName: String;
FileName: String;
ProcName: String;
LineNumber: Integer;
end;
TExcMagic = class
private
FCallStack : TExcCallStack;
FCallStackStrings : TStringList;
FContextStrings : TStringList;
FCustomInfoStrings : TStringList;
FCustomTab : String;
//
FModules: TList; { list of TModuleDebugInfo }
FIcon: PChar;
FEnabled: Boolean;
FLogFile: String;
FLogEnabled: Boolean;
FLogHandled: Boolean;
FOptions: TExcMagicOptions;
FMaxCallStack: Integer;
FSuppressRecursion: Boolean;
FOnExceptionMsg: TExcMagicMsgProc;
FOnExceptionShow: TExcMagicShowProc;
FOnExceptionLog: TExcMagicLogProc;
FOnCustomInfo: TExcMagicCustomInfoProc;
FOnTerminate: TExcMagicTerminateProc;
//
procedure SetEnabled( Value: Boolean );
function GetExcMagicAbout: String;
function GetExcMagicVersion: String;
//
function FindDebugModule( Address: Pointer ): TModuleDebugInfo;
procedure LogExceptionData( Buffer: PChar; BufLen: Integer );
procedure DumpAll;
procedure DumpContext( StrList: TStringList );
function GetContext: TContext;
function GetExceptionRec: TExceptionRecord;
function GetExceptionInfo: TExceptionMessageInfo;
public
constructor Create;
destructor Destroy; override;
function UnMangle( Source: String; IsDelphi: Boolean ): String;
function GetAddressSourceInfo( Address: Pointer; var ModuleDebugInfo: TModuleDebugInfo; var ModuleName: String; var FileName: String;
var ProcName: String; var LineNumber: Integer ): Boolean;
function GetSourceInfo( var ModuleDebugInfo: TModuleDebugInfo; var ModuleName: String; var FileName: String;
var ProcName: String; var LineNumber: Integer ): Boolean; stdcall;
function GetAddressSourceInfoRec( Address: Pointer ): TSourceInfo;
function GetSourceInfoRec: TSourceInfo; stdcall;
procedure LogException;
procedure Log( Text: PChar; WithHeader: Boolean );
property About: String read GetExcMagicAbout;
property CallStack: TExcCallStack read FCallStack;
property CustomTab: String read FCustomTab write FCustomTab;
property Enabled: Boolean read FEnabled write SetEnabled default True;
property ExceptionContext: TContext read GetContext;
property ExceptionInfo: TExceptionMessageInfo read GetExceptionInfo;
property ExceptionRec: TExceptionRecord read GetExceptionRec;
property Icon: PChar read FIcon write FIcon;
property LogEnabled: Boolean read FLogEnabled write FLogEnabled default True;
property LogFile: String read FLogFile write FLogFile;
property LogHandled: Boolean read FLogHandled write FLogHandled default False;
property MaxCallStack: Integer read FMaxCallStack write FMaxCallStack default 100;
property SuppressRecursion: Boolean read FSuppressRecursion write FSuppressRecursion default True;
property Options: TExcMagicOptions read FOptions write FOptions;
property Version: String read GetExcMagicVersion;
property OnExceptionMsg: TExcMagicMsgProc read FOnExceptionMsg write FOnExceptionMsg;
property OnExceptionShow: TExcMagicShowProc read FOnExceptionShow write FOnExceptionShow;
property OnExceptionLog: TExcMagicLogProc read FOnExceptionLog write FOnExceptionLog;
property OnCustomInfo: TExcMagicCustomInfoProc read FOnCustomInfo write FOnCustomInfo;
property OnTerminate: TExcMagicTerminateProc read FOnTerminate write FOnTerminate;
end;
var
ExceptionHook: TExcMagic;
{ =========================== } implementation { =========================== }
{$IFNDEF EXCMAGIC_GUI}
{$IFNDEF EXCMAGIC_CON}
Define EXCMAGIC_GUI or EXCMAGIC_CON !!!
{$ENDIF}
{$ENDIF}
{$IFDEF EXCMAGIC_GUI}
uses Forms;
{$ENDIF}
{$R ExcMagic.RES}
{ $I MapFiles.inc}
const
ExcMagicVerNum = '1.51';
ExcMagicAbout = 'ExceptionalMagic Delphi unit (c)Dimus Gremyakoff [http:\\dimus.virtualave.net]';
//
SOnlyOneAllowed = 'Only one instance of TExcMagic allowed';
SDefaultLog = 'ExcMagic.Log';
SDefaultCustom = 'Additional';
{$IFDEF EXCMAGIC_GUI}
ExcMagicType = 'GUI';
{$ELSE}
ExcMagicType = 'CONSOLE';
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -