excmagic.pas

一个异常处理的类

                    Result := PtrDimProc32^.dwNameIndex;
                    Exit;
                  end;
                Inc( PtrDimProc32 );
              end;

            FMMFile.UnMapData;
          end;
      end;
end;

function TModuleDebugInfo.GetProcName( Address: Pointer; var ModuleNameIndex,ProcNameIndex: Integer ): Boolean;
var
  i,n: Integer;
  MH: TsstModuleHeader;
  MS: TsstModuleSegInfo;
  EntryOfs: Longword;
begin
  Result          := False;
  ModuleNameIndex := -1;
  ProcNameIndex   := -1;

  if not FLoaded then Exit;

  // 1. Find Module with Address

  for i := 0 to FTDSSubdir.sshRecordCount-1 do
    if FTDSEntries^[i].sseType = SST_MODULE then
      begin
        // check if sstModule in allowed demo array of modules
      {$IFDEF EXCMAGIC_DEMO}
        EntryOfs := 0;
        for n := 0 to FsstSrcCount-1 do
          if FsstSrcTable[n].sseModIndex = FTDSEntries^[i].sseModIndex then
            begin
              EntryOfs := EntryOffset( i );
              Break;
            end;
        if EntryOfs = 0 then Continue;
      {$ELSE}
        EntryOfs := EntryOffset( i );
      {$ENDIF}

        FMMFile.Seek( EntryOfs, soFromBeginning );
        FMMFile.Read( MH, SizeOf(MH) );
        for n := 0 to MH.SegCount-1 do
          begin
            FMMFile.Read( MS, SizeOf(MS) );
            if ((MS.Flags and 1) <> 0) and
               (LongWord(Address) >= MS.Start) and
               (LongWord(Address) <  MS.Start+MS.Size) then
                 begin
                   // 2. Find proc in AlignSymbol info for current module
                   Result := True;
                   ModuleNameIndex := MH.NameIndex;
                   ProcNameIndex   := FindProc( Address, FTDSEntries^[i].sseModIndex );
                   Exit;
                 end;
          end;
      end;
end;


{$HINTS OFF}
function TModuleDebugInfo.GetSourceLine( Address: Pointer; var SrcFileNameIndex,SrcLineNum: Integer ): Boolean;
var
  i: Longint;
  pSrcInfoOffsets: PLongArray;
  ww,w,u: Integer;
  pSrcModule,pSrcFileInfo,pLinesInfo: Pointer;
  SrcModuleSize: Dword;
  SrcModuleOffset,SrcFileInfoOffset,LinesInfoOffset: Dword;
  SrcInfoOffsetsSize: Longint;
  wSrcFiles,wSegments,wLineNumBlocks: Word;
  pSegRanges: PTDS_SegmentRangeArray;
  pSegNumbers: PWordArray;
  dwFilenameIndex: Longword;
  wLinesSegIdx,wLinesCount: Word;
  pLineNum: PWordArray;
  pLineOffset: PLongArray;
  pSrcBaseLines: PLongArray;
  pSrcStartEnds: PTDS_SegmentRangeArray;
  binLeft,binRight,binMid: Word;
begin
  Result      := False;
  SrcLineNum  := -1;
  SrcFileNameIndex := -1;

  if not FLoaded then Exit;

