unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
function NetMessageBufferSendSubstA(ServerName, MsgName, FromName, Msg: AnsiString): Boolean;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.NetMessageBufferSendSubstA(ServerName, MsgName, FromName, Msg: AnsiString): Boolean;
{.$DEFINE SYNCHRONOUS}
const
szService = '
\mailslot\messngr';
MaxBufLen = $700;
var
hFile: THandle;
WrittenBytes: DWORD;
{$IFNDEF SYNCHRONOUS}
ovs: OVERLAPPED;
EventName:
String;
{$ENDIF}
begin
Result := False;
if Length(Msg) > MaxBufLen
then
SetLength(Msg, MaxBufLen);
{$IFNDEF SYNCHRONOUS}
EventName:='
NetSendEvent_'+ServerName;
{$ENDIF}
ServerName := '
\\' + Servername + szService;
hFile := CreateFileA(
@ServerName[1], GENERIC_WRITE, FILE_SHARE_READ,
nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL
or FILE_FLAG_NO_BUFFERING
or FILE_FLAG_OVERLAPPED, 0);
if hFile <> INVALID_HANDLE_VALUE
then
try
Msg := FromName + #0 + MsgName + #0 + Msg;
{$IFNDEF SYNCHRONOUS}
ovs.hEvent := CreateEventA(
nil, True, False, @EventName[1]);
WriteFile(hFile, Pointer(Msg)^, Length(Msg), WrittenBytes, @ovs);
{$ELSE}
WriteFile(hFile, Pointer(Msg)^, Length(Msg), WrittenBytes,
nil);
{$ENDIF}
Result := GetLastError = ERROR_IO_PENDING;
finally
{$IFNDEF SYNCHRONOUS}
if WaitForSingleObject(ovs.hEvent, INFINITE) <> WAIT_TIMEOUT
then
{$ENDIF}
CloseHandle(hFile);
end;
end;
//Aufruf:
procedure TForm1.Button1Click(Sender: TObject);
begin
NetMessageBufferSendSubstA('
10.0.0.70', '
Ist eh egal', '
DerAbsender', '
Die Nachricht');
end;
end.