Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

WinMessenger

Profik © (2005-10-10 11:14:00)
Люди, погибаю вот уже вторую неделю, ПОМОГИТЕ!!! Как моему приложению отловить сообщение с WinMessengera? Ссылок не давайте - у меня все сайты заблокированы кромя этого. Пожалуйста - киньте кусок кода, кто знает. Спасибо большое!

Digitman (2005-10-10 13:43:00) [1]

> Profik © (10.10.05 13:40) [7]

ты что-нибудь слышал про встроенный в Делфи отладчик Делфи-программ?

Profik (2005-10-10 13:40:00) [2]
GetMailSlotInfo(MailslotHandle, NIL, NextMsgSize, @MsgCount, NIL);
If NextMsgSize<>MAILSLOT_NO_MESSAGE then
begin
showmessage('wetgywreyh2j2');
//////
Здеся глюк (в таймере) - если бы сообщение было - хотя бы предупреждение выводилось бы - а то даже этого нет - не могу понять почему

-=S..S=- (2005-10-10 13:27:00) [3]

> SetLength(NewLine,NextMsgSize);
> ReadFile(MailslotHandle, PChar(NewLine)^, NextMsgSize,
> MsgSize, nil);

сделай переменную NewLine - типа PChar ...
стрингу SetLength не нужен ... или попробуй
ReadFile(MailslotHandle, @NewLine, NextMsgSize, MsgSize, nil);

Profik (2005-10-10 13:19:00) [4]
Я кину код - посмотри - я ведь отсылаю сообщения со своей проги на винмесс - а принять не могу

// функция отпpaвки сообщения:

function SendMessage(ToComputer, Msg:string): boolean;
var
hToSlot:THandle;
BytesWritten:DWord;
FullSlot,
Data:String;
SendMsg:string;
begin
Result:=false;
SendMsg:=copy(Msg,1,length(Msg));
CharToOEM(PChar(SendMsg), PChar(SendMsg)); // необходимо чтобы поняли по pyсски.
Data:=ComputerName+#0+ToComputer+#0+SendMsg; // собирам сообщение для отправки

FullSlot:='\\'+ToComputer+'\mailslot\'+MSlotName; // собираем имя mailslot'а
hToSlot:=CreateFile(PChar(FullSlot), // создаём файл, для записи данных
GENERIC_WRITE,
FILE_SHARE_READ,
NIL,
CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL,
0);

if hToSlot<>INVALID_HANDLE_VALUE then
begin
BytesWritten:=0;
If (NOT
WriteFile(hToSlot,
Pointer(Data)^,
Length(Data),
BytesWritten,
NIL)) OR
(BytesWritten <> Length(Data)) then Result:=false Else Result:=true;
// если не удалось записать данные или размер записанных данных
// и данных подготовленых для отправки не совпадает то вернуть ложное значение.
end; // hToSlot<>INVALID_HANDLE_VALUE
end;

// процедура чтения:

procedure ReadMessage(NextMsgSize:DWord);
var
Newline,Sender,Recip,Msg:String;
MsgSize:DWord;
begin
SetLength(NewLine,NextMsgSize);
ReadFile(MailslotHandle, PChar(NewLine)^, NextMsgSize, MsgSize, nil);
Sender:=lowercase(Copy(newline,1,pos(chr(0),newline)-1));
Sender[1]:=upcase(sender[1]);
Delete(newline,1,Pos(chr(0),newline));
// определение получателя
Recip:=lowercase(Copy(newline,1,pos(chr(0),newline)-1));
Recip[1]:=upcase(Recip[1]);
Delete(newline,1,Pos(chr(0),newline));
// всё что осталось - сообщение
Msg:=TrimLeft(TrimRight(newline));
OEMToChar(PChar(Msg),PChar(Msg)); // чтобы понять pyсские символы.
Form1.Memo1.Lines.Add(Sender+' сообщил для '+Recip+' вот что:'+Msg);
end;

// в тaймеp с интеpвaлом в 200мс (можно меньше, но зaчем?) встaвляем:

procedure TForm1.Timer1Timer(Sender: TObject);
var
NextMsgSize,
MsgSize,
MsgCount:DWord;
NewLine:String;
DummyBuffer:Char;
begin
NextMsgSize:=0;
MsgSize:=0;
GetMailSlotInfo(MailslotHandle, NIL, NextMsgSize, @MsgCount, NIL);
If NextMsgSize<>MAILSLOT_NO_MESSAGE then
begin
if NextMsgSize>5 then ReadMessage(NextMsgSize)
// по формату сообщение не может быть меньше 5 символов, даже от компьютера,
// чьё имя состоит из одной буквы.
Else ReadFile(MailslotHandle, DummyBuffer, NextMsgSize, MsgSize, nil);
// считываем в ненужный буфер чтобы сообщение не лежало в слоте.
end;
end;

// функция получения имени компьютера

function GetComputerName:String;
var
N: Cardinal;
Buf: array [0..MAX_COMPUTERNAME_LENGTH + 1] of AnsiChar;
begin
N:=SizeOf(Buf)-1;
Windows.GetComputerName(Buf, N);
Result:=PChar(@Buf[0]);
end;

// нa создание главной формы:

procedure TForm1.FormCreate(Sender: TObject);
var
MSlotCreate:String;
Error:Dword;
begin
ComputerName:=Uppercase(GetComputerName);
MSlotName:='messngr'; // messngr - майлслот службы сообщений.
MSlotCreate:='\\.\mailslot\'+MSlotName;
MailslotHandle:=0;
Error:=0;
SetLastError(0);
MailslotHandle:=CreateMailSlot(PChar(MSlotCreate), 0, MAILSLOT_WAIT_FOREVER, nil);
Error:=GetLastError();
if (Error<>0) or (MailslotHandle=0) or (MailslotHandle=INVALID_HANDLE_VALUE) then
begin
ShowMessage('Пожалуйста перед запуском закройте все программы - аналоги winpopup'+#13#10+
'или остановите службу сообщений.');
Application.Terminate;
end;
end;

-=S..S=- (2005-10-10 13:15:00) [5]
В прямом ... если при сообщении не создаёться никаких окон ... и нет никакого интерфейса для регистрации хука на сообщение или какого-то системного сообщения при получении мессаджа ... то НИКАК

-=S..S=- (2005-10-10 13:15:00) [6]
или ты что то типа снифера хоч писать ?

Profik (2005-10-10 13:12:00) [7]
в смысле?

-=S..S=- (2005-10-10 12:59:00) [8]
если новое окно не появляеться .. и это не предусмотрено .. то никак

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »