Mega Code Archive
Programming a Mail Slot
<![CDATA[
Title: Programming a Mail-Slot
Question: How can two applications communicate with each other if they are running on different machines?
Answer:
unit Chris;
interface
uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Menus, IniFiles, Buttons, ComCtrls,
Spin, Registry, FileCtrl, ShellAPI, WinSvc;
// -----------------------------------------------------------------------
// First of all the Type-Definitions
Type
TChMailSlot = class
LastError: String;
function CreateLocalServer(MailSlotName: String): Boolean;
function CreateRemoteServer(Server, MailSlotName: String): Boolean;
function CreateLocalClient(MailSlotName: String): Boolean;
function CreateRemoteClient(Server, MailSlotName: String): Boolean;
function ReadMail : String;
function WriteMail(Text: String) : Boolean;
procedure CloseServer;
procedure CloseClient;
private
{ Private declarations }
FMailslotServer : THandle;
FMailslotClient : THandle;
public
{ Public declarations }
end;
Var ChMailSlot : TChMailSlot;
implementation
{ -----------------------------------------------------------------------------}
{ -------------------- Begin of TChMailSlot-Declarations ----------------- }
{ -----------------------------------------------------------------------------}
function TChMailSlot.CreateLocalServer(MailSlotName: String): Boolean;
const cERRNOCREATE = 'The Mailslot %s could not be created';
cSUCCESSCREATE = 'The Mailslotserver %s has been created';
begin
LastError:= '';
FMailslotServer := CreateMailslot(PChar('\\.\mailslot\'+MailSlotName), 0, 0, nil);
if FMailslotServer = Invalid_Handle_Value then begin
Result:= False;
LastError:= Format(cERRNOCREATE, [MailSlotName]);
end else begin
Result:= True;
LastError:= Format(cSUCCESSCREATE, [MailSlotName]);
end;
end;
function TChMailSlot.CreateRemoteServer(Server, MailSlotName: String): Boolean;
const cERRNOCREATE = 'The Mailslot %s could not be created';
cSUCCESSCREATE = 'The Mailslotserver %s has been created';
begin
LastError:= '';
FMailslotServer := CreateMailslot(PChar('\\'+Server+'\mailslot\'+MailSlotName), 0, 0, nil);
if FMailslotServer = Invalid_Handle_Value then begin
Result:= False;
LastError:= Format(cERRNOCREATE, [MailSlotName]);
end else begin
Result:= True;
LastError:= Format(cSUCCESSCREATE, [MailSlotName]);
end;
end;
function TChMailSlot.CreateLocalClient(MailSlotName: String): Boolean;
Const cERRNOOPEN = 'The Mailslot %s could not be opened.';
cSUCCESSCREATE = 'The Mailslotclient %s could be created';
begin
FMailslotClient := CreateFile(PChar('\\.\mailslot\'+MailSlotName), Generic_Write, File_Share_Read,
nil, Open_Existing, File_Attribute_Normal, 0);
if FMailslotClient = INVALID_HANDLE_VALUE then begin
Result:= False;
LastError:= Format(cERRNOOPEN, [MailSlotName]);
end else begin
Result:= True;
LastError:= Format(cSUCCESSCREATE, [MailSlotName]);
end;
end;
function TChMailSlot.CreateRemoteClient(Server, MailSlotName: String): Boolean;
Const cERRNOOPEN = 'The Mailslot %s could not be opened.';
cSUCCESSCREATE = 'The Mailslotclient %s was be created successfully';
begin
FMailslotClient := CreateFile(PChar('\\'+Server+'\mailslot\'+MailSlotName), Generic_Write, File_Share_Read,
nil, Open_Existing, File_Attribute_Normal, 0);
if FMailslotClient = INVALID_HANDLE_VALUE then begin
Result:= False;
LastError:= Format(cERRNOOPEN, [MailSlotName]);
end else begin
Result:= True;
LastError:= Format(cSUCCESSCREATE, [MailSlotName]);
end;
end;
function TChMailSlot.ReadMail : String;
const cERRNOINFO = 'Reading Mailslot information not possible.';
cERRNOREAD = 'It was not possible to read the information from the Mailslot.';
Var iMsgSize : DWord;
iRead : DWord;
sMsg : String;
begin
Result:= '';
LastError:= '';
if not GetMailslotInfo(FMailslotServer, nil, iMsgSize, nil, nil) then
begin
LastError:= cERRNOINFO;
end;
if iMsgSize MAILSLOT_NO_MESSAGE then
begin
SetLength(sMsg, iMsgSize);
if not ReadFile(FMailslotServer, sMsg[1], iMsgSize, iRead, nil) then
begin
LastError:=cERRNOREAD;
end;
Result:= sMsg;
end;
end;
function TChMailSlot.WriteMail(Text: String) : Boolean;
const cERRNOWRITE = 'It was not possible to send the information to the Mailslot.';
var
iBytes : DWord;
sMsg : String;
begin
sMsg := Text;
LastError:= cERRNOWRITE;
Try
WriteFile(FMailslotClient, sMsg[1], Length(sMsg), iBytes, nil);
Result:= True;
LastError:='';
except
LastError:= cERRNOWRITE;
Result:= False;
end;
end;
procedure TChMailSlot.CloseServer;
begin
CloseHandle(FMailslotServer);
end;
procedure TChMailSlot.CloseClient;
begin
CloseHandle(FMailslotClient);
end;
begin { ---------------- Initialisation of the Unit ---------------- }
ChMailSlot:= TChMailSlot.Create;
END.
{ -----------------------------------------------------------------------------}
{ ---------------------- End of TChMailSlot-Declarations --------------------- }
{ -----------------------------------------------------------------------------}
{ And now a simple client-programm using the Mailslot definitions above defined in the unit Chris }
unit MainClient;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,Chris;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Messages: TEdit;
Text: TEdit;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
ChMailSlot.CreateLocalClient('TestMailSlot');
Messages.Text:= ChMailSlot.LastError;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ChMailSlot.CloseClient;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
If not ChMailSlot.WriteMail(Text.Text) then begin
MessageBeep(0);
end;
Messages.Text:= ChMailSlot.LastError;
Text.SelectAll;
end;
end.
{ And the corresponding server-programm using the Mailslot definitions above defined in the unit Chris }
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,Chris, ExtCtrls;
type
TForm1 = class(TForm)
Messages: TEdit;
Label1: TLabel;
Text: TEdit;
Label2: TLabel;
Button1: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
ChMailSlot.CreateLocalServer('TestMailSlot');
Messages.Text:= ChMailSlot.LastError;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ChMailSlot.CloseServer;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Text.Text:=ChMailSlot.ReadMail;
Messages.Text:= ChMailSlot.LastError;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
Var Mail: String;
begin
Mail:= ChMailSlot.ReadMail;
If Mail '' then begin
Text.Text:= Mail;
Messages.Text:= ChMailSlot.LastError;
end;
end;
end.
]]>