dctype.pas

SrcDecompiler is about creating a Delphi program decompiler. The program is written for Delphi 4 or

end;

procedure TdcDynArrayType.SetElementType(Value: IdcType);
begin
  FElementType := Value;
end;

{ TdcEnumerationType }

constructor TdcEnumerationType.CreateX(dcType: TdcType);
begin
  inherited CreateX(dcType);
  NameList := TStringList.Create;
end;

destructor TdcEnumerationType.Destroy;
begin
  NameList.Free;
  inherited Destroy;
end;

function TdcEnumerationType.GetBaseType: IdcType;
begin
  Result := FBaseType;
end;

procedure TdcEnumerationType.SetBaseType(Value: IdcType);
begin
  FBaseType := Value;
end;

function TdcEnumerationType.GetNameList: TStrings;
begin
  Result := FNameList;
end;

procedure TdcEnumerationType.SetNameList(Value: TStrings);
begin
  FNameList.Assign(Value);
end;

{ TdcFloatType }

function TdcFloatType.GetFloatType: TFloatType;
begin
  Result := FFloatType;
end;

procedure TdcFloatType.SetFloatType(Value: TFloatType);
begin
  FFloatType := Value;
end;

{ TdcInt64Type }

function TdcInt64Type.GetMaxValue: Int64;
begin
  Result := FMaxValue;
end;

procedure TdcInt64Type.SetMaxValue(Value: Int64);
begin
  FMaxValue := Value;
end;

function TdcInt64Type.GetMinValue: Int64;
begin
  Result := FMinValue;
end;

procedure TdcInt64Type.SetMinValue(Value: Int64);
begin
  FMinValue := Value;
end;

{ TdcInterfaceType }

function TdcInterfaceType.GetInterface: TInterface;
begin
  Result := FAInterface;
end;

procedure TdcInterfaceType.SetInterface(Value: TInterface);
begin
  FAInterface := Value;
end;

{ TdcNonSetOrdType }

function TdcNonSetOrdType.GetMaxValue: Integer;
begin
  Result := FMaxValue;
end;

procedure TdcNonSetOrdType.SetMaxValue(Value: Integer);
begin
  FMaxValue := Value;
end;

function TdcNonSetOrdType.GetMinValue: Integer;
begin
  Result := FMinValue;
end;

procedure TdcNonSetOrdType.SetMinValue(Value: Integer);
begin
  FMinValue := Value;
end;

{ TdcOrdType }

function TdcOrdType.GetOrdType: TOrdType;
begin
  Result := FOrdType;
end;

procedure TdcOrdType.SetOrdType(Value: TOrdType);
begin
  FOrdType := Value;
end;

{ TdcRecordType }

constructor TdcRecordType.CreateX(dcType: TdcType);
begin
  inherited CreateX(dcType);
  FFields := TList.Create;
end;

destructor TdcRecordType.Destroy;
begin
  FFields.Free;
  inherited Destroy;
end;

function TdcRecordType.GetCount: Integer;
begin
  Result := FCount;
end;

procedure TdcRecordType.SetCount(Value: Integer);
begin
  FCount := Value;
end;

function TdcRecordType.GetField(Index: Integer): TdcRecordField;
begin
  Result := TdcRecordField(FFields[Index]^);
end;

procedure TdcRecordType.SetField(Index: Integer; Value: TdcRecordField);
begin
  TdcRecordField(FFields[Index]^) := Value;
end;

{ TdcSetOrdType }

function TdcSetOrdType.GetCompType: IdcType;
begin
  Result := FCompType;
end;

procedure TdcSetOrdType.SetCompType(Value: IdcType);
begin
  FCompType := Value;
end;

{ TdcString}

function TdcStringType.GetMaxLength: Integer;
begin
  Result := FMaxLength;
end;

procedure TdcStringType.SetMaxLength(Value: Integer);
begin
  FMaxLength := Value;
end;

{ TdcType }

constructor TdcType.Create;
begin
  inherited Create;
  FPossSizes := [Low(TTypeSize)..High(TTypeSize)];
  FPossTypeKinds := [Low(TEnhTypeKind).. High(TEnhTypeKind)];
end;

function TdcType.GetPossTypeKinds: TEnhTypeKinds;
begin
  Result := FPossTypeKinds;
end;

procedure TdcType.SetPossTypeKinds(Value: TEnhTypeKinds);
const
  TypeDataType: array[TEnhTypeKind] of array[1..3] of TdcTypeImplementClass =
    ((nil, nil, nil), (TdcOrdType, TdcNonSetOrdType, nil), (TdcOrdType, TdcNonSetOrdType, nil),
    (TdcOrdType, TdcNonSetOrdType, TdcEnumerationType), (TdcFloatType, nil, nil),
    (TdcStringType, nil, nil), (TdcOrdType, TdcSetOrdType, nil), (TdcClassType, nil, nil),
    (nil, nil, nil), (TdcOrdType, TdcNonSetOrdType, nil),
    (nil, nil, nil), (nil, nil, nil), (nil, nil, nil), (TdcArrayType, nil, nil),
    (TdcRecordType, nil, nil), (TdcInterfaceType, nil, nil),
    (TdcInt64Type, nil, nil), (TdcDynArrayType, nil, nil), (nil, nil, nil),
    (nil, nil, nil), (nil, nil, nil));
