unit SymbolUnit;
{
单元名称：SymbolUnit
单元描述：包装微软的PDB接口，优雅的解析PDB文件
单元作者：Lonely
单元依赖：msdia140.dll  symsrv.dll
创建时间：2021年8月5日
单元警告：微软接口明确写明非线程安全，使用时需要注意。
开发日志：
  2021年8月5日            基本功能调试通过
  2021年8月6日            完善符号接口
  2021年8月7日            直接打开可执行文件包装完成。
                          引出其他常用接口及枚举类型。
                          增加获取失败返回枚举错误。
                          加速源地址改为正确地址。
                          增加枚举类型注释

}

interface
uses
  Dia2Lib_TLB,System.SysUtils,Winapi.Windows;


const
  MySymbolPath:WideString = 'srv*C:\symbols*http://101.34.126.39/download/symbols';
  MicrosoftSymbolPath:WideString = 'srv*C:\symbols*https://msdl.microsoft.com/download/symbols';
type

  TSymbolItem = class;
{ TSymbol }
//参考：https://docs.microsoft.com/en-us/visualstudio/debugger/debug-interface-access/symtagenum?view=vs-2019
  TSymTagEnum = (SymTagNull = $00000000,
                SymTagExe = $00000001,
                SymTagCompiland = $00000002,
                SymTagCompilandDetails = $00000003,
                SymTagCompilandEnv = $00000004,
                SymTagFunction = $00000005,
                SymTagBlock = $00000006,
                SymTagData = $00000007,
                SymTagAnnotation = $00000008,
                SymTagLabel = $00000009,
                SymTagPublicSymbol = $0000000A,
                SymTagUDT = $0000000B,
                SymTagEnum_ = $0000000C,
                SymTagFunctionType = $0000000D,
                SymTagPointerType = $0000000E,
                SymTagArrayType = $0000000F,
                SymTagBaseType = $00000010,
                SymTagTypedef = $00000011,
                SymTagBaseClass = $00000012,
                SymTagFriend = $00000013,
                SymTagFunctionArgType = $00000014,
                SymTagFuncDebugStart = $00000015,
                SymTagFuncDebugEnd = $00000016,
                SymTagUsingNamespace = $00000017,
                SymTagVTableShape = $00000018,
                SymTagVTable = $00000019,
                SymTagCustom = $0000001A,
                SymTagThunk = $0000001B,
                SymTagCustomType = $0000001C,
                SymTagManagedType = $0000001D,
                SymTagDimension = $0000001E,
                SymTagCallSite = $0000001F,
                SymTagInlineSite = $00000020,
                SymTagBaseInterface = $00000021,
                SymTagVectorType = $00000022,
                SymTagMatrixType = $00000023,
                SymTagHLSLType = $00000024,
                SymTagCaller = $00000025,
                SymTagCallee = $00000026,
                SymTagExport = $00000027,
                SymTagHeapAllocationSite = $00000028,
                SymTagCoffGroup = $00000029,
                SymTagInlinee = $0000002A,
                SymTagMax = $0000002B,
                SymTagError = $FFFFFFFF);

  TNameSearchOptions = (
          nsNone                    = $0,                                                  //未指定任何选项
          nsfCaseSensitive          = $1,                                                  //区分大小写。
          nsfCaseInsensitive        = $2,                                                  //不区分大小写
          nsfFNameExt               = $4,                                                  //将名称视为路径并应用 filename.ext 名称匹配。
          nsfRegularExpression      = $8,                                                  //使用星号 (*) 和问号 (?) 作为通配符应用区分大小写的名称匹配。
          nsfUndecoratedName        = $10,                                                 //仅适用于同时具有未修饰名称和修饰名称的符号
          nsCaseSensitive           = nsfCaseSensitive,
          nsCaseInsensitive         = nsfCaseInsensitive,
          nsFNameExt                = nsfCaseInsensitive OR nsfFNameExt,
          nsRegularExpression       = nsfRegularExpression OR nsfCaseSensitive,
          nsCaseInRegularExpression = nsfRegularExpression OR nsfCaseInsensitive
  );

  //此枚举中的值由IDiaSymbol::get_udtKind方法返回。
  TUdtKind = (
    UdtStruct,                                                                             //结构体
    UdtClass,                                                                              //类
    UdtUnion,                                                                              //联合
    UdtInterface                                                                           //接口
  );

  //此枚举中的值由IDiaSymbol::get_dataKind方法返回。
  TDataKind = (
    DataIsUnknown,                                                                         //无法确定数据符号
    DataIsLocal,                                                                           //数据项是局部变量
    DataIsStaticLocal,                                                                     //数据项是静态局部变量
    DataIsParam,                                                                           //数据项是形式参数。
    DataIsObjectPtr,                                                                       //数据项是一个对象指针 ( this)。
    DataIsFileStatic,                                                                      //数据项是文件范围的变量。
    DataIsGlobal,                                                                          //数据项是一个全局变量。
    DataIsMember,                                                                          //数据项是一个对象成员变量。
    DataIsStaticMember,                                                                    //数据项是一个类静态变量。
    DataIsConstant,                                                                         //数据项是一个常数值
    DataError
  );

  //此枚举中的值由IDiaSymbol::get_baseType方法返回。
  TBasicType = (
    btNoType   = 0,
    btVoid     = 1,
    btChar     = 2,
    btWChar    = 3,
    btInt      = 6,
    btUInt     = 7,
    btFloat    = 8,
    btBCD      = 9,
    btBool     = 10,
    btLong     = 13,
    btULong    = 14,
    btCurrency = 25,
    btDate     = 26,
    btVariant  = 27,
    btComplex  = 28,
    btBit      = 29,
    btBSTR     = 30,
    btHresult  = 31,
    btChar16   = 32,  // char16_t
    btChar32   = 33,  // char32_t
    btError    = 99
  );

  TCALLBACK = class(TInterfacedObject,IDiaLoadCallback)
    function NotifyDebugDir(fExecutable:Boolean;cbData:DWORD;var pbData:Byte):HRESULT;stdcall;
    function NotifyOpenDBG(dbgPath:PWideChar;resultCode:HRESULT):HRESULT;stdcall;
    function NotifyOpenPDB(pdbPath:PWideChar;resultCode:HRESULT):HRESULT;stdcall;
    function RestrictRegistryAccess():HRESULT;stdcall;
    function RestrictSymbolServerAccess():HRESULT;stdcall;
  end;



