| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Named pipes trouble [D7, WinXP]
Чапаев © (2004-06-01 10:34:00)Задача: при нажатии на кнопку программа запускает другую программу, если та
ещё не запущена и выдаёт MessageBox об успешном запуске. Вторая программа
создаёт глобальный объект (мьютекс), который сигнализирует о том, что эта
программа запущена, создаёт именованный канал и регистрирует некоторое
оконное сообщение. По нажатию на вторую кнопку первая программа передаёт
второй через канал некий текст и отправляет оповещение.
Теперь собственно проблема. Если MessageBox не закрыть, вторая программа
получает мусор. Если же его закрыть или не выдавать совсем, всё передаётся
правильно.
Первая программа:
unit RunnerU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellApi, Constants;
type
TForm1 = class(TForm)
btnCheckRun: TButton;
mmXML: TMemo;
btnSendXml: TButton;
procedure btnCheckRunClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnSendXmlClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Pipe:THandle;
MsgNumber:Cardinal;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnCheckRunClick(Sender: TObject);
begin
if OpenMutex(MUTEX_ALL_ACCESS,True,MutexName)=0
then
if
ShellExecute(Application.Handle,'open',ProgramName,'','',SW_SHOW)<32
then raise Exception.Create('Can''t run '+ProgramName);
else MessageBox(0,'Program runned successfully','OK',MB_OK or
MB_ICONINFORMATION) //Debug
else MessageBox(0,'Program already runned','OK',MB_OK or
MB_ICONINFORMATION); //Debug
while OpenMutex(MUTEX_ALL_ACCESS,True,MutexName)=0 do;
Pipe:=CreateFile('\\.\pipe\'+PipeName,GENERIC_WRITE,0,nil,OPEN_EXISTING,0,0)
;
if Pipe=INVALID_HANDLE_VALUE then
raise Exception.Create('Can''t open pipe');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MsgNumber:=RegisterWindowMessage(MessageName);
if MsgNumber=0 then
raise Exception.Create('Can''t register message');
end;
procedure TForm1.btnSendXmlClick(Sender: TObject);
var
ActualWritten:Cardinal;
Recipients:PDWORD;
begin
WriteFile(Pipe,mmXML.Text[1],Length(mmXML.Text),ActualWritten,nil);
New(Recipients);
Recipients^:=BSM_APPLICATIONS;
BroadcastSystemMessage(BSF_IGNORECURRENTTASK or
BSF_POSTMESSAGE,Recipients,MsgNumber,0,Length(mmXML.Text));
Dispose(Recipients);
end;
end.
Вторая программа:
unit RunnableU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
mmXML: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Pipe:THandle;
Msg:Cardinal;
Mutex:THandle;
protected
procedure WndProc(var Mssg:TMessage);override;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Constants;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Mutex:=OpenMutex(MUTEX_ALL_ACCESS,true,MutexName);
if Mutex<>0 then begin
raise Exception.Create('Program already runned');
Halt;
end;
Pipe:=CreateNamedPipe('\\.\pipe\'+PipeName,PIPE_ACCESS_INBOUND,PIPE_TYPE_BYT
E or PIPE_WAIT,1,100000,1000000,1000,nil);
if Pipe=INVALID_HANDLE_VALUE then begin
raise Exception.Create('Can''t create pipe');
Halt;
end;
Msg:=RegisterWindowMessage(MessageName);
if Msg=0 then begin
raise Exception.Create('Can''t register message');
Halt;
end;
Mutex:=CreateMutex(nil,True,MutexName);
if Mutex=0 then begin
raise Exception.Create('Can''t create mutex');
Halt;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseHandle(Mutex);
CloseHandle(Pipe);
end;
procedure TForm1.WndProc(var Mssg: TMessage);
var
ActRead:Cardinal;
S:string;
begin
if Mssg.Msg=Msg
then begin
SetLength(S,Mssg.LParam);
ReadFile(Pipe,S[1],Mssg.LParam,ActRead,nil);
mmXML.Clear;
mmXML.Lines.Add(S);
end
else
inherited;
end;
end.
Игорь Шевченко (2004-06-01 12:37:00) [1]Чапаев © (01.06.04 12:27)
GIGO - garbage in, garbage out :)
Удачи!
Чапаев (2004-06-01 12:27:00) [2]>И кстати, что возвращает WriteFile ? Тоже ведь код возврата не проверяется..
Хе. Возвращает False. Вопрос снимается.
Игорь Шевченко (2004-06-01 12:21:00) [3]
> но я не понимаю, почему с каналом проблемы получаются?
На мой взгляд очень похоже на ситуацию, что сообщение приходит раньше, чем данные в канал помещены...Winsight или Spy++ могут помочь прояснить ситуацию.
И кстати, что возвращает WriteFile ? Тоже ведь код возврата не проверяется..
Чапаев (2004-06-01 12:08:00) [4]Оно-то поможет, но я не понимаю, почему с каналом проблемы получаются?
Игорь Шевченко (2004-06-01 11:56:00) [5]
> Ну она ж немодальная...
А сделать MessageBox модальным по отношению к ней, может, поможет ?
Чапаев (2004-06-01 11:33:00) [6]>А глупый вопрос: как ты можешь нажать на вторую кнопку, пока MessageBox на экране ?
Ну она ж немодальная...
Игорь Шевченко (2004-06-01 11:32:00) [7]
> MessageBox принадлежит первой программе, почему же данные
> по каналу не доходят до второй? Ведь само-то сообщение она
> ловит...
А глупый вопрос: как ты можешь нажать на вторую кнопку, пока MessageBox на экране ? Может, для пущей синхронизации использовать Application.MessageBox ?
Чапаев (2004-06-01 11:18:00) [8]Угу... Действительно, ReadFile возвращает False. Только всё же непонятно... MessageBox принадлежит первой программе, почему же данные по каналу не доходят до второй? Ведь само-то сообщение она ловит...
Игорь Шевченко (2004-06-01 10:58:00) [9]
> ReadFile(Pipe,S[1],Mssg.LParam,ActRead,nil);
В этой строчке проверять код возврата.
Весьма вероятно, что сообщение, посылаемое по BSM, выбирается в цикле выборки сообщений MessageBox'а.
| |
