Question

在Delphi XE2中，如何在内存中设置一个特定的全局标志，该标志可以被其他进程看到，并且在创建全局标志的进程终止时不会被删除。例如：

1）ProcessA：

if CreateGlobalFlag('{B244A213-72EC-47BF-814B-2E7608F55C50}') then
  MessageDialog('GlobalFlag has been created');

2）ProcessA终止。

3）ProcessB：

boolGlobalFlagExists := IsGlobalFlagSet('{B244A213-72EC-47BF-814B-2E7608F55C50}');
if boolGlobalFlagExists then 
begin
  if RemoveGlobalFlag('{B244A213-72EC-47BF-814B-2E7608F55C50}') then
    MessageDialog('GlobalFlag has been removed');
end;

其他不了解上述GUID的流程应该无法检测到此全局标记。

如何实现这样的功能？

EDIT201406231757：
如果可能的话，全球旗帜应该存在于记忆中如果可能，该标志应该一直存在，直到Windows关闭如果可能，全局标志应该是每台机器（不是每个用户）全局标志应该在ShutDown死掉。如果可能，全局标志应该是秘密的。

Answer 1

您可能最好使用易失性注册表项，而不是使用Atom表。请参阅RegCreateKeyEx的文档。 REG_OPTION_VOLATILE将创建一个仅在内存中维护的密钥，并在卸载关联的注册表配置单元时被丢弃。

因此，如果您使用RegCreateKeyEx在REG_OPTION_VOLATILE密钥中创建HKEY_LOCAL_MACHINE密钥，该密钥将一直存在，直到机器关闭。

如果您确实需要保密内容“秘密”，则可以保护注册表项，以确保只有特定用户或群组才能阅读其内容。

这应该符合您所提出的所有要求。

Answer 2

您可以使用全局原子来保留超出进程生命周期的内存中标志。

About Atom Tables：

字符串原子的原子名称保留在全局原子表中，只要其引用计数大于零，即使在将其放入表中的应用程序终止之后也是如此。

例如：

if GlobalAddAtom('{B244A213-72EC-47BF-814B-2E7608F55C50}') <> 0 then
  MessageDialog('GlobalFlag has been created');

var
  GlobalFlag: ATOM;
begin
  GlobalFlag := GlobalFindAtom('{B244A213-72EC-47BF-814B-2E7608F55C50}');
  if GlobalFlag <> 0 then 
  begin
    SetLastError(0);
    GlobalDeleteAtom(GlobalFlag);
    if GetLastError() = 0 then
      MessageDialog('GlobalFlag has been removed');
  end;

请记住，全局原子表是一种有限的资源。它一次只能容纳少于16K的原子，这些原子用于其他全局资源，如注册的剪贴板格式。所以谨慎使用原子。

此外，无法预料的情况，如资源管理器/会话崩溃，可以擦除全局原子表，从而丢失您的标志。

Answer 3

在注意到问题得到解答之前，我曾经玩过一些原子：

program TestAtoms;

{$APPTYPE CONSOLE}

uses
  Windows;

const
  AtomName = 'bla-bla-bla-bla-bla-bla-bla';

var
  AtomValue: TAtom;

procedure Test;
begin
  AtomValue:= GlobalFindAtom(PChar(AtomName));
  if AtomValue = 0 then begin
    Writeln('Atom not found, creating');
    AtomValue:= GlobalAddAtom(PChar(AtomName));
    if AtomValue <> 0 then
      Writeln('Atom created, ', AtomValue)
    else
      Writeln('Atom create failed !!!');
  end
  else begin
    Writeln('Atom found, deleting');
    SetLastError(ERROR_SUCCESS);

    GlobalDeleteAtom(AtomValue);
    if GetLastError = ERROR_SUCCESS then
      Writeln('Atom deleted')
    else
      Writeln('Atom delete failed !!!');
  end;
end;

begin
  Test;
  Readln;
end.

<强>更新

Global Atom API不安全;对手应用程序可以轻松扫描全局原子表并找到您的原子字符串：

procedure ScanAtomTable;
var
  nAtom: TAtom;
  Buffer: array[0..1023] of Char;
  Size: Cardinal;
  S: string;

begin
  nAtom:= $C000;
  repeat
    Size:= GlobalGetAtomName(nAtom, @Buffer, 1024);
    if Size > 0 then begin
      S:= PChar(@Buffer);
      Writeln(S);
    end;
    Inc(nAtom);
  until nAtom = 0;
end;

如何在内存中设置/检测/删除全局标志，其他进程可以看到？

3 个答案: