Question

我的故事是我正在设计一个必须与Windows服务通信的新应用。经过大量研究后，我得出结论，命名管道是推荐的方法（How do I send a string from one instance of my Delphi program to another?）但是，由于安全问题，我似乎无法在Win7中使用SendMessage或命名管道......消息永远不会到达在申请服务之外。

我正在使用Russell Libby的名为Pipe的组件，这些组件在普通桌面应用程序之间毫无障碍地工作，但Windows服务似乎在解决方案中占了一席之地。进一步的研究告诉我，双方都可以开放安全性让他们进行沟通，但是，我对此的知识水平最低限度，而且我无法对可能的API调用做出正面或反面的讨论。

基于Delphi组件pipes.pas，需要做些什么来打开这个宝宝，这样双方才能开始交谈？我确定pipes.pas文件中的以下两个函数可以识别安全属性，是否有人能够帮助我在这里？

谢谢！

procedure InitializeSecurity(var SA: TSecurityAttributes);
var
  sd: PSecurityDescriptor;
begin

  // Allocate memory for the security descriptor
  sd := AllocMem(SECURITY_DESCRIPTOR_MIN_LENGTH);

  // Initialize the new security descriptor
  if InitializeSecurityDescriptor(sd, SECURITY_DESCRIPTOR_REVISION) then
  begin
    // Add a NULL descriptor ACL to the security descriptor
    if SetSecurityDescriptorDacl(sd, True, nil, False) then
    begin
      // Set up the security attributes structure
      SA.nLength := SizeOf(TSecurityAttributes);
      SA.lpSecurityDescriptor := sd;
      SA.bInheritHandle := True;
    end
    else
      // Failed to init the sec descriptor
      RaiseWindowsError;
  end
  else
    // Failed to init the sec descriptor
    RaiseWindowsError;

end;

procedure FinalizeSecurity(var SA: TSecurityAttributes);
begin

  // Release memory that was assigned to security descriptor
  if Assigned(SA.lpSecurityDescriptor) then
  begin
    // Reource protection
    try
      // Free memory
      FreeMem(SA.lpSecurityDescriptor);
    finally
      // Clear pointer
      SA.lpSecurityDescriptor := nil;
    end;
  end;

end;

Answer 1

Windows Vista，Seven和2008强制使用命名管道，例如参见http://blogs.technet.com/b/nettracer/archive/2010/07/23/why-does-anonymous-pipe-access-fail-on-windows-vista-2008-windows-7-or-windows-2008-r2.aspx

Answer 2

我试图实现这个：

function GetUserSid(var SID: PSID; var Token: THandle): boolean;
var TokenUserSize: DWORD;
    TokenUserP: PSIDAndAttributes;
begin
  result := false;
  if not OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token) then
    if (GetLastError <> ERROR_NO_TOKEN) or
       not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token) then
      Exit;
  TokenUserP := nil;
  TokenUserSize := 0;
  try
    if not GetTokenInformation(Token, TokenUser, nil, 0, TokenUserSize) and
       (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
      Exit;
    TokenUserP := AllocMem(TokenUserSize);
    if not GetTokenInformation(Token, TokenUser, TokenUserP,
       TokenUserSize, TokenUserSize) then
      Exit;
    SID := TokenUserP^.Sid;
    result := true;
  finally
    FreeMem(TokenUserP);
  end;
end;

function ConvertSidToStringSidA(aSID: PSID; var aStr: PAnsiChar): BOOL; stdcall; external advapi32;
function ConvertStringSecurityDescriptorToSecurityDescriptorA(
  StringSecurityDescriptor: PAnsiChar; StringSDRevision: DWORD;
  SecurityDescriptor: pointer; SecurityDescriptorSize: Pointer): BOOL; stdcall; external advapi32;

const
  SDDL_REVISION_1 = 1;

procedure InitializeSecurity(var SA: TSecurityAttributes; var SD; Client: boolean);
var OK: boolean;
    Token: THandle;
    pSidOwner: PSID;
    pSid: PAnsiChar;
    SACL: AnsiString;
begin
  fillchar(SD,SECURITY_DESCRIPTOR_MIN_LENGTH,0);
  // Initialize the new security descriptor
  OK := false;
  if InitializeSecurityDescriptor(@SD, SECURITY_DESCRIPTOR_REVISION) then begin
    if Client or (OSVersionInfo.dwMajorVersion<6) then
      // before Vista: add a NULL descriptor ACL to the security descriptor
      OK := SetSecurityDescriptorDacl(@SD, true, nil, false)
     else begin
      // since Vista: need to specify special ACL
      if GetUserSid(pSidOwner,Token) then
      try
        if ConvertSidToStringSidA(pSidOwner,pSid) then
        try
          SACL := 'D:(A;;GA;;;'+pSID+')(A;;GWGR;;;AN)(A;;GWGR;;;WD)S:(ML;;NW;;;S-1-16-0)';
          OK := ConvertStringSecurityDescriptorToSecurityDescriptorA(
            pointer(SACL),SDDL_REVISION_1,@SD,nil);
        finally
          LocalFree(PtrUInt(pSid));
        end;
      finally
        FreeSid(pSidOwner);
        CloseHandle(Token);
      end;
    end;
  end;
  if OK then begin
    // Set up the security attributes structure
    SA.nLength := sizeof(TSecurityAttributes);
    SA.bInheritHandle := true;
    SA.lpSecurityDescriptor := @SD;
  end else
    fillchar(SA,sizeof(SA),0); // mark error: no security
end;

它似乎在服务器端工作（即安全属性是按预期创建的），您必须编写客户端代码，而不必忘记在 SYSTEM \ CurrentControlSet \ Services \中添加管道名称lanmanserver \ parameters \ NullSessionPipes 注册表项，如预期的那样。

Answer 3

当我们将产品从Win 2K迁移到Win7时，我们运行了命名管道退出工作。在与MS（以及275美元）交谈2周后，我们发现它是由使用共享文件夹文件设置引起的。取消选中此功能可以让我们继续使用管道。

Answer 4

我似乎记得RemObjects在其包中有一个命名管道客户端/服务器控件。除非你有预算，否则我强烈建议你看一下这样的事情的成品组件。为了做到这一点既耗时又棘手。

另外，Justin Smyth现在有一篇关于命名管道的文章。在这里查看他关于这个主题的博客：http://smythconsulting.blogspot.com/2011/07/smartmediaplayer-pipes-part4.html

祝你好运！

Answer 5

我遇到了同样的问题并且解决了它。对我来说，它没有工作的原因是因为Russels TPipe实现在管道创建之前检查了线程ID：if not(Sync.SyncBaseTID = FNotifyThread) then..

原来我在我服务的错误位置创建了TPipeServer。（我覆盖DoStart等而不是使用事件OnStart ...不要这样做！）我现在正在同一个线程中创建TPipeServer实例，稍后我将其激活。

命名管道从Windows服务到客户端应用程序

5 个答案: