ujavaclass.pas

ESS-Model is a powerful, reverse engine, UML-tool for Delphi/Kylix and Java-files.

  numAttr := readU2( Input );
  if (numAttr > 0) then
  begin
    SetLength(classAttrTab,numAttr);
    for I := 0 to numAttr-1 do
      classAttrTab[i] := TAttrFactory.allocAttr( Input, constPoolSec );
  end;
end;

{ TClassFile }

constructor TClassFile.Create(Input: TStream);
begin
  try
    header := TClassFileHeader.Create( Input );
    classConstPool := TConstPool.Create( Input );
    classDecl := TClassDeclSec.Create( Input, classConstPool );
    classFields := TClassFieldSec.Create(Input, classConstPool);
    className := classDecl.getClassName;
    classMethods := TClassMethodSec.Create(Input, classConstPool, className );
    classAttrs := TClassAttrSec.Create(Input, classConstPool);
  finally
    Input.Free;
  end;
end;


destructor TClassFile.Destroy;
begin
  if Assigned(Header) then FreeAndNil(header);
  if Assigned(classConstPool) then FreeAndNil(classConstPool);
  if Assigned(classDecl) then FreeAndNil(classDecl);
  if Assigned(classFields) then FreeAndNil(classFields);
  if Assigned(classMethods) then FreeAndNil(classMethods);
  if Assigned(classAttrs) then FreeAndNil(classAttrs);
  inherited;
end;

{ TAttrInfo }

constructor TAttrInfo.Create(Name: string; Length: integer);
begin
  attrName := Name;
  len := length;
end;

function TAttrInfo.GetName: string;
begin
  Result := attrName;
end;

{ TAttrFactory }

class function TAttrFactory.allocAttr(Input: TStream; constPoolSec: TConstPool): TAttrInfo;
var
  length : integer;
  retObj : TAttrInfo;
begin
  retObj := nil;

  ReadU2(Input);
  length := ReadU4(Input);

  //Skip all attributes
  skip_data(length,Input);

  Result := retObj;
end;

class procedure TAttrFactory.skip_data(len: integer; Input: TStream);
begin
  if (Input.Position>=Input.Size) and (Len<>0) then
    raise Exception.Create('Unexpected end of file');
  Input.Position := Input.Position + Len;
end;



{ TConstBase }


function TConstBase.getString: string;
begin
  Result := '**noname';
end;

procedure TConstBase.set_ref(const objAry: array of TConstBase);
begin
  //nothing
end;

{ TConstPool }


function TConstPool.allocConstEntry(tag: integer): TConstBase;
begin
  Result := nil;
  case Tag of
    CONSTANT_Utf8:
      Result := TConstUtf8.Create;
    CONSTANT_Integer:
      Result := TConstInt.Create;
    CONSTANT_Float:
      Result := TConstFloat.Create;
    CONSTANT_Long:
      Result := TConstLong.Create;
    CONSTANT_Double:
      Result := TConstDouble.Create;
    CONSTANT_Class,
    CONSTANT_String:
      Result := TConstClass_or_String.Create;
    CONSTANT_Fieldref,
    CONSTANT_Methodref,
    CONSTANT_InterfaceMethodref:
      Result := TConstRef.Create;
    CONSTANT_NameAndType:
      Result := TConstName_and_Type_info.Create;
  else
    ErrorHandler.Trace('allocConstEntry: bad tag value = ' + IntToStr(tag));
  end;

  if Assigned(Result) then
    Result.Tag := Tag;
end;

function TConstPool.ConstPoolElem(ix: integer): TConstBase;
begin
  Result := nil;
  if (ix>0) and (ix<Length(constPool)) then
    Result := constPool[ix];
end;

constructor TConstPool.Create(Input: TStream);
begin
  constPoolCnt := readU2(Input);

  SetLength(constPool,constPoolCnt);

  readConstPool(Input);
  resolveConstPool;
end;

destructor TConstPool.Destroy;
var
  I : integer;
begin
  for I:=0 to High(ConstPool) do
    if Assigned(ConstPool[I]) then FreeAndNil(ConstPool[I]);
  inherited;
end;

procedure TConstPool.readConstPool(Input: TStream);
var
  i,tag : integer;
  constObj : TConstBase;
begin
  I := 1;
  while I<constPoolCnt do
  begin
    Tag := ReadU1(Input);
    if (Tag > 0) then
    begin
      constObj := allocConstEntry( tag );
      constObj.read( Input );
      constPool[i] := constObj;
      if (constObj is TConstLong) or (constObj is TConstDouble) then
      begin
        Inc(I);
        constPool[i] := nil;
      end;
    end
    else
      ; //ErrorHandler.Trace('tag == 0');
    Inc(I);
  end;
end;

procedure TConstPool.resolveConstPool;
var
  I : integer;
begin
  //Index 0 is not used
  for I:=1 to constPoolCnt-1 do
    if Assigned(constPool[I]) then
      constPool[I].set_ref(constPool);
end;


{ TConstClass_or_String }

function TConstClass_or_String.GetString: string;
begin
  Result := Utf8.GetString;
end;

procedure TConstClass_or_String.Read(Input: TStream);
begin
  index := readU2( Input );
end;

procedure TConstClass_or_String.set_ref(const objAry: array of TConstBase);
var
  tmp : TConstBase;
begin
  tmp := objAry[ index ];
  if (tmp is TConstUtf8) then
    Utf8 := tmp as TConstUtf8
  else
    ;//ErrorHandler.Trace('not utf8');
end;


{ TConstLongConvert }

function TConstLongConvert.readLong(Input: TStream): int64;
var
  h,l : integer;
begin
  h := readU4(Input);
  l := readU4(Input);
  Result := toLong(h,l);
end;

function TConstLongConvert.toLong(h, l: integer): int64;
begin
  Result := (h shl 32) or l;
end;

{ TConstDouble }

procedure TConstDouble.Read(Input: TStream);
var
  I : int64;
begin
  //Is this cast ok?
  I := ReadLong(Input);
  Move(I,D,SizeOf(D));
end;

{ TConstFloat }

procedure TConstFloat.Read(Input: TStream);
var
  L : longword;
begin
  L := ReadU4(Input);
  //Is this cast ok?
  Move(L,F,SizeOf(F));
end;

{ TConstInt }

procedure TConstInt.Read(Input: TStream);
var
  L : longword;
begin
  L := ReadU4(Input);
  Val := L;
end;

{ TConstLong }

procedure TConstLong.Read(Input: TStream);
begin
  longVal := ReadLong(Input);
end;

{ TConstName_and_Type_info }

procedure TConstName_and_Type_info.Read(Input: TStream);
begin
  inherited read(Input);
  descriptor_index := readU2(Input);
end;

procedure TConstName_and_Type_info.set_ref(const objAry: array of TConstBase);
var
  tmp : TConstBase;
begin
  inherited set_ref( objAry );
  Tmp := objAry[ descriptor_index ];
  if (tmp is TConstUtf8) then
    descriptor_Utf8 := tmp as TConstUtf8
  else
    ; //ErrorHandler.Trace('utf8');
end;

{ TConstRef }

procedure TConstRef.Read(Input: TStream);
begin
  index := readU2( Input );
  name_and_type_index := readU2( Input );
end;

procedure TConstRef.set_ref(const objAry: array of TConstBase);
var
  tmp : TConstBase;
begin
  Tmp := objAry[ index ];
  if (tmp is TConstClass_or_String) then
    class_ref := tmp as TconstClass_or_String
  else
    ; //ErrorHandler.Trace('nix');

  Tmp := objAry[ name_and_type_index ];
  if (tmp is TConstName_and_Type_info) then
    name_ref := tmp as TConstName_and_Type_info
  else
    ;//ErrorHandler.Trace('nix');
end;

{ TConstUtf8 }


procedure TConstUtf8.Read(Input: TStream);
var
  one_char : word;
  len, charCnt : integer;
  one_byte,first_byte : byte;
  tmp : word;
begin
  len := readU2( Input );

  charCnt := 0;
  while (charCnt < len) do
  begin
    one_byte := readU1( Input );
    Inc(charCnt);
    if ((one_byte shr 7) = 1) then
    begin
      tmp := (one_byte and $3f);  // Bits 5..0 (six bits)
      first_byte := one_byte;
      one_byte := readU1( Input );
      Inc(charCnt);
      tmp := (tmp or ((one_byte and $3f) shl 6));
      if ((first_byte shr 4) = 2+4+8) then
      begin
        one_byte := readU1( Input );
        Inc(charCnt);
        one_byte := (one_byte and $0F);
        tmp := (tmp or (one_byte shl 12));
      end;
      one_char := tmp;
    end
    else
      one_char := one_byte;
    Str := Str + char(Lo(One_Char));
  end;
end;

function TConstUtf8.GetString: string;
begin
  Result := str;
end;

{ TAccData }

class function TAccData.isAbstract(Val: integer): boolean;
begin
  Result := (Val and ACC_ABSTRACT) <> 0;
end;

class function TAccData.isFinal(Val: integer): boolean;
begin
  Result := (Val and ACC_FINAL) <> 0;
end;

class function TAccData.isInterface(Val: integer): boolean;
begin
  Result := (Val and ACC_INTERFACE) <> 0;
end;

class function TAccData.isNative(Val: integer): boolean;
begin
  Result := (Val and ACC_NATIVE) <> 0;
end;

class function TAccData.isPrivate(Val: integer): boolean;
begin
  Result := (Val and ACC_PRIVATE) <> 0;
end;

class function TAccData.isProtected(Val: integer): boolean;
begin
  Result := (Val and ACC_PROTECTED) <> 0;
end;

class function TAccData.isPublic(Val: integer): boolean;
begin
  Result := (Val and ACC_PUBLIC) <> 0;
end;

class function TAccData.isStatic(Val: integer): boolean;
begin
  Result := (Val and ACC_STATIC) <> 0;
end;

class function TAccData.isStrict(Val: integer): boolean;
begin
  Result := (Val and ACC_STRICT) <> 0;
end;

class function TAccData.isSuper(Val: integer): boolean;
begin
  Result := (Val and ACC_SYNC) <> 0;  //sync and super share the same bit-flag
end;

class function TAccData.isSync(Val: integer): boolean;
begin
  Result := (Val and ACC_SYNC) <> 0;
end;

class function TAccData.isTransient(Val: integer): boolean;
begin
  Result := (Val and ACC_TRANSIENT) <> 0;
end;

class function TAccData.isVolatile(Val: integer): boolean;
begin
  Result := (Val and ACC_VOLATILE) <> 0;
end;


{ TObjNameFormat }


class function TObjNameFormat.toDotSeparator(slashName: string): string;
var
  I : integer;
  Ch : char;
begin
  Result := '';
  for I:=1 to Length(SlashName) do
  begin
    ch := SlashName[I];
    if ch='/' then
      Result := Result + '.'
    else if ch<>';' then
      Result := Result + ch;
  end;
end;

end.