在 64 位运行时访问指向记录的指针会导致访问冲突答案

【问题标题】：Accessing Pointer to a Record causes Access Violation at runtime in 64-bit在 64 位运行时访问指向记录的指针会导致访问冲突
【发布时间】：2019-09-13 00:24:31
【问题描述】：

我正在将最初在 Delphi 5 中创建的旧应用程序更新和转换为更现代的 XE7 版本并创建 64 位版本。到目前为止，我的转化按预期进行。

我已经归结为应用程序主要部分的最后两个功能。第一个功能是一个内部插件，它被分离成一个 DLL。第二个是全局键盘挂钩，用于激活应用程序的三个功能之一，而另一个应用程序是活动应用程序并具有焦点。

关于内部插件的问题。该插件使用记录在主应用程序之间传递信息。记录在其自己的单元中定义，主应用程序和插件 DLL 在构建时都使用该单元。目前，除了获取记录设置之外，我还没有在插件上工作过。

这是插件记录的问题。在插件 DLL 和主应用程序中，记录由指针访问。当我将应用程序构建为 32 位程序时，程序编译并运行没有任何错误。但是，如果我将应用程序构建为 64 位程序，它会在没有任何编译器错误的情况下编译和构建，但是当它运行时，我会在访问记录指针的每一行代码中收到有关访问冲突的运行时错误消息.

对于全局键盘挂钩，最初使用的代码基于this code。为此，有两个问题。第一个和上面一样，当访问指向记录的指针时。第二个问题涉及 WinAPI PostMessage() 函数的使用。在这两种情况下，应用程序都将作为 32 位程序编译、构建和运行而不会出现任何问题或错误，但作为 64 位程序会出现运行时错误 Access Violation。

插件记录代码：

unit memlocs;

interface

uses
  db, dbclient, dialogs, sysutils, windows, registry, StrUtils, classes;

function GetMMFile: String;

type
  TGlobal = record
    InstanceCount: Cardinal;
    Command: Integer;
    Param1: ShortString;
    Param2: ShortString;
    Param3: ShortString;
    Param4: ShortString;
    Param5: ShortString;
    Performed: ShortInt;
    Result: ShortString;
    Result2: ShortString;
    PromptDiv: Integer;
    Status: Byte;
    DivideHandle: THandle;
  end;

var
  Global: ^TGlobal;
  MapHandle: THandle;

const
  MMFileName: String = 'Divide';

implementation

function GetMMFile: String;
var
  sFile: String;
begin
  sFile := MMFileName;
  sFile := AnsiReplaceStr(sFile, ' ', '');
  sFile := AnsiReplaceStr(sFile, '.', '');
  sFile := AnsiReplaceStr(sFile, '(', '');
  sFile := AnsiReplaceStr(sFile, ')', '');
  Result := sFile;
end;

initialization

finalization

end.

访问记录导致访问冲突的代码：

Global.DivideHandle := Handle

全局键盘钩子中使用的记录代码：

{ The record type filled in by the hook dll}
THookRec = record
  TheHookHandle : HHOOK;
  TheAppWinHandle : HWND;
  TheCtrlWinHandle : HWND;
  TheKeyCount: DWORD;
  Keys: ShortString;
  StartStopKey: ShortString;
end;

{A pointer type to the hook record}                           
PHookRec = ^THookRec;

记录在公共部分的应用程序主窗体中实例化为：

lpHookRec: PHookRec;

访问记录并执行PostMessage() 的代码都导致访问冲突：

procedure TIDEEditor.tmKeysTimer(Sender: TObject);
begin
  if (Trim(KeyStart) <> '')
    and (KeyStart+',' = lpHookRec^.StartStopKey) then
  begin
    lpHookRec^.TheKeyCount := 0;
    lpHookRec^.Keys := '';
    lpHookRec^.StartStopKey := '';
    Postmessage(self.handle, wm_user + 912, 789, 0);
  end
  else                                                                                               
  if (Trim(KeyStop) <> '')
    and (KeyStop+',' = lpHookRec^.StartStopKey) then
  begin
    lpHookRec^.TheKeyCount := 0;
    lpHookRec^.Keys := '';
    lpHookRec^.StartStopKey := '';                            
    Postmessage(self.handle, wm_user + 913, 789, 0);
  end                                              
  else                                                                                               
  if (Trim(KeyStop) <> '')
    and (KeyStop+',' = lpHookRec^.StartStopKey) then
  begin
    lpHookRec^.TheKeyCount := 0;
    lpHookRec^.Keys := '';
    lpHookRec^.StartStopKey := '';                            
    Postmessage(self.handle, wm_user + 914, 789, 0);
  end;
end;

提醒，所有这些代码都适用于 32 位版本的应用程序。无需修改。但是，当我构建 64 位版本的应用程序时，我得到了访问记录和 PostMessage() 的所有代码行的运行时错误访问冲突。

我已通过 Google 搜索了有关从 32 位到 64 位的指针更改的任何信息。而且我的发现似乎对我遇到的运行时错误没有任何帮助。

至于导致访问冲突的 WinAPI PostMessage()。我对此没有做太多研究。

所以，任何有关访问记录和PostMessage() 的帮助对我来说都是很大的帮助。

编辑：2019 年 9 月 13 日

为了进一步详细说明，当我构建 64 位版本的程序时，我还构建了一个新的 64 位版本的 dll。我只使用 64 位 dll 和 64 位程序。至于缺少的代码，我很抱歉。除了下面的代码之外，这些记录中没有其他方法或代码。 TGlobal 记录和全局指针在 memlocs 单元中定义，如前面在该单元的代码中所示。并且在uses接口uses子句中增加了memlocs单元。

在表单的 OnCreate 事件期间调用 OpenSharedData 方法。在表单的 OnDestroy 事件期间调用 CloseSharedData。

主应用中的剩余代码：

TIDEEditor = class(TForm)

    {snip}

private

    {snip}
    // For the hooking of another process
    hHookLib: THANDLE; {A handle to the hook dll}
    GetHookRecPointer: TGetHookRecPointer; {Function pointer}
    StartKeyBoardHook: TStartKeyBoardHook; {Function pointer}
    StopKeyBoardHook: TStopKeyBoardHook; {Function pointer}

    // Divide's constants
    FKeyStart: string;
    FKeyPause: string;
    FKeyStop: string;
    FMouseKey: string;
    FKeyAC: boolean;
    FKeyGlobal: Boolean;

    {snip}

    // for the hooking of another process
    procedure CloseSharedData;
    procedure OpenSharedData(sValue: String = '');
    procedure StartHook;
    procedure StopHook;
    procedure ProcessStartKey(var Message: TMessage); message WM_USER + 912;
    procedure ProcessStopKey(var Message: TMessage); message WM_USER + 913;
    procedure ProcessMouseKey(var Message: TMessage); message WM_USER + 914;

protected

public
    { Public declarations }

    { snip }

    lpHookRec: PHookRec; {A pointer to the hook record}

    property KeyStart: string read FKeyStart write FKeyStart;
    property KeyPause: string read FKeyPause write FKeyPause;
    property KeyStop: string read FKeyStop write FKeyStop;
    property MouseKey: string read FMouseKey write FMouseKey;
    property KeyAC: boolean read FKeyAC write FKeyAC;
    property KeyGlobal: Boolean read FKeyGlobal write FKeyGlobal;

    {snip}
end;

procedure TIDEEditor.OpenSharedData(sValue: string = '');
var
    iX: Integer;
    iSize: Int64;
begin
    iSize := SizeOf(TGlobal);

    if sValue = '' then
        MapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
          0, iSize, PChar(GetMMFile))
    else
        MapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
          0, iSize, PChar(sValue));

    iX := GetLastError;
    if MapHandle = 0 then
      Exit;

    Global := MapViewOfFile(MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, iSize);

    if Global = nil then
    begin
        CloseHandle(MapHandle);
        MapHandle := 0;
        Exit;
    end;

    if iX = ERROR_ALREADY_EXISTS then
    begin
        if Global.InstanceCount = 912 then
        begin
            UnmapViewOfFile(Global);
            CloseHandle(MapHandle);
            pnlNoDecal.Visible := True;
            OpenSharedData('Divide' + IntToStr(TimeGetTime));
        end
        else
        begin
            Global.InstanceCount := 912;
            StartHook;
        end;
    end
    else
    begin
        Global.InstanceCount := 912;
    vStartHook;
    end;
end;

procedure TIDEEditor.CloseSharedData;
begin
    if MapHandle <> 0 then
    begin
        StopHook;
        Global.InstanceCount := Global.InstanceCount - 1;
        UnmapViewOfFile(Global);
        CloseHandle(MapHandle);
    end;
end;

