Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2004.05.23;
Скачать: [xml.tar.bz2];

Вниз

Опять NET SEND   Найти похожие ветки 

 
AlexeyITN   (2004-03-10 18:25) [0]

Изужажлась эта тема на всех форумах. Вся ясно и понятно!
Не понятно одно как реализовать перехват winpopup, кажется, окна...то бишь, если приходит NET SEND, то его самому показывать\не показывать....
Слышал, мол, какую-то почтовую службу у Винды отключать...
но КАК? Помогите, пожайлуста...с примерчиком желательно :)
Заранее благодарен!


 
Rouse_ ©   (2004-03-11 11:29) [1]

отключить службу сообщений

uses ..., WinSvc;

procedure TForm1.Button1Click(Sender: TObject);
var
 hSCM, hSrv: THandle;
 SS:SERVICE_STATUS;
begin
 hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
 hSrv:=OpenService(hSCM,"Messenger",SERVICE_ALL_ACCESS);
 ControlService(hSrv,SERVICE_CONTROL_STOP,SS);
 CloseServiceHandle(hSrv);
 CloseServiceHandle(hSCM);
end;


Потом запустить данный код:
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   Timer1: TTimer;
   Memo1: TMemo;
   procedure Timer1Timer(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   MailSlot: THandle;
   ErrStr: array [0..MAX_PATH] of Char;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
 CurrentSize, Size, Count: DWORD;
 Msg: String;
 Err: LongBool;
 I: Integer;
 From, sTo: String;
begin
 Count := 0;
 Err := GetMailSlotInfo(MailSlot, nil, Size, @Count, nil);
 if not Err then
 begin
   FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,

                   nil,
                   GetLastError,
                   0,
                   @ErrStr[0],
                   MAX_PATH,
                   nil);
   Memo1.Lines.Add("Can not GetMailSlotInfo: " + String(ErrStr));
   Exit;
 end;
 if Count > 0 then
 begin
   SetLength(Msg, Size);
   ReadFile(MailSlot, Msg[1], Size, CurrentSize, nil);
   I := 1;
   while (Msg[I] <> #0) do Inc(I);
   From := Copy(Msg, 1, I - 1);
   Delete(Msg, 1, I);
   I := 1;
   while (Msg[I] <> #0) do Inc(I);
   sTo := Copy(Msg, 1, I - 1);
   Delete(Msg, 1, I);
   OemToChar(PChar(From), PChar(From));
   OemToChar(PChar(sTo), PChar(sTo));
   OemToChar(PChar(Msg), PChar(Msg));
   Memo1.Lines.Add("Получено сообщение от: " + From +
   " для " + sTo + #13#10 + Msg);
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MailSlot := CreateMailslot("\\.\mailslot\messngr", 0, MAILSLOT_WAIT_FOREVER, nil);
 if MailSlot = INVALID_HANDLE_VALUE then
 begin
   FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
                   nil,
                   GetLastError,
                   0,
                   @ErrStr[0],
                   MAX_PATH,
                   nil);
   Memo1.Lines.Add("Can not create mailslot: " + String(ErrStr));
   Exit;
 end;
end;

end.


когда уже данная возможность не нужна - запустить службу сообщений
procedure TForm1.Button2Click(Sender: TObject);
var
 hSCM, hSrv: THandle;
 SS:SERVICE_STATUS;
 Par: PChar;
begin
 Par := nil;
 hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
 hSrv:=OpenService(hSCM,"Messenger",SERVICE_ALL_ACCESS);
 StartService(hSrv, 0, Par);
 CloseServiceHandle(hSrv);
 CloseServiceHandle(hSCM);
end;


 
MetalFan ©   (2004-04-02 17:56) [2]

не работает((( сообщения не ловит(((
а надо!


 
Rouse_ ©   (2004-04-02 21:49) [3]

Видимо что-то не так сделал...


 
Игорь Шевченко ©   (2004-04-04 00:29) [4]

А что, проверка на ошибки уже не в моде, при обращении к SCM ?


 
Rouse_ ©   (2004-04-04 01:28) [5]

> [4] Игорь Шевченко ©   (04.04.04 00:29)
Писал как демо - поэтому не затруднял себя проверкой...
Скорее вопрос к спрашивающим...


 
MetalFan ©   (2004-04-05 15:28) [6]

нет... делал все так.
просто после остановки сервиса Messenger не получается Net Send"ом слать на машину сообщения...
а при запущщеном нетсенде не создается маилслот с таким названием(((


 
Rouse_ ©   (2004-04-05 16:39) [7]

Ну так естественно - слать то нужно с другой машины или при помощи следующего кода:

procedure TForm1.Button1Click(Sender: TObject);
var
 MSHandle: THandle;
 MSMessage: array [0..2] of String;
 ResultMsMessage: String;
 MSWrite: DWORD;
 ServerName: String;
begin
 ServerName := Edit1.Text;
 if ServerName = "" then ServerName := "*\";
 if ServerName[Length(ServerName)] <> "\" then ServerName := ServerName + "\";

 MSHandle := CreateFile(PChar("\\" + ServerName + "mailslot\messngr"),
   GENERIC_WRITE,// or GENERIC_READ,
   FILE_SHARE_READ,
   nil,
   OPEN_EXISTING,
   FILE_ATTRIBUTE_NORMAL,
   0);
 if not Win32Check(MSHandle <> INVALID_HANDLE_VALUE) then Exit;

 MSMessage[0] := Edit2.Text;
 MSMessage[1] := Edit3.Text;
 MSMessage[2] := Memo1.Text;

 CharToOem(PChar(MSMessage[0]), PChar(MSMessage[0]));
 CharToOem(PChar(MSMessage[1]), PChar(MSMessage[1]));
 CharToOem(PChar(MSMessage[2]), PChar(MSMessage[2]));

 ResultMsMessage := MSMessage[0] + #0 + MSMessage[1] + #0 + MSMessage[2];

 WriteFile(MSHandle, Pointer(PChar(ResultMsMessage))^, Length(ResultMsMessage), MSWrite, nil);
 Win32Check(MSWrite = Length(ResultMsMessage));
 CloseHandle(MSHandle);
end;


Почему именно так?
Потому что при отключенной службе сообщений NetMessageBufferSend также не будет работать...


 
MetalFan ©   (2004-04-05 16:43) [8]

т.о. ПЕРЕХВАТИТЬ входящее сообщение net send"а нельзя ?
по крайней мере через mailslots...


 
Rouse_ ©   (2004-04-05 17:08) [9]

Почемуже, данный код работает абсолютно идентично стандартному Net Send
Просто ты отключаешь службу ответственную за отправку и приемку сообщений и запускаешь свой отправщик и приемщик...

А перехватить можно сниффером также...


 
BlackTr   (2004-04-05 18:10) [10]

Попробовал код отправки->не работает. На другую машину не приходит ничего :)
А почему это NetMessageBufferSend не будет работать при отключенной службе?
Вот у меня служба сообщений отключена, NetMessageBufferSend прекрасно отправляет на другие машины.
Кстати: если пробовать и передачу и прием, по привиденному выше коду, то все прекрасно работает. А вот если в комбинации с стандартными виндовыми то ничего не получается :(


 
MetalFan ©   (2004-04-05 19:59) [11]

да.. в комбинации не получается... обидно!


 
Rouse_ ©   (2004-04-05 22:28) [12]

Не получается?
Странно, проверял под 2000 и ХР все работало...
Также буквально только что проверил из под 98 отправку в ХР - также без сбоев.
Проверю еще раз.

Также проверял и с NetMessageBufferSend.

Нельзя ли поподробнее привести информацию по вашим системам и сервиспакам.


 
BlackTr   (2004-04-06 09:32) [13]

Win2000 sp3, winXP sp1
Прикольно еще то, что где-то полгода назад у меня получалось принимать. А вот сейчас не могу вспомнить, что я тогда такого сделал :(


 
Rouse_ ©   (2004-04-06 09:45) [14]

Вот сейчас сижу на 2000 SP2 - прием нормальный :)


 
MetalFan ©   (2004-04-06 10:02) [15]

2000 SP4 - если Messnger остановлен, то net send возвращает ошибку - имя компутера не найдено!


 
Rouse_ ©   (2004-04-06 10:18) [16]

Попробуй сначала отправить на адрес * (звездочка)


 
MetalFan ©   (2004-04-06 10:58) [17]

так тогда всем придет?
кстати... иногда такой глюк возникает полсе остановки Messenger"a
таким способом:
procedure TfmNetSend.StopMessenger;
var
hSCM, hSrv: THandle;
SS: SERVICE_STATUS;
begin
hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
hSrv:=OpenService(hSCM, "Messenger", SERVICE_ALL_ACCESS);
ControlService(hSrv,SERVICE_CONTROL_STOP,SS);
while SS.dwCurrentState = SERVICE_STOP_PENDING do
   ControlService(hSrv,SERVICE_CONTROL_INTERROGATE,SS);
CloseServiceHandle(hSrv);
CloseServiceHandle(hSCM);
end;

вылезает системное окно с текстом
" остановлен системный процесс services.exe с кодом 128...
пожалуйста, сохраните все данные!
через ХХХ секунд произойдет перезагрузка системы"
что за косяк???


 
Rouse_ ©   (2004-04-06 11:47) [18]

Да, придет всем, но ты проверь...

А для чего используешь этот код? :
while SS.dwCurrentState = SERVICE_STOP_PENDING do
  ControlService(hSrv,SERVICE_CONTROL_INTERROGATE,SS);

Ведь результат ты никуда не выводишь...

Во вторых, боюсь ошибиться, но меня поправят.
Вполне возможно что вызов ControlService(hSrv,SERVICE_CONTROL_INTERROGATE,SS); после остановки самого сервиса дает такой результат...
Насколько мне извесно, останавливается он практически моментально...


 
Rouse_ ©   (2004-04-06 11:51) [19]

Проверь какой результат возвращает ControlService.
Вполне вероятно что ERROR_SERVICE_NOT_ACTIVE


 
MetalFan ©   (2004-04-06 13:05) [20]

если придет всем...
то придут эти все))) человек, как минимум 30)))
и попинають мене )))


> А для чего используешь этот код? :
> while SS.dwCurrentState = SERVICE_STOP_PENDING do
>   ControlService(hSrv,SERVICE_CONTROL_INTERROGATE,SS);
> Ведь результат ты никуда не выводишь...

чтобы дождаться завершения работы сервиса... у меня около 500-800 мсек.


 
BlackTr   (2004-04-06 15:47) [21]

Отправка все-таки работает.
Работает, только, если указываешь имя а не IP :)
А вот с приемом так нифига и не получилось :(


 
BlackTr   (2004-04-06 16:07) [22]

Короче, при отправке с вин2000 net send"om на вин2000 с программой приема:
"Не удалось найти псевдоним сообщений в сети."
И так и сяк пробовал, ничего не получается. :)

Может все-таки есть способ побороть это ? Или все таки снифер свой писать ? :)))


 
MetalFan ©   (2004-04-06 16:10) [23]


> BlackTr   (06.04.04 15:47) [21]

мдя... прием "своих" сообщений намана... а вот "рожных" нетсендовских - фик)
надо искать другой путь



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2004.05.23;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.51 MB
Время: 0.034 c
1-1083828107
xman
2004-05-06 11:21
2004.05.23
Запуск моей программы


1-1083553133
Bond
2004-05-03 06:58
2004.05.23
Rave


4-1081319290
Gamlet
2004-04-07 10:28
2004.05.23
Создание приложений без VCL


1-1083943549
DDA
2004-05-07 19:25
2004.05.23
Result=PChar(s)


3-1083311033
Alina
2004-04-30 11:43
2004.05.23
TDateTime в DBGrid e





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский