[abcdef]

вот передалел немножко на свежую голову... - заработало,
теперь нужно сделать чтоб распознавались блоки "Code", "Exception", "LocalVariableTable"
будет свободное время - надо начинать делать java-ассемблер

{$apptype console}
{$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;}
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;
{}
tExceptions_attribute = record
attribute_name_index : word;
attribute_length : longInt;
number_of_exceptions : word;
{exception_index_table[number_of_exceptions] of word}
end;
{}
tInnerClasses_attribute = record
attribute_name_index : word;
attribute_length : longInt;
number_of_classes : word;
{classes[number_of_classes] of record
inner_class_info_index : word;
outer_class_info_index : word;
inner_name_index : word;
inner_class_access_flags : word;
end}
end;
{}
tSynthetic_attribute = record
attribute_name_index : word;
attribute_length : longInt;
end;
{}
Deprecated_attribute = record
attribute_name_index : word;
attribute_length : longInt;
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;
{--------------------------}
tarr = array[0..$FFFF-1] of byte;
var
cf : record {ClassFile}
magic : longInt;
minor_version : word;
major_version : word;
constant_pool_count : word;
cp_info :^tarr;{constant_pool[constant_pool_count - 1];}
access_flags : word;
this_class : word;
super_class : word;
interfaces_count : word;
interfaces :^tarr;{[interfaces_count];}
fields_count : word;
field_info :^tarr;{fields[fields_count];}
methods_count : word;
method_info :^tarr;{methods[methods_count];}
attributes_count : word;
attribute_info :^tarr;{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
w1,w2 : ^word;
w : word;
begin
w1 := swap2(p,0);
w2 := swap2(w1,0);
w := w1^; w1^ := w2^; w2^ := w;
swap4 := w2;
end;


function pconst(i : integer) : pointer;
var
w :^word;
p :^byte;
begin
p := nil;
if (i>=1) and (i<cf.constant_pool_count-1) then
begin
p := @cf.cp_info^;
while i>=1 do
begin
case p^ of
CONSTANT_Class: inc(p,1+2);
CONSTANT_Fieldref,CONSTANT_Methodref,CONSTANT_Inte rfaceMethodref: inc(p,1+4);
CONSTANT_String: inc(p,1+2);
CONSTANT_Integer,CONSTANT_Float: inc(p,1+4);
CONSTANT_Long: inc(p,1+8 );
CONSTANT_NameAndType: inc(p,1+4);
CONSTANT_Utf8, CONSTANT_Unicode:
begin {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
inc(p);
w := @p^;
inc(p,2);
inc(p,w^)
end;
else
begin
p := nil; i := 0;
end;
end;
dec(i);
end;
end;
pconst := p;
end;

function getConstStr(index : word) : string;
var
s : string;
i,j : word;
p :^byte;
w :^word;
begin
s := '';
p := pconst(index);
if p<>nil then
case p^ of
CONSTANT_Class:
begin
w := @p^;
inc(w);
p := pconst(w^);
end;
CONSTANT_Fieldref,CONSTANT_Methodref,CONSTANT_Inte rfaceMethodref:
begin
w := @p^;
inc(w);
p := pconst(w^);
end;
CONSTANT_String:
begin
w := @p^;
inc(w);
p := pconst(w^);
end;
CONSTANT_NameAndType:
begin
w := @p^;
inc(w);
p := pconst(w^);
end;
end;
{null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
if p<>nil then
if (p^ in [CONSTANT_Utf8, CONSTANT_Unicode]) then
begin
inc(p);
w := @p^;
inc(p,2);
for j := 0 to w^-1 do
begin
s := s+chr(p^);
inc(p);
end;
end;
getConstStr := s;
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_Inte rfaceMethodref:
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(s wap4(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(swap4(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_leng th);
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 n := 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 n := 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 n := 0 to pattributes_count^-1 do
load_attribute_info;
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_na me_index)),
' attribute_name_index:',pLocalVariableTable_attribu te^.attribute_name_index);
writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.attribute_le ngth)),
' attribute_length:',pLocalVariableTable_attribute^. attribute_length);
writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.local_variab le_table_length)),
' local_variable_table_length:',pLocalVariableTable_ attribute^.local_variable_table_length);
for n := 0 to pLocalVariableTable_attribute^.local_variable_tabl e_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_p c);
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 n := 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^.attribute s_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^.attribut es_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_vers ion),n);
blockWrite(f,cf.major_version,sizeof(cf.major_vers ion),n);{...}
reset(f,1);
rc := 0;
swap4(get(@cf.magic,sizeof(cf.magic)),0);
swap2(get(@cf.minor_version,sizeof(cf.minor_versio n)),0);
swap2(get(@cf.major_version,sizeof(cf.major_versio n)),0);
swap2(get(@cf.constant_pool_count,sizeof(cf.consta nt_pool_count)),0);
p := @cf.cp_info^;
for i := 1 to cf.constant_pool_count-1 do {здесь именно с 1 по cf.constant_pool_count-1}
begin
write(hexw(rc-1),'h ',i:3,' ');
load_const; {загрузка и распознование cp_info}
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.interface s_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; {загрузка 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; {загрузка field_info}
end;
writeln('__________________________');
writeln(#13#10'-----method_info----');
swap2(get(@cf.methods_count,sizeof(cf.methods_coun t)),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; {загрузка method_info}
end;
writeln('__________________________');
writeln('OFFSET:',hexw(rc));
swap2(get(@cf.attributes_count,sizeof(cf.attribute s_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.