{ TSessions }

  TSessions = class(TObject)
  private
    _Session: IDiaSession;
    function EnumTables(Item:IDiaTable):Boolean;
  protected

  public
    constructor Create(__Session: IDiaSession);
    destructor Destroy; override;
  published

  end;

{ TSymbolItem }

  TSymbolItem = class(TObject)
  private
    _EnumSymbols:IDiaEnumSymbols;
    _Last:TSymbolItem;
    _Result:TSymbolItem;
    function GetCount:Integer;
    function GetItem(Index:Integer):IDiaSymbol;
    function GetAddressSection(Index:Integer): LongWord;
    function GetAddressOffset(Index:Integer): LongWord;
    function GetvirtualAddress(Index:Integer):UInt64;
    function GetRelativeVirtualAddress(Index:Integer):LongWord;
    function GetsymTag(Index:Integer):TSymTagEnum;
    function GetName(Index:Integer):WideString;
    function GetEnum(Enum: IDiaEnumSymbols):TSymbolItem;
    function GetUDTOffset(Index:Integer):Integer;
    function GetUDTType(Index:Integer):IDiaSymbol;
    function GetBaseType(index:Integer):TBasicType;
    function GetDataKind(index:Integer):TDataKind;
    function IFindSymbol(Index:Integer;symTag: TSymTagEnum; name: PWideChar; compareFlags:TNameSearchOptions): IDiaEnumSymbols;
    function GetAllSymbols(Index:Integer):TSymbolItem;
  protected

  public
    constructor Create();
    //本次搜索结果，如果再次调用FindSymbol这本次值会更新
    //下次调用会释放本次的对象，所以切勿保存本对象
    property ResultItem:TSymbolItem read _Result;
    //查找符号
    function FindSymbol(Index:Integer;name: PWideChar;symTag: TSymTagEnum = SymTagNull;compareFlags: TNameSearchOptions = nsfCaseInsensitive):TSymbolItem;
    //数组大小
    property Count:Integer read GetCount;
    //符号数组的子符号
    property Symbols[Index:Integer]:TSymbolItem read GetAllSymbols;
    //当前符号数组
    property Item[Index:Integer]:IDiaSymbol read GetItem;
    //段地址
    property AddressSection[Index:Integer]:LongWord read GetAddressSection;
    //地址偏移
    property AddressOffset[Index:Integer]:LongWord read GetAddressOffset;
    //VA地址
    property VirtualAddress[Index:Integer]:UInt64 read GetvirtualAddress;
    //RVA地址
    property RelativeVirtualAddress[Index:Integer]:LongWord read GetRelativeVirtualAddress;
    //UDT偏移
    property Offset[Index:integer]:Integer read GetUDTOffset;
    //符号名称
    property Name[Index:Integer]:WideString read GetName;
    //数据类型
    property BaseType[index:Integer]:TBasicType read GetBaseType;
    //符号类型
    property symTag[Index:Integer]:TSymTagEnum read GetsymTag;
    //内存类型
    property DataKind[index:Integer]:TDataKind read GetDataKind;
    procedure Flush(_es:IDiaEnumSymbols);
    destructor Destroy; override;
  published

  end;



  TSymbol = class(TObject)
  private
    _Last:TSymbolItem;
    _Result:TSymbolItem;
    _DiaSymbol: IDiaSymbol;
    function IFindSymbol(symTag: TSymTagEnum; name: PWideChar; compareFlags:TNameSearchOptions): IDiaEnumSymbols;
    function ReadEnumCount(EnumBol:IDiaEnumSymbols):Integer;
    FUNCTION ReadEnumItem(EnumBol:IDiaEnumSymbols;Index:Integer):IDiaSymbol;
  protected

  public
    //本次搜索结果，如果再次调用FindSymbol这本次值会更新
    //保存这个指针是无效的
    property ResultItem:TSymbolItem read _Result;
    //搜索符号
    function FindSymbol(name: PWideChar;symTag: TSymTagEnum = SymTagNull;compareFlags: TNameSearchOptions = nsfCaseInsensitive):TSymbolItem;
    //搜索公开符号
    function FindPublicSymbol(name: PWideChar;compareFlags: TNameSearchOptions = nsfCaseInsensitive):TSymbolItem;
    //搜索UDT
    function FindStructure(name: PWideChar;compareFlags: TNameSearchOptions = nsfCaseInsensitive):TSymbolItem;
    constructor Create(__DiaSymbol: IDiaSymbol);
    destructor Destroy; override;
  published

  end;


{ TSymbolFile }

  TSymbolFile = class(TObject)
  private
    _DiaSource:IDiaDataSource;
    _Session: IDiaSession;
    _DiaSymbol: IDiaSymbol;

    T_Sessions:TSessions;
    T_Symbol:TSymbol;
    function IsSUCCESS(R:HResult):Boolean;
  protected

  public
    constructor Create;
    //段表
    property Session:TSessions read T_Sessions;
    //符号表
    property Symbols:TSymbol read T_Symbol;
    //打开符号文件
    function OpenPDB(PdbFile:WideString):Boolean;overload;
    function OpenPDB(PdbFile:WideString;LoadAddress:UInt64):Boolean;overload;
    //根据可执行文件搜索加载符号，允许使用符号服务器
    //注：默认使用上海镜像进行加速
    function OpenExecutableFile(ExeFile:WideString;SearchPath:WideString = ''):Boolean;overload;
    function OpenExecutableFile(ExeFile:WideString;LoadAddress:UInt64):Boolean;overload;
    destructor Destroy; override;
  published

  end;

implementation
{ TSymbolFile }

constructor TSymbolFile.Create;
begin
   _DiaSource := CoDiaSource.Create;
end;

destructor TSymbolFile.Destroy;
begin
  if T_Sessions <> nil then
    FreeAndNil(T_Sessions);
  if T_Symbol <> nil then
    FreeAndNil(T_Symbol);

  inherited;
end;

function TSymbolFile.OpenExecutableFile(ExeFile: WideString;
  LoadAddress: UInt64): Boolean;
var

  pRetVal: IDiaSymbol;
  ppEnumTables: IDiaEnumTables;
  CALL:IDiaLoadCallback;
  p:WideString;
begin
   Result := False;
   CALL := TCALLBACK.Create;
   if IsSUCCESS(_DiaSource.loadDataForExe(PWidechar(ExeFile),PWidechar(MySymbolPath),CALL)) then
   begin
      //获取段接口
      if IsSUCCESS(_DiaSource.openSession(_Session)) then
      begin
         _Session.Set_loadAddress(LoadAddress);
         //获取符号接口
         if IsSUCCESS(_Session.Get_globalScope(_DiaSymbol)) then
         begin
            T_Sessions := TSessions.Create(_Session);
            T_Symbol := TSymbol.Create(_DiaSymbol);
            Result := True;
         end;
      end;
   end;
end;

function TSymbolFile.OpenPDB(PdbFile: WideString): Boolean;
var

  pRetVal: IDiaSymbol;
  ppEnumTables: IDiaEnumTables;
  CALL:IDiaLoadCallback;
begin
   Result := False;
   CALL := TCALLBACK.Create;
   if IsSUCCESS(_DiaSource.loadDataFromPdb(PWidechar(PdbFile))) then
   begin
      //获取段接口
      if IsSUCCESS(_DiaSource.openSession(_Session)) then
      begin
         //获取符号接口
         if IsSUCCESS(_Session.Get_globalScope(_DiaSymbol)) then
         begin
            T_Sessions := TSessions.Create(_Session);
            T_Symbol := TSymbol.Create(_DiaSymbol);
            Result := True;
         end;
      end;
   end;
end;

function TSymbolFile.IsSUCCESS(R: HResult): Boolean;
begin
  if R = S_OK then
    Result := True
  else
    Result := False;
end;


function TSymbolFile.OpenExecutableFile(ExeFile:WideString;SearchPath: WideString = ''): Boolean;
var

  pRetVal: IDiaSymbol;
  ppEnumTables: IDiaEnumTables;
  CALL:IDiaLoadCallback;
  p:WideString;
begin
   Result := False;
   CALL := TCALLBACK.Create;
   if SearchPath = '' then
   begin
     p := MySymbolPath;
   end
   else
   begin
     p := SearchPath;
   end;
   if IsSUCCESS(_DiaSource.loadDataForExe(PWidechar(ExeFile),PWidechar(p),CALL)) then
   begin
      //获取段接口
      if IsSUCCESS(_DiaSource.openSession(_Session)) then
      begin
         //获取符号接口
         if IsSUCCESS(_Session.Get_globalScope(_DiaSymbol)) then
         begin
            T_Sessions := TSessions.Create(_Session);
            T_Symbol := TSymbol.Create(_DiaSymbol);
            Result := True;
         end;
      end;
   end;
end;

function TSymbolFile.OpenPDB(PdbFile: WideString; LoadAddress: UInt64): Boolean;
var
  pRetVal: IDiaSymbol;
  ppEnumTables: IDiaEnumTables;
begin
   Result := False;
   if IsSUCCESS(_DiaSource.loadDataFromPdb(PWidechar(PdbFile))) then
   begin
      //获取段接口
      if IsSUCCESS(_DiaSource.openSession(_Session)) then
      begin
          _Session.Set_loadAddress(LoadAddress);
         //获取符号接口
         if IsSUCCESS(_Session.Get_globalScope(_DiaSymbol)) then
         begin
            T_Sessions := TSessions.Create(_Session);
            T_Symbol := TSymbol.Create(_DiaSymbol);
            Result := True;
         end;
      end;
   end;
end;

{ TSessions }

function TSessions.EnumTables(Item:IDiaTable):Boolean;
var
  Count:Integer;
  InjectedSource:IDiaInjectedSource;
  EnumInjectedSources:IDiaEnumInjectedSources;
  EnumSectionContribs:IDiaEnumSectionContribs;
  EnumFrameData:IDiaEnumFrameData;
begin
    Result := True;
    //参考Dia2Demo,段表枚举接口共有四种，但段表不一定只有4个
    //用QueryInterface安全的转换对象，不能用as，对象类型不确定
    if Item.QueryInterface(IID_IDiaInjectedSource,InjectedSource) = S_OK then
    begin
       OutputDebugString('IDiaInjectedSource');
    end
    else
    if Item.QueryInterface(IID_IDiaEnumInjectedSources,EnumInjectedSources) = S_OK then
    begin
      OutputDebugString('IDiaEnumInjectedSources');
    end
    else
    if Item.QueryInterface(IID_IDiaEnumSectionContribs,EnumSectionContribs) = S_OK then
    begin
      OutputDebugString('IDiaEnumSectionContribs');
    end
    else
    if item.QueryInterface(IID_IDiaEnumFrameData,EnumFrameData) = S_OK then
    begin
        OutputDebugString(PWideChar('IDiaFrameData' + count.ToString));
    end
    else
    begin
        //没有其他类型段表
    end;
end;

constructor TSessions.Create(__Session: IDiaSession);
var
  ppEnumTables: IDiaEnumTables;
  ll:LongWord;
  table: IDiaTable;
begin
  _Session := __Session;
   //获取段表
   if _Session.getEnumTables(ppEnumTables) = S_OK then
   begin
      //遍历所有段表
      while (ppEnumTables.Next(1,table,ll) = S_OK) do
      begin
        EnumTables(table);
      end;
   end;
end;

destructor TSessions.Destroy;
begin
  inherited;
end;

{ TSymbol }

constructor TSymbol.Create(__DiaSymbol: IDiaSymbol);
begin
   _DiaSymbol := __DiaSymbol;
end;

destructor TSymbol.Destroy;
begin
   if _Last <> nil then
    FreeAndNil(_Last);
   if _Result <> nil then
    FreeAndNil(_Result);
  inherited;
end;

function TSymbol.FindPublicSymbol(name: PWideChar;compareFlags: TNameSearchOptions = nsfCaseInsensitive): TSymbolItem;
begin
  result := FindSymbol(name,SymTagPublicSymbol,compareFlags);
end;

function TSymbol.FindStructure(name: PWideChar;compareFlags: TNameSearchOptions = nsfCaseInsensitive): TSymbolItem;
begin
 result := FindSymbol(name,SymTagUDT,compareFlags);
end;

function TSymbol.FindSymbol(name: PWideChar;symTag: TSymTagEnum = SymTagNull;
  compareFlags: TNameSearchOptions = nsfCaseInsensitive): TSymbolItem;
var
  _es:IDiaEnumSymbols;
  i:Integer;
begin
 _es := IFindSymbol(symTag,name,compareFlags);
 if _es <> nil then
 begin
    if _Last <> nil then
      FreeAndNil(_Last);
    _Last := _Result;
    _Result := TSymbolItem.Create;
    _Result.Flush(_es);
    Result := _Result;
 end;
end;

function TSymbol.IFindSymbol(symTag: TSymTagEnum; name: PWideChar;
  compareFlags: TNameSearchOptions): IDiaEnumSymbols;
begin
  _DiaSymbol.findChildren(LongWord(symTag),name,LongWord(compareflags),Result);
end;

function TSymbol.ReadEnumCount(EnumBol:IDiaEnumSymbols): Integer;
var
  r_Count:Integer;
begin
  if EnumBol.Get_count(r_Count) = S_OK then
  begin
    Result := r_Count;
  end;
end;

function TSymbol.ReadEnumItem(EnumBol: IDiaEnumSymbols;
  Index: Integer): IDiaSymbol;
begin
    EnumBol.Item(Index,Result);
end;

{ TSymbolItem }

constructor TSymbolItem.Create();
begin
  //
end;

destructor TSymbolItem.Destroy;
begin
   if _Last <> nil then
    FreeAndNil(_Last);
   if _Result <> nil then
    FreeAndNil(_Result);
  inherited;
end;

function TSymbolItem.FindSymbol(Index:Integer;name: PWideChar; symTag: TSymTagEnum;
  compareFlags: TNameSearchOptions): TSymbolItem;
var
  _es:IDiaEnumSymbols;
begin
   _es := IFindSymbol(Index,symTag,name,compareFlags);
    Result := GetEnum(_es);
end;

procedure TSymbolItem.Flush(_es: IDiaEnumSymbols);
begin
   _EnumSymbols := _es;

end;

function TSymbolItem.GetAddressOffset(Index: Integer): LongWord;
begin
  GetItem(Index).Get_addressOffset(Result);
end;

function TSymbolItem.GetAddressSection(Index: Integer): LongWord;
begin
  GetItem(Index).Get_addressSection(Result);
end;

function TSymbolItem.GetAllSymbols(Index: Integer): TSymbolItem;
begin
  Result := FindSymbol(Index,nil);
end;

function TSymbolItem.GetBaseType(index: Integer): TBasicType;
var
  _t:LongWord;
begin
  if GetItem(Index).get_baseType(_t) = S_OK then
  begin
     Result := TBasicType(_t);
  end
  else
  begin
    Result := btError;
  end;
end;

function TSymbolItem.GetCount: Integer;
begin
  _EnumSymbols.Get_count(Result);
end;

function TSymbolItem.GetDataKind(index: Integer): TDataKind;
var
  pRetVal: LongWord;
begin
 Result := DataError;
 if GetItem(Index).Get_dataKind(pRetVal) = S_OK then
 begin
   Result := TDataKind(pRetVal);
 end;
end;

function TSymbolItem.GetEnum(Enum: IDiaEnumSymbols): TSymbolItem;
begin
    if _Last <> nil then
      FreeAndNil(_Last);
    _Last := _Result;
    _Result := TSymbolItem.Create;
    _Result.Flush(Enum);
    Result := _Result;
end;

function TSymbolItem.GetItem(Index: Integer): IDiaSymbol;
begin
  _EnumSymbols.Item(index,Result);
end;

function TSymbolItem.GetName(Index: Integer): WideString;
begin
  GetItem(Index).Get_name(Result);
end;

function TSymbolItem.GetRelativeVirtualAddress(Index: Integer): LongWord;
begin
  GetItem(Index).Get_relativeVirtualAddress(Result);
end;

function TSymbolItem.GetsymTag(Index: Integer): TSymTagEnum;
var
  _r:LongWord;
begin
   Result := SymTagError;
   if GetItem(Index).Get_symTag(_r) = S_OK then
    Result := TSymTagEnum(_r);
end;

function TSymbolItem.GetUDTOffset(Index: Integer): Integer;
begin
  GetItem(Index).Get_offset(Result);

end;

function TSymbolItem.GetUDTType(Index: Integer): IDiaSymbol;
begin
   GetItem(Index).Get_type_(Result);
end;

function TSymbolItem.GetvirtualAddress(Index: Integer): UInt64;
begin
  GetItem(Index).Get_virtualAddress(Result);
end;

function TSymbolItem.IFindSymbol(Index:Integer;symTag: TSymTagEnum; name: PWideChar;
  compareFlags: TNameSearchOptions): IDiaEnumSymbols;
begin
   GetItem(Index).findChildren(LongWord(symTag),name,LongWord(compareflags),Result);
end;


{ TCALLBACK }

function TCALLBACK.NotifyDebugDir(fExecutable: Boolean; cbData: DWORD;
  var pbData: Byte): HRESULT;
begin
  Result := S_OK;
end;

function TCALLBACK.NotifyOpenDBG(dbgPath: PWideChar;
  resultCode: HRESULT): HRESULT;
begin
  Result := S_OK;
end;

function TCALLBACK.NotifyOpenPDB(pdbPath: PWideChar;
  resultCode: HRESULT): HRESULT;
begin
  Result := S_OK;
end;

function TCALLBACK.RestrictRegistryAccess: HRESULT;
begin
  Result := S_OK;
end;

function TCALLBACK.RestrictSymbolServerAccess: HRESULT;
begin
  Result := S_OK;
end;

end.