关于VISTA下命名管道的问题（全文搜索DNS错误，只好提问了）(300分)

ThenLong · 2008-02-28

大家都知道： VISTA下系统服务和桌面程序已经隔离了 所以许多通信机制失效了 经过查找资料和试验最终决定选用命名管道(namedPipe)来通信 但现在遇到新的问题难以解决 情况是这样的 BHO(BrowserHelpObject)插件需要与系统服务通信 系统服务建立的管道（例如//./pipe/mypipe）， BHO中只能读这个管道，而写不了。。。 说明：前提是不关闭UAC，也不关闭浏览器的安全模式 有高手能解答或给出别的通信机制吗？谢谢

LSUPER · 2008-02-29

可以通过 sendmessage，不同的是，接收端需要声明可以接受该用户级别的消息。 具体可以参考哦 innosetup 源码中的 debug 机制。 这是由于 vista 的 uac 等限制 inno 做的若干修改。

LSUPER · 2008-02-29

看看这段代码： unit DebugClient; {   Inno Setup   Copyright (C) 1997-2006 Jordan Russell   Portions by Martijn Laan   For conditions of distribution and use, see LICENSE.TXT.   Debug info stuff   $jrsoftware: issrc/Projects/DebugClient.pas,v 1.23 2006/10/01 02:42:36 jr Exp $ } interface uses   Windows, SysUtils, Messages, DebugStruct; var   Debugging: Boolean;   DebugClientCompiledCodeText: String;   DebugClientCompiledCodeDebugInfo: String; function DebugNotify(Kind: TDebugEntryKind; Index: Integer;   var ADebugContinueStepOver: Boolean): Boolean; procedure DebugNotifyException(Exception: String; Kind: TDebugEntryKind; Index: Integer); function DebugNotifyIntermediate(Kind: TDebugEntryKind; Index: Integer;   var ADebugContinueStepOver: Boolean): Boolean; procedure DebugNotifyLogMessage(const Msg: String); procedure DebugNotifyTempDir(const Dir: String); procedure DebugNotifyUninstExe(UninstExe: String); procedure EndDebug; procedure SetDebugWnd(Wnd: HWND; WantCodeText: Boolean); implementation uses   Forms, Classes, CmnFunc2, Main; type   TDummyClass = class   private     class procedure DebugClientWndProc(var Message: TMessage);   end; var   DebugWnd: HWND;   DebugClientWnd: HWND;   DebugContinue: Boolean;   DebugContinueStepOver: Boolean; procedure SetDebugWnd(Wnd: HWND; WantCodeText: Boolean); const   MSGFLT_ADD = 1; var   ChangeWindowMessageFilter: function(msg: UINT; dwFlag: DWORD): BOOL; stdcall;   I: Integer; begin   { On Vista, unprivileged processes can't send messages to elevated processes     by default. Allow the debugger (which normally runs unprivileged) to send     messages to us. }   ChangeWindowMessageFilter := GetProcAddress(GetModuleHandle(user32),     'ChangeWindowMessageFilter');   if Assigned(ChangeWindowMessageFilter) then     for I := Low(DebugClientMessages) to High(DebugClientMessages) do       ChangeWindowMessageFilter(DebugClientMessages, MSGFLT_ADD);   Debugging := True;   DebugWnd := Wnd;   DebugClientWnd := AllocateHWnd(TDummyClass.DebugClientWndProc);   SendMessage(DebugWnd, WM_Debugger_Hello, WPARAM(DebugClientWnd), LPARAM(WantCodeText)); end; procedure EndDebug; begin   Debugging := False;   if DebugWnd <> 0 then begin     SendMessage(DebugWnd, WM_Debugger_Goodbye, 0, 0);     DebugWnd := 0;   end;   if DebugClientWnd <> 0 then begin     DeallocateHWnd(DebugClientWnd);     DebugClientWnd := 0;   end; end; function InternalDebugNotify(DebuggerMsg: UINT; Kind: TDebugEntryKind;   Index: Integer; var ADebugContinueStepOver: Boolean): Boolean; { Returns True if the debugger paused. ADebugContinueStepOver is set to True   if the debugger paused and the user resumed via Step Over, False otherwise. } var   SaveAppTitle: String;   WindowList: Pointer;   Msg: TMsg;   TopWindow: HWND; begin   Result := False;   ADebugContinueStepOver := False;   if not Debugging then     Exit;   DebugContinue := False;   if SendMessage(DebugWnd, DebuggerMsg, Ord(Kind), Index) = 0 then begin     { Don't pause }     Exit;   end;   Result := True;   { Wait until we get clearance to continue }   SaveAppTitle := Application.Title;   WindowList := DisableTaskWindows(0);   try     Application.Title := '[Paused] ' + SaveAppTitle;     while not DebugContinue do begin       case Integer(GetMessage(Msg, 0, 0, 0)) of         -1: Break; { if GetMessage failed }         0: begin              { Repost WM_QUIT messages }              PostQuitMessage(Msg.WParam);              Break;            end;       end;       TranslateMessage(Msg);       DispatchMessage(Msg);     end;     ADebugContinueStepOver := DebugContinueStepOver;   finally     EnableTaskWindows(WindowList);     Application.Title := SaveAppTitle;   end;   { Bring us back to the foreground, unless we've been detached }   if Debugging then begin     TopWindow := GetThreadTopWindow;     if TopWindow <> 0 then begin       { First ask the debugger to call SetForegroundWindow() on our window. If         we don't do this then Windows (98/2000+) will prevent our window from         becoming activated if the debugger is currently in the foreground. }       SendMessage(DebugWnd, WM_Debugger_SetForegroundWindow, WPARAM(TopWindow), 0);       { Now call SetForegroundWindow() ourself. Why? When a remote thread         calls SetForegroundWindow(), the request is queued; the window doesn't         actually become active until the next time the window's thread checks         the message queue. This call causes the window to become active         immediately. }       SetForegroundWindow(TopWindow);     end;   end; end; function DebugNotify(Kind: TDebugEntryKind; Index: Integer;   var ADebugContinueStepOver: Boolean): Boolean; begin   Result := InternalDebugNotify(WM_Debugger_Stepped, Kind, Index,     ADebugContinueStepOver); end; function DebugNotifyIntermediate(Kind: TDebugEntryKind; Index: Integer;   var ADebugContinueStepOver: Boolean): Boolean; begin   Result := InternalDebugNotify(WM_Debugger_SteppedIntermediate, Kind, Index,     ADebugContinueStepOver); end; procedure DebugNotifyException(Exception: String; Kind: TDebugEntryKind; Index: Integer); var   B: Boolean; begin   SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_Exception,     Exception);   InternalDebugNotify(WM_Debugger_Exception, Kind, Index, B); end; procedure DebugNotifyTempDir(const Dir: String); begin   SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_TempDir, Dir); end; procedure DebugNotifyUninstExe(UninstExe: String); begin   SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_UninstExe, UninstExe); end; procedure DebugNotifyLogMessage(const Msg: String); begin   SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_LogMessage, Msg); end; class procedure TDummyClass.DebugClientWndProc(var Message: TMessage); var   VariableDebugEntry: TVariableDebugEntry;   EvaluateExp, EvaluateResult: String; begin   try     case Message.Msg of       WM_DebugClient_Detach: begin           Debugging := False;           DebugWnd := 0;           { If it's paused, force it to continue }           DebugContinue := True;           DebugContinueStepOver := False;           { Make the GetMessage call in DebugNotify return immediately }           PostMessage(0, 0, 0, 0);         end;       WM_DebugClient_Continue: begin           DebugContinue := True;           DebugContinueStepOver := Message.wParam = 1;           { Make the GetMessage call in DebugNotify return immediately }           PostMessage(0, 0, 0, 0);         end;       WM_DebugClient_SetForegroundWindow: begin           SetForegroundWindow(HWND(Message.WParam));         end;       WM_COPYDATA: begin           case TWMCopyData(Message).CopyDataStruct.dwData of             CD_DebugClient_EvaluateConstant: begin                 try                   SetString(EvaluateExp, PChar(TWMCopyData(Message).CopyDataStruct.lpData),                     TWMCopyData(Message).CopyDataStruct.cbData);                   try                     ConstReadOnly := True;                     try                       EvaluateResult := ExpandConst(EvaluateExp);                     finally                       ConstReadOnly := False;                     end;                     Message.Result := 1;                   except                     EvaluateResult := GetExceptMessage;                     Message.Result := 2;                   end;                   SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_Reply,                     EvaluateResult);                 except                   { don't propogate exceptions }                 end;               end;             CD_DebugClient_EvaluateVariableEntry: begin                 try                   Move(TWMCopyData(Message).CopyDataStruct.lpData^, VariableDebugEntry, SizeOf(VariableDebugEntry));                   try                     if CodeRunner = nil then                       raise Exception.Create('Cannot evaluate variable because

代码:

isn''t running yet');                     EvaluateResult := CodeRunner.EvaluateUsedVariable(VariableDebugEntry.Param1,                       VariableDebugEntry.Param2, VariableDebugEntry.Param3, VariableDebugEntry.Param4);                     Message.Result := 1;                   except                     EvaluateResult := GetExceptMessage;                     Message.Result := 2;                   end;                   SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_Reply,                     EvaluateResult);                 except                   { don't propogate exceptions }                 end;               end;             CD_DebugClient_CompiledCodeText: begin                 try                   DebugClientCompiledCodeText := '';                   SetString(DebugClientCompiledCodeText, PChar(TWMCopyData(Message).CopyDataStruct.lpData),                     TWMCopyData(Message).CopyDataStruct.cbData);                   Message.Result := 1;                 except                   { don't propogate exceptions }                 end;               end;             CD_DebugClient_CompiledCodeDebugInfo: begin                 try                   DebugClientCompiledCodeDebugInfo := '';                   SetString(DebugClientCompiledCodeDebugInfo, PChar(TWMCopyData(Message).CopyDataStruct.lpData),                     TWMCopyData(Message).CopyDataStruct.cbData);                   Message.Result := 1;                 except                   { don't propogate exceptions }                 end;               end;           end;         end;     else       with Message do         Result := DefWindowProc(DebugClientWnd, Msg, WParam, LParam);     end;   except     Application.HandleException(nil);   end end; end.

ThenLong · 2008-02-29

谢了，我先研究下 如果消息机制能用起来，那么我的程序架构的修改将最小 ps:论坛限制300分，解决之后另开贴给200分

ThenLong · 2008-03-11

接受答案了.

关于VISTA下命名管道的问题（全文搜索DNS错误，只好提问了）(300分)

ThenLong

Unregistered / Unconfirmed

LSUPER

Unregistered / Unconfirmed

LSUPER

Unregistered / Unconfirmed

ThenLong

Unregistered / Unconfirmed

ThenLong

Unregistered / Unconfirmed

Similar threads