clrdemotableform.pas

East make Tray Icon in delphi

  Assert(ATable.RowCount = 1);
  with ATable[0] do
  begin
    Dump('Name     : %s', [Name]);
    Dump('Mvid     : %s', [GUIDToString(Mvid)]);
    if HasEncId then
      Dump('EncId    : %s', [GUIDToString(EncId)]);
    if HasEncBaseId then
      Dump('EncBaseId: %s', [GUIDToString(EncBaseId)]);
  end;
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableModuleRef);
var
  I: Integer;
begin
   for I:=0 to ATable.RowCount-1 do
    Dump('Name : ' + ATable[I].Name);
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableTypeDef);
const
  ClassSemanticsNames: array[TJclClrClassSemantics] of string =
  ('.class', 'interface');
  TypeVisibilityNames: array[TJclClrTypeVisibility] of string =
  ('private', 'public', 'nested public', 'nested private', 'nested family',
   'nested assembly', 'nested famandassem', 'nested famorassem');
  AbstractNames: array[Boolean] of string = ('', 'abstract ');
  ClassLayoutNames: array[TJclClrClassLayout] of string =
  ('auto', 'sequential', 'explicit');
  StringFormattingNames: array[TJclClrStringFormatting] of string =
  ('ansi', 'unicode', 'autochar');
  ImportNames: array[Boolean] of string = ('', 'import ');
  SerializableNames: array[Boolean] of string = ('', 'serializable');
  SealedNames: array[Boolean] of string = ('', 'sealed ');
  SpecialNameNames: array[Boolean] of string = ('', 'specialname ');
  BeforeFieldInitNames: array[Boolean] of string = ('', 'beforefieldinit ');
  RTSpecialNameNames: array[Boolean] of string = ('', 'rtspecialname ');
  HasSecurityNames: array[Boolean] of string = ('', 'HasSecurity ');
var
  I, J: Integer;
begin
  for I:=0 to ATable.RowCount-1 do
  with ATable.Rows[I] do
  begin
    Dump('%s %s %s%s %s %s%s%s%s%s%s%s%s',
      [ClassSemanticsNames[ClassSemantics],
       TypeVisibilityNames[Visibility],
       AbstractNames[taAbstract in Attributes],
       ClassLayoutNames[ClassLayout],
       StringFormattingNames[StringFormatting],
       ImportNames[taImport in Attributes],
       SerializableNames[taSerializable in Attributes],
       SealedNames[taSealed in Attributes],
       SpecialNameNames[taSpecialName in Attributes],
       BeforeFieldInitNames[taBeforeFieldInit in Attributes],
       RTSpecialNameNames[taRTSpecialName in Attributes],
       HasSecurityNames[taHasSecurity in Attributes],
       FullName]);

    if HasField then
    for J:=0 to FieldCount-1 do
      Dump('  .field %s', [Fields[J].Name]);

    if HasMethod then
    for J:=0 to MethodCount-1 do
      Dump('  .method %s', [Methods[J].Name]);
  end;
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableTypeRef); 
var
  I: Integer;
begin
  for I:=0 to ATable.RowCount-1 do
    Dump('%s.%s', [ATable.Rows[I].Namespace, ATable.Rows[I].Name])
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableMethodDef); 
var
  I, J: Integer;
  AttrStr, ParamStr: string;
begin
  for I:=0 to ATable.RowCount-1 do
  with ATable.Rows[I] do
  begin
    if HasParam then
    begin
      ParamStr := '';
      for J:=0 to ParamCount-1 do
      begin
        if ParamStr <> '' then
          ParamStr := ParamStr + ', ';
        if Params[J].Flags <> [] then
        begin
          AttrStr := '';
          if pkIn in Params[J].Flags then
            AttrStr := AttrStr + 'In';
          if pkOut in Params[J].Flags then
          begin
            if AttrStr <> '' then
              AttrStr := AttrStr + ', ';
            AttrStr := AttrStr + 'Out';
          end;
          if pkOptional in Params[J].Flags then
          begin
            if AttrStr <> '' then
              AttrStr := AttrStr + ', ';
            AttrStr := AttrStr + 'Opt';
          end;
          if pkHasDefault in Params[J].Flags then
          begin
            if AttrStr <> '' then
              AttrStr := AttrStr + ', ';
            AttrStr := AttrStr + 'Default';
          end;
          if pkHasFieldMarshal in Params[J].Flags then
          begin
            if AttrStr <> '' then
              AttrStr := AttrStr + ', ';
            AttrStr := AttrStr + 'Marshal';
          end;
          ParamStr := ParamStr + '[' + AttrStr + '] ';
        end;
        ParamStr := ParamStr + Params[J].Name;
      end;
    end;
    if Assigned(MethodBody) then
    begin
      Dump('%s.%s::%s(%s) @ %p:%d', [ParentToken.Namespace, ParentToken.Name, Name, ParamStr, Pointer(RVA), MethodBody.Size]);
      TfrmAbstract.DumpBuf(MethodBody.Code, MethodBody.Size, memDump, DWORD(MethodBody.Code), False);
    end
    else
    begin
      Dump('%s.%s::%s(%s)', [ParentToken.Namespace, ParentToken.Name, Name, ParamStr]);
    end;
  end;
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableFieldDef); 
var
  I: Integer;
begin
  for I:=0 to ATable.RowCount-1 do
    Dump('%s', [ATable.Rows[I].Name])
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableMemberRef); 
var
  I: Integer;
begin
  for I:=0 to ATable.RowCount-1 do
    Dump('%s', [ATable.Rows[I].Name])
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableCustomAttribute); 
  function GetParent(const Attr: TJclClrTableCustomAttributeRow): string;
  var
    ARow: TJclClrTableRow;
  begin
    ARow   := Attr.Parent;
    if ARow is TJclClrTableAssemblyRow then
      with ARow as TJclClrTableAssemblyRow do
        Result := Name
    else if ARow is TJclClrTableTypeDefRow then
      with ARow as TJclClrTableTypeDefRow do
        Result := Namespace + '.' + Name
    else if ARow is TJclClrTableTypeRefRow then
      with ARow as TJclClrTableTypeRefRow do
        Result := Namespace + '.' + Name
    else if ARow is TJclClrTableMethodDefRow then
      with ARow as TJclClrTableMethodDefRow do
        Result := Name
    else if ARow is TJclClrTableParamDefRow then
      with ARow as TJclClrTableParamDefRow do
        Result := Method.ParentToken.Namespace + '.' + Method.ParentToken.Name + '::' +
                  Method.Name + '(..., ' + Name + ', ...)'
    else
      Result := 'Unknown Parent';

    Result := Result + ' <' + Copy(ARow.ClassName, Length('TJclClrTable')+1,
        Length(ARow.ClassName)-Length('TJclClrTable')-Length('Row')) +
        '> [' + IntToHex(Attr.ParentIdx, 8) + ']';
  end;
  function GetMethod(const Attr: TJclClrTableCustomAttributeRow): string;
    function GetParentClassName(const ParentClass: TJclClrTableRow): string;
    begin
      if ParentClass is TJclClrTableTypeRefRow then
        with ParentClass as TJclClrTableTypeRefRow do
          Result := Namespace + '.' + Name
      else if ParentClass is TJclClrTableModuleRefRow then
        with ParentClass as TJclClrTableModuleRefRow do
          Result := Name
      else if ParentClass is TJclClrTableMethodDefRow then
        with ParentClass as TJclClrTableMethodDefRow do
          Result := Name
      else if ParentClass is TJclClrTableTypeSpecRow then
        Result := ''
      else if ParentClass is TJclClrTableTypeDefRow then
        with ParentClass as TJclClrTableTypeDefRow do
          Result := Namespace + '.' + Name
      else
        Result := 'Unknown Class - ' + ParentClass.ClassName;
    end;
  var
    AMethod: TJclClrTableRow;
  begin
    AMethod := Attr.Method;
    if AMethod is TJclClrTableMethodDefRow then
      with AMethod as TJclClrTableMethodDefRow do
        Result := ParentToken.Namespace + '.' + ParentToken.Name + ' :: ' + Name
    else if AMethod is TJclClrTableMemberRefRow then
      with AMethod as TJclClrTableMemberRefRow do
        Result := GetParentClassName(ParentClass) + '::' + Name
    else
      Result := 'Unknown method type - ' + IntToHex(Attr.ParentIdx, 8);

    Result := Result + ' <' + Copy(AMethod.ClassName, Length('TJclClrTable')+1,
        Length(AMethod.ClassName)-Length('TJclClrTable')-Length('Row')) +
        '> [' + IntToHex(Attr.TypeIdx, 8) + ']';
  end;
var
  I: Integer;
begin
  for I:=0 to ATable.RowCount-1 do
  begin
    Dump('Parent: ' + GetParent(ATable[I]));
    Dump('Method: ' + GetMethod(ATable[I]));
    Dump('Value: ', ATable[I].Value);
    Dump(lkWide);
  end;
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableParamDef);
var
  I: Integer;
  Attr: string;
begin
  for I:=0 to ATable.RowCount-1 do
  begin
    Attr := '';
    if pkIn in ATable.Rows[I].Flags then
      Attr := Attr + 'In ';
    if pkOut in ATable.Rows[I].Flags then
      Attr := Attr + 'Out ';
    if pkOptional in ATable.Rows[I].Flags then
      Attr := Attr + 'Opt ';
    if pkHasDefault in ATable.Rows[I].Flags then
      Attr := Attr + 'Default ';
    if pkHasFieldMarshal in ATable.Rows[I].Flags then
      Attr := Attr + 'Marshal ';

    Dump('%s %s', [ATable.Rows[I].Name, Attr]);
  end;
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTablePropertyDef); 
var
  I: Integer;
begin
  for I:=0 to ATable.RowCount-1 do
    Dump('%s', [ATable.Rows[I].Name])
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableManifestResource); 
var
  I: Integer;
begin
  for I:=0 to ATable.RowCount-1 do
    Dump('%s', [ATable.Rows[I].Name])
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableFile);
var
  I: Integer;
begin
  for I:=0 to ATable.RowCount-1 do
  begin
    Dump('File Name: ' + ATable[I].Name);
    Dump('Contains Metadata: ' + BooleanToStr(ATable[I].ContainsMetadata));
    Dump('Hash Value: ', ATable[I].HashValue);
  end;
end;

procedure TfrmTable.DumpTable(const ATable: TJclClrTableExportedType);
var
  I: Integer;
begin
  for I:=0 to ATable.RowCount-1 do
    Dump(ATable[I].TypeNamespace + '.' + ATable[I].TypeName);
end;

procedure TfrmTable.btnDumpILClick(Sender: TObject);
begin
  frmMain.actFileDump.Execute;
end;

end.