Delphi 正在寻找进程间通信中使用的windows消息的替代方案

我有一个多线程应用程序（MIDAS），它利用windows消息与自身通信

主要形式

主窗体接收RDM发送的windows消息 日志数据（'DataToLog'）

由于使用了windows消息，因此它们具有以下属性

收到的信息是不可分割的

接收到的消息按发送顺序排队

问题：

你能推荐一种不用windows消息的更好的方法吗

主表单代码

const
    UM_LOGDATA      = WM_USER+1002;

type

  TLogData = Record
      Msg        : TMsgNum;
      Src        : Integer;
      Data       : String;
  end;
  PLogData = ^TLogData;


  TfrmMain = class(TForm)
  //  
  private
    procedure LogData(var Message: TMessage);        message UM_LOGDATA;
  public
  //        
  end;


procedure TfrmMain.LogData(var Message: TMessage);
var LData : PLogData;
begin
    LData  :=  PLogData(Message.LParam);
    SaveData(LData.Msg,LData.Src,LData.Data);
    Dispose(LData);
end;

RDM代码

procedure TPostBoxRdm.LogData(DataToLog : String);
var
  WMsg  : TMessage;
  LData : PLogData;
  Msg   : TMsgNum;
begin
  Msg := MSG_POSTBOX_RDM;
  WMsg.LParamLo := Integer(Msg);
  WMsg.LParamHi := Length(DataToLog);
  new(LData);
    LData.Msg    := Msg;
    LData.Src    := 255;
    LData.Data   := DataToLog;
  WMsg.LParam := Integer(LData);
  PostMessage(frmMain.Handle, UM_LOGDATA, Integer(Msg), WMsg.LParam);
end;

编辑：

为什么要删除windows邮件：

• 我想将应用程序转换为windows服务
• 当系统繁忙时，windows消息缓冲区将满，速度会减慢

---

选项1：自定义消息队列

您可以构建自定义消息队列，将消息推送到队列中，根据业务规则对队列进行排序，并从主线程弹出队列中的消息进行处理。使用关键部分进行同步

选项2：回调

使用回调从线程来回发送数据。同样，使用关键部分进行同步。

在

OtlComm.pas

单元中包含非常有效的消息队列

---

文档目前不是很好（），但您始终可以使用。

是–Gabr您可以在服务中使用windows消息

==============================

在Windows Vista之前，您可以将服务配置为与桌面交互。这使得服务与登录用户在同一桌面上运行，因此以该用户身份运行的程序可以向服务的窗口发送消息。不过，Windows Vista隔离了服务；它们不能再与任何用户的桌面交互

=============================

罗布·肯尼迪的一段话

但我将无法使用“frmMain.Handle”将消息从RDM发布到windows Vista中的主窗体

---

我所需要做的就是找到一种不同的方式来发布和接收消息

使用命名管道。如果你不知道如何使用它们，那么现在是学习的时候了

使用命名管道，您可以发送任何类型的数据结构（只要服务器和客户端都知道该数据结构是什么）。我通常使用一组记录来来回发送大量信息。非常方便

我使用Russell Libby的免费（开源）命名管道组件。附带一个TPipeServer和一个TPipeClient可视组件。它们使使用命名管道变得非常简单，命名管道对于进程间通信（IPC）非常有用

。源代码中的描述是：//description:Delphi的客户机和服务器命名管道组件集，如下所示 //还有一个控制台管道重定向组件

此外，Russell在Experts Exchange上帮助我使用该组件的旧版本在控制台应用程序中工作，通过命名管道发送/接收消息。这可能有助于指导您使用他的组件。请注意，在VCL应用程序或服务中，您不需要像我在这个控制台应用程序中那样编写自己的消息循环

program CmdClient;
{$APPTYPE CONSOLE}

uses
  Windows, Messages, SysUtils, Pipes;

type
  TPipeEventHandler =  class(TObject)
  public
     procedure  OnPipeSent(Sender: TObject; Pipe: HPIPE; Size: DWORD);
  end;

procedure TPipeEventHandler.OnPipeSent(Sender: TObject; Pipe: HPIPE; Size: DWORD);
begin
  WriteLn('On Pipe Sent has executed!');
