jclcil.pas

East make Tray Icon in delphi

    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {50}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {58}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {60}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptToken, {68}
    ptToken,  ptToken,  ptToken,  ptToken,  ptToken,  ptToken,  ptVoid,   ptVoid,  {70}
    ptVoid,   ptToken,  ptVoid,   ptToken,  ptToken,  ptToken,  ptToken,  ptToken, {78}
    ptToken,  ptToken,  ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {80}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptToken,  ptToken,  ptVoid,   ptToken, {88}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {90}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {98}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {A0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {A8}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {B0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {B8}
    ptVoid,   ptVoid,   ptToken,  ptVoid,   ptVoid,   ptVoid,   ptToken,   ptVoid, {C0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {C8}
    ptToken,  ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {D0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptI4,     ptI1,     ptVoid,  {D8}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {E0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {E8}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {F0}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,  {F8}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptToken,  ptToken, {00}
    ptVoid,   ptU2,     ptU2,     ptU2,     ptU2,     ptU2,     ptU2,     ptVoid,  {08}
    ptVoid,   ptVoid,   ptI1,     ptVoid,   ptVoid,   ptToken,  ptVoid,   ptVoid,  {10}
    ptVoid,   ptVoid,   ptVoid,   ptVoid,   ptToken,  ptVoid,   ptVoid,   ptVoid,  {18}
    ptVoid,   ptVoid,   ptVoid);                                                   {20}

//===  { TJclClrILGenerator } ================================================

constructor TJclClrILGenerator.Create(AMethod: TJclClrMethodBody = nil);
var
  OpCode: Byte;
  Stream: TMemoryStream;
  Instruction: TJclInstruction;
begin
  inherited Create;
  FMethod := AMethod;
  FInstructions := TObjectList.Create;
  if Assigned(AMethod) then
  begin
    Stream := TMemoryStream.Create;
    try
      Stream.Write(Method.Code^, Method.Size);
      Stream.Seek(0, soFromBeginning);
      while Stream.Position < Stream.Size do
      begin
        OpCode := PByte(Longint(Stream.Memory) + Stream.Position)^;
        if OpCode = STP1 then
        begin
          OpCode := PByte(Longint(Stream.Memory) + Stream.Position + 1)^;
          Instruction := TJclInstruction.Create(Self, TJclOpCode(MaxByte + 1 + OpCode));
        end
        else
          Instruction := TJclInstruction.Create(Self, TJclOpCode(OpCode));
        if Assigned(Instruction) then
        begin
          FInstructions.Add(Instruction);
          Instruction.Load(Stream);
        end;
      end;
    finally
      FreeAndNil(Stream);
    end;
  end;
end;

destructor TJclClrILGenerator.Destroy;
begin
  FreeAndNil(FInstructions);
  inherited Destroy;
end;

function TJclClrILGenerator.DumpIL(Options: TJclInstructionDumpILOptions): string;
var
  I, J, Indent: Integer;

  function FlagsToName(Flags: TJclClrExceptionClauseFlags): string;
  begin
    if cfFinally in Flags then
      Result := 'finally'
    else
    if cfFilter in Flags then
      Result := 'filter'
    else
    if cfFault in Flags then
      Result := 'fault'
    else
      Result := 'catch';
  end;

  function IndentStr: string;
  begin
    Result := StrRepeat('  ', Indent);
  end;

begin
  Indent := 0;
  with TStringList.Create do
  try
    for I := 0 to InstructionCount-1 do
    begin
      for J := 0 to Method.ExceptionHandlerCount-1 do
      with Method.ExceptionHandlers[J] do
      begin
        if Instructions[I].Offset = TryBlock.Offset then
        begin
          Add(IndentStr + '.try');
          Add(IndentStr + '{');
          Inc(Indent);
        end;
        if Instructions[I].Offset = (TryBlock.Offset + TryBlock.Length) then
        begin
          Dec(Indent);
          Add(IndentStr + '}  // end .try');
        end;
        if Instructions[I].Offset = HandlerBlock.Offset then
        begin
          Add(IndentStr + FlagsToName(Flags));
          Add(IndentStr + '{');
          Inc(Indent);
        end;
        if Instructions[I].Offset = (HandlerBlock.Offset + HandlerBlock.Length) then
        begin
          Dec(Indent);
          Add(IndentStr + '}  // end ' + FlagsToName(Flags));
        end;
      end;
      Add(IndentStr + Instructions[I].DumpIL(Options));
    end;
    Result := Text;
  finally
    Free;
  end;
end;

function TJclClrILGenerator.GetInstructionCount: Integer;
begin
  Result := FInstructions.Count;
end;

function TJclClrILGenerator.GetInstruction(const Idx: Integer): TJclInstruction;
begin
  Result := TJclInstruction(FInstructions[Idx]);
end;

//=== { TJclInstruction } ====================================================

constructor TJclInstruction.Create(AOwner :TJclClrILGenerator; AOpCode: TJclOpCode);
begin
  inherited Create;
  FOwner := AOwner;
  FOpCode := AOpCode;
end;

function TJclInstruction.GetWideOpCode: Boolean;
begin
  Result := Integer(OpCode) > MaxByte;
end;

function TJclInstruction.GetRealOpCode: Byte;
begin
  if WideOpCode then
    Result := Integer(OpCode) mod (MaxByte + 1)
  else
    Result := Integer(OpCode);
end;

function TJclInstruction.GetParamType: TJclInstructionParamType;
begin
  Result := OpCodeParamTypes[OpCode];
end;

function TJclInstruction.GetName: string;
begin
  Result := OpCodeInfos[OpCode, itName];
end;

function TJclInstruction.GetFullName: string;
begin
  Result := OpCodeInfos[OpCode, itFullName];
end;

function TJclInstruction.GetDescription: string;
begin
  Result := OpCodeInfos[OpCode, itDescription]
end;

function TJclInstruction.GetSize: DWORD;
const
  OpCodeSize: array [Boolean] of DWORD = (1, 2);
begin
  case ParamType of
    ptSOff, ptI1, ptU1:
      Result := SizeOf(Byte);
    ptI2, ptU2:
      Result := SizeOf(Word);
    ptLOff, ptI4, ptToken, ptU4, ptR4:
      Result := SizeOf(DWORD);
    ptI8, ptU8, ptR8:
      Result := SizeOf(Int64);
    ptArray:
      Result := (VarArrayHighBound(FParam, 1) - VarArrayLowBound(FParam, 1) + 1 + 1) * SizeOf(Integer);
  else
    Result := 0;
  end;
  Result := OpCodeSize[OpCode in [opNop..opPrefixRef]] + Result;
end;

procedure TJclInstruction.Load(Stream: TStream);
var
  Code: Byte;
  I, ArraySize, Value: DWORD;   { TODO : I, ArraySize = DWORD create a serious problem }
begin
  FOffset := Stream.Position;
  try
    Stream.Read(Code, SizeOf(Code));
    if WideOpCode then
    begin
      if Code <> STP1 then
        raise EJclCliInstructionStreamInvalid.CreateRes(@RsInstructionStreamInvalid);
      Stream.Read(Code, SizeOf(Code));
    end;

    if Code <> RealOpCode then
      raise EJclCliInstructionStreamInvalid.CreateRes(@RsInstructionStreamInvalid);

    with TVarData(FParam) do
    case ParamType of
      ptU1:
        begin
          Stream.Read(VByte, SizeOf(Byte));
          VType := varByte;
        end;
      ptI2:
        begin
          Stream.Read(VSmallInt, SizeOf(SmallInt));
          VType := varSmallInt;
        end;
      ptLOff, ptI4:
        begin
          Stream.Read(VInteger, SizeOf(Integer));
          VType := varInteger;
        end;
      ptR4:
        begin
          Stream.Read(VSingle, SizeOf(Single));
          VType := varSingle;
        end;
      ptR8:
        begin
          Stream.Read(VDouble, SizeOf(Double));
          VType := varDouble;
        end;
      ptArray:
        begin
          Stream.Read(ArraySize, SizeOf(ArraySize));
          FParam := VarArrayCreate([0, ArraySize-1], varInteger);
          for I := 0 to ArraySize-1 do  { TODO : ArraySize = 0 and we have a nearly endless loop }
          begin