访问记录指针会导致 64 位运行时出现访问冲突

Question

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

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

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

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

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

插件记录代码：

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;

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

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 记录和 Global 指针在 memlocs 单元内定义，如前面单元代码中所示。并且 memlocs 单元被添加到 uses 接口 uses 子句中。

在窗体的 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.

Answer 1

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

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

TGlobal = packed record

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

Answer 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');

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

在进行了非常简短的 Google 搜索后，我发现问题实际上出在那些行中使用了 $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 位中编译、构建和运行s，没有任何错误。并且两者都存在所需的正确结果。

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

谢谢大家

访问记录指针会导致 64 位运行时出现访问冲突

Accessing Pointer to a Record causes Access Violation at runtime in 64-bit

delphi

64-bit

delphi-xe7