我正在更新和转换最初在Delphi 5中创建的旧应用程序到更现代的XE7版本，并创建一个64位版本。到目前为止，我的转换已按预期进行。
我已经归结为应用程序主要部分的最后两个功能。第一个功能是分隔成 DLL 的内部插件。第二个是全局键盘挂钩，用于激活应用程序的三个功能之一，而另一个应用程序是活动应用程序并具有焦点。
对于内部插件的问题。该插件使用记录将信息传入和传出主应用程序。记录在其自己的单元中定义，主应用程序和插件 DLL 在构建时都使用该单元。目前，除了获得记录设置之外，我还没有在插件上工作。
这是插件记录的问题。该记录由插件 DLL 和主应用程序中的指针访问。当我将应用程序构建为 32 位程序时，该程序编译并运行时没有任何错误。但是，如果我将应用程序构建为 64 位程序，它会在没有任何编译器错误的情况下进行编译和构建，但是当它运行时，我在访问指向记录的指针的每一行代码上都会收到有关访问冲突的运行时错误消息。
对于全局键盘挂钩，最初使用的代码基于此代码。为此，有两个问题。第一个与上述相同，当访问指向记录的指针时。第二个问题涉及WinAPIPostMessage()函数的使用。在这两种情况下，应用都将作为 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;
记录在公共部分的应用主窗体中实例化为：
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()的所有代码行，我都会收到运行时错误访问冲突。
我已经通过谷歌搜索了从 32 位到 64 位的指针更改中的任何信息。我发现的似乎对我遇到的运行时错误没有任何帮助。
至于导致访问违规的WinAPIPostMessage()。我对此没有做太多研究。
因此，任何有关访问记录和PostMessage()的帮助都将对我有很大帮助。
编辑： 09/13/2019
为了进一步详细说明，当我构建 64 位版本的程序时，我还构建了一个新的 64 位版本的 dll。 并且我只将 64 位 dll 与 64 位程序一起使用。至于缺少的代码，我很抱歉。除了下面的代码外，没有其他方法或代码记录这些。 TGlobal 记录和全局指针在 memlocs 单元中定义，如前面单元的代码所示。并且内存单元被添加到 use 接口 use 子句中。
OpenSharedData 方法在窗体的 OnCreate 事件期间调用。CloseSharedData 在表单的 OnDestroy 事件期间调用。
主应用程序中的剩余代码：
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.
从您展示的代码来看，我能想到的最有可能的罪魁祸首是您使用不同的Record Field Alignment编译 DLL 和 EXE。32 位没有问题，因为字段在 32 位中会巧合地相同对齐，但在 64 位中不会这样做(或者您的 32 位设置是正确的，只有您的 64 位设置不正确)。
测试它的一种简单方法是使记录packed，重新生成 EXE 和 DLL，然后再次测试。
TGlobal = packed record
访问记录的最后一个字段会导致访问冲突，这将与对齐问题一致。
好吧，我终于能够自己解决问题了。在花时间远离代码之后，看看这里是否有人能够阐明这个问题。今天，我添加了一些代码来帮助我缩小实际问题所在。
事实证明，我问题的原因是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。这篇文章 64 位代码在实际程序中的问题：魔术常数很好地概述了这个问题。
有了这些新信息。我为所有三行添加了以下编译器指令代码：
MapHandle := CreateFileMapping(
{$IFDEF WIN64}
$FFFFFFFFFFFFFFFF,
{$ELSE}
$FFFFFFFF,
{$ENDIF}
nil, PAGE_READWRITE, 0, iSize, PChar(GetMMFile));
有了这个，我的程序现在可以在 32 位和 64 位中编译、构建和运行，没有任何错误。两者中都存在所需和适当的结果。
我要感谢@KenBourassa试图得到答案，并感谢他建议使用打包记录。然后我要感谢其他根本无法提供帮助的人。
谢谢大家。