Question

我有一个delphi应用程序加载一个delphi 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应用程序的句柄。

最后两个功能尚未实现。如果需要，我可以发布接收器代码，但它可以与其他构建为'sender'的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你需要使用 ChangeWindowMessageFilter

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

1 个答案: