Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

COM связь между двумя пользователями


Дмитрий Белькевич   (15.07.10 20:27

Приложение-клиент, запущенное из-под юзера 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]

Некроман?


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо