(******************************************************************************
This code is PUBLIC DOMAIN!
You may find it on [url]http://assarbad.net[/url] or [url]http://assarbad.net[/url]
Contact me via eMail: Assarbad AT gmx DOT info
... or via ICQ : 28 16 45
******************************************************************************)
function 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;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not NetMessageBufferSendSubstA('
hal9000', '
Empfänger', '
Absender', '
üäö')
then
RaiseLastOSError();
end;