jclcil.pas

East make Tray Icon in delphi

            Stream.Read(Value, SizeOf(Value));
            FParam[I] := Value;
          end;
        end;
      {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
      ptSOff, ptI1:
        begin
          Stream.Read(VShortInt, SizeOf(ShortInt));
          VType := varShortInt;
        end;
      ptU2:
        begin
          Stream.Read(VWord, SizeOf(Word));
          VType := varWord;
        end;
      ptToken, ptU4:
        begin
          Stream.Read(VLongWord, SizeOf(LongWord));
          VType := varLongWord;
        end;
      ptI8, ptU8:
        begin
          Stream.Read(VInt64, SizeOf(Int64));
          VType := varInt64;
        end;
      {$ENDIF RTL140_UP}
    end;
  except
    Stream.Position := FOffset;
    raise;
  end;
end;

procedure TJclInstruction.Save(Stream: TStream);
var
  Code: Byte;
  {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
  ArraySize: DWORD;
  I, Value: Integer;
  {$ENDIF RTL140_UP}
begin
  if WideOpCode then
  begin
    Code := STP1;
    Stream.Write(Code, SizeOf(Code));
  end;

  Code := RealOpCode;;
  Stream.Write(Code, SizeOf(Code));

  case ParamType of
    ptU1:
      Stream.Write(TVarData(FParam).VByte, SizeOf(Byte));
    ptI2:
      Stream.Write(TVarData(FParam).VSmallInt, SizeOf(SmallInt));
    ptLOff, ptI4:
      Stream.Write(TVarData(FParam).VInteger, SizeOf(Integer));
    ptR4:
      Stream.Write(TVarData(FParam).VSingle, SizeOf(Single));
    ptR8:
      Stream.Write(TVarData(FParam).VDouble, SizeOf(Double));
    {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
    ptSOff, ptI1:
      Stream.Write(TVarData(FParam).VShortInt, SizeOf(ShortInt));
    ptU2:
      Stream.Write(TVarData(FParam).VWord, SizeOf(Word));
    ptToken, ptU4:
      Stream.Write(TVarData(FParam).VLongWord, SizeOf(LongWord));
    ptI8, ptU8:
      Stream.Write(TVarData(FParam).VInt64, SizeOf(Int64));
    ptArray:
      begin
        ArraySize := VarArrayHighBound(FParam, 1) - VarArrayLowBound(FParam, 1) + 1;
        Stream.Write(ArraySize, SizeOf(ArraySize));
        { TODO : VarArrayHighBound to VarArrayLowBound very likely wrong }
        for I := VarArrayHighBound(FParam, 1) to VarArrayLowBound(FParam, 1) do
        begin
          Value := VarArrayGet(FParam, [I]);
          Stream.Write(Value, SizeOf(Value));
        end;
      end;
    {$ENDIF RTL140_UP}
  end;
end;

function TJclInstruction.DumpIL(Options: TJclInstructionDumpILOptions): string;
var
  Opt: TJclInstructionDumpILOption;
begin
  if doLineNo in Options then
    Result := DumpILOption(doLineNo) + ': ';
  if doRawBytes in Options then
    Result := Result + Format(' /* %.24s */ ', [DumpILOption(doRawBytes)]);
  for Opt := doIL to doTokenValue do
    Result := Result + DumpILOption(Opt) + ' ';
  if (doComment in Options) and ((FullName <> '') or (Description <> '')) then
    Result := Result + ' // ' + DumpILOption(doComment);
end;

function TJclInstruction.FormatLabel(Offset: Integer): string;
begin
  Result := 'IL_' + IntToHex(Offset, 4);
end;

function TJclInstruction.DumpILOption(Option: TJclInstructionDumpILOption): string;

  function TokenToString(Token: DWORD): string;
  begin
    Result := '(' + IntToHex(Token shr 24, 2) + ')' + IntToHex(Token mod (1 shl 24), 6);
  end;

var
  {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
  I: Integer;
  Row: TJclClrTableRow;
  {$ENDIF RTL140_UP}
  CodeStr, ParamStr: string;
begin
  case Option of
    doLineNo:
      Result := 'IL_' + IntToHex(Offset, 4);
    doRawBytes:
      begin
        if WideOpCode then
          CodeStr := IntToHex(STP1, 2);

        CodeStr := CodeStr + IntToHex(RealOpCode, 2);
        CodeStr := CodeStr + StrRepeat(' ', 4 - Length(CodeStr));

        case ParamType of
          ptSOff, ptI1, ptU1:
            ParamStr := IntToHex(TVarData(FParam).VByte, 2);
          ptArray:
            ParamStr := 'Array';
          {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
          ptI2, ptU2:
            ParamStr := IntToHex(TVarData(FParam).VWord, 4);
          ptLOff, ptI4, ptU4, ptR4:
            ParamStr := IntToHex(TVarData(FParam).VLongWord, 8);
          ptI8, ptU8, ptR8:
            ParamStr := IntToHex(TVarData(FParam).VInt64, 16);
          ptToken:
            ParamStr := TokenToString(TVarData(FParam).VLongWord);
          {$ENDIF RTL140_UP}
        else
          ParamStr := '';
        end;
        ParamStr := ParamStr + StrRepeat(' ', 10 - Length(ParamStr));
        Result := CodeStr + ' | ' + ParamStr;
      end;
    doIL:
      begin
        case ParamType of
        ptVoid:
          ; // do nothing
        ptLOff:
          Result := FormatLabel(Integer(Offset + Size) + TVarData(Param).VInteger - 1);
        {$IFDEF RTL140_UP}  { TODO -cTest : since RTL 14.0 or 15.0? }
        ptToken:
          begin
            if Byte(TJclPeMetadata.TokenTable(TVarData(Param).VLongWord)) = $70 then
              Result := '"' + Owner.Method.Method.Table.Stream.Metadata.UserStringAt(TJclPeMetadata.TokenIndex(TVarData(Param).VLongWord)) + '"'
            else
            begin
              Row := Owner.Method.Method.Table.Stream.Metadata.Tokens[TVarData(Param).VLongWord];
              if Assigned(Row) then
              begin
                if Row is TJclClrTableTypeDefRow then
                  Result := TJclClrTableTypeDefRow(Row).FullName
                else
                if Row is TJclClrTableTypeRefRow then
                  with TJclClrTableTypeRefRow(Row) do
                    Result := FullName
                else
                if Row is TJclClrTableMethodDefRow then
                  with TJclClrTableMethodDefRow(Row) do
                    Result := ParentToken.FullName + '.' + Name
                else
                if Row is TJclClrTableMemberRefRow then
                  with TJclClrTableMemberRefRow(Row) do
                    Result := FullName
                else
                if Row is TJclClrTableFieldDefRow then
                  with TJclClrTableFieldDefRow(Row) do
                    Result := ParentToken.FullName + '.' + Name
                else
                  Result := Row.DumpIL;
              end
              else
                Result := '';
            end;
            Result := Result + ' /* ' + IntToHex(TVarData(FParam).VLongWord, 8) + ' */';
          end;
        ptSOff:
          Result := FormatLabel(Integer(Offset + Size) + TVarData(Param).VShortInt - 1);
        ptArray:
          begin
            for I := VarArrayHighBound(FParam, 1) to VarArrayLowBound(FParam, 1) do
            begin
              Result := Result + FormatLabel(Offset + Size + VarArrayGet(FParam, [I]));
              if I <> VarArrayLowBound(FParam, 1) then
                Result := Result + ', ';
            end;
            Result := ' (' + Result + ')';
          end;
        {$ENDIF RTL140_UP}
        else
          Result := VarToStr(Param);
        end;
        Result := GetName + StrRepeat(' ', 10 - Length(GetName)) + ' ' + Result;
        Result := Result + StrRepeat(' ', 20 - Length(Result));
      end;
    doTokenValue:
      Result := ''; // do nothing
    doComment:
      if FullName = '' then
        Result := Description
      else
      if Description = '' then
        Result := FullName
      else
        Result := FullName + ' - ' + Description;
  end;
end;

// History:

// $Log: JclCIL.pas,v $
// Revision 1.13  2005/03/08 08:33:22  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.12  2005/03/07 17:27:58  marquardt
// reworked for resorucestrings
//
// Revision 1.11  2005/02/27 14:55:26  marquardt
// changed overloaded constructors to constructor with default parameter (BCB friendly)
//
// Revision 1.10  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.9  2004/10/17 21:00:14  mthoma
// cleaning
//
// Revision 1.8  2004/08/03 17:13:28  marquardt
// make duplicate string literals constants
//
// Revision 1.7  2004/06/14 13:05:21  marquardt
// style cleaning ENDIF, Tabs
//
// Revision 1.6  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.5  2004/04/06 04:55:17
// adapt compiler conditions, add log entry
//

end.