关闭掉新版Delphi的几个固定导出函数(__dbk_fcall_wrapper,dbkFCallWrapperAddr,TMethodImplementationIntercept)

不知道从什么时候起Delphi编译的PE文件总是三个固定的导出函数。

一方面有强迫症的同学们会不爽，另一方面其实是不安全的。

这三个函数是：__dbk_fcall_wrapper,dbkFCallWrapperAddr,TMethodImplementationIntercept

有两种方式可以去掉他们。

1.修改RTL源代码，注释掉这几处函数的exports代码行。重新编译。不过重新编译对小白或者比较懒的同学确实不方便。况且出了新版本Delphi又要重做一遍。

2.把编译后的EXE，DLL处理一下，去掉这几个函数。

做了个小工具，可以删除EXE，DLL的导出函数的，可以批量删除导出函数，函数名用逗号分隔。为了方便被批处理或脚本调用写成了命令行工具，返回值0表示成功，-1失败。经测试，可以使用。自动识别WIN32，WIN64的程序，分别处理。

使用方法如：RemoveExportProc.exe ContextMenu64.dll  __dbk_fcall_wrapper,dbkFCallWrapperAddr,TMethodImplementationIntercept  d:\test.dll’

另一方面，用XE10.2可以编译出59KB的小程序，自从Delphi2010加入RTTI信息以后，很少见到1MB以下的Delphi程序了:)。

下载链接：RemoveExportProc

代码也非常少，可以直接贴出来：

program RemoveExportProc;

{$IF CompilerVersion >= 21.0}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
{$ENDIF}
{$APPTYPE CONSOLE}
{$R *.res}

uses
Winapi.Windows;

{$POINTERMATH on}

type
TBytes = array of Byte;
TDynArrayString = array of string;

PIMAGE_EXPORT_DIRECTORY = ^IMAGE_EXPORT_DIRECTORY;

_IMAGE_EXPORT_DIRECTORY = record
Characteristics: DWORD;
TimeDateStamp: DWORD;
MajorVersion: Word;
MinorVersion: Word;
Name: DWORD;
Base: DWORD;
NumberOfFunctions: DWORD;
NumberOfNames: DWORD;
AddressOfFunctions: DWORD;
AddressOfNames: DWORD;
AddressOfNameOrdinals: DWORD;
end;

IMAGE_EXPORT_DIRECTORY = _IMAGE_EXPORT_DIRECTORY;

function StrIComp(const Str1, Str2: PAnsiChar): Integer;
var
P1, P2: PAnsiChar;
C1, C2: AnsiChar;
begin
P1 := Str1;
P2 := Str2;
while True do
begin
if P1^ in ['a' .. 'z'] then
C1 := AnsiChar(Byte(P1^) xor $20)
else
C1 := P1^;

if P2^ in ['a' .. 'z'] then
C2 := AnsiChar(Byte(P2^) xor $20)
else
C2 := P2^;

