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

Материал из 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