Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

Mailslot - Обмен информацией между Вашими программами в сети по почтовым каналам

Delphi , Интернет и Сети , E-mail

Как реализовать обмен информацией между Вашими приложениями в сети? ОС Windows предлагает несколько технологий. Эта статья опишет один очень простой и надежный способ для Win9x/NT - MailSlots. The CreateMailslot function creates a mailslot with the specified name and returns a handle that a mailslot server can use to perform operations on the mailslot. The mailslot is local to the computer that creates it. An error occurs if a mailslot with the specified name already exists.
Обмен текстовыми данными в локальной сети очень прост. Для этого необходимы три функции:

· CreateMailslot - создание почтового канала;

· GetMailslotInfo - определение наличия сообщения в канале;

· ReadFile - чтение сообщения из канала, как из файла;

· WriteFile - запись сообщения в канал, как в файл;

Функции работы с почтовыми каналами присутствуют как в Windows 9x, так и в Windows NT.
Рассмотрим создание почтового канала (сервер).

Code:

//... создание канала с именем MailSlotName - по этому имени к нему
//    будут обращаться клиенты
h := CreateMailSlot(PChar('\.mailslot' + MailSlotName), 0, MAILSLOT_WAIT_FOREVER,nil);
 
if h = INVALID_HANDLE_VALUE then begin
   raise Exception.Create('MailSlotServer: Ошибка создания канала !');

Отправка сообщений по почтовомуо каналу (клиенты).

Code:

if not GetMailSlotInfo(h,nil,DWORD(MsgNext),@MsgNumber,nil) then
begin
   raise Exception.Create('TglMailSlotServer: Ошибка сбора информации!');
end;
if MsgNext <> MAILSLOT_NO_MESSAGE then begin
   beep;
   // чтение сообщения из канала и добавление в текст протокола
   if ReadFile(h,str,200,DWORD(Read),nil) then
     MessageText := str
   else
     raise Exception.Create('TglMailSlotServer: Ошибка чтения сообщения !');
end;

 

Все очень просто. Теперь для удобства использования создадим два компонента - клиент и сервер

Code:

{
Globus Delphi VCL Extensions Library        
' GLOBUS LIB '                        
Freeware                                
Copyright (c) 2000 Chudin A.V, FidoNet: 1246.1
===================================================================
gl3DCol Unit 05.2000 components TglMailSlotServer, TglMailSlotClient
===================================================================
}
unit glMSlots;
 
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, extctrls;
 
type
TOnNewMessage = procedure (Sender: TObject; MessageText: string) of object;
 
TglMailSlotServer = class(TComponent)
private
   FMailSlotName, FLastMessage: string;
   FOnNewMessage: TOnNewMessage;
 
   Timer: TTimer; //...таймер для прослушивания канала
   h : THandle;
   str : string[250];
   MsgNumber,MsgNext,Read : DWORD;
public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure Open;  //...создание канала
   procedure Close; //...закрытие канала
protected
   procedure Loaded; override;
   procedure OnTimer(Sender: TObject);
published
   property MailSlotName: string read FMailSlotName write FMailSlotName;
   //...событие получения сообщения
   property OnNewMessage: TOnNewMessage read FOnNewMessage write FOnNewMessage; 
end;
 
 
TglMailSlotClient = class(TComponent)
private
   FMailSlotName, FServerName, FLastMessage: string;
public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   function Send(str: string):boolean; //...отправка сообщения
protected
   procedure Loaded; override;
   procedure ErrorCatch(Sender : TObject; Exc : Exception);
published
   property ServerName: string read FServerName write FServerName;
   property MailSlotName: string read FMailSlotName write FMailSlotName;
end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
RegisterComponents('Gl Components', [TglMailSlotServer, TglMailSlotClient]);
end;
 
constructor TglMailSlotServer.Create(AOwner: TComponent);
begin
inherited;
FEnabled := true;  
FMailSlotName := 'MailSlot';
Timer := TTimer.Create(nil);
Timer.Enabled := false;
Timer.OnTimer := OnTimer;
end;
 
destructor TglMailSlotServer.Destroy;
begin
Timer.Free;
// закрытие канала
Close;
inherited;
end;
 