procedure TIDEEditor.StartHook;
begin
    lpHookRec := NIL;
    LibLoadSuccess := FALSE;
    @GetHookRecPointer := NIL;
    @StartKeyBoardHook := NIL;
    @StopKeyBoardHook := NIL;

    hHookLib := LoadLibrary('DivideHook.dll');

    if hHookLib = 0 then
        Exit;

    @GetHookRecPointer := GetProcAddress(hHookLib, 'GETHOOKRECPOINTER');
    @StartKeyBoardHook := GetProcAddress(hHookLib, 'STARTKEYBOARDHOOK');
    @StopKeyBoardHook := GetProcAddress(hHookLib, 'STOPKEYBOARDHOOK');

    if (@GetHookRecPointer = NIL)
    or (@StartKeyBoardHook = NIL)
    or (@StopKeyBoardHook = NIL) then
    begin
        FreeLibrary(hHookLib);
        hHookLib := 0;
        @GetHookRecPointer := NIL;
        @StartKeyBoardHook := NIL;
        @StopKeyBoardHook := NIL;
    end
    else
    begin
        LibLoadSuccess := True;
        lpHookRec := GetHookRecPointer;
        if (lpHookRec <> nil) then
        begin
            lpHookRec^.TheHookHandle := 0;
            lpHookRec^.TheKeyCount := 0;
            lpHookRec^.Keys := '';
            StartKeyBoardHook;
        end;
    end;
end;

procedure TIDEEditor.StopHook;
begin
    if not LibLoadSuccess then
        Exit;

    if (lpHookRec = nil) then
        Exit;

    if (lpHookRec^.TheHookHandle <> 0) then
        StopKeyBoardHook;

    FreeLibrary(hHookLib);
    @GetHookRecPointer := NIL;
    @StartKeyBoardHook := NIL;
    @StopKeyBoardHook := NIL;
end;

procedure TIDEEditor.ProcessStartKey(var Message: TMessage);
var
    s: String;
    AValid: Boolean;
    ARunning: Boolean;
    APaused: Boolean;

begin
    AValid := IDEEngine1.ActiveScript <> nil;
    ARunning := AValid and IDEEngine1.Scripter.Running;
    APaused := AValid and IDEEngine1.Scripter.Paused;

    if Message.WParam = 789 then
        if not KeyGlobal then
            Exit
    else
        if not KeyAC then
            Exit;

    lpHookRec^.TheKeyCount := 0;
    lpHookRec^.Keys := '';
    if ARunning and not APaused then
        acPauseExecute(nil)
    else
        acRunExecute(nil);                                                
end;

procedure TIDEEditor.ProcessStopKey(var Message: TMessage);
var
    AValid: Boolean;
    ARunning: Boolean; 

begin
    AValid := IDEEngine1.ActiveScript <> nil;
    ARunning := AValid and IDEEngine1.Scripter.Running;

    lpHookRec^.TheKeyCount := 0;
    lpHookRec^.Keys := '';
    if ARunning then
        acResetExecute(nil);
end;

procedure TIDEEditor.ProcessMouseKey(var Message: TMessage);
var
    AValid: Boolean;
    ARunning: Boolean; 

begin
    AValid := IDEEngine1.ActiveScript <> nil;
    ARunning := AValid and IDEEngine1.Scripter.Running;

    lpHookRec^.TheKeyCount := 0;
    lpHookRec^.Keys := '';
    if not ARunning then
      acQuickMousePosExecute(nil);
end;

dll的代码：

    library DivideHook;

uses
  System.SysUtils,
  System.Classes,
  Windows, Winapi.Messages;

{$R *.res}

{Define a record for recording and passing information process wide}
type
    PHookRec = ^THookRec;

    THookRec = record
        TheHookHandle: HHook;
        TheAppWinHandle: HWND;
        TheCtrlWinHandle: HWND;
        TheKeyCount: DWORD;
        Keys: ShortString;
        StartStopKey: ShortString;
     end;

var
    hObjHandle: THandle; {Variable for the file mapping object}
    lpHookRec: PHookRec; {Pointer to our hook record}

procedure MapFIleMemory(dwAllocSize: DWORD);
begin
    {Create a process wide memory mapped variable}
    hObjHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, dwAllocSize, 'DivideHookRecMemBlock');
    if (hObjHandle = 0) then
    begin
        MessageBox(0, 'Divide Hook DLL', 'Could not create file map object', MB_OK);
        exit;
    end;
    {Get a pointer to our process wide memory mapped variable}
    lpHookRec := MapViewOfFile(hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
    if (lpHookRec = nil) then
    begin
        CloseHandle(hObjHandle);
        MessageBox(0, 'Divice Hook DLL', 'Could not map file', MB_OK);
        exit;
    end;
end;

procedure UnMapFileMemory;
begin
    {Delete our process wide memory mapped variable}
    if (lpHookRec <> nil) then
    begin
        UnmapViewOfFile(lpHookRec);
        lpHookRec := nil;
    end;

    if (hObjHandle > 0) then
    begin
        CloseHandle(hObjHandle);
        hObjHandle := 0;
    end;
end;

function GetHookRecPointer: pointer stdcall;
begin
    {Return a pointer to our process wide memory mapped variable}
    result := lpHookRec;
end;

{The function that actually processes the keystrokes for our hook}
function KeyBoardProc(Code: integer; wParam: integer; lParam: integer): integer; stdcall;
var
    KeyUp: bool;
    IsAltPressed: bool;
    IsCtrlPressed: bool;
    IsShiftPressed: bool;
    s: string;
begin
    result := 0;

    case Code of
        HC_ACTION:
        begin
            {We trap the keystrokes here}

            {Is this a key up message?}
            KeyUp := ((lParam AND (1 shl 31)) <> 0);

            {Is the Alt key pressed}
            IsAltPressed := ((lParam AND (1 shl 29)) <> 0);

            {Is the Control key pressed}
            IsCtrlPressed := ((GetKeyState(VK_CONTROL) AND (1 shl 15)) <> 0);

            {if the Shift key pressed}
            IsShiftPressed := ((GetKeyState(VK_SHIFT) AND (1 shl 15)) <> 0);

            {If KeyUp then increment the key count}
            if (KeyUp <> FALSE) then
            begin
                if (wParam < VK_SHIFT) or (wParam > VK_MENU) then
                begin
                    Inc(lpHookRec^.TheKeyCount);
                    s := '';
                    if IsAltPressed then
                    s := s + '@';
                    if IsCtrlPressed then
                    s := s + '^';
                    if IsShiftPressed then
                    s := s + '~';
                    s := s + FormatFloat('000', wParam) + ',';
                    if Length(lpHookRec^.Keys) > 200 then
                    begin
                        lpHookRec^.Keys := Copy(lpHookRec^.Keys,
                        Pos(',', lpHookRec^.Keys) + 1, Length(lpHookRec^.Keys));
                    end;
                    lpHookRec^.Keys := lpHookRec^.Keys + s;
                    lpHookRec^.StartStopKey := s;
                end;
            end;
            result := 0;
        end;

        HC_NOREMOVE:
        begin
            {This is a keystroke message, but the keystroke message}
            {has not been removed from the message queue, since an}
            {application has called PeekMessage() specifying PM_NOREMOVE}
            result := 0;
            exit;
        end;
    end; {case code}

    if (Code < 0) then
    {Call the next hook in the hook chain}
    result := CallNextHookEx(lpHookRec^.TheHookHandle, Code, wParam, lParam);
end;

procedure StartKeyBoardHook; stdcall;
begin
    {If we have a process wide memory variable}
    {and the hook has not already been set...}
    if ((lpHookRec <> NIL) AND (lpHookRec^.TheHookHandle = 0)) then
    begin
        {Set the hook and remember our hook handle}
        lpHookRec^.TheHookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyBoardProc, hInstance, 0);
    end;
end;

procedure StopKeyBoardHook; stdcall;
begin
    {If we have a process wide memory variable}
    {and the hook has already been set...}
    if ((lpHookRec <> NIL) AND (lpHookRec^.TheHookHandle <> 0)) then
    begin
        {Remove our hook and clear our hook handle}
        if (UnHookWindowsHookEx(lpHookRec^.TheHookHandle) <> FALSE) then
        begin
            lpHookRec^.TheHookHandle := 0;
        end;
    end;
end;

procedure DllEntryPoint(dwReason : DWORD);
begin
    case dwReason of
        Dll_Process_Attach :
        begin
            {If we are getting mapped into a process, then get}
            {a pointer to our process wide memory mapped variable}
            hObjHandle := 0;
            lpHookRec := NIL;
            MapFileMemory(sizeof(lpHookRec^));
        end;
        Dll_Process_Detach :
        begin
            {If we are getting unmapped from a process then, remove}
            {the pointer to our process wide memory mapped variable}
            UnMapFileMemory;
        end;
    end;
end;

exports
    KeyBoardProc name 'KEYBOARDPROC',
    GetHookRecPointer name 'GETHOOKRECPOINTER',
    StartKeyBoardHook name 'STARTKEYBOARDHOOK',
    StopKeyBoardHook name 'STOPKEYBOARDHOOK';

begin
    {Set our Dll's main entry point}
    DLLProc := @DllEntryPoint;
    {Call our Dll's main entry point}
    DllEntryPoint(Dll_Process_Attach);
end.

【问题讨论】：

您没有显示实际分配Global 和lpHookRec 的代码。请这样做。它们只是指针，它们实际上指向的是什么？这将是你问题的根源。
调试也会有所帮助。确定哪个指针无效。
您不应该构建 64 位版本的 DLL 吗？
基于您仅在 64 位应用程序中获得 AV 的事实，我怀疑您正在尝试在 64 位应用程序中使用 32 位版本的 DLL，这将不起作用。 64 位应用程序需要 64 位 DLL。
我不相信可以在 64 位应用程序中使用 32 位 .DLL。但可能是 64 位 .DLL 的接口是一个整数（在 64 位程序中仍然是 32 位 - 至少在 Windows 上），然后将其转换为指针。如果你想编程多位大小，你应该声明这样的整数“NativeInt”（它随着目标 CPU 大小而变化 - 至少在 Windows 上）。消息也有同样的问题，如果那是运输的话。从 64 位到 32 位程序，参数会被截断到 32 位，从 32 位到 64 位，一个是零扩展，另一个是符号扩展。

标签： delphi 64-bit delphi-xe7

【解决方案1】：

从您显示的代码中，我能想到的最可能的罪魁祸首是您使用不同的Record Field Alignment 编译 DLL 和 EXE。 32 位没有问题，因为字段会巧合地在 32 位中对齐，但不要在 64 位中这样做（或者您的 32 位设置是正确的，只有您的 64 位设置不正确）。

一个简单的测试方法是记录packed，重建你的EXE和DLL，然后再次测试。

TGlobal = packed record

访问记录的最后一个字段会导致访问冲突，这与对齐问题是一致的。

【讨论】：

我刚刚添加了 dll 的代码。在原始程序中，在 Delphi 5 中完成，两个记录都被打包。但是，我通过谷歌找到的所有信息都表明当前编译器不再需要打包记录。但是，我会将它们重新添加并进行重建。
我真的很想阅读您所谈论的信息，因为这与...嗯，几乎所有我所知道的主题相矛盾。
我按照原始代码和您的建议将记录打包。我仍然能够编译构建 64 位版本的 dll 和应用程序。但是，我仍然收到运行时访问冲突错误。 @Ken Bourassa 至于信息，这里有一个指向 Embarcadero DocWiki 的链接，上面写着 docwiki.embarcadero.com/RADStudio/Rio/en/…
我不太相信您链接到的文档。首先，它非常模糊。 2nd，它指的是{$OLDTYPELAYOUT ON}，它是关于曾经被打包在记录中的字段，而不是打包记录本身。然后它还提到Because data alignment can change, it is a good idea to pack any record structure that you intend to write to disk or pass in memory to another module compiled using a different version of the compiler.所以是的......在我得到更好的信息之前，我会坚持打包记录。
至于你的问题，我能做的心理调试就这么多了。

【解决方案2】：

好吧，我终于能够自己解决问题了。在花时间远离代码后，看看这里是否有人能够阐明这个问题。今天，我去添加了一些代码来帮助我缩小问题所在。

事实证明，我的问题的原因在于 OpenSharedData 方法中的这些行。

    MapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
      0, iSize, PChar(GetMMFile))

    MapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
      0, iSize, PChar(sValue));

以及钩子 dll 中的这一行：

hObjHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, dwAllocSize, 'DivideHookRecMemBlock');

似乎没有创建内存映射文件并且返回了它的句柄。这反过来又没有分配记录指针。并在运行时导致访问冲突。

在做了一个很短的谷歌搜索后，我发现问题实际上是那些行中使用的 $FFFFFFFF。这篇Problems of 64-bit code in real programs: magic constants的文章很好的概括了这个问题。

有了这些新信息。我为所有三行添加了以下编译器指令代码：

MapHandle := CreateFileMapping(
{$IFDEF WIN64}
$FFFFFFFFFFFFFFFF,
{$ELSE}
$FFFFFFFF,
{$ENDIF}
nil, PAGE_READWRITE, 0, iSize, PChar(GetMMFile));

这样，我的程序现在可以在 32 位和 64 位下编译、构建和运行，没有任何错误。并且两者都存在所需和正确的结果。

我要感谢@KenBourassa 试图获得答案以及他对使用打包记录的建议。然后我要感谢其他没有提供任何帮助的人。

谢谢大家。

【讨论】：

更好的解决方法是尊重文档并使用 INVALID_HANDLE_VALUE。如果我们得到 128 位操作系统，您的代码将再次崩溃。