Delphi 10版本中的TLS（线程本地存储）回调支持

我正在阅读这篇文章，解释如何在Delphi中设置TLS回调。文章作者说，该示例在Delphi上运行：2007、2010、XE4、XE10。但是我已经在Delphi10西雅图、柏林和里约热内卢上进行了测试，它不工作TLS回调没有执行，但是当我在Delphi XE5上测试它时，它工作得很好

我还注意到，在delphixe5和delphi10中编译test_应用程序项目时，.map文件的大小是不同的。Delphi 10中的.map文件比Delphi XE5中的.map文件大5倍，分别约25KB和125KB

我在这里遗漏了什么细节

以下是add_tls项目和test_app项目的合理英语翻译代码

PS：需要设置test_应用程序项目以生成.map文件。项目>选项>链接>映射文件=>详细信息

添加\u 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

创建一个小单元，完全没有依赖关系no uses子句

unit FirstLoaded;

interface

// NO "uses" clause!

implementation

procedure SomeThingToDoEarly;
begin
end;

initialization
  SomeThingToDoEarly;
end.

然后将它作为第一个单元放在project.dpr的uses子句中，然后再放在其他单元之前

program Project1;

uses
  FirstLoaded, // before anything!
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

单元初始化部分的代码将在system.pas之后调用

---

请注意，如果您在单元的uses子句中添加了一些内容，那么这些单元及其依赖项将首先初始化。

值得注意的是，没有XE10这样的东西。您试图解决的问题是什么？当最后一个使用D10版本编译时，为什么没有将TLS回调添加到test_应用程序中？这里测试了D10西雅图、柏林、里约热内卢、DXE7、DXE5；只有在DXE5上才有效。但你到底想做什么？我经常使用TLS，我需要看到任何像这样的需要。我经常使用TLS，我需要看到任何像这样的需要。我认为你没有用这种方法链接文章。这就是为什么如果你能用这个黑客代码解释你试图解决的问题会很有帮助。我的直觉是，这不是解决你问题的办法。