将消息从 Delphi DLL 传递到应用程序

Question

我有一个德尔福应用程序加载了一个德尔福 dll，它会将消息发送回它。为了进行测试，我让 dll 向另一个应用程序发送消息，但它们没有显示。

DLL 代码

type
  TSampleRecord = packed record
    card : string[50];
  end;
var
  handle: HWND;
procedure PrepareDLL(AppHandle : HWND); stdcall;
begin
  handle := AppHandle;
end;
procedure ConfigccDLL(Variables: PChar); stdcall;
var
  sampleRecord: TSampleRecord;
  copyDataStruct: TCopyDataStruct;
  receiverHandle: HWND;
begin
  sampleRecord.card := 'FakeCard';
  copyDataStruct.dwData := Integer(2);
  copyDataStruct.cbData := SizeOf(sampleRecord);
  copyDataStruct.lpData := @sampleRecord;
  receiverHandle := FindWindow(PChar('TReceiverMainForm'),PChar('ReceiverMainForm'));
  SendMessage(receiverHandle, WM_COPYDATA, Integer(Handle), Integer(@copyDataStruct));
end;

接收器代码

type
  TSampleRecord = packed record
    card : string[50];
  end;
  TReceiverMainForm = class(TForm)
    cdMemo: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    procedure WMCopyData(var Msg : TWMCopyData); message WM_COPYDATA;
    procedure HandleCopyDataRecord(copyDataStruct : PCopyDataStruct);
  end;
var
  ReceiverMainForm: TReceiverMainForm;
implementation
procedure TReceiverMainForm.FormCreate(Sender: TObject);
begin
  cdMemo.Clear;
end;
procedure TReceiverMainForm.HandleCopyDataRecord(
  copyDataStruct: PCopyDataStruct);
var
  CodeRcvd: string;
  sampleRecord : TSampleRecord;
begin
  sampleRecord.card := TSampleRecord(CopyDataStruct.lpData^).card;
  CodeRcvd := '$B';
  cdMemo.Lines.Add(Format('Received record at %s',[DateToStr(Now)]));
  cdMemo.Lines.Add(CodeRcvd);
  cdMemo.Lines.Add(Format('sampleRecord.card = %s',[sampleRecord.card]));
  cdMemo.Lines.Add(Format('sampleRecord size: %d %d',[SizeOf(sampleRecord), copyDataStruct.cbData]));
end;
procedure TReceiverMainForm.WMCopyData(var Msg: TWMCopyData);
begin
  cdMemo.Lines.Add(Format('WM_CopyData from: %d',[msg.From]));
  HandleCopyDataRecord(Msg.CopyDataStruct);
  msg.Result := cdMemo.Lines.Count;
end;
end.

PrepareDLL通过调用DLL的delphi应用程序的句柄传递。

最后两个函数尚未实现。如果需要，我可以发布接收器代码，但它与其他构建为"发送者"的 delphi 应用程序一起工作正常。

函数本身被调用得很好，ShowMessage（） 函数调用工作。

我已经检查了SendMessage和RaiseLastError的返回代码，它们都表示成功。

我有一种感觉，这可能与 UIPI 有关，但我已经使用 ProcessExplorer 检查了两个应用程序的"完整性"，并且它们都设置为中等。

这是在Windows Vista上。

Answer 1

只有在 Receiver 以管理员身份运行时，它才在 Windows 10 上对我不起作用。在这种情况下，您需要以下内容才能允许它。

type
  TChangeFilterStruct = packed record
    cbSize: DWORD;
    ExtStatus: DWORD;
  end;
  PChangeFilterStruct = ^TChangeFilterStruct;
const
  MSGFLT_ALLOW = 1;
  MSGFLT_DISALLOW = 2;
  MSGFLT_RESET = 0;
{$WARN SYMBOL_PLATFORM OFF}
function ChangeWindowMessageFilterEx(Wnd: HWND; Message: UINT; Action: DWORD;
  ChangeFilterStruct: PChangeFilterStruct): Bool; stdcall; external 'User32.dll' delayed;
{$WARN SYMBOL_PLATFORM ON}

    ChangeWindowMessageFilterEx(ReceiverWindowHandle, WM_COPYDATA, MSGFLT_ALLOW, nil);

更新实际上这个功能只存在于Windows 7之后，对于Vista你需要使用更改窗口消息筛选器