var FileName := '
C:\Program Files (x86)\Embarcadero\Studio\22.0\lib\win32\debug\vcl.dcp';
var FileMem := TFile.ReadAllBytes(FileName);
var ReadCheck: TBytes :=
nil;
SetLength(ReadCheck, Length(FileMem));
var JResult := TJSONObject.Create;
var FileData := TDataReader.Create(JResult, 255, 0, @FileMem[0], @ReadCheck[0], Length(FileMem));
JSONAddOrUpdate(JResult, '
ReadStatus', NULL);
JSONAddOrUpdate(JResult, '
DataType', '
DCP: Delphi Compiled Package');
{ Header :
INT:PKX? (IF isMSIL)INT:MSIL
INT:cntRequires INT:cntContains INT:sizeContains INT:posContains
WORD:cntWord5a WORD:cntWord5b INT:cntInt6 INT:cntInt7
PCHAR:Filename
}
var Magic := FileData.ReadChar;
JSONAddOrUpdate(JResult, '
FileMagic',
string(Magic));
if Copy(Magic, 1, 3) <> '
PKX'
then
JSONSetAndAbort(JResult, '
ReadStatus', '
invalid file magic');
var FileVersion := Magic[3];
JSONAddOrUpdate(JResult, '
FileVersion', FileVersion);
if not (Magic[3]
in ['
0', '
4', '
5', '
7', '
9'])
then
JSONSetAndAbort(JResult, '
ReadStatus', '
invalid file version');
var isMSIL := EndsText('
L', FileName);
if isMSIL
then
JSONAddOrUpdate(JResult, '
Platform', '
MSIL');
if isMSIL
then FileData.ReadInt;
var cntRequires := FileData.ReadInt;
var cntContains := FileData.ReadInt;
var sizeContains := FileData.ReadInt;
var posContains := FileData.ReadInt;
var cntInt5 := FileData.ReadInt;
var cntInt6 := FileData.ReadInt;
var cntInt7 := FileData.ReadInt;
JSONAddOrUpdate(JResult, '
Counts', Format('
req%d con%d@%d:%d flg%.8x %d %d',
[cntRequires, cntContains, posContains, sizeContains,
cntInt5, cntInt6, cntInt7]));
JSONAddOrUpdate(JResult, '
FileName', FileData.Read0Str);
if (cntRequires < 0)
or (cntContains < 0)
or (posContains < 0)
or (sizeContains < 0)
then
JSONSetAndAbort(JResult, '
ReadStatus', '
out of range');
var posRequires := FileData.CurPos;
var posUnits := posContains + sizeContains;
var sizeUnits := Length(FileMem) - posUnits;
{ Requires :
(LOOP cntRequires(
PCHAR:Package
)
}
var List := TJSONArray.Create;
JSONAddOrUpdate(JResult, '
Requires', List);
for var i := 0
to cntRequires-1
do
JSONAddOrUpdate(List, '
@', FileData.Read0Str);
{ HeaderCheck }
if FileData.CurPos < posContains
then begin
var Len := posContains - FileData.CurPos;
var Data: TBytes;
var SData :=
string.Create(#0, Len * 2);
SetLength(Data, Len);
FileData.
Read(Data[0], Len);
BinToHex(Data[0], PChar(SData), Len);
JSONAddOrUpdate(JResult, '
UnknownHeader', SData);
end;
{ Contains :
(LOOP cntContains(
UnitHeader Flags FileFime bplCode bplData
(IF Ver<>4)INT:bplBSS (IF Ver=0,9 or MSIL)INT:X
INT:H INT:I INT:J INT:K INT:L
(IF Ver=0)INT:M INT:N INT:O
PCHAR:Unit PCHAR:Package
)
}
var ContainsData := FileData.GetBlock(sizeContains, posContains);
var List := TJSONObject.Create;
var Values: TJSONValue;
JSONAddOrUpdate(JResult, '
Contains', List);
for var i := 0
to cntContains-1
do begin
var _Cont := ContainsData.RealPos;
var _Unit :=
{@UnitHeader}ContainsData.PeakInt;
Values := TJSONObject.Create;
JSONAddOrUpdate(Values, '
@UnitHeader', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
UnitHeader', '
');
JSONAddOrUpdate(Values, '
Flags', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
FileFime', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
bplCode', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
bplData', ContainsData.ReadHex4);
if FileVersion <> '
4'
then
JSONAddOrUpdate(Values, '
bplBSS', ContainsData.ReadHex4);
if (FileVersion
in ['
0', '
9'])
or isMSIL
then
JSONAddOrUpdate(Values, '
X', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
H', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
I', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
J', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
K', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
L', ContainsData.ReadHex4);
if FileVersion = '
0'
then begin
JSONAddOrUpdate(Values, '
M', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
N', ContainsData.ReadHex4);
JSONAddOrUpdate(Values, '
O', ContainsData.ReadHex4);
end;
var Unitname := ContainsData.Read0Str;
var Namespace := '
';
if Length(Unitname) > 255
then
JSONSetAndAbort(JResult, '
ReadStatus', '
unit name to long');
if FileVersion
in ['
0', '
9']
then begin
Namespace := ContainsData.Read0Str;
if Unitname = '
'
then begin
if (Namespace <> '
')
and (Namespace[1] <> '
.')
then
Namespace := '
~' + Namespace;
Unitname := Namespace;
end;
end;
if (Values
is TJSONObject)
and (Namespace <> '
')
then
JSONAddOrUpdate(Values, '
Namespace', Namespace);
JSONAddOrUpdate(List, Unitname, Values);
end;
if ContainsData.CurPos < sizeContains
then begin
var Len := sizeContains - ContainsData.CurPos;
var Data: TBytes;
var SData :=
string.Create(#0, Len * 2);
SetLength(Data, Len);
ContainsData.
Read(Data[0], Len);
BinToHex(Data[0], PChar(SData), Len);
JSONAddOrUpdate(JResult, '
UnknownContains', SData);
end;
{ Units : }
var UnitsData := FileData.GetBlock(sizeUnits, posUnits);
...
{if UnitsData.CurPos < sizeUnits then begin
var Len := sizeUnits - UnitsData.CurPos;
var Data: TBytes;
var SData := string.Create(#0, Len * 2);
SetLength(Data, Len);
UnitsData.Read(Data[0], Len);
BinToHex(Data[0], PChar(SData), Len);
JSONAddOrUpdate(JResult, 'UnknownUnits', SData);
end;}