if (C1 <> C2) or (C1 = #0) then
begin
Result := (Ord(C1) - Ord(C2));
Exit;
end;
Inc(P1);
Inc(P2);
end;
end;

function RVA2RAWInSection(Base: PByte; RVA: UInt64;
const psection: PImageSectionHeader): Pointer; overload;
begin
Result := @Base[psection^.PointerToRawData +
(RVA - psection^.VirtualAddress)];
end;

function RVA2RAW32(Base: PByte; pHeader: PImageNtHeaders32; RVA: UInt64;
var psection: PImageSectionHeader): Pointer; overload;
var
i: Integer;
SectionAlign: DWORD;
startAddr, EndAddr: UInt64;
begin
Result := Pointer(RVA);
SectionAlign := pHeader^.OptionalHeader.SectionAlignment;
psection := IMAGE_FIRST_SECTION(pHeader^);
for i := 0 to pHeader^.FileHeader.NumberOfSections - 1 do
begin
startAddr := psection^.VirtualAddress;
EndAddr := psection^.VirtualAddress + psection^.VirtualAddress;
if (RVA >= startAddr) and (RVA <= EndAddr) and
((RVA - psection^.VirtualAddress) < psection^.SizeOfRawData) then
begin
Result := @Base[psection^.PointerToRawData + (RVA - startAddr)];
Break;
end;
Inc(psection);
end;
end;

function RVA2RAW64(Base: PByte; pHeader: PImageNtHeaders64; RVA: UInt64;
var psection: PImageSectionHeader): Pointer; overload;
var
i: Integer;
SectionAlign: DWORD;
startAddr, EndAddr: UInt64;
begin
Result := Pointer(RVA);
SectionAlign := pHeader^.OptionalHeader.SectionAlignment;
psection := IMAGE_FIRST_SECTION(pHeader^);
for i := 0 to pHeader^.FileHeader.NumberOfSections - 1 do
begin
startAddr := psection^.VirtualAddress;
EndAddr := psection^.VirtualAddress + psection^.VirtualAddress;
if (RVA >= startAddr) and (RVA <= EndAddr) and
((RVA - psection^.VirtualAddress) < psection^.SizeOfRawData) then
begin
Result := @Base[psection^.PointerToRawData + (RVA - startAddr)];
Break;
end;
Inc(psection);
end;
end;

function RAW2RVA(Base: PByte; RAW: UInt64;
const psection: PImageSectionHeader): UInt64;
begin
Result := RAW + psection.VirtualAddress - psection.PointerToRawData -
UInt64(Base);
end;

function RemoveExportProc64(Base: PByte; pHeader: PImageNtHeaders64;
const lpProcName: LPCSTR): boolean;
var
i, idx: Integer;
dir: PImageDataDirectory;
Ordinal: PWORD;
nameRef: PDWORD;
functions: PDWORD;
exps: PIMAGE_EXPORT_DIRECTORY;
func: DWORD;
pdos: PImageDosHeader ABSOLUTE Base;
diff: Integer;
lpFuncNameInExports: PAnsiChar;

var
psection: PImageSectionHeader;
j: Integer;
begin
Result := False;
idx := -1;

// Exit(FindMyResFunc(pm^.codeBase, lpProcName));
dir := PImageDataDirectory(@pHeader^.OptionalHeader.DataDirectory
[IMAGE_DIRECTORY_ENTRY_EXPORT]);

if (dir^.VirtualAddress = 0) or (dir^.Size = 0) then
Exit;

exps := PIMAGE_EXPORT_DIRECTORY(RVA2RAW64(Base, pHeader, dir.VirtualAddress,
psection));
RVA2RAWInSection(Base, exps^.Name, psection);

if (exps^.NumberOfFunctions = 0) then
Exit;
// 16位以上是0,那么就是用索引查找函数.
if ((NativeUInt(lpProcName)) <= $FFFF) then
begin
idx := NativeUInt(lpProcName) - exps^.Base;
end
else // 否则按照函数名称查找
begin
if (exps^.NumberOfNames = 0) then
Exit;
nameRef := PDWORD(RVA2RAWInSection(Base, exps^.AddressOfNames, psection));
Ordinal := PWORD(RVA2RAWInSection(Base, exps^.AddressOfNameOrdinals,
psection));
functions := PDWORD(RVA2RAWInSection(Base, exps^.AddressOfFunctions,
psection));
for i := 0 to exps^.NumberOfNames - 1 do
begin
lpFuncNameInExports := LPCSTR(RVA2RAWInSection(Base, nameRef[i],
psection));
if StrIComp(lpProcName, lpFuncNameInExports) = 0 then
begin
// idx函数的序号，func函数的地址
idx := exps^.Base + Ordinal[i];
func := functions[Ordinal[i]];
//
// Ordinal[0] := Ordinal[1];
{ Move(Ordinal[i + 1], Ordinal[i],
SizeOf(Word) * exps^.NumberOfFunctions - 1 - i);
}
{
Move(nameRef[i + 1], nameRef[i],
SizeOf(DWORD) * exps^.NumberOfNames - 1 - i);
nameRef[exps^.NumberOfNames - 1] := 0;
}
for j := i to exps^.NumberOfFunctions - 1 do
begin
if j = (exps^.NumberOfFunctions - 1) then
Ordinal[j] := 0
else
Ordinal[j] := Ordinal[j + 1];
end;
for j := i to exps^.NumberOfNames - 1 do
begin
if j = (exps^.NumberOfNames - 1) then
nameRef[j] := 0
else
nameRef[j] := nameRef[j + 1];
end;

// functions[Ordinal[i]] := 0;

Dec(exps^.NumberOfNames);
Dec(exps^.NumberOfFunctions);
//
Result := True;
Break;
end;
end;
end;

end;

function RemoveExportProc32(Base: PByte; pHeader: PImageNtHeaders32;
const lpProcName: LPCSTR): boolean;

var
i, idx: Integer;
dir: PImageDataDirectory;
Ordinal: PWORD;
nameRef: PDWORD;
functions: PDWORD;
exps: PIMAGE_EXPORT_DIRECTORY;
func: DWORD;
pBuf: PByte;
pdos: PImageDosHeader absolute Base;
diff: Integer;
lpFuncNameInExports: PAnsiChar;

var
psection: PImageSectionHeader;
j: Integer;
begin
Result := False;
idx := -1;

// Exit(FindMyResFunc(pm^.codeBase, lpProcName));
dir := PImageDataDirectory(@pHeader^.OptionalHeader.DataDirectory
[IMAGE_DIRECTORY_ENTRY_EXPORT]);

if (dir^.VirtualAddress = 0) or (dir^.Size = 0) then
Exit;

exps := PIMAGE_EXPORT_DIRECTORY(RVA2RAW32(Base, pHeader, dir.VirtualAddress,
psection));
RVA2RAWInSection(Base, exps^.Name, psection);

if (exps^.NumberOfFunctions = 0) then
Exit;
// 16位以上是0,那么就是用索引查找函数.
if ((NativeUInt(lpProcName)) <= $FFFF) then
begin
idx := NativeUInt(lpProcName) - exps^.Base;
end
else // 否则按照函数名称查找
begin
if (exps^.NumberOfNames = 0) then
Exit;
nameRef := PDWORD(RVA2RAWInSection(Base, exps^.AddressOfNames, psection));
Ordinal := PWORD(RVA2RAWInSection(Base, exps^.AddressOfNameOrdinals,
psection));
functions := PDWORD(RVA2RAWInSection(Base, exps^.AddressOfFunctions,
psection));
for i := 0 to exps^.NumberOfNames - 1 do
begin
lpFuncNameInExports := LPCSTR(RVA2RAWInSection(Base, nameRef[i],
psection));
if StrIComp(lpProcName, lpFuncNameInExports) = 0 then
begin
// idx函数的序号，func函数的地址
idx := exps^.Base + Ordinal[i];
func := functions[Ordinal[i]];
//
// Ordinal[0] := Ordinal[1];
{ Move(Ordinal[i + 1], Ordinal[i],
SizeOf(Word) * exps^.NumberOfFunctions - 1 - i);
}
{
Move(nameRef[i + 1], nameRef[i],
SizeOf(DWORD) * exps^.NumberOfNames - 1 - i);
nameRef[exps^.NumberOfNames - 1] := 0;
}
for j := i to exps^.NumberOfFunctions - 1 do
begin
if j = (exps^.NumberOfFunctions - 1) then
Ordinal[j] := 0
else
Ordinal[j] := Ordinal[j + 1];
end;
for j := i to exps^.NumberOfNames - 1 do
begin
if j = (exps^.NumberOfNames - 1) then
nameRef[j] := 0
else
nameRef[j] := nameRef[j + 1];
end;

// functions[Ordinal[i]] := 0;

Dec(exps^.NumberOfNames);
Dec(exps^.NumberOfFunctions);
//
Result := True;
Break;
end;
end;
end;

end;

function SpliteStr(Delimiter, Value: String; var strs: TDynArrayString)
: Integer; overload;
var
P: Integer;
Item: String;
begin
SetLength(strs, 0);

P := Pos(Delimiter, Value);
while P > 0 do
begin
Item := Copy(Value, 1, P - 1);
SetLength(strs, Length(strs) + 1);
strs[Length(strs) - 1] := Item;
Value := Copy(Value, P + Length(Delimiter), Length(Value));
P := Pos(Delimiter, Value);
end;
SetLength(strs, Length(strs) + 1);
strs[Length(strs) - 1] := Value;
end;

function _RemoveExportProc(Module: TBytes; const lpProcName: string)
: boolean; overload;
var
Base: PByte;
dos: PImageDosHeader absolute Base;
header32: PImageNtHeaders32;
header64: PImageNtHeaders64 ABSOLUTE header32;
procNames: TDynArrayString;
i: Integer;
begin
Result := False;
Base := @Module[0];
SpliteStr(',', lpProcName, procNames);
if dos.e_magic = IMAGE_DOS_SIGNATURE then
begin
header32 := PImageNtHeaders32(@Base[dos._lfanew]);
case header32.FileHeader.Machine of
IMAGE_FILE_MACHINE_I386:
begin
for i := Low(procNames) to High(procNames) do
Result := RemoveExportProc32(Base, header32,
PAnsiChar(AnsiString(procNames[i])));
end;
IMAGE_FILE_MACHINE_AMD64:
begin
for i := Low(procNames) to High(procNames) do
Result := RemoveExportProc64(Base, header64,
PAnsiChar(AnsiString(procNames[i])));
end;
end;
end;
end;

function FileOpen(const FileName: string; ReadOnly: boolean): THandle;
var
g, s: DWORD;
begin
Result := INVALID_HANDLE_VALUE;
if ReadOnly then
begin
g := GENERIC_READ;
s := FILE_SHARE_WRITE;
end
else
begin
g := GENERIC_READ or GENERIC_WRITE;
s := FILE_SHARE_WRITE or FILE_SHARE_READ;
end;
Result := CreateFile(PChar(FileName), g, FILE_SHARE_WRITE, nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
end;

function FileCreate(const FileName: string): THandle;
begin
Result := INVALID_HANDLE_VALUE;
Result := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil,
CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
end;

function FileRead(Handle: THandle; var Buffer; Count: LongWord): Integer;
begin
if not ReadFile(Handle, Buffer, Count, LongWord(Result), nil) then
Result := -1;
end;

function FileWrite(Handle: THandle; const Buffer; Count: LongWord): Integer;
begin
if not WriteFile(Handle, Buffer, Count, LongWord(Result), nil) then
Result := -1;
end;

procedure FileClose(Handle: THandle); inline;
begin
CloseHandle(Handle);
end;

function ReadAllBytes(const AFileName: string; var AData: TBytes): boolean;
var
hFile: THandle;
fSize: Int64;
begin
Result := False;
hFile := FileOpen(PChar(AFileName), True);
if hFile <> INVALID_HANDLE_VALUE then
begin
if GetFileSizeEx(hFile, fSize) and (fSize <> 0) then
begin
SetLength(AData, fSize);
Result := FileRead(hFile, AData[0], fSize) = fSize;
end;
FileClose(hFile);
end;
end;

function WriteAllBytes(const AFileName: string; AData: TBytes): boolean;
var
hFile: THandle;
fSize: Int64;
begin
Result := False;
hFile := FileCreate(PChar(AFileName));
if hFile <> INVALID_HANDLE_VALUE then
begin
if Length(AData) > 0 then
begin
Result := FileWrite(hFile, AData[0], Length(AData)) = Length(AData);
end;
FileClose(hFile);
end;
end;

function _RemoveExportProc(DLLName, NewDLLName: string;
const lpProcName: string): boolean; overload;
var
bs: TBytes;
begin
if ReadAllBytes(DLLName, bs) then
begin
_RemoveExportProc(bs, lpProcName);
WriteAllBytes(NewDLLName, bs);
end;
end;

var
DLLName, NewDLLName, ProcName: string;

begin
if not(ParamCount in [2, 3]) then
begin
Writeln('RemoveExportProc.exe DLLName ProcName,ProcName [NewDLLName]');
Writeln('eg:RemoveExportProc.exe ContextMenu64.dll  __dbk_fcall_wrapper,dbkFCallWrapperAddr,TMethodImplementationIntercept  d:\test.dll');
Readln(DLLName);
end
else
begin
DLLName := ParamStr(1);
ProcName := ParamStr(2);
if ParamCount = 3 then
NewDLLName := ParamStr(3)
else
NewDLLName := DLLName;
if not _RemoveExportProc(DLLName, NewDLLName, ProcName) then
ExitCode := -1;
end;

end.