end;

var
  lpMsg:         TMsg;
  WideChars:     Array [0..255] of WideChar;
  myString:      String;
  iLength:       Integer;
  pcHandler:     TPipeClient;
  peHandler:     TPipeEventHandler;

begin

  // Create message queue for application
  PeekMessage(lpMsg, 0, WM_USER, WM_USER, PM_NOREMOVE);

  // Create client pipe handler
  pcHandler:=TPipeClient.CreateUnowned;
  // Resource protection
  try
     // Create event handler
     peHandler:=TPipeEventHandler.Create;
     // Resource protection
     try
        // Setup clien pipe
        pcHandler.PipeName:='myNamedPipe';
        pcHandler.ServerName:='.';
        pcHandler.OnPipeSent:=peHandler.OnPipeSent;
        // Resource protection
        try
           // Connect
           if pcHandler.Connect(5000) then
           begin
              // Dispatch messages for pipe client
              while PeekMessage(lpMsg, 0, 0, 0, PM_REMOVE) do DispatchMessage(lpMsg);
              // Setup for send
              myString:='the message I am sending';
              iLength:=Length(myString) + 1;
              StringToWideChar(myString, wideChars, iLength);
              // Send pipe message
              if pcHandler.Write(wideChars, iLength * 2) then
              begin
                 // Flush the pipe buffers
                 pcHandler.FlushPipeBuffers;
                 // Get the message
                 if GetMessage(lpMsg, pcHandler.WindowHandle, 0, 0) then DispatchMessage(lpMsg);
              end;
           end
           else
              // Failed to connect
              WriteLn('Failed to connect to ', pcHandler.PipeName);
        finally
           // Show complete
           Write('Complete...');
           // Delay
           ReadLn;
        end;
     finally
        // Disconnect event handler
        pcHandler.OnPipeSent:=nil;
        // Free event handler
        peHandler.Free;
     end;
  finally
     // Free pipe client
     pcHandler.Free;
  end;

end.

---

Windows消息仍可在Windows Vista中使用！目前的问题是vista中一种称为用户界面特权隔离（UIPI）的技术阻止完整性级别（IL）较低的进程向IL较高的进程发送消息（例如，windows服务的IL较高，用户模式应用的IL中等）

但是，这可以绕过，并且允许中等IL应用程序向高IL进程发送wm

UIPI不是一个安全边界，其目的不是防止 所有粉碎攻击。用户界面可访问性 应用程序可以通过以下方式绕过UIPI 将其“uiAccess”值设置为TRUE 作为他们清单文件的一部分。这 要求应用程序位于 程序文件或Windows目录，如 以及由有效代码签名 签署权限，但这些 需求不一定会停止 恶意软件不尊重他们

此外，某些消息仍然允许通过，例如 WM_KEYDOWN，允许较低的IL 将输入驱动到提升驱动器的进程 命令提示符

最后，函数 ChangeWindowMessageFilter允许 中等IL流程（均为非高架 除Internet Explorer之外的进程 保护模式）更改消息 一个高IL进程可以接收 从一个较低的IL过程。这 有效地允许绕过UIPI， 除非从Internet Explorer运行 或者它的一个子进程

Delphi PRAXIS的某人（链接是德语的。使用谷歌翻译页面）已经解决了这个问题，并使用ChangeWindowMessageFilter发布了他们的代码。我相信他们的问题是，除非他们修改代码以绕过UIPI以获得WM_COPYDATA，否则WM_COPYDATA将无法在Vista上工作

