[abcdef]

вот сбрал приблизительную модель загрузки clsass-файлов, но после считывания константного пула, где-то рвет в размерах считываемых байтов, соответственно неверно заполняются поля размера ниже-следующих структур, посмотрите кто-нить в чем здесь неправ.

формат и доку брал из предоставленной информации.

Программу можно компилировать как и в TurboPascal 7.0, так и Delphi 7.0
только после создания .exe-файла в Delphi антивирус кричит на него что это вирус...

{$R+,S+}
const
  CONSTANT_Class              = 7;
  CONSTANT_Fieldref           = 9;
  CONSTANT_Methodref          = 10;
  CONSTANT_InterfaceMethodref = 11;
  CONSTANT_String             = 8;
  CONSTANT_Integer            = 3;
  CONSTANT_Float              = 4;
  CONSTANT_Long               = 5;
  CONSTANT_Double             = 6;
  CONSTANT_NameAndType        = 12;
  CONSTANT_Utf8               = 1;
  CONSTANT_Unicode            = 2;
  {------------------------------}
  ACC_PUBLIC = 1;
  ACC_PRIVATE = 2;
  ACC_PROTECTED = 4;
  ACC_STATIC = 8;
  ACC_FINAL = 16;
  ACC_SYNCHRONIZED = 32;
  ACC_SUPER = 32;
  ACC_VOLATILE = 64;
  ACC_TRANSIENT = 128;
  ACC_NATIVE = 256;
  ACC_INTERFACE = 512;
  ACC_ABSTRACT = 1024;
{}
type
  tfield_info = record
    access_flags : word;
    name_index : word;
    signature_index : word;
    attributes_count : word;
    {attributes[attribute_count]}
  end;
{}
  tmethod_info = record
    access_flags : word;
    name_index : word;
    signature_index : word;
    attributes_count : word;
    {attributes[attribute_count]}
  end;
  {--атрибуты--}
  tGenericAttribute_info = record
    attribute_name : word;
    attribute_length : longInt;
    {info[attribute_length] of byte}
  end;
  {}
  tSourceFile_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    sourcefile_index : word;
  end;
  {}
  tLineNumberTable_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    line_number_table_length : word;
    {line_number_table[line_number_table_length] of record start_pc,line_number:word;}
  end;
  {}
  tConstantValue_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    constantvalue_index : word;
  end;
  {}
  tLocalVariableTable_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    local_variable_table_length : word;
    {local_variable_table[local_variable_table_length]}
  end;
  tLocal_variable_table = record
    start_pc   : word;
    length     : word;
    name_index : word;
    signature_index : word;
    slot       : word;
  end;
  {}
  tCode_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    max_stack : word;
    max_locals : word;
    code_length : longInt;
  end;
  {code[code_length]}
  {exception_table_length : word;{***}
  {exception_table[exception_table_length]}
  {attributes_count : word;{***}
  {attribute_info[attribute_count]}
  tException_table = record
    start_pc : word;
    end_pc : word;
    handler_pc : word;
    catch_type : word;
  end;
  {--------------------------}
var
  cf : record      {ClassFile}
    magic               : longInt;
    minor_version       : word;
    major_version       : word;
    constant_pool_count : word;
    cp_info             : pointer; {constant_pool[constant_pool_count - 1];}
    access_flags        : word;
    this_class          : word;
    super_class         : word;
    interfaces_count    : word;
    interfaces          : pointer; {[interfaces_count];}
    fields_count        : word;
    field_info          : pointer; {fields[fields_count];}
    methods_count       : word;
    method_info         : pointer; {methods[methods_count];}
    attributes_count    : word;
    attribute_info      : pointer; {attributes[attribute_count];}
  end;
var
  f                     : file;
  i,j,n,rc              : integer;{longInt;}
  s                     : string;
  tag                   : byte;
  p                     :^byte;
  pfield_info           :^tfield_info;
  pmethod_info          :^tmethod_info;
  pGenericAttribute_info:^tGenericAttribute_info;
  pCode_attribute       :^tCode_attribute;
  pException_table      :^tException_table;
  pexception_table_length:^word;
  pattributes_count      :^word;
  pLocalVariableTable_attribute:^tLocalVariableTable_attribute;
  pLocal_variable_table :^tLocal_variable_table;


function hex(b:byte) : string;
const
  h : array[0..$F] of char = '0123456789ABCDEF';
begin
  hex := h[b shr 4]+h[b and $F];
end;


function hexw(w:word) : string;
begin
  hexw:=hex(hi(w))+hex(lo(w));
end;


function get(p : pointer;  count : integer) : pointer;
var
  n : integer;
begin
  blockRead(f,p^,count,n);
  inc(longInt(p),n); {pasc}
  inc(rc,n);
  get := p;  {get := ptr(cardinal(p)+count);  //delphi}
end;

function swap2(p:pointer; offs:integer) : pointer;
var
  b1,b2 :^byte;
  b     : byte;
begin
  dec(longInt(p),offs+1);
  b1:=p;
  dec(longInt(p));
  b2:=p;
  b:=b1^;b1^:=b2^;b2^:=b;
  swap2 := p;
end;


function swap4(p:pointer; offs:integer) : pointer;
var
  b1,b2,b3,b4 :^byte;
  b           : byte;
begin
  dec(longInt(p),offs+1);
  b1:=p;
  dec(longInt(p));
  b2:=p;
  dec(longInt(p));
  b3:=p;
  dec(longInt(p));
  b4:=p;
  b:=b1^;b1^:=b4^;b4^:=b;
  b:=b2^;b2^:=b3^;b3^:=b;
  swap4 := p;
end;


function getConstStr(index : word) : string;
var
  s     : string;
  i,j,w : word;
  p     :^byte;
begin
  s:='';
  p:=cf.cp_info;
  for i := 1 to cf.constant_pool_count-1 do  {цикл начинается именно с 1, а не 0}
  begin
    if i=index then if (p^ in [CONSTANT_Utf8, CONSTANT_Unicode]) then
    begin
      w:=p^;
      inc(p,2);
      for j := 0 to w-1 do
      begin
        s := s+chr(p^);
        inc(p);
      end;
      getConstStr := s;
      break;
    end;
    case p^ of
      CONSTANT_Class: inc(p,2);
      CONSTANT_Fieldref,CONSTANT_Methodref,CONSTANT_InterfaceMethodref: inc(p,4);
      CONSTANT_String: inc(p,2);
      CONSTANT_Integer,CONSTANT_Float: inc(p,4);
      CONSTANT_Long: inc(p,8);
      CONSTANT_NameAndType: inc(p,4);
      CONSTANT_Utf8, CONSTANT_Unicode:
      begin      {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
        w:=p^;
        inc(p,2);
        inc(p,w)
      end;
    end;
    getConstStr := s;
  end;
end;

{-------------------}

procedure load_const;
begin
  get(p,1);
  tag:=p^;
  inc(p);
  write(tag:2,' ');
  case tag of
    CONSTANT_Class:
    begin
      p:=get(p,2);
      write('CONSTANT_Class:',word(swap2(p,0)^));
    end;
    CONSTANT_Fieldref,CONSTANT_Methodref,CONSTANT_InterfaceMethodref:
    begin
      case tag of
        CONSTANT_Fieldref: write('CONSTANT_Fieldref:');
        CONSTANT_Methodref: write('CONSTANT_Methodref:');
        CONSTANT_InterfaceMethodref: write('CONSTANT_InterfaceMethodref:');
      end;
      p:=get(p,4);
      write(word(swap2(p,2)^),'  ',word(swap2(p,0)^));
    end;
    CONSTANT_String:
    begin
      p:=get(p,2);
      write('CONSTANT_String:',word(swap2(p,0)^));
    end;
    CONSTANT_Integer,CONSTANT_Float:
    begin
      case tag of
        CONSTANT_Integer: write('CONSTANT_Integer:');
        CONSTANT_Float: write('CONSTANT_Float:');
      end;
      p:=get(p,4);
      write(longInt(swap4(p,0)^));
    end;
    CONSTANT_Long,CONSTANT_Double:
    begin
      case tag of
        CONSTANT_Long: write('CONSTANT_Integer:');
        CONSTANT_Double: write('CONSTANT_Double:');
      end;
      p:=get(p,8);
      write('_hi_',longInt(swap4(p,4)^),'_lo_',longInt(swap4(p,0)^));
    end;
    CONSTANT_NameAndType:
    begin
      p:=get(p,4);
      write('CONSTANT_NameAndType:',word(swap2(p,2)^),' ',word(swap2(p,0)^));
    end;
    CONSTANT_Utf8, CONSTANT_Unicode:
    begin        {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
      p:=get(p,2);       {length}
      n:=word(swap2(p,0)^);
      write('CONSTANT_Utf8-Unicode [',n,']=');
      for j := 0 to n-1 do
      begin
        get(p,1);
        write(chr(p^));
        inc(p);
      end;
    end;
    else
    if tag<>0 then
    begin
      write('error:',tag);
      halt;
    end;
  end;
  writeln;
end;


procedure load_attribute_info;
begin
  writeln(hexw(rc), 'h  GenericAttribute_info');
  p:=get(p,sizeof(pGenericAttribute_info^));
  pGenericAttribute_info:=swap2(swap2{4}(p,0),0);
  writeln('attribute_name:',pGenericAttribute_info^.attribute_name);
  writeln('attribute_length:',pGenericAttribute_info^.attribute_length);
  s := getConstStr(pGenericAttribute_info^.attribute_name);
  if s='Code' then
  begin
    writeln(hexw(rc), 'h  Code');
    p:=get(p,sizeof(pCode_attribute^));
    pCode_attribute := swap2(swap4(swap2(swap2(swap4(p,0),0),0),0),0);
    writeln(hexw(rc-sizeof(pCode_attribute^.attribute_name_index)),
      ' attribute_name_index:',pCode_attribute^.attribute_name_index);
    writeln(hexw(rc-sizeof(pCode_attribute^.attribute_length)),
      ' attribute_length:',pCode_attribute^.attribute_length);
    writeln(hexw(rc-sizeof(pCode_attribute^.max_stack)),
      ' max_stack:',pCode_attribute^.max_stack);
    writeln(hexw(rc-sizeof(pCode_attribute^.max_locals)),
      ' max_locals:',pCode_attribute^.max_locals);
    writeln(hexw(rc-sizeof(pCode_attribute^.code_length)),
      ' code_length:',pCode_attribute^.code_length);
    for j := 0 to pCode_attribute^.code_length-1 do  p:=get(p,1);
    p:=get(p,sizeof(pexception_table_length^));
    pexception_table_length:=swap2(p,0);
    for j := 0 to pexception_table_length^-1 do
    begin
      p := get(p,sizeof(pException_table^));
      pException_table := swap2(swap2(swap2(swap2(p,0),0),0),0);
    end;
    p:=get(p,sizeof(pattributes_count^));
    pattributes_count :=swap2(p,0);
    for j := 0 to pattributes_count^-1 do p:=get(p,1);
  end
  else if s='LocalVariableTable' then
  begin
    writeln(hexw(rc), 'h  LocalVariableTable');
    p := get(p,sizeof(pLocalVariableTable_attribute^));
    pLocalVariableTable_attribute := swap2(swap4(swap2(p,0),0),0);
    writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.attribute_name_index)),
      ' attribute_name_index:',pLocalVariableTable_attribute^.attribute_name_index);
    writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.attribute_length)),
      ' attribute_length:',pLocalVariableTable_attribute^.attribute_length);
    writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.local_variable_table_length)),
      ' local_variable_table_length:',pLocalVariableTable_attribute^.local_variable_table_length);
    for j := 0 to pLocalVariableTable_attribute^.local_variable_table_length-1 do
    begin
      p := get(p,sizeof(pLocal_variable_table^));
      pLocal_variable_table := swap2(swap2(swap2(swap2(swap2(p,0),0),0),0),0);
      writeln('start_pc:',pLocal_variable_table^.start_pc);
      writeln('length:',pLocal_variable_table^.length);
      writeln('name_index:',pLocal_variable_table^.name_index);
      writeln('signature_index:',pLocal_variable_table^.signature_index);
      writeln('slot:',pLocal_variable_table^.slot);
    end;
  end
  {if s='SourceFile' then
  begin
  end
  else if s='LineNumberTable' then
  begin
  end{}
  else  {don't know... skip atributes}
  begin
    for j := 0 to pGenericAttribute_info^.attribute_length-1 do
    begin
      get(p,1);
      write(hex(byte(p^)),' ');
      inc(p);
    end;
  end;
  writeln;
end;


procedure load_interfaces;
begin
  p:=get(p,2);
  write(word(swap2(p,0)^),',');
end;


procedure load_field_info;
begin
  p := get(p,sizeof(pfield_info^));
  pfield_info := swap2(swap2(swap2(swap2(p,0),0),0),0);
  writeln('access_flags:',pfield_info^.access_flags);
  writeln('name_index:',pfield_info^.name_index);
  writeln('signature_index:',pfield_info^.signature_index);
  writeln('attributes_count:',pfield_info^.attributes_count, ' offs:[',hexw(rc), 'h]');
  for j := 0 to pfield_info^.attributes_count-1 do
    load_attribute_info;
end;


procedure method_info;
begin
  p := get(p,sizeof(pmethod_info^));
  pmethod_info := swap2(swap2(swap2(swap2(p,0),0),0),0);
  writeln('access_flags:',pmethod_info^.access_flags);
  writeln('name_index:',pmethod_info^.name_index);
  writeln('signature_index:',pmethod_info^.signature_index);
  writeln('attributes_count:',pmethod_info^.attributes_count, ' offs:[',hexw(rc), 'h]' );
  for j := 0 to pmethod_info^.attributes_count-1 do
    load_attribute_info;
end;


begin
  getMem(cf.cp_info,$FFFF);
  getMem(cf.interfaces,$7FFF);
  getMem(cf.field_info,$FFFF);
  getMem(cf.method_info,$FFFF);
  getMem(cf.attribute_info,$FFFF);
  fillChar(cf.cp_info^, $FFFF, 0);
  fillChar(cf.interfaces^, $7FFF, 0);
  fillChar(cf.field_info^, $FFFF, 0);
  fillChar(cf.method_info^, $FFFF, 0);
  fillChar(cf.attribute_info^, $FFFF, 0);
  assign(f,'fw.cla');
  {cf.magic := $CAFEBABE; cf.minor_version := $0000; cf.major_version := $002E;
  rewrite(f,1);
  blockWrite(f,cf.magic,sizeof(cf.magic),n);
  blockWrite(f,cf.minor_version,sizeof(cf.minor_version),n);
  blockWrite(f,cf.major_version,sizeof(cf.major_version),n);{...}
  reset(f,1);
  rc:=0;
  swap4(get(@cf.magic,sizeof(cf.magic)),0);
  swap2(get(@cf.minor_version,sizeof(cf.minor_version)),0);
  swap2(get(@cf.major_version,sizeof(cf.major_version)),0);
  swap2(get(@cf.constant_pool_count,sizeof(cf.constant_pool_count)),0);
  p:=cf.cp_info;
  for i := 1 to cf.constant_pool_count-1 do {цикл начинается именно с 1, а не 0}
  begin
    write(hexw(rc-1),'h ',i:3,' ');
    load_const;
  end;
  writeln('__________________________');
  swap2(get(@cf.access_flags,sizeof(cf.access_flags)),0);
  writeln(hexw(rc-sizeof(cf.access_flags)),'h access_flags:',cf.access_flags);
  swap2(get(@cf.this_class,sizeof(cf.this_class)),0);
  writeln(hexw(rc-sizeof(cf.this_class)),'h this_class:',cf.this_class);
  swap2(get(@cf.super_class,sizeof(cf.super_class)),0);
  writeln(hexw(rc-sizeof(cf.super_class)),'h super_class:',cf.super_class);
  writeln(#13#10'-----load_interfaces----');
  swap2(get(@cf.interfaces_count,sizeof(cf.interfaces_count)),0);
  writeln(hexw(rc-sizeof(cf.interfaces_count)),'h interfaces[',cf.interfaces_count,']=');
  p := cf.interfaces;
  for i := 0 to cf.interfaces_count-1 do
    load_interfaces;
  writeln(#13#10'__________________________');
  writeln(#13#10'-----load_field_info----');
  swap2(get(@cf.fields_count,sizeof(cf.fields_count)),0);
  writeln(hexw(rc-sizeof(cf.fields_count)),'h field_info[',cf.fields_count,']=');
  p := cf.field_info;
  for i:=0 to cf.fields_count-1 do
  begin
    writeln(hexw(rc), 'h  field_info:',i:3,'---------');
    load_field_info;
  end;
  writeln('__________________________');
  writeln(#13#10'-----method_info----');
  swap2(get(@cf.methods_count,sizeof(cf.methods_count)),0);
  writeln(hexw(rc-sizeof(cf.methods_count)), 'h  method_info [',cf.methods_count,']=');
  p := cf.method_info;
  for i:=0 to cf.methods_count-1 do
  begin
    writeln(hexw(rc),'h  method_info:',i:3,'---------');
    method_info;
  end;
  writeln('__________________________');
  writeln('OFFSET:',hexw(rc));
  swap2(get(@cf.attributes_count,sizeof(cf.attributes_count)),0);
  writeln(hexw(rc-sizeof(cf.attributes_count)),'h  attribute_info [',cf.attributes_count,']=');
  p:=cf.attribute_info;
  for i:=0 to cf.attributes_count-1 do
  begin
    load_attribute_info;
    writeln('-');
  end;
  close(f);
  freeMem(cf.attribute_info,$FFFF);
  freeMem(cf.method_info,$FFFF);
  freeMem(cf.field_info,$FFFF);
  freeMem(cf.interfaces,$7FFF);
  freeMem(cf.cp_info,$FFFF);
end.