Конференция "Corba" » COM связь между двумя пользователями
 
  • Дмитрий Белькевич (15.07.10 20:27) [0]
    Приложение-клиент, запущенное из-под юзера SYSTEM, пытается через COM подключиться к другому приложению-серверу, запущенному под текущим залогиненным пользователем. Такое подключение клиенту не удаётся, запускается еще одна копия приложения-сервера.

    Можно ли как-то подключиться к уже запущенному COM серверу?
  • Игорь Шевченко © (15.07.10 20:42) [1]
    COM работает через сообщения, а сообщения не передаются между десктопами.
  • Дмитрий Белькевич (15.07.10 22:02) [2]
    Понятно, была надежда обойтись малой кровью. Как лучше выполнить взаимодействие приложения с сервисом?
  • Дмитрий Белькевич (16.07.10 18:37) [3]
    Нашел:

    http://www.delphimaster.ru/articles/named_pipes/

    " Именованные каналы являются наиболее простым способом организации связи между сервисами и пользовательскими приложениями, нуждающимися в такой связи."

    Спасибо, Игорь, за статью, буду разбираться.
  • Дмитрий Белькевич (16.07.10 22:46) [4]
    Нашел еще такое:

    Создание именованых каналов. Автор: Стас "Hexorg" Пономарёв.

    http://forum.sources.ru/index.php?showtopic=140047

    Сделал из этого более удобоваримый класс, не могу понять, почему приходит мусор в буфере в этой строке:


    if ReadFile(Pipe, FPipeData[0], 1024, FPipeDataLength, nil) then



    Весь класс:


    TPipeThread = class(TThread)
    private
     FPipeData:       array[0..1023] of byte;
     FPipeDataLength: DWord;
     FOnDataReceived: TNotifyEvent;
     FPipeName:       string;
     procedure DoDataReceived;
    protected
     procedure Execute; override;
    public
     constructor Create(const PipeName: string; CreateSuspended: boolean);
     procedure CopyDataToBuffer(var Buffer: TDAByte);
     class function SendToPipe(const PipeName: string; const Buffer: TDAByte): integer;
     property OnDataReceived: TNotifyEvent Read FOnDataReceived Write FOnDataReceived;
    end;

    procedure TPipeThread.CopyDataToBuffer(var Buffer: TDAByte);
    var
    i: integer;
    begin
    SetLength(Buffer, FPipeDataLength);
    for i := 0 to FPipeDataLength - 1 do
     Buffer[i] := FPipeData[i];
    end;

    constructor TPipeThread.Create(const PipeName: string; CreateSuspended: boolean);
    begin
    FPipeName := PipeName;
    inherited Create(CreateSuspended);
    end;

    procedure TPipeThread.DoDataReceived;
    begin
    if Assigned(FOnDataReceived) then
     FOnDataReceived(Self);
    end;

    procedure TPipeThread.Execute;
    var
    Pipe: THandle; //Указатель на наш канал
    // bytesRead: DWORD;  //Количество прочитанных байт
    begin
    Pipe := CreateNamedPipe(PChar('\\.\PIPE\' + FPipeName), //Наше имя
     PIPE_ACCESS_INBOUND,         // сервер может только читать канал
     PIPE_WAIT or                 // Синхронная работа
     PIPE_READMODE_MESSAGE or     // метод чтения - пакеты
     PIPE_TYPE_MESSAGE,
     {PIPE_UNLIMITED_INSTANCES}1, // Бесконечно много клиентов
     1024,                        //размер буфера чтения
     1024,                        // размер буфера записи
     100,                         // Тайм-аут
     nil);                        // Артрибуты безопасности.
    if Pipe = INVALID_HANDLE_VALUE then
     Exit; //Если не удалось создать канал, то выходим

    while True do //Теперь читаем, пока не надоест!
     try
      //Подключаемся к каналу, второй параметр нужен только, если вместо PIPE_WAIT вы указали PIPE_NOWAIT
      ConnectNamedPipe(Pipe, nil);
      //Теперь читаем, параметры – указатель на канал, наш буфер, кол-во прочитанных байт, и последнее опять таки только для PIPE_NOWAIT.
      if ReadFile(Pipe, FPipeData[0], 1024, FPipeDataLength, nil) then
       Synchronize(DoDataReceived);//Синхронизируемся с главным потоком
     finally
      DisconnectNamedPipe(Pipe);
     end;
    end;

    class function TPipeThread.SendToPipe(const PipeName: string; const Buffer: TDAByte): integer;
    var
    Pipe: THandle;
    BytesWritten: DWORD;
    begin
    Result := 0;
    Pipe := CreateFile(PChar('\\.\PIPE\' + PipeName),
     GENERIC_WRITE,          //Только запись
     FILE_SHARE_READ or      // Обмениваемся чтенью\записью
     FILE_SHARE_WRITE, nil,  //Артрибуты безопасности
     OPEN_EXISTING,          // Канал должен быть создан
     0, 0);
    if Pipe = INVALID_HANDLE_VALUE then
     Exit;
    if WriteFile(Pipe, Buffer, Length(Buffer), BytesWritten, nil) then
    begin
     DisconnectNamedPipe(Pipe); //Если удачно запиали, закрываем канал.
     Result := BytesWritten;
    end;
    end;


  • Сергей М. © (27.07.10 09:32) [5]
    Как объявлен TDAByte ?
  • _oIo_ (27.07.10 20:42) [6]

    > COM работает через сообщения, а сообщения не передаются
    > между десктопами.

    В огороде бузина, а в Киеве дядя
  • Германн © (28.07.10 02:04) [7]

    > _oIo_   (27.07.10 20:42) [6]
    >
    >
    > > COM работает через сообщения, а сообщения не передаются
    > > между десктопами.
    >
    > В огороде бузина, а в Киеве дядя
    >

    А на ДМ новый аноним.
  • Дмитрий Белькевич (31.07.10 10:43) [8]
    TDAByte = TBytes.

    Окончательный вариант на данный момент, в предыдущей версии какие-то особенности с указателями на TBytes и разыменованием были, скорее всего, лень было разбираться в ассемблере, переделал на буфер-строку:


    unit PipeThread;
    {
    Original idea (c) 2006 Стас "Hexorg" Пономарёв.
    http://forum.sources.ru/index.php?showtopic=140047
    Some fixes and improvements (c) 2010 Dmitry Belkevich
    http://makhaon.com
    }


    interface

    uses
    Classes, Windows, SysUtils;

    type
    TPipeData = string[255];

    TPipeThread = class(TThread)
    private
     FPipeData:       TPipeData;
     FPipeDataLength: DWord;
     FOnDataReceived: TNotifyEvent;
     FPipeName:       string;
     procedure DoDataReceived;
     function GetPipeData: string;
    protected
     procedure Execute; override;
    public
     constructor Create(const PipeName: string; CreateSuspended: boolean);
     destructor Destroy; override;
     class function SendToPipe(const PipeName: string; Data: TPipeData; DataLength: integer): integer;
     class function CreatePipe(const PipeName: string): THandle;
     class function PipeExists(const PipeName: string): boolean;
     property OnDataReceived: TNotifyEvent Read FOnDataReceived Write FOnDataReceived;
     property PipeData: string Read GetPipeData;
    end;

    implementation

    { TPipeThread }

    constructor TPipeThread.Create(const PipeName: string; CreateSuspended: boolean);
    begin
    FPipeName := PipeName;
    inherited Create(CreateSuspended);
    end;

    class function TPipeThread.CreatePipe(const PipeName: string): THandle;
    begin
    Result := CreateNamedPipe(PChar('\\.\PIPE\' + PipeName), //Наше имя
     PIPE_ACCESS_INBOUND,         // сервер может только читать канал
     PIPE_WAIT or                 // Синхронная работа
     PIPE_READMODE_MESSAGE or     // метод чтения - пакеты
     PIPE_TYPE_MESSAGE,
     PIPE_UNLIMITED_INSTANCES,    // Бесконечно много клиентов
     256 * SizeOf(char),          //размер буфера чтения
     256 * SizeOf(char),          // размер буфера записи
     100,                         // Тайм-аут
     nil);                        // Артрибуты безопасности.
    end;

    destructor TPipeThread.Destroy;
    begin
    Terminate;
    PipeExists(FPipeName);
    inherited;
    end;

    procedure TPipeThread.DoDataReceived;
    begin
    if Assigned(FOnDataReceived) then
     FOnDataReceived(Self);
    end;

    procedure TPipeThread.Execute;
    var
    Pipe: THandle;
    begin
    Pipe := CreatePipe(FPipeName);
    if Pipe = INVALID_HANDLE_VALUE then
     RaiseLastOSError;
    while True do
     try
      //Подключаемся к каналу, второй параметр нужен только, если вместо PIPE_WAIT вы указали PIPE_NOWAIT
      ConnectNamedPipe(Pipe, nil);
      if Terminated then
       Break;
      //Теперь читаем, параметры – указатель на канал, наш буфер, кол-во прочитанных байт, и последнее опять таки только для PIPE_NOWAIT.
      if ReadFile(Pipe, FPipeData, 256 * SizeOf(char), FPipeDataLength, nil) then
       Synchronize(DoDataReceived);
     finally
      DisconnectNamedPipe(Pipe);
     end;
    end;

    function TPipeThread.GetPipeData: string;
    begin
    Result := Copy(string(FPipeData), 1, FPipeDataLength);
    end;

    class function TPipeThread.PipeExists(const PipeName: string): boolean;
    begin
    Result := SendToPipe(PipeName, 'test', 4) <> 0;
    end;

    class function TPipeThread.SendToPipe(const PipeName: string; Data: TPipeData; DataLength: integer): integer;
    var
    Pipe: THandle;
    BytesWritten: DWORD;
    begin
    Result := 0;
    Pipe := CreateFile(PChar('\\.\PIPE\' + PipeName), GENERIC_WRITE,          //Только запись
     FILE_SHARE_READ or      // Обмениваемся чтенью\записью
     FILE_SHARE_WRITE, nil,  //Артрибуты безопасности
     OPEN_EXISTING,          // Канал должен быть создан
     0, 0);
    if Pipe = INVALID_HANDLE_VALUE then
     Exit;
    if WriteFile(Pipe, Data, DataLength * SizeOf(char), BytesWritten, nil) then
    begin
     DisconnectNamedPipe(Pipe); //Если удачно запиали, закрываем канал.
     Result := BytesWritten;
    end;
    end;

    end.


  • Дмитрий Белькевич (03.09.10 10:13) [9]
    Замечена одна особенность.

    Вероятнее всего, какой-то вызов API в TPipeThread.SendToPipe выполняется асинхронно. Предполагаю, что WriteFile. Из-за этого появляется проблема, когда TPipeThread.SendToPipe вызывается несколько раз подряд. CreateFile при быстром повторном вызове возвращает INVALID_HANDLE_VALUE, LastError - все копии канала уже заняты или что-то такое.
    Как исправить - не знаю, пока что убрал множественные вызовы TPipeThread.SendToPipe, но проблема осталась.
  • Дмитрий Белькевич (01.03.11 16:33) [10]
    Финальный вариант, если кому-то интересно:


    unit PipeThread;

    {
    Original idea (c) 2006 Стас "Hexorg" Пономарёв.
    http://forum.sources.ru/index.php?showtopic=140047
    Some fixes and improvements (c) 2010 Dmitry Belkevich
    http://makhaon.com
    }


    interface

    uses
    Classes, Windows, SysUtils;

    type
    TPipeData = string[255];

    TPipeThread = class(TThread)
    private
     FPipeData:       TPipeData;
     FPipeDataLength: DWord;
     FOnDataReceived: TNotifyEvent;
     FPipeName:       string;
     procedure DoDataReceived;
     function GetPipeData: string;
    protected
     procedure Execute; override;
    public
     constructor Create(const PipeName: string; CreateSuspended: boolean);
     destructor Destroy; override;
     class function SendToPipe(const PipeName: string; Data: TPipeData; DataLength: integer): integer;
     class function CreatePipe(const PipeName: string): THandle;
     class function PipeExists(const PipeName: string): boolean;
     property OnDataReceived: TNotifyEvent Read FOnDataReceived Write FOnDataReceived;
     property PipeData: string Read GetPipeData;
    end;

    implementation

    { TPipeThread }

    constructor TPipeThread.Create(const PipeName: string; CreateSuspended: boolean);
    begin
    FPipeName := PipeName;
    inherited Create(CreateSuspended);
    end;

    class function TPipeThread.CreatePipe(const PipeName: string): THandle;
    var
    pSD: PSecurityDescriptor;
    sa:  TSecurityAttributes;
    begin
    pSD := PSecurityDescriptor(LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH));
    if not Assigned(pSD) then
     RaiseLastOSError;
    if not InitializeSecurityDescriptor(pSD, SECURITY_DESCRIPTOR_REVISION) then
     RaiseLastOSError;
    // Добавить NULL ACL к дескриптору безопасности
    if not SetSecurityDescriptorDacl(pSD, True, nil, False) then
     RaiseLastOSError;
    sa.nLength := sizeof(sa);
    sa.lpSecurityDescriptor := pSD;
    sa.bInheritHandle := True;
    Result := CreateNamedPipe(PChar('\\.\PIPE\' + PipeName), //Наше имя
     PIPE_ACCESS_INBOUND,         // сервер может только читать канал
     PIPE_WAIT or                 // Синхронная работа
     PIPE_READMODE_MESSAGE or     // метод чтения - пакеты
     PIPE_TYPE_MESSAGE, PIPE_UNLIMITED_INSTANCES,    // Бесконечно много клиентов
     255 * SizeOf(char),          //размер буфера чтения
     255 * SizeOf(char),          // размер буфера записи
     100,                         // Тайм-аут
     @sa);                        // Артрибуты безопасности.
    end;

    destructor TPipeThread.Destroy;
    begin
    Terminate;
    PipeExists(FPipeName);
    inherited;
    end;

    procedure TPipeThread.DoDataReceived;
    begin
    if Assigned(FOnDataReceived) then
     FOnDataReceived(Self);
    end;

    procedure TPipeThread.Execute;
    var
    Pipe: THandle;
    begin
    Pipe := CreatePipe(FPipeName);
    if Pipe = INVALID_HANDLE_VALUE then
     RaiseLastOSError;
    while True do
     try
      //Подключаемся к каналу, второй параметр нужен только, если вместо PIPE_WAIT вы указали PIPE_NOWAIT
      ConnectNamedPipe(Pipe, nil);
      if Terminated then
       Break;
      //Теперь читаем, параметры – указатель на канал, наш буфер, кол-во прочитанных байт, и последнее опять таки только для PIPE_NOWAIT.
      if ReadFile(Pipe, FPipeData, 255 * SizeOf(char), FPipeDataLength, nil) then
       Synchronize(DoDataReceived);
     finally
      DisconnectNamedPipe(Pipe);
     end;
    end;

    function TPipeThread.GetPipeData: string;
    begin
    Result := Copy(string(FPipeData), 1, FPipeDataLength);
    end;

    class function TPipeThread.PipeExists(const PipeName: string): boolean;
    begin
    Result := SendToPipe(PipeName, 'test', 4) <> 0;
    end;

    class function TPipeThread.SendToPipe(const PipeName: string; Data: TPipeData; DataLength: integer): integer;
    var
    Pipe: THandle;
    BytesWritten: DWORD;
    begin
    Result := 0;
    Pipe := CreateFile(PChar('\\.\PIPE\' + PipeName), GENERIC_WRITE,          //Только запись
     FILE_SHARE_READ or      // Обмениваемся чтенью\записью
     FILE_SHARE_WRITE, nil,  //Артрибуты безопасности
     OPEN_EXISTING,          // Канал должен быть создан
     0, 0);
    if Pipe = INVALID_HANDLE_VALUE then
     Exit;
    if WriteFile(Pipe, Data, DataLength * SizeOf(char), BytesWritten, nil) then
    begin
     DisconnectNamedPipe(Pipe); //Если удачно записали, закрываем канал.
     Result := BytesWritten;
    end;
    end;

    end.

  • Дмитрий Белькевич (11.07.13 18:56) [11]
    Еще небольшие исправления...

    unit PipeThread;

    {
    Original idea (c) 2006 Стас "Hexorg" Пономарёв.
    http://forum.sources.ru/index.php?showtopic=140047
    Some fixes and improvements (c) 2010 Dmitry Belkevich
    http://makhaon.com
    }

    interface

    uses
    Classes, Windows, SysUtils;

    type
    TPipeData = array[0..1023] of AnsiChar;

    TPipeThread = class(TThread)
    private
     FPipeData:       TPipeData;
     FPipeDataLength: DWord;
     FOnDataReceived: TNotifyEvent;
     FPipeName:       string;
     procedure DoDataReceived;
     function GetPipeData: string;
    protected
     procedure Execute; override;
    public
     constructor Create(const PipeName: string; CreateSuspended: boolean);
     destructor Destroy; override;
     class function SendToPipe(const PipeName, s: string): integer;
     class function CreatePipe(const PipeName: string): THandle;
     class function PipeExists(const PipeName: string): boolean;
     property OnDataReceived: TNotifyEvent Read FOnDataReceived Write FOnDataReceived;
     property PipeData: string Read GetPipeData;
    end;

    implementation

    { TPipeThread }

    constructor TPipeThread.Create(const PipeName: string; CreateSuspended: boolean);
    begin
    FPipeName := PipeName;
    inherited Create(CreateSuspended);
    end;

    class function TPipeThread.CreatePipe(const PipeName: string): THandle;
    var
    PSD: PSecurityDescriptor;
    Sa:  TSecurityAttributes;
    begin
    PSD := PSecurityDescriptor(LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH));
    if not Assigned(PSD) then
     RaiseLastOSError;
    if not InitializeSecurityDescriptor(PSD, SECURITY_DESCRIPTOR_REVISION) then
     RaiseLastOSError;
    // Добавить NULL ACL к дескриптору безопасности
    if not SetSecurityDescriptorDacl(PSD, True, nil, False) then
     RaiseLastOSError;
    Sa.nLength := SizeOf(Sa);
    Sa.lpSecurityDescriptor := PSD;
    Sa.bInheritHandle := True;
    Result := CreateNamedPipe(PChar('\\.\PIPE\' + PipeName), //Наше имя
     PIPE_ACCESS_INBOUND,          // сервер может только читать канал
     PIPE_WAIT or                  // Синхронная работа
     PIPE_READMODE_MESSAGE or      // метод чтения - пакеты
     PIPE_TYPE_MESSAGE, PIPE_UNLIMITED_INSTANCES,    // Бесконечно много клиентов
     1024,          //размер буфера чтения
     1024,          // размер буфера записи
     100,                          // Тайм-аут
     @Sa);                         // Артрибуты безопасности.
    end;

    destructor TPipeThread.Destroy;
    begin
    Terminate;
    PipeExists(FPipeName);
    inherited;
    end;

    procedure TPipeThread.DoDataReceived;
    begin
    if Assigned(FOnDataReceived) then
     FOnDataReceived(Self);
    end;

    procedure TPipeThread.Execute;
    var
    Pipe: THandle;
    begin
    Pipe := CreatePipe(FPipeName);
    if Pipe = INVALID_HANDLE_VALUE then
     RaiseLastOSError;
    while True do
     try
      //Подключаемся к каналу, второй параметр нужен только, если вместо PIPE_WAIT вы указали PIPE_NOWAIT
      ConnectNamedPipe(Pipe, nil);
      if Terminated then
       Break;
      //Теперь читаем, параметры – указатель на канал, наш буфер, кол-во прочитанных байт, и последнее опять таки только для PIPE_NOWAIT.
      if ReadFile(Pipe, FPipeData, 1024, FPipeDataLength, nil) then
       Synchronize(DoDataReceived);
     finally
      DisconnectNamedPipe(Pipe);
     end;
    end;

    function TPipeThread.GetPipeData: string;
    begin
    Result := Copy(string(FPipeData), 1, FPipeDataLength);
    end;

    class function TPipeThread.PipeExists(const PipeName: string): boolean;
    begin
    Result := SendToPipe(PipeName, 'test') <> 0;
    end;

    class function TPipeThread.SendToPipe(const PipeName, s: string): integer;
    var
    Pipe: THandle;
    FullPipeName: PChar;
    BytesWritten: DWORD;
    Data: TPipeData;

    procedure OpenPipe;
    begin
     Pipe := CreateFile(FullPipeName, GENERIC_WRITE,          //Только запись
      FILE_SHARE_READ or      // Обмениваемся чтенью\записью
      FILE_SHARE_WRITE, nil,  //Артрибуты безопасности
      OPEN_EXISTING,          // Канал должен быть создан
      0, 0);
    end;

    begin
    StrPLCopy(Data, ansistring(s), Length(s));
    Result := 0;
    FullPipeName := PChar('\\.\PIPE\' + PipeName);
    OpenPipe;
    if GetLastError = ERROR_PIPE_BUSY then
    begin
     WaitNamedPipe(FullPipeName, 2000);
     OpenPipe;
    end;
    if Pipe = INVALID_HANDLE_VALUE then
     Exit;
    if WriteFile(Pipe, Data, Length(s), BytesWritten, nil) then
    begin
     DisconnectNamedPipe(Pipe); //Если удачно записали, закрываем канал.
     Result := BytesWritten;
    end;
    end;

    end.
  • Плохиш © (13.07.13 23:31) [12]
    Некроман?
 
Конференция "Corba" » COM связь между двумя пользователями
Есть новые Нет новых   [103795   +3][b:0.001][p:0.025]