Как реализовать обмен информацией между Вашими приложениями в сети? ОС 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, распространяемой с исходными текстами. Вы можете скачать ее на тут.
составление статьи: Андрей
Чудин, ЦПР
ТД
Библио-Глобус.
Статья Mailslot - Обмен информацией между Вашими программами в сети по почтовым каналам раздела Интернет и Сети E-mail может быть полезна для разработчиков на Delphi и FreePascal.
