Обмен информацией между Вашими программами в сети по почтовым каналам
Материал из DRKB
Обмен информацией между Вашими программами в сети по почтовым каналам[править | править код]
Как реализовать обмен информацией между Вашими приложениями в сети? ОС 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.Рассмотрим создание почтового канала (сервер).
//... создание канала с именем MailSlotName - по этому имени к нему
// будут обращаться клиенты
h := CreateMailSlot(PChar('\\.\mailslot\' + MailSlotName), 0, MAILSLOT_WAIT_FOREVER, nil);
if h = INVALID_HANDLE_VALUE then
begin
raise Exception.Create('MailSlotServer: Ошибка создания канала !');
Отправка сообщений по почтовомо каналу (клиенты).
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;
Все очень просто. Теперь для удобства использования создадим два компонента - клиент и сервер
{
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('\\.\mailslot\MailSlot', 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 - имя сервера
// (\\.\\mailslot\xxx - монитор работает на этом же ПК)
// 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.
Компонент создает почтовый канал с именем TglMailSlotServerMailSlotName и принимает входящие сообщения. Компонент TglMailSlotClient отправляет сообщения в канал с именем MailSlotName на машине ServerName. Эти компоненты входят в состав библиотеки GlobusLib, распространяемой с исходными текстами. Вы можете скачать ее на тут:
http://rsdn.org/article/Files/libs/globus_vcl.xml
Author: Андрей Чудин, ЦПР ТД Библио-Глобус.
Source: Взято из http://delphi.chertenok.ru
ID: 02082