弹出一个非阻塞对话框（在程序关闭后 仍然显示对话框）

Posted 2020-08-04

今天有个小需求, 程序要求执行一个检测操作, 如果检测失败的话则弹出信息并且关闭程序

由于检测代码是封装到一个独立进程里的, 所以直接使用TerminateProcess(GetCurrentProcess, 0);来关闭当前进程

可是在测试时却发现, 原本使用MessageBox来弹出消息却会阻塞结束进程的操作

一般我们在系统里弹出对话框都是调用Windows.MessageBox, 这个方法在一般情况下, 可以不阻塞本程序的操作(虽然在代码层面仍然是阻塞的)

 

大家可以用一个小例子试试

procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageBox(0, ‘测试内容1‘, ‘测试标题‘, MB_OK);
  MessageBox(0, ‘测试内容2‘, ‘测试标题‘, MB_OK);
end;

实际情况执行以后, 点击按钮弹出第一个对话框, 这时, 虽然程序界面仍然可以移动输入等执行其他操作, 但是测试内容2却没有弹出

只有吧第一个对话框关闭以后, 第2个对话框才能弹出来

所以, 猜测MessageBox的非阻塞只是在内部处理了对当前进程的消息循环, 但是代码层面并没有返回并向后执行, 所以并不是真正意义上的非阻塞

 

那需求怎么办呢.......

 

伟大的Google, 码农们需要你的时候来了(虽然这几天Google又被伟大的GFW给墙了...不过咱们可以换IP...嘿嘿 你懂的: 啦啦啦)

终于搜到一个相关的文章, 关于在win7下如果让一个服务向用户界面推送消息的问题: 穿透Session0隔离

其中有一个关键性函数: WTSSendMessage, 可以向指定的Session发送消息

既然是想Session发送消息, 那肯定是桌面级的, 和应用程序无关了呗, 咱们再看看他的定义: WTSSendMessage function

显然, 最后一个参数是控制是否阻塞等待的, 看来这就是我要的东西了, 马上写代码试试:

补充一下, 不知道为什么 这个自从XP就出现的函数, 直到Delphi XE5都没有被定义到Windows单元中, 而其他的2个WTS相关函数却定义了(也许定义到其他单元我没找到?)

const
  WTS_CURRENT_SERVER_HANDLE = 0;

function WTSSendMessage(Server: HWND; SessionId: DWORD; Title: PChar;
  TitleLength: DWORD; AMessage: PChar; MessageLength: DWORD; Style: DWORD;
  Timeout: DWORD; var Response: DWORD; Wait: Boolean): Boolean; stdcall;
  external ‘wtsapi32.dll‘ name ‘WTSSendMessageA‘;

function WTSGetActiveConsoleSessionId: DWORD; stdcall;
  external kernel32 name ‘WTSGetActiveConsoleSessionId‘;


procedure TForm1.Button1Click(Sender: TObject);
var
  nTitle, nMessage: string;
  nResponse: DWORD;
begin
  nTitle := ‘测试标题‘;
  nMessage := ‘测试内容1‘;
  WTSSendMessage(WTS_CURRENT_SERVER_HANDLE, WTSGetActiveConsoleSessionId,
    PChar(nTitle), Length(nTitle), PChar(nMessage), Length(nMessage),
    MB_OK, 0, nResponse, False);
  nMessage := ‘测试内容2‘;
  WTSSendMessage(WTS_CURRENT_SERVER_HANDLE, WTSGetActiveConsoleSessionId,
    PChar(nTitle), Length(nTitle), PChar(nMessage), Length(nMessage),
    MB_OK, 0, nResponse, False);
end;

执行测试一下, 我擦....居然还是必须先吧内容1确定了以后才能弹出内容2? 难道是我理解错了不成?

单步跟踪一下...#^&%^*

不对啊, 弹出了内容1马上就执行到内容2的代码了啊, 然后就直接end结束了, 可是为什么只弹出了1个对话框呢?

再补充一下测试

const
  WTS_CURRENT_SERVER_HANDLE = 0;

function WTSSendMessage(Server: HWND; SessionId: DWORD; Title: PChar;
  TitleLength: DWORD; AMessage: PChar; MessageLength: DWORD; Style: DWORD;
  Timeout: DWORD; var Response: DWORD; Wait: Boolean): Boolean; stdcall;
  external ‘wtsapi32.dll‘ name ‘WTSSendMessageA‘;

function WTSGetActiveConsoleSessionId: DWORD; stdcall;
  external kernel32 name ‘WTSGetActiveConsoleSessionId‘;


procedure TForm1.Button1Click(Sender: TObject);
var
  nTitle, nMessage: string;
  nResponse: DWORD;
begin
  nTitle := ‘测试标题‘;
  nMessage := ‘测试内容1‘;
  WTSSendMessage(WTS_CURRENT_SERVER_HANDLE, WTSGetActiveConsoleSessionId,
    PChar(nTitle), Length(nTitle), PChar(nMessage), Length(nMessage),
    MB_OK, 0, nResponse, False);
  nMessage := ‘测试内容2‘;
  WTSSendMessage(WTS_CURRENT_SERVER_HANDLE, WTSGetActiveConsoleSessionId,
    PChar(nTitle), Length(nTitle), PChar(nMessage), Length(nMessage),
    MB_OK, 0, nResponse, False);
  TerminateProcess(GetCurrentProcess, 0);
end;

看看这样, 执行结果, 果然 程序关闭了, 但是只有内容1的对话框, 确定以后才弹出内容2的

个人猜测, 应该是WTSSendMessage以类似消息队列方式给Session发对话框消息, 而对于Session的处理, 则必须是阻塞的, 估计是为了能够让用户知道多条消息的先后顺序吧

 

无所谓啦, 只要程序不阻塞就行, 搞定....嘿嘿嘿嘿.......

http://www.cnblogs.com/hs-kill/p/3797103.html