{$IFDEF EXCMAGIC_DEMO}
  for i := 0 to FsstSrcCount-1 do
      begin
        SrcModuleOffset := FTDSOffset + FsstSrcTable[i].sseOffset;
        SrcModuleSize   := FsstSrcTable[i].sseSize;
{$ELSE}
  for i := 0 to FTDSSubdir.sshRecordCount-1 do
    if FTDSEntries^[i].sseType = SST_SRCMODULE then
      begin
        SrcModuleOffset := EntryOffset(i);
        SrcModuleSize   := FTDSEntries^[i].sseSize;
{$ENDIF}
        FMMFile.Seek( SrcModuleOffset, soFromBeginning );

        pSrcModule      := FMMFile.MapData( SrcModuleOffset, SrcModuleSize );

        wSrcFiles       := PWord(pSrcModule)^;
        wSegments       := PWord(Longint(pSrcModule)+2)^;
        pSrcInfoOffsets := Pointer(Longint(pSrcModule)+4);
        pSegRanges      := Pointer(Longint(pSrcInfoOffsets) + wSrcFiles*4);
        pSegNumbers     := Pointer(Longint(pSegRanges) + wSegments*8);

        // find range with ADDRESS
        for ww := 0 to Integer(wSegments)-1 do
          if (Longword(Address) >= pSegRanges^[ww].sStart) and (Longword(Address) <= pSegRanges^[ww].sEnd) then
              for w := 0 to Integer(wSrcFiles)-1 do
                begin
                  // offset of source file info # w
                  pSrcFileInfo := Pointer( Longword(pSrcModule) + pSrcInfoOffsets^[w] );
                  wLineNumBlocks  := PWord(pSrcFileInfo)^;
                  // name index in my string list
                  dwFilenameIndex := PLongword( Longint(pSrcFileInfo) + 2 )^;

                  pSrcBaseLines   := Pointer( Longint(pSrcFileInfo) + 6 );
                  pSrcStartEnds   := Pointer( Longint(pSrcBaseLines) + wLineNumBlocks * 4 );

                  // find range with ADDRESS
                  for u := 0 to Integer(wLineNumBlocks)-1 do
                    if (Longword(Address) >= pSrcStartEnds^[u].sStart) and (Longword(Address) <= pSrcStartEnds^[u].sEnd) then
                      begin
                        pLinesInfo   := Pointer( Longword(pSrcModule) + pSrcBaseLines^[u] );
                        wLinesSegIdx := PWord(pLinesInfo)^;
                        wLinesCount  := PWord(Longint(pLinesInfo)+2)^;

                        pLineOffset  := Pointer(Longint(pLinesInfo)+4);
                        pLineNum     := Pointer(Longint(pLineOffset)+4*wLinesCount);

                        // binsearch

                        binLeft  := 0;
                        binRight := wLinesCount-1;
                        binMid   := 0;
                        while binLeft < binRight-1 do
                          begin
                            binMid := (binLeft + binRight) div 2;
                            if Longword(Address) >= pLineOffset^[binMid] then
                              binLeft := binMid
                            else
                              binRight := binMid;
                          end;

                        // now Address in [binLeft..binRight[, so get binLeft as linenum index

                        SrcLineNum := Longword( pLineNum^[binLeft] );
                        SrcFileNameIndex := dwFilenameIndex;
                        Result := True;
                        // unmap data
                        FMMFile.UnMapData;
                        Exit;
                      end;
                end;
        FMMFile.UnMapData;
      end;
end;
{$HINTS ON}

function  TModuleDebugInfo.SourceLine( Address: Pointer; var SrcFileNameIndex,SrcLineNum: Integer ): Boolean;
begin
  Result := GetSourceLine( GetConvertedAddress(Address), SrcFileNameIndex, SrcLineNum );
end;

function  TModuleDebugInfo.ProcName( Address: Pointer; var ModuleNameIndex,ProcNameIndex: Integer ): Boolean;
begin
  Result := GetProcName( GetConvertedAddress(Address), ModuleNameIndex, ProcNameIndex );
end;

function TModuleDebugInfo.LoadTDS2: Boolean;
var
  D: Longword;
begin
  Result := False;
  try
    FMMFile.Seek( -8, soFromEnd );
    D := FMMFile.ReadDword;
    if (D = FB09_SIGNATURE) or (D = FB0A_SIGNATURE) then
      begin
        FTDSTotalSize := FMMFile.ReadDword;
        FMMFile.Seek( -FTDSTotalSize, soFromEnd );
        D := FMMFile.ReadDword;
        if (D = FB09_SIGNATURE) or (D = FB0A_SIGNATURE) then
          begin
            FSignature   := D;
            FTDSOffset   := FMMFile.Position - 4;
            FTDSDataSize := FMMFile.ReadDword;
            // read Subsection directory header
            FMMFile.Seek( FTDSOffset + FTDSDataSize, soFromBeginning );
            FMMFile.Read( FTDSSubdir, SizeOf(FTDSSubdir) );
            // check Subsection Header
            Result := (FTDSSubdir.sshHeaderSize = $0010) and
                      (FTDSSubdir.sshRecordSize = $000C);
            if Result then
              begin
                // alloc and read Subsection entries
                GetMem( FTDSEntries, SizeOf(TDS_SubsectionEntry) * FTDSSubdir.sshRecordCount );
                FMMFile.Read( FTDSEntries^, SizeOf(TDS_SubsectionEntry) * FTDSSubdir.sshRecordCount );
                // Create array with Names offsets
                Result  := Result and CreateNamesArray;
                FLoaded := True;
                {$IFDEF EXCMAGIC_DEBUG}
                  DebugFmt( 'Loaded. (Result %d)', [Ord(Result)] );
                {$ENDIF}
                FMMFile.UnMapData;
              end;
          end;
      end;
  except
  end;
end;

function TModuleDebugInfo.LoadTDS( AFileName: String ): Boolean;
begin
  Result := False;
  UnLoadDebugInfo;

  {$IFDEF EXCMAGIC_DEBUG}
    DebugMsg( 'Looking for debug-info in ' + AFileName );
  {$ENDIF}

  if FileExists(AFileName) then
    try
      FMMFile := TMMFileStream.Create( AFileName, fmOpenRead + fmShareDenyNone, 'ExcMagic.'+AFileName );
      try
        Result := LoadTDS2;
      except
        FreeAndNil( FMMFile );
        FLoaded := False;
      end;
    except
      {$IFDEF EXCMAGIC_DEBUG}
        DebugMsg( '  Error opening ' + AFileName );
      {$ENDIF}
      Exit;
    end;
