delphi - Delphi 10 版本中的 TLS(线程本地存储)回调支持
问题描述
我正在阅读这篇解释如何在 Delphi 中设置 TLS 回调的文章。文章作者说该示例适用于“Delphi: 2007, 2010, XE4, XE10”。但是我已经在 Delphi 10 Seattle、Berlin 和 Rio 上进行了测试,但它不起作用(没有执行 TLS 回调),但是当我在 Delphi XE5 上测试它时,它工作正常。
我还注意到在 Delphi XE5 和 Delphi 10 中.map
编译test_app项目时文件的大小是不同的。Delphi 10 中的文件.map
比.map
Delphi XE5 中的文件大 5 倍(分别约为 25KB 和 125KB)。
我在这里缺少什么细节?
以下是add_tls项目和test_app项目合理翻译成英文的代码。
PS: test_app项目需要设置生成文件.map
。项目>选项>链接>地图文件=>详细。
add_tls:
program add_tls;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Windows,
Classes,
SysUtils,
Generics.Collections;
procedure ShowHelp;
begin
Writeln('Usage: AddTls.exe "executable path"');
Writeln('Return Codes:');
Writeln(' - 0: TLS Callback successfully added');
Writeln(' - 1: the path to the executable file is not specified');
Writeln(' - 2: executable not found');
Writeln(' - 3: MAP file not found matching the specified file');
Writeln(' - 4: MAP file parsing error');
Writeln(' - 5: error accessing executable file');
Writeln(' - 6: there is no initialized TLS section in the executable file');
end;
type
TSectionData = record
Index: Integer;
StartAddr: DWORD;
SectionName: ShortString;
end;
TSectionDataList = TList<TSectionData>;
const
HardcodeTLS32Offset = 12;
//
// This is an easy way to search for TLS BUT tables - only in projects,
// collected in XE and above
// If the executable is built by another compiler, it will not work naturally
// but the article is not about that :)
// so:
// =============================================================================
function GetTlsTableAddr(const FilePath: string): DWORD;
var
F: TFileStream;
DOS: TImageDosHeader;
NT: TImageNtHeaders;
I: Integer;
Section: TImageSectionHeader;
begin
Result := 0;
// open the file for reading
F := TFileStream.Create(FilePath, fmOpenRead or fmShareDenyWrite);
try
// read DOS header to go to NT
F.ReadBuffer(DOS, SizeOf(TImageDosHeader));
F.Position := DOS._lfanew;
// We read the NT header to get the number of sections
F.ReadBuffer(NT, SizeOf(TImageNtHeaders));
// read sections and look for TLS
for I := 0 to NT.FileHeader.NumberOfSections - 1 do
begin
F.ReadBuffer(Section, SizeOf(TImageSectionHeader));
if PAnsiChar(@Section.Name[0]) = '.tls' then
begin
// found IMAGE_TLS_DIRECTORY, we immediately correct the AddressOfCallback field
Result := Section.PointerToRawData + HardcodeTLS32Offset;
Break;
end;
end;
finally
F.Free;
end;
end;
// just parse the map file and look for the addresses of the sections
function GetSectionDataList(const FilePath: string; var Index: Integer): TSectionDataList;
var
S: TStringList;
Line: string;
Section: TSectionData;
begin
Result := TSectionDataList.Create;
try
S := TStringList.Create;
try
S.LoadFromFile(FilePath);
Index := 0;
Writeln('I am looking for a table of sections...');
while Copy(Trim(S[Index]), 1, 5) <> 'Start' do
Inc(Index);
Inc(Index);
while Trim(S[Index]) <> '' do
begin
Line := Trim(S[Index]);
Section.Index := StrToInt(Copy(Line, 1, 4));
Delete(Line, 1, 5);
Section.StartAddr := StrToInt('$' + Copy(Line, 1, 8));
Delete(Line, 1, 19);
Section.SectionName := ShortString(Trim(Copy(Line, 1, 8)));
Result.Add(Section);
Inc(Index);
end;
Writeln('Total sections found: ', Result.Count);
finally
S.Free;
end;
except
// we suppress all exceptions. there are error codes
on E: Exception do
Writeln('GetSectionDataList: ' + E.ClassName + ': ' + E.Message);
end;
end;
// again, parse the mapfile and look for the address of the function called tls_callback
// which (if found) we summarize with the address of the section in which it is located
function GetTlsCallbackAddr(const FilePath: string;
SectionDataList: TSectionDataList; Index: Integer): DWORD;
var
S: TStringList;
Line: string;
SectionIndex, TlsAddr: Integer;
begin
Result := 0;
try
S := TStringList.Create;
try
S.LoadFromFile(FilePath);
Writeln('Looking for tls_callback...');
repeat
Line := Trim(S[Index]);
Inc(Index);
if Index = S.Count then Break;
until Pos('.tls_callback', Line) <> 0;
if Pos('.tls_callback', Line) = 0 then
begin
Writeln('No tls_callback entry found in MAP file');
Exit;
end;
SectionIndex := StrToInt(Copy(Line, 1, 4));
Delete(Line, 1, 5);
TlsAddr := StrToInt('$' + Copy(Line, 1, 8));
Writeln('tls_callback found, offset: ', IntToHex(TlsAddr, 8), ', section: ', SectionIndex);
Writeln('Looking for a record about the section...');
for Index := 0 to SectionDataList.Count - 1 do
if SectionDataList[Index].Index = SectionIndex then
begin
Result := SectionDataList[Index].StartAddr + DWORD(TlsAddr);
Writeln('TLS Callback, found in section "', SectionDataList[Index].SectionName,
'", offset sections: ', IntToHex(SectionDataList[Index].StartAddr, 8),
', calculated addressc: ', IntToHex(Result, 8));
Break;
end;
if Result = 0 then
Writeln('Section containing tls_callback not found')
finally
S.Free;
end;
except
// we suppress all exceptions. there are error codes
on E: Exception do
Writeln('GetTlsCallbackAddr: ' + E.ClassName + ': ' + E.Message);
end;
end;
// directly patch file
function Patch(const FilePath, MapPath: string; TlsTable, CallbackAddr: DWORD): Boolean;
var
F: TFileStream;
NewFilePath, BackUpFilePath: string;
OldCallbackTableAddr: DWORD;
begin
Result := False;
try
NewFilePath := ExtractFilePath(FilePath) + 'tls_aded_' +
ExtractFileName(FilePath);
Writeln('I create a copy of the file, the path: ', NewFilePath);
CopyFile(PChar(FilePath), PChar(NewFilePath), False);
F := TFileStream.Create(NewFilePath, fmOpenReadWrite);
try
Writeln('File open');
F.Position := TlsTable;
// read the address where the previous callback referred
F.ReadBuffer(OldCallbackTableAddr, 4);
// in a delphi image, it refers to the SizeOfZeroFill structure of IMAGE_TLS_DIRECTORY
// in which both last fields are filled with zeros (supposedly there is no callback chain)
// Therefore, we will not spoil the working structure and make it refer to the address
// immediately outside of this structure (plus 2 yards in 32 bit, in 64 bit)
Inc(OldCallbackTableAddr, SizeOf(DWORD) * 2);
F.Position := TlsTable;
// write a new address to the old place
F.WriteBuffer(OldCallbackTableAddr, 4);
Writeln('Assigned a new address to the chain of processors, offset: ', IntToHex(TlsTable, 8),
', new value: ', IntToHex(OldCallbackTableAddr, 8));
// now we jump to the place where the VA address of the handler (not RVA) should be written
// skip SizeOfZeroFill and Characteristics and get right behind them
F.Position := TlsTable + SizeOf(DWORD) * 3;
// and now write the address of our callback
F.WriteBuffer(CallbackAddr, 4);
Writeln('Callback address set, offset: ', IntToHex(TlsTable + SizeOf(DWORD) * 3, 8));
// after which we write zero to indicate the end of the callback chain
CallbackAddr := 0;
F.WriteBuffer(CallbackAddr, 4);
finally
F.Free;
end;
// if everything is fine, then rename back
Writeln('I create a backup');
BackUpFilePath := FilePath + '.bak';
DeleteFile(BackUpFilePath);
RenameFile(FilePath, BackUpFilePath);
Writeln('I keep the result');
RenameFile(NewFilePath, FilePath);
Writeln('All tasks completed');
Result := True;
except
// we suppress all exceptions. there are error codes
on E: Exception do
begin
// in the event of an error, we clean ourselves up - returning everything back
DeleteFile(NewFilePath);
RenameFile(BackUpFilePath, FilePath);
Writeln('Patch: ' + E.ClassName + ': ' + E.Message);
end;
end;
end;
var
MapPath: string;
TlsTable, CallbackAddr: DWORD;
SectionDataList: TSectionDataList;
Index: Integer;
begin
ExitCode := 0;
if ParamCount = 0 then
begin
ShowHelp;
ExitCode := 1;
ExitProcess(ExitCode);
end;
if not FileExists(ParamStr(1)) then
begin
Writeln('No executable found: ', ParamStr(1));
ExitCode := 2;
ExitProcess(ExitCode);
end;
TlsTable := GetTlsTableAddr(ParamStr(1));
if TlsTable = 0 then
begin
ExitCode := 6;
ExitProcess(ExitCode);
end;
MapPath := ChangeFileExt(ParamStr(1), '.map');
if not FileExists(MapPath) then
begin
Writeln('MAP file not found: ', MapPath);
ExitCode := 3;
ExitProcess(ExitCode);
end;
Index := 0;
SectionDataList := GetSectionDataList(MapPath, Index);
try
if SectionDataList.Count = 0 then
begin
Writeln('Could not build partition table');
ExitCode := 9;
ExitProcess(ExitCode);
end;
CallbackAddr := GetTlsCallbackAddr(MapPath, SectionDataList, Index);
if CallbackAddr = 0 then
begin
ExitCode := 4;
ExitProcess(ExitCode);
end;
if not Patch(ParamStr(1), MapPath, TlsTable, CallbackAddr) then
ExitCode := 5;
finally
SectionDataList.Free;
end;
ExitProcess(ExitCode);
end.
测试应用程序:
program test_app;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Windows;
// this callback will be called if the file is correctly patched
procedure tls_callback(hModule: HMODULE;
ul_reason_for_call: DWORD; lpReserved: Pointer); stdcall;
begin
if ul_reason_for_call = DLL_PROCESS_ATTACH then
MessageBox(0, 'TLS Callback Message', nil, 0);
end;
const
ptls_callback: Pointer = @tls_callback;
begin
// so that the tls_callback procedure appears in the MAP file
// you need a link to it, it’s corny like this:
if ptls_callback <> nil then
MessageBox(0, 'Entry Point Message', nil, 0);
end.
解决方案
如果您的目标是让一些代码尽快执行,这里有一些适用于任何 Delphi 修订版和任何平台(不仅是 Windows)的东西。
创建一个没有依赖关系的小单元(根本没有uses
子句)。
unit FirstLoaded;
interface
// NO "uses" clause!
implementation
procedure SomeThingToDoEarly;
begin
end;
initialization
SomeThingToDoEarly;
end.
然后将其作为uses
项目条款中的第一个单元.dpr
- 在其他任何内容之前。
program Project1;
uses
FirstLoaded, // before anything!
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
您单元部分的代码initialization
将在system.pas
.
请注意,如果您在uses
单元的子句中添加某些内容,则这些单元(及其依赖项)将首先被初始化。
推荐阅读
- c# - 检索与 ObservableCollection 的对象对应的 ListBoxItem
- c++ - 在“编译时”分配内存是什么意思?
- javascript - 获取在 Chart.js 3 中单击饼图的点的值
- python - 访问 HTML 中 span 标签的内容
- git - 当前分支没有跟踪信息。GIT问题
- java - 编写我的非智能 Nim 游戏的最佳方法?
- html - CSS-在另一个顶部添加圆形状态按钮
- python - 使用另一个数据帧更改一个数据帧中的记录值,同时保持记录中的所有其他值不变(熊猫)
- algorithm - 在这种情况下我应该使用哪种元启发式算法?
- android - Gson 不支持 MutableLiveData
在科特林