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

0
votes

I am in the process of updating and converting an old application originally created in Delphi 5 to a more modern version XE7 and for creating a 64-bit version. And so far my conversion has gone as expected.

I have come down to the last two features for the Main portion of the application. The first feature is an internal plugin that is separated into a DLL. And the second is a global keyboard hook to activate one of three features of the application while another application is the active app and has focus.

For the problem with the internal plugin. The plugin uses a record to pass information to and from the main app. The record is defined in its own unit that is used by both the main app and the plugin DLL as they are built. At this time, I have not worked on the Plugin beyond getting the record setup.

Here is the problem with plugin record. The record is accessed by a pointer, in both the plugin DLL and the Main app. When I build the app as a 32-bit program, the program compiles and runs without any errors. But, if I build the app as a 64-bit program, it compiles and builds without any compiler errors, but when it is run I get a Runtime Error message about an Access Violation at every line of code that accesses the pointer to the record.

For the Global Keyboard hook, the code that was originally used is based on this code. For this, there are two problems. The first is the same as the above, when accessing the pointer to the record. The second problem deals with the use of the WinAPI PostMessage() function. In both cases, the app will compile, build, and run without any issue or errors as a 32-bit program, but has a runtime error Access Violation as a 64-bit program.

Plugin Record code:

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.

Code to access record that gives the Access Violation:

Global.DivideHandle := Handle

The code for record used in the Global Keyboard hook:

{ 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;

The record is instantiated in the app's main form in the public section as:

lpHookRec: PHookRec;

Code that accesses the record and does the PostMessage(), both cause an Access Violation:

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;

Reminder, all of this code works in the 32-bit version of the app. No modification is necessary. But, when I build the 64-bit version of the app, I get a RunTime Error Access Violation for all lines of code that access the records and the PostMessage().

I have searched through Google for any information in changes for the pointers from 32-bit to 64-bit. And what I have found does not seem to offer any help with the runtime error that I am getting.

As for the WinAPI PostMessage() causing the Access Violation. I have not done much research on that.

So, any help with the accessing of the records and the PostMessage() would be a great help to me.

EDIT: 09/13/2019

To further elaborate, when i build the 64-bit version of the program I also build a new 64-bit version of the dll. and I only use the 64-bit dll with the 64-bit program. As for the the missing code, I am sorry. With the exception of the code below, there is no other methods or code that those records. The TGlobal record and the Global pointer are defined within the memlocs unit, as previously shown in the code for the unit. And the memlocs unit is added to the uses interface uses clause.

The OpenSharedData method is called during the form's OnCreate event. The CloseSharedData is called during the form's OnDestroy event.

Remaining code in the main app:

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;

The code for the 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
delphi64-bitdelphi-xe7
You didn't show the code that actually allocates Global and lpHookRec. Please do so. They are just pointers, what are they actually pointing at? That is going to be the root of your issues. - Remy Lebeau
Debugging will help too. Identify which pointer is invalid. - David Heffernan
Shouldn't you be building a 64-bit version of the DLL? - Pat Heuvel
Based on te fact that you are getting AV only in 64 bit of your application I suspect that you are trying to use 32 bit version of your DLL in your 64 bit application which won't work. You need 64 bit DLL's for 64 bit applications. - SilverWarior
I don't believe it is possible to use a 32-bit .DLL in a 64-bit application. But it could be that the interface to the 64-bit .DLL is an integer (which is still 32-bit in 64-bit program - at least on Windows) that is then cast to a pointer. If you want to program multi-bit-size, you should declare such integers "NativeInt" (which shifts with the target CPU size - at least on Windows). Same problem with messages, if that's the transportation. From 64-bit to 32-bit programs, the parameters will be truncated to 32-bit, and from 32-bit to 64-bit one will be zero extended, the other sign extended. - HeartWare

2 Answers

0
votes

From the code you show, the most likely culprit I can come up with is that you compile the DLL and your EXE with a different Record Field Alignment. There is no problem in 32 bits because fields will coincidentally align identically in 32 bits, but don't do so in 64 bits (Or your 32 bits setting are correct and only your 64 bits settings aren't).

An easy way to test it is by making your record packed, rebuild both your EXE and DLL, and test it again.

TGlobal = packed record

Accessing the last field of the record causes the access violation, that would be coherent with an alignment problem.

-1
votes

Well, I was finally able to solve the problem myself. After spending time away from the code to see if anyone here would be able to shed some light on the problem. Today, I went and added some code to help me narrow down what line of was actually the problem.

It turns out that the cause of my issues is with these lines in the OpenSharedData method.

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

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

and this line in the hook dll:

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

It seemed that the Memory Mapped File was not being created and the Handle to it being returned. Which in turn was not assigning the record pointers. And causing the Access Violations at run time.

After doing a very short Google search I found that the problem was actually the $FFFFFFFF being used in those lines. This article Problems of 64-bit code in real programs: magic constants outlines the issue very well.

With that new information. I added the following compiler directive code for all three lines:

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

With that my program now compiles, builds, and runs in both 32-bit and 64-bit without any errors. And the required and proper results are present in both.

I would like to thank @KenBourassa for attempting to have an answer and his recommendation for the use of packed records. And then I would like to thank everyone else that was not able to help at all.

I thank you all.