寻找进程间通信中使用的Windows消息的替代方法

时间:2008-12-11 18:00:57

标签: delphi winapi windows-vista window-messages

我有一个多线程应用程序(MIDAS),它使用windows消息与自己进行通信。

主要表格

主窗体接收RDM发送的Windows消息 LogData('DataToLog')

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

  1. 收到的消息是不可分割的
  2. 收到的邮件按照发送顺序排队
  3. 问题:

    你能否在不使用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消息缓冲区变满,事情变慢

7 个答案:

答案 0 :(得分:10)

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

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

我使用Russell Libby的免费(和开源)命名管道组件。附带一个TPipeServer和一个TPipeClient可视组件。它们使命名管道非常容易使用,命名管道非常适合进程间通信(IPC)。

You can get the component here。来自源的描述是://描述:用于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.

答案 1 :(得分:2)

是 - Gabr您可以在服务中使用Windows消息。

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

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

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

Rob Kennedy的报价回答‘TService won’t process messages’

但我无法使用'frmMain.Handle'将邮件从RDM发布到Windows Vista中的主窗体。

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

答案 2 :(得分:2)

选项1:自定义消息队列

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

选项2:回调

使用回调从线程中来回发送数据。同样,使用临界区进行同步。

答案 3 :(得分:2)

OmniThreadLibraryOtlComm.pas单元中包含非常有效的邮件队列。

目前文档不是很好(start here),但您始终可以使用forum

答案 4 :(得分:0)

我将此库用于IPc(使用共享内存+互斥锁): http://17slon.com/gp/gp/gpsync.htm

它有TGpMessageQueueReader和TGpMessageQueueWriter。在名称前面使用“Global”,这样您就可以在用户登录时使用它来在Windows服务和“Service GUI Helper”之间进行通信。(由于会话安全环,Vista需要Global \前缀,而且对于用户会话之间的Windows XP / 2003)。

它非常快,多线程等等。我会使用这个而不是WM_COPYDATA(如果你经常使用它,那么速度和开销都很慢,但对于小事情,消息可以正常)

答案 5 :(得分:0)

Windows消息仍然可以在Windows Vista中使用!手头的问题是,称为用户界面权限隔离(UIPI)的远程技术可以防止具有较低完整性级别(IL)的进程向具有高IL的进程发送消息(例如,Windows服务具有高IL和用户 - 模式应用程序具有中等IL)。

然而,这可以被绕过,并且可以允许中型IL应用程序将wm发送到高IL进程。

Wikipedia says it best:

  

UIPI不是安全边界,并不旨在防范   所有破碎的攻击。 UI辅助功能   应用程序可以绕过UIPI   将其“uiAccess”值设置为TRUE   作为其清单文件的一部分。这个   要求申请在   程序文件或Windows目录,如   以及由有效代码签名   签署权威,但这些   要求不一定会停止   恶意软件尊重他们。

     

此外,仍然允许一些消息通过,例如   WM_KEYDOWN ,允许较低的IL   将输入驱动到高架的过程   命令提示符。

     

最后,功能   ChangeWindowMessageFilter允许一个   中等IL过程(均未升高   除Internet Explorer之外的进程   保护模式)更改消息   高IL进程可以接收   来自较低的IL流程。这个   有效地允许绕过UIPI,   除非从Internet Explorer运行   或其中一个子进程。

有人在Delphi-PRAXIS(链接是德语。使用Google翻译页面)已经解决了这个问题,并使用ChangeWindowMessageFilter发布了他们的代码。我相信他们的问题是WM_COPYDATA在修改代码以绕过UIPI for WM_COPYDATA之前不能在Vista上运行。

Original Link (German)

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.

答案 6 :(得分:0)

madExcept库等的创建者提供可用于代替Windows消息的IPC功能。

http://help.madshi.net/IPC.htm

我在一个阶段开发了一个Windows屏幕保护程序,我想让我的屏幕保护程序向另一个程序发送一些通知,而当屏幕保护程序处于活动状态时,我无法在两个应用程序之间使用窗口消息。

我将其替换为上述IPC功能。

做了一个款待。

豫ICP备18024241号-1