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

时间：2019-09-13 00:24:31

标签： delphi 64-bit delphi-xe7

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

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

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

这是插件记录的问题。可以通过插件DLL和Main应用程序中的指针访问该记录。当我将应用程序构建为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位程序一起使用。至于缺少的代码，对不起。除下面的代码外，没有其他方法或代码可以记录。 Tmem记录单元中定义了TGlobal记录和Global指针，如之前在该单元的代码中所示。然后将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.

2 个答案:

答案 0 :(得分：0)

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

一种简单的测试方法是记录packed，重新生成EXE和DLL，然后再次测试。

TGlobal = packed record

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

答案 1 :(得分：-1)

好吧，我终于可以自己解决问题了。在花了一些时间去看代码之后，看看这里是否有人可以阐明这个问题。今天，我去添加了一些代码来帮助我缩小实际问题所在的范围。

事实证明，我遇到问题的原因是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位上编译，构建和运行，而没有任何错误。并在两者中都提供了所需的适当结果。

我要感谢@KenBourassa尝试给出答案以及他对使用打包记录的建议。然后，我要感谢其他根本无法提供帮助的人。

谢谢大家。

相关问题
最新问题