单位μmin；
接口
使用
窗口、消息、系统工具、变体、类、图形、控件、窗体、，
对话框、ExtCtrls、StdCtrls、uallHook、uallProcess、uallUtil、uallKernel；
类型
TfrmMain=类（TForm）
lbl1:TLabel；
秃鹰：TTimer；
mmo1:TMemo；
过程表单创建（发送方：ToObject）；
程序tmrSearchCondorTimer（发送方：TObject）；
销毁程序表（发送方：TObject）；
私有的
{私营部门}
fCondorPID:DWord；
fInjected：布尔型；
fDontWork：布尔型；
程序搜索秃鹰；
程序功能；
程序卸载功能；
函数GetDebugPrivileges:布尔；
过程WriteText（s:字符串）；
程序WMNOTIFYCD（var Msg:TWMCopyData）；消息WM_COPYDATA；
公开的
{酒吧
unit uMain; 

interface 

uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, ExtCtrls, StdCtrls, uallHook, uallProcess, uallUtil, uallKernel; 

type 
  TfrmMain = class(TForm) 
    lbl1: TLabel; 
    tmrSearchCondor: TTimer; 
    mmo1: TMemo; 
    procedure FormCreate(Sender: TObject); 
    procedure tmrSearchCondorTimer(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen } 
    fCondorPID : DWord; 
    fInjected : Boolean; 
    fDontWork : Boolean; 
    procedure SearchCondor; 
    procedure InjectMyFunctions; 
    procedure UnloadMyFunctions; 
    function GetDebugPrivileges : Boolean; 
    procedure WriteText(s : string); 
    procedure WMNOTIFYCD(var Msg: TWMCopyData); message WM_COPYDATA; 
  public 
    { Public-Deklarationen } 
  end; 

var 
  frmMain: TfrmMain; 
  ChangeWindowMessageFilter: function (msg : Cardinal; dwFlag : Word) : BOOL; stdcall; 

implementation 

{$R *.dfm} 

type Tmydata = packed record 
       datacount: integer; 
       ind: boolean; 
     end; 

const cCondorApplication = 'notepad.exe'; 
      cinjComFuntionsDLL = 'injComFunctions.dll'; 

var myData : TMydata; 

procedure TfrmMain.WMNOTIFYCD(var Msg: TWMCopyData); 
begin 
  if Msg.CopyDataStruct^.cbData = sizeof(TMydata) then 
  begin 
    CopyMemory(@myData,Msg.CopyDataStruct^.lpData,sizeof(TMyData)); 
    WriteText(IntToStr(mydata.datacount)) 
  end; 
end; 

procedure TfrmMain.WriteText(s : string); 
begin 
  mmo1.Lines.Add(DateTimeToStr(now) + ':> ' + s); 
end; 

procedure TfrmMain.InjectMyFunctions; 
begin 
  if not fInjected then begin 
    if InjectLibrary(fCondorPID, PChar(GetExeDirectory + cinjComFuntionsDLL)) then fInjected := True; 
  end; 
end; 

procedure TfrmMain.UnloadMyFunctions; 
begin 
  if fInjected then begin 
    UnloadLibrary(fCondorPID, PChar(GetExeDirectory + cinjComFuntionsDLL)); 
    fInjected := False; 
  end; 
end; 

procedure TfrmMain.SearchCondor; 
begin 
  fCondorPID := FindProcess(cCondorApplication); 
  if fCondorPID <> 0 then begin 
    lbl1.Caption := 'Notepad is running!'; 
    InjectMyFunctions; 
  end else begin 
    lbl1.Caption := 'Notepad isn''t running!'; 
  end; 
end; 

procedure TfrmMain.FormDestroy(Sender: TObject); 
begin 
  UnloadMyFunctions; 
end; 

function TfrmMain.GetDebugPrivileges : Boolean; 
begin 
  Result := False; 
  if not SetDebugPrivilege(SE_PRIVILEGE_ENABLED) then begin 
    Application.MessageBox('No Debug rights!', 'Error', MB_OK); 
  end else begin 
    Result := True; 
  end; 
end; 

procedure TfrmMain.FormCreate(Sender: TObject); 
begin 
  @ChangeWindowMessageFilter := GetProcAddress(LoadLibrary('user32.dll'), 'ChangeWindowMessageFilter'); 
  ChangeWindowMessageFilter(WM_COPYDATA, 1); 
  fInjected := False; 
  fDontWork := not GetDebugPrivileges; 
  tmrSearchCondor.Enabled := not fDontWork; 
end; 

procedure TfrmMain.tmrSearchCondorTimer(Sender: TObject); 
begin 
  tmrSearchCondor.Enabled := False; 
  SearchCondor; 
  tmrSearchCondor.Enabled := True; 
end; 

end.