📄 dcp.pas
字号:
unit DCP;
interface
(*
The *.DCP (Delphi Compiled Package) support routines and data types
of the DCU32INT utility by Alexei Hmelnov.
----------------------------------------------------------------------------
E-Mail: alex@icc.ru
http://hmelnov.icc.ru/DCU/
----------------------------------------------------------------------------
See the file "readme.txt" for more details.
------------------------------------------------------------------------
IMPORTANT NOTE:
This software is provided 'as-is', without any expressed or implied warranty.
In no event will the author be held liable for any damages arising from the
use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented, you must not
claim that you wrote the original software.
2. Altered source versions must be plainly marked as such, and must not
be misrepresented as being the original software.
3. This notice may not be removed or altered from any source
distribution.
*)
uses
SysUtils,Classes;
type
PDCPHdr = ^TDCPHdr;
TDCPHdr = record
{ %$IF MSIL;
ulong X0 //DCPIL files contain additional DWORD
%$END }
nRequires,nContains: LongInt;
Sz1: Cardinal;
pContains: Cardinal;
//The rest of header is ignored here
end ;
PDCPUnitHdr = ^TDCPUnitHdr;
TDCPUnitHdr = record
Magic: LongInt;
FileSize: LongInt;
end ;
PDCPUnitInfo = ^TDCPUnitInfo;
TDCPUnitInfo = record
pData: Cardinal; //PDCPUnitHdr
F,FT: Cardinal;
bplCode,bplData: LongInt;
{
%$IF Ver>4; //Not checked for D4
ulong bplBSS
%$END
%$IF (Ver>=9)or MSIL;
ulong X
%$END
PChar Name
%$IF Ver>=9;
PChar Name1
%$END}
end ;
TDCPackage = class(TStringList)
protected
FMemPtr: Pointer;
FMemSize: Cardinal;
FOk,FLoaded: boolean;
public
destructor Destroy; override;
function Load(FN: String): boolean;
function GetFileByName(Name: String): PDCPUnitHdr;
end ;
implementation
{ TDCPackage. }
destructor TDCPackage.Destroy;
begin
if FMemPtr<>Nil then
FreeMem(FMemPtr,FMemSize);
inherited Destroy;
end ;
type
TMagicChars = array[0..3]of Char;
const
DCPMagic: TMagicChars = 'PKG'#0;
DCPMagicMask = $00FFFFFF;
function TDCPackage.Load(FN: String): boolean;
var
F: File;
Magic: LongInt;
DP: Pointer;
VerCh: Char;
Hdr: PDCPHdr;
NP,EP: PChar;
UI: PDCPUnitInfo;
UD: PDCPUnitHdr;
i,l: integer;
NS: String;
procedure DCPErr(Msg: String);
begin
raise Exception.Create(Msg);
end ;
function CheckDCPOfs(Ofs: Cardinal; Msg: String): Pointer;
begin
if (Ofs<0)or(Ofs>=FMemSize) then
DCPErr(Msg);
Result := PChar(FMemPtr)+Ofs;
end ;
begin
if FLoaded then begin
Result := FOk;
Exit;
end ;
FLoaded := true;
Result := false;
AssignFile(F,FN);
FileMode := 0; //Read only, helps with DCUs on CD
Reset(F,1);
try
FMemSize := FileSize(F);
if FMemSize<$40 then
DCPErr('Package file is too small.');
GetMem(FMemPtr,FMemSize);
BlockRead(F,FMemPtr^,FMemSize);
finally
Close(F);
end ;
DP := FMemPtr;
Magic := LongInt(DP^);
Inc(PChar(DP),SizeOf(LongInt));
if (Magic and DCPMagicMask)<>LongInt(DCPMagic) then
DCPErr('Wrong PKG magic.');
VerCh := TMagicChars(Magic)[3];
if (VerCh<'4')or(VerCh>'9')or(VerCh='6')or(VerCh='8') then
DCPErr('Wrong PKG version.');
Hdr := DP;
if (Hdr^.nRequires>$100{Empirical limitation})or(Hdr^.nRequires<0) then
DCPErr('Package requires too much.');
UI := CheckDCPOfs(Hdr^.pContains,'Wrong contains pointer.');
for i:=0 to Hdr^.nContains-1 do begin
UD := CheckDCPOfs(UI^.pData,'Wrong unit data pointer.');
CheckDCPOfs(UI^.pData+UD^.FileSize-1,'Wrong unit data size');
NP := PChar(UI)+SizeOf(TDCPUnitInfo);
if VerCh>'4' then
Inc(NP,SizeOf(LongInt));
if VerCh>='9' then
Inc(NP,SizeOf(LongInt));
EP := StrEnd(NP);
l := EP-NP;
if l>255 then
DCPErr('Too long unit name.');
SetString(NS,NP,l);
AddObject(NS,Pointer(UD));
Inc(EP);
if VerCh>='9' then begin
EP := StrEnd(EP);
Inc(EP);
end ;
UI := Pointer(EP);
end ;
FOk := true;
Result := true;
end ;
function TDCPackage.GetFileByName(Name: String): PDCPUnitHdr;
var
i: integer;
begin
Result := Nil;
i := IndexOf(Name);
if i<0 then
Exit;
Result := PDCPUnitHdr(Objects[i]);
end ;
procedure FreePackages;
begin
end ;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -