jclclr.pas

East make Tray Icon in delphi

begin
  if AToken = 0 then
    Result := nil
  else
  try
    Result := Tables[TokenTable(AToken)].Rows[TokenIndex(AToken)-1];
  except
    Result := nil;
  end;
end;

function TJclPeMetadata.GetString(const Idx: Integer): WideString;
begin
  if Assigned(FStringStream) or
     FindStream(TJclClrStringsStream, TJclClrStream(FStringStream)) then
    Result := FStringStream.Strings[Idx]
  else
    Result := '';
end;

function TJclPeMetadata.GetStringCount: Integer;
begin
  if Assigned(FStringStream) or
     FindStream(TJclClrStringsStream, TJclClrStream(FStringStream)) then
    Result := FStringStream.StringCount
  else
    Result := 0;
end;

function TJclPeMetadata.UserGetString(const Idx: Integer): WideString;
begin
  if Assigned(FUserStringStream) or
     FindStream(TJclClrUserStringStream, TJclClrStream(FUserStringStream)) then
    Result := FUserStringStream.Strings[Idx-1]
  else
    Result := '';
end;

function TJclPeMetadata.UserGetStringCount: Integer;
begin
  if Assigned(FUserStringStream) or
     FindStream(TJclClrUserStringStream, TJclClrStream(FUserStringStream)) then
    Result := FUserStringStream.StringCount
  else
    Result := 0;
end;

function TJclPeMetadata.StringAt(const Offset: DWORD): WideString;
begin
  if Assigned(FStringStream) or
     FindStream(TJclClrStringsStream, TJclClrStream(FStringStream)) then
    Result := FStringStream.At(Offset)
  else
    Result := '';
end;

function TJclPeMetadata.UserStringAt(const Offset: DWORD): WideString;
begin
  if Assigned(FUserStringStream) or
     FindStream(TJclClrUserStringStream, TJclClrStream(FUserStringStream)) then
    Result := TJclClrUserStringStream(FUserStringStream).At(Offset)
  else
    Result := '';
end;

function TJclPeMetadata.BlobAt(const Offset: DWORD): TJclClrBlobRecord;
begin
  if Assigned(FBlobStream) or
     FindStream(TJclClrBlobStream, TJclClrStream(FBlobStream)) then
    Result := TJclClrBlobStream(FBlobStream).At(Offset)
  else
    Result := nil;
end;

function TJclPeMetadata.GetGuid(const Idx: Integer): TGUID;
begin
  if Assigned(FGuidStream) or
     FindStream(TJclClrGuidStream, TJclClrStream(FGuidStream)) then
    Result := FGuidStream.Guids[Idx]
  else
    Result := GUID_NULL;
end;

function TJclPeMetadata.GetGuidCount: Integer;
begin
  if Assigned(FGuidStream) or
     FindStream(TJclClrGuidStream, TJclClrStream(FGuidStream)) then
    Result := FGuidStream.GuidCount
  else
    Result := 0;
end;

function TJclPeMetadata.GetBlob(const Idx: Integer): TJclClrBlobRecord;
begin
  if Assigned(FBlobStream) or
     FindStream(TJclClrBlobStream, TJclClrStream(FBlobStream)) then
    Result := FBlobStream.Blobs[Idx]
  else
    Result := nil;
end;

function TJclPeMetadata.GetBlobCount: Integer;
begin
  if Assigned(FBlobStream) or
     FindStream(TJclClrBlobStream, TJclClrStream(FBlobStream)) then
    Result := FBlobStream.BlobCount
  else
    Result := 0;
end;

function TJclPeMetadata.GetTable(const AKind: TJclClrTableKind): TJclClrTable;
begin
  if Assigned(FTableStream) or
     FindStream(TJclClrTableStream, TJclClrStream(FTableStream)) then
    Result := FTableStream.Tables[AKind]
  else
    Result := nil;
end;

function TJclPeMetadata.GetTableCount: Integer;
begin
  if Assigned(FTableStream) or
     FindStream(TJclClrTableStream, TJclClrStream(FTableStream)) then
    Result := FTableStream.TableCount
  else
    Result := 0;
end;

function TJclPeMetadata.TokenExists(const Token: TJclClrToken): Boolean;
begin
  Result := TokenIndex(Token) in [1..Tables[TokenTable(Token)].RowCount];
end;

class function TJclPeMetadata.TokenTable(const Token: TJclClrToken): TJclClrTableKind;
begin
  Result := TJclClrTableKind(Token shr 24);
end;

class function TJclPeMetadata.TokenIndex(const Token: TJclClrToken): Integer;
begin
  Result := Token and DWORD($FFFFFF);
end;

class function TJclPeMetadata.TokenCode(const Token: TJclClrToken): Integer;
begin
  Result := Token and $FF000000;
end;

class function TJclPeMetadata.MakeToken(const Table: TJclClrTableKind;
  const Idx: Integer): TJclClrToken;
begin
  Result := (DWORD(Table) shl 24) and TokenIndex(Idx);
end;

function TJclPeMetadata.DumpIL: string;
begin
  with TStringList.Create do
  try
    Add(Format('.imagebase 0x%.8x', [Image.OptionalHeader.ImageBase]));
    Add(Format('.subsystem 0x%.8x', [Image.OptionalHeader.SubSystem]));
    Add(Format('.file alignment %d', [Image.OptionalHeader.FileAlignment]));
    if Assigned(FTableStream) then
    begin
      FTableStream.Update;
      Result := Text + AnsiLineBreak + FTableStream.DumpIL;
    end;
  finally
    Free;
  end;
end;

//=== { TJclClrResourceRecord } ==============================================

constructor TJclClrResourceRecord.Create(const AData: PChar;
  const AOffset: DWORD; const ARVA: DWORD);
begin
  FData := AData;
  FOffset := AOffset;
  FRVA := ARVA;
  inherited Create(Pointer(DWORD(Data)+SizeOf(DWORD)), PDWORD(Data)^);
end;

//=== { TJclClrVTableFixupRecord } ===========================================

constructor TJclClrVTableFixupRecord.Create(AData: PImageCorVTableFixup);
begin
  inherited Create;
  FData := AData;
end;

function TJclClrVTableFixupRecord.GetCount: DWORD;
begin
  Result := Data.Count;
end;

function TJclClrVTableFixupRecord.GetKinds: TJclClrVTableKinds;
begin
  Result := VTableKinds(Data.Kind);
end;

function TJclClrVTableFixupRecord.GetRVA: DWORD;
begin
  Result := Data.RVA;
end;

class function TJclClrVTableFixupRecord.VTableKinds(const Kinds: TJclClrVTableKinds): DWORD;
var
  AKind: TJclClrVTableKind;
begin
  Result := 0;
  for AKind := Low(TJclClrVTableKind) to High(TJclClrVTableKind) do
    if AKind in Kinds then
      Result := Result or ClrVTableKindMapping[AKind];
end;

class function TJclClrVTableFixupRecord.VTableKinds(const Kinds: DWORD): TJclClrVTableKinds;
var
  AKind: TJclClrVTableKind;
begin
  Result := [];
  for AKind := Low(TJclClrVTableKind) to High(TJclClrVTableKind) do
    if (ClrVTableKindMapping[AKind] and Kinds) = ClrVTableKindMapping[AKind] then
      Include(Result, AKind);
end;

//=== { TJclClrInformation } =================================================

constructor TJclClrHeaderEx.Create(const AImage: TJclPeImage);

  procedure UpdateVTableFixups;
  begin
    // (rom) What is this?
    if Header.VTableFixups.VirtualAddress = 0 then
  end;

begin
  inherited Create(AImage);
  FFlags := ClrImageFlag(Header.Flags);
  FMetadata := nil;
  FResources := nil;
  FStrongNameSignature := nil;
  FVTableFixups := nil;
end;

destructor TJclClrHeaderEx.Destroy;
begin
  FreeAndNil(FVTableFixups);
  FreeAndNil(FStrongNameSignature);
  FreeAndNil(FResources);
  FreeAndNil(FMetadata);
  inherited Destroy;
end;

class function TJclClrHeaderEx.ClrImageFlag(const Flags: DWORD): TJclClrImageFlags;
var
  AFlag: TJclClrImageFlag;
begin
  Result := [];
  for AFlag := Low(TJclClrImageFlag) to High(TJclClrImageFlag) do
    if (ClrImageFlagMapping[AFlag] and Flags) = ClrImageFlagMapping[AFlag] then
      Include(Result, AFlag);
end;

class function TJclClrHeaderEx.ClrImageFlag(const Flags: TJclClrImageFlags): DWORD;
var
  AFlag: TJclClrImageFlag;
begin
  Result := 0;
  for AFlag := Low(TJclClrImageFlag) to High(TJclClrImageFlag) do
    if AFlag in Flags then
      Result := Result or ClrImageFlagMapping[AFlag];
end;

function TJclClrHeaderEx.GetMetadata: TJclPeMetadata;
begin
  if not Assigned(FMetadata) and HasMetadata then
    FMetadata := TJclPeMetadata.Create(Image);
  Result := FMetadata;
end;

function TJclClrHeaderEx.HasStrongNameSignature: Boolean;
begin
  with Header.StrongNameSignature do
  Result := Assigned(FStrongNameSignature) or
    ((Size > 0) and not IsBadReadPtr(Image.RvaToVa(VirtualAddress), Size));
end;

function TJclClrHeaderEx.HasVTableFixup: Boolean;
begin
  with Header.VTableFixups do
  Result := Assigned(FVTableFixups) or
    ((Size > 0) and not IsBadReadPtr(Image.RvaToVa(VirtualAddress), Size));
end;

function TJclClrHeaderEx.GetStrongNameSignature: TCustomMemoryStream;
begin
  if not Assigned(FStrongNameSignature) and HasStrongNameSignature then
  with Header.StrongNameSignature do
    FStrongNameSignature := TJClreferenceMemoryStream.Create(Image.RvaToVa(VirtualAddress), Size);
  Result := FStrongNameSignature;
end;

function TJclClrHeaderEx.HasResources: Boolean;
begin
  with Header.Resources do
  Result := Assigned(FResources) or
    ((Size > 0) and not IsBadReadPtr(Image.RvaToVa(VirtualAddress), Size));
end;

procedure TJclClrHeaderEx.UpdateResources;
var
  Base, Ptr: PChar;
  ARes: TJclClrResourceRecord;
begin
  FResources := TObjectList.Create;
  with Header.Resources do
  begin
    Base := Image.RvaToVa(VirtualAddress);
    Ptr := Base;
    while DWORD(Ptr-Base) < Size do
    begin
      ARes := TJclClrResourceRecord.Create(Ptr, Ptr-Base, Ptr-Image.LoadedImage.MappedAddress);
      FResources.Add(ARes);
      Ptr := PChar(ARes.Memory) + ARes.Size;
    end;
  end;
end;

function TJclClrHeaderEx.GetResource(
  const Idx: Integer): TJclClrResourceRecord;
begin
  if not Assigned(FResources) and HasResources then
    UpdateResources;
  Result := TJclClrResourceRecord(FResources.Items[Idx]);
end;

function TJclClrHeaderEx.GetResourceCount: Integer;
begin
  if not Assigned(FResources) and HasResources then
    UpdateResources;
  if Assigned(FResources) then
    Result := FResources.Count
  else
    Result := 0;
end;

function TJclClrHeaderEx.GetEntryPointToken: TJclClrTableRow;
begin
  Result := Metadata.Tokens[Header.EntryPointToken]
end;

function TJclClrHeaderEx.GetVTableFixup(
  const Idx: Integer): TJclClrVTableFixupRecord;
var
  I: Integer;
  pData: PImageCorVTableFixup;
begin
  if not Assigned(FVTableFixups) and HasVTableFixup then
  begin
    FVTableFixups := TObjectList.Create;
    with Header.VTableFixups do
    begin
      pData := PImageCorVTableFixup(Image.RvaToVa(VirtualAddress));
      for I := 0 to GetVTableFixupCount-1 do
      begin
        FVTableFixups.Add(TJclClrVTableFixupRecord.Create(pData));
        Inc(pData);
      end;
    end;
  end;
  Result := TJclClrVTableFixupRecord(FVTableFixups.Items[Idx]);
end;

function TJclClrHeaderEx.GetVTableFixupCount: Integer;
begin
  Result := Header.VTableFixups.Size div SizeOf(TImageCorVTableFixup);
end;

function TJclClrHeaderEx.ResourceAt(const Offset: DWORD): TJclClrResourceRecord;
var
  I: Integer;
begin
  if HasResources then
    for I := 0 to ResourceCount-1 do
    begin
      Result := Resources[I];
      if Result.Offset = Offset then
        Exit;
    end;
  Result := nil;
end;

function TJclClrHeaderEx.DumpIL: string;
begin
  with TStringList.Create do
  try
    Add(RsClrCopyright);
    Add(Format('.corflags 0x%.8x', [Header.Flags]));
    Result := Text + AnsiLineBreak + Metadata.DumpIL;
  finally
    Free;
  end;
end;

// History:

// $Log: JclCLR.pas,v $
// Revision 1.14  2005/03/08 08:33:22  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.13  2005/03/06 18:15:03  marquardt
// JclGUIDToString and JclStringToGUID moved to JclSysUtils.pas, CrLf replaced by AnsiLineBreak
//
// Revision 1.12  2005/02/25 07:20:15  marquardt
// add section lines
//
// Revision 1.11  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.10  2004/10/17 21:00:14  mthoma
// cleaning
//
// Revision 1.9  2004/08/01 11:40:23  marquardt
// move constructors/destructors
//
// Revision 1.8  2004/07/31 06:21:03  marquardt
// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved
//
// Revision 1.7  2004/06/14 13:05:21  marquardt
// style cleaning ENDIF, Tabs
//
// Revision 1.6  2004/05/13 07:35:09  rrossmair
// removed obsolete TODO
//
// Revision 1.5  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.4  2004/04/06 04:55:17
// adapt compiler conditions, add log entry
//

end.