end;

function TModuleDebugInfo.LoadDebugInfo( FileName: String ): Boolean;
begin
  UnLoadDebugInfo;
  Result := True;
  if not LoadTDS(FileName) then
    if not LoadTDS( ChangeFileExt(FileName,'.TDS') ) then
      if not LoadTDS( ChangeFileExt(FileName,'.DSI') ) then Result := False;
end;

procedure TModuleDebugInfo.UnLoadDebugInfo;
begin
  FreeAndNil( FMMFile );
  if Assigned(FTDSEntries)  then FreeMem( FTDSEntries, SizeOf(TDS_SubsectionEntry) * FTDSSubdir.sshRecordCount );
  if Assigned(FNameIndexes) then FreeMem( FNameIndexes, FNamesCount * SizeOf(Pointer) );
  FTDSEntries  := nil;
  FNameIndexes := nil;
  FNamesCount  := 0;
  FLoaded      := False;
end;

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

procedure TExcCallStack.Clear;
var
  i: Integer;
begin
  for i := 0 to Count-1 do FreeMem( Items[i] );
  inherited;
end;

function  TExcCallStack.GetItem(Index: Integer): PCallStackItem;
begin
  Result := PCallStackItem( inherited Items[Index] );
end;

{
  Address: return address (i.e. address of instruction after CALL)
  RegEBP : current value of EBP (stack frame pointer)

  function _must_ retrieve args from stack (so use stdcall) !!!
}
procedure TExcCallStack.GenerateFromAddr(
      Address: Pointer; RegEBP: LongWord; MaxSize: Integer; SuppressRecursion: Boolean ); stdcall;
type
  PPointer = ^Pointer;
var
  CurModule: TModuleDebugInfo;
  ConvertedAddress,PrevAddress: Pointer;
  pCallItem: PCallStackItem;
begin
  Clear;
  PrevAddress := nil;

  {$IFDEF EXCMAGIC_DEBUG}
    DebugFmt( 'Generating CallStack. Addr %p, EBP %.08X', [Address,RegEBP] );
  {$ENDIF}

  while True do
    begin
      if IsBadReadPtr( Address, 4 ) then Break;

      CurModule := ExceptionHook.FindDebugModule( Address );
      if CurModule = nil then Break;
      // if not CurModule.Loaded then Break;

      {$IFDEF EXCMAGIC_DEBUG}
        DebugFmt( '  call from %p', [Address] );
      {$ENDIF}

      ConvertedAddress := CurModule.GetConvertedAddress( Address );

      if (Address = PrevAddress) and SuppressRecursion then
        begin
          Inc( Items[Count-1]^.NestingLevel );
        end
      else
        begin
          GetMem( pCallItem, SizeOf(pCallItem^) );
          with pCallItem^ do
            begin
              DebugModule := CurModule;
              CallAddress := Address;
              // get source line with CALL instruction
              // so use ReturnAddress - 1 !!!
              CurModule.GetSourceLine( Pointer(Longword(ConvertedAddress)-1), FileNameIndex, FileLineNumber );
              CurModule.GetProcName( ConvertedAddress, ModuleNameIndex, ProcNameIndex );
              NestingLevel := 1;
            end;
          Add( pCallItem );
        end;
{
  standard stack frame:

  push ebp
  mov  ebp,esp
  [sub esp,xxx]
  ...
  mov  esp,ebp
  ret [xxx]

      -------------
  +4  | ret.addr. |
      -------------
  +0  | EBP_old   | <---- EBP_new
      -------------
}
      if Count >= MaxSize then Break;
      if IsBadReadPtr( PPointer(PChar(RegEBP)+4), 4 ) then Break;
      if IsBadReadPtr( Pointer(RegEBP), 4 ) then Break;

      PrevAddress     := Address;
      Address         := PPointer(PChar(RegEBP)+4)^;
      Pointer(RegEBP) := PPointer(RegEBP)^;

      // if (LongWord(Address) and $80000000) <> 0 then Break; // from OS (win9x)
    end;
end;

{
  Generates call-stack for location from it was called.
  this function must have a stack frame (stdcall) !!!
}
procedure TExcCallStack.Generate( MaxSize: Integer; SuppressRecursion: Boolean ); stdcall;
var
  Address: Pointer;
  RegEBP: LongWord;
begin
  asm
    mov     eax,[ebp]     // get caller EBP
    mov     RegEBP,eax
    mov     eax,[ebp+4]   // return address
    mov     Address,eax