procedure TglMailSlotServer.Loaded;
begin
inherited;
Open;
end;
 
procedure TglMailSlotServer.Open;
begin
// создание канала с именем MailSlotName - по этому имени к нему
// будут обращаться клиенты
h := CreateMailSlot(PChar('\.mailslot' + MailSlotName), 0, MAILSLOT_WAIT_FOREVER,nil);
//h:=CreateMailSlot('\.mailslotMailSlot',0,MAILSLOT_WAIT_FOREVER,nil);
 
if h = INVALID_HANDLE_VALUE then begin
   raise Exception.Create('TglMailSlotServer: Ошибка создания канала !');
end;
Timer.Enabled := true;
end;
 
procedure TglMailSlotServer.Close;
begin
if h <> 0 then CloseHandle(h);
h := 0;
end;
 
procedure TglMailSlotServer.OnTimer(Sender: TObject);
var
MessageText: string;
begin
 
MessageText := '';
// определение наличия сообщения в канале
if not GetMailSlotInfo(h,nil,DWORD(MsgNext),@MsgNumber,nil) then
begin
   raise Exception.Create('TglMailSlotServer: Ошибка сбора информации!');
end;
if MsgNext <> MAILSLOT_NO_MESSAGE then
begin
   beep;
   // чтение сообщения из канала и добавление в текст протокола
   if ReadFile(h,str,200,DWORD(Read),nil) then
     MessageText := str
   else
     raise Exception.Create('TglMailSlotServer: Ошибка чтения сообщения !');
end;
 
if (MessageText<>'')and Assigned(OnNewMessage) then OnNewMessage(self, MessageText);
 
FLastMessage := MessageText;
end;
//------------------------------------------------------------------------------
 
constructor TglMailSlotClient.Create(AOwner: TComponent);
begin
inherited;
FMailSlotName := 'MailSlot';
FServerName := '';
end;
 
destructor TglMailSlotClient.Destroy;
begin
inherited;
end;
 
procedure TglMailSlotClient.Loaded;
begin
inherited;
Application.OnException := ErrorCatch;
end;
 
procedure TglMailSlotClient.ErrorCatch(Sender : TObject; Exc : Exception);
var
UserName: array[0..99] of char;
i: integer;
begin
// получение имени пользователя
i:=SizeOf(UserName);
GetUserName(UserName,DWORD(i));
 
Send('/'+UserName+'/'+FormatDateTime('hh:mm',Time)+'/'+Exc.Message);
// вывод сообщения об ошибке пользователю
Application.ShowException(Exc);
end;
 
function TglMailSlotClient.Send(str: string):boolean;
var
strMess: string[250];
UserName: array[0..99] of char;
h: THandle;
i: integer;
begin
// открытие канала : MyServer - имя сервера
// (\.\mailslotxxx - монитор работает на этом же ПК)
// xxx - имя канала
if FServerName = '' then FServerName := '.';
h:=CreateFile( PChar('\' + FServerName + 'mailslot' + FMailSlotName), GENERIC_WRITE,
                FILE_SHARE_READ,nil,OPEN_EXISTING, 0, 0);
if h <> INVALID_HANDLE_VALUE then
begin
   strMess := str;
   // передача текста ошибки (запись в канал и закрытие канала)
   WriteFile(h,strMess,Length(strMess)+1,DWORD(i),nil);
   CloseHandle(h);
end;
Result := h <> INVALID_HANDLE_VALUE;
end;
 
end.

Компонент TglMailSlotServer создает почтовый канал с именем MailSlotName и принимает входящие ссобщения. Компонент TglMailSlotClient отправляет сообщения в канал с именем MailSlotName на машине ServerName.
Эти компонеты входят в состав библиотеки GlobusLib, распространяемой с исходными текстами. Вы можете скачать ее на тут.

составление статьи: Андрей Чудин, ЦПР ТД Библио-Глобус.

Взято из http://delphi.chertenok.ru

Статья Mailslot - Обмен информацией между Вашими программами в сети по почтовым каналам раздела Интернет и Сети E-mail может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: E-mail ::


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Rambler's Top100
27.06.2017 20:30:59/0.06081485748291/2