var
  NewTypeKind: TEnhTypeKind;
  OldTypeKind: TEnhTypeKind;
  I: Integer;
begin
  if Value = [] then
    raise EDecompilerError.Create('Empty PossTypeKinds');
  if not (Value <= FPossTypeKinds) then
    raise EDecompilerError.Create('A new PossTypeKind is introduced.');
  // Save the old type kind.
  OldTypeKind := TypeKind;
  // set the private var.
  FPossTypeKinds := Value;
  // Change the TypeData object.
  NewTypeKind := TypeKind;
  for I := 1 to 3 do
    if TypeDataType[OldTypeKind, I] <> TypeDataType[NewTypeKind, I] then
    begin
      FTypeData[I] := nil;
      FTypeData[I] := TypeDataType[NewTypeKind, I].CreateX(Self);
    end;
end;

function TdcType.GetPossSizes: TTypeSizes;
begin
  Result := FPossSizes;
end;

const
  CPossTypeKinds: array[TTypeSize] of TEnhTypeKinds =
    ({ts0}  [etkUnknown, etkUTInteger, etkUTString],
     {ts1}  [etkInteger, etkChar],
     {ts2}  [etkInteger],
     {ts4}  [etkInteger, etkChar, etkEnumeration, etkFloat,
      etkString, etkSet, etkClass, etkWChar, etkLString, etkWString,
      etkInterface, etkDynArray, etkPointer],
     {ts6}  [etkFloat],
     {ts8}  [etkFloat, etkMethod, etkInt64],
     {ts12} [etkFloat],
     {ts16} [etkVariant, etkRecord, etkArray],
     {tsComplex} [etkArray, etkRecord]);

procedure TdcType.SetPossSizes(Value: TTypeSizes);
var
  IncludedSize: TTypeSize;
begin
  if Value = [] then
    raise EDecompilerError.Create('Empty PossTypeKinds');
  if not (Value <= FPossSizes) then
    raise EDecompilerError.Create('A new PossTypeKind is introduced.');
  // Set the var.
  FPossSizes := Value;
  for IncludedSize := Low(TTypeSize) to High(TTypeSize) do
    if IncludedSize in PossSizes then
      PossTypeKinds := PossTypeKinds * CPossTypeKinds[IncludedSize];
end;

function TdcType.GetTypeKind: TEnhTypeKind;
var
  I, J: Integer;
begin
  // Convert the poss type kind to a type kind, take the first set item as the result.
  I := Integer(FPossTypeKinds);
  Assert(I <> 0, 'Empty possible type kind');
  J := 0;
  while I mod 2 = 0 do
  begin
    I := I div 2;
    Inc(J);
  end;
  Result := TEnhTypeKind(J);
end;

function TdcType.GetArrayType: IdcArrayType;
begin
  if (FTypeData[1] = nil) or
     (FTypeData[1].QueryInterface(IdcArrayType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetClassType: IdcClassType;
begin
  if (FTypeData[1] = nil) or
     (FTypeData[1].QueryInterface(IdcClassType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetDynArrayType: IdcDynArrayType;
begin
  if (FTypeData[1] = nil) or
     (FTypeData[1].QueryInterface(IdcDynArrayType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetEnumerationType: IdcEnumerationType;
begin
  if (FTypeData[3] = nil) or
     (FTypeData[3].QueryInterface(IdcEnumerationType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetFloatType: IdcFloatType;
begin
  if (FTypeData[1] = nil) or
     (FTypeData[1].QueryInterface(IdcFloatType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetInt64Type: IdcInt64Type;
begin
  if (FTypeData[1] = nil) or
     (FTypeData[1].QueryInterface(IdcInt64Type, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetInterfaceType: IdcInterfaceType;
begin
  if (FTypeData[1] = nil) or
     (FTypeData[1].QueryInterface(IdcInterfaceType, Result)<> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetNonSetOrdType: IdcNonSetOrdType;
begin
  if (FTypeData[2] = nil) or
     (FTypeData[2].QueryInterface(IdcNonSetOrdType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetOrdType: IdcOrdType;
begin
  if (FTypeData[1] = nil) or
     (FTypeData[1].QueryInterface(IdcOrdType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetRecordType: IdcRecordType;
begin
  if (FTypeData[1] = nil) or
     (FTypeData[1].QueryInterface(IdcRecordType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetSetOrdType: IdcSetOrdType;
begin
  if (FTypeData[2] = nil) or
     (FTypeData[2].QueryInterface(IdcSetOrdType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

function TdcType.GetStringType: IdcStringType;
begin
  if (FTypeData[1] = nil) or
     (FTypeData[1].QueryInterface(IdcStringType, Result) <> 0) then
    raise EDecompilerError.Create('Invalid typecast to type type');
end;

end.