Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.01.15;
Скачать: CL | DM;

Вниз

MailSlot   Найти похожие ветки 

 
Profik ©   (2005-10-04 11:54) [0]

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


 
Digitman ©   (2005-10-04 13:50) [1]


> все сайты заблокированы кромя этого


не ври.


 
Profik ©   (2005-10-04 14:39) [2]

Специально для Digitmana  -  У нас на работе открыты сайты только те, где в адресе есть слово Delphi, остальные блокированы. Плюс не в одном из них поисковики не работают. И вообще, лучше бы помог советом, а не наежжал!!!


 
Digitman ©   (2005-10-04 14:48) [3]


> У нас на работе открыты сайты только те, где в адресе есть
> слово Delphi, остальные блокированы


да на здоровье !

Messenger не имеет никакого отношения ни к каким "сайтам".


 
Profik ©   (2005-10-04 15:04) [4]

Я не понимаю твоих наездов. А про блокированые сайты я сказал, потому что вчера мне вместо совета дали ссылку на один сайт, где типа есть похожая инфа - но я то не могу её посмотреть-сайт недоступен!!! Вот потому я и прошу, по возможности кинуть кусок кода, если кто знает.


 
Profik ©   (2005-10-04 15:09) [5]

Для WAL -

// устанавливаем глобальные переменные:
var
  MailslotHandle:Word;
  MSlotName:String;
  ComputerName:String;

// функция отп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;


 
Digitman ©   (2005-10-04 15:16) [6]


> где типа


вот и кидай сюда эту ссылку...
растрясем ее до костей ..


> кинуть кусок кода


тот "кусок кода", что ты "кинул", в теории вроде бы работоспособен, но  НИКАКОГО отношения к каим-то там "сайтам" не имеет - разве это не очевидно ?

ГДЕ в этом "куске" какие-то там "сайты", к которым тебя якобы кто-то там не пускает ?!


 
Profik ©   (2005-10-04 15:34) [7]

Для Digitmana -
Да причем тут сайты до моей проги - я говорю что не могу найти нужную мне инфу из-за блокировки полезных сайтов. А ссылку ща кину


 
Profik ©   (2005-10-04 15:38) [8]

http://torry.net/vcl/lan/comms/almailsl.zip
http://torry.net/vcl/lan/comms/cbmailslot.zip - это типа исходники по работе с майлслотом , я напряг админа их закачать (6кб и 17 кб) - но они не качаються


 
Digitman ©   (2005-10-04 15:42) [9]


> Profik ©   (04.10.05 15:34) [7]


если тебе перекрыт "кислород" от msdn.microsoft.com, то
- либо вешайся,
- либо пусть вешается твой админ,
- либо вы оба,
- либо админ открывает тебе как программеру доступ к этому ресурсу, и ты в  6 екунд находишь там ответы на свой вопрос


 
Piter ©   (2005-10-05 18:19) [10]

Может хватит плодить темы?

http://delphimaster.net/view/2-1128090671/
http://delphimaster.net/view/2-1128090671/
http://delphimaster.net/view/2-1128090671/



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

Текущий архив: 2006.01.15;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.107 c
1-1134324968
markers
2005-12-11 21:16
2006.01.15
Tlabel и WordWrap


3-1132653851
G707
2005-11-22 13:04
2006.01.15
Не присваиваются значения, Вот фрагмент:


5-1121170591
Aleksandr.
2005-07-12 16:16
2006.01.15
Почему неправильно работает OnMeasureItem?


2-1135497900
kop
2005-12-25 11:05
2006.01.15
Запрос > мемо


1-1134039040
BURN
2005-12-08 13:50
2006.01.15
OnClick = ButtonSendClick