{*******************************************************************************
Project : -
Filename : NetSend
Date : 2004-01-17
Version :
Last modified :
Author : Michael Puff
URL : [url]www.luckie-online.de[/url]
Copyright : Copyright (c) 2003 Michael Puff
History :
When I die I want 'Hello, world' carved on my headstone.
*******************************************************************************}
{*******************************************************************************
Copyright (c) 2001-2003, Michael Puff ["copyright holder(s)"]
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
3. The name(s) of the copyright holder(s) may not be used to endorse or
promote products derived from this software without specific prior written
permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*******************************************************************************}
{*******************************************************************************
Class for sending messages with the messenger service of NT machines.
Provides also methods for checking whether the messenger service is
running and starting / stopping the service.
*******************************************************************************}
unit NetSend;
interface
uses
windows, WinSvc;
const
bit29 = 1
SHL 28;
NERR_Success = 0;
NERR_BASE = 2100;
NERR_NameNotFound = NERR_BASE + 173;
NERR_NetworkError = NERR_BASE + 36;
ERROR_FAILED_STARTING_SERVICE = 1
or bit29;
ERROR_FAILED_STOPPING_SERVICE = 2
or bit29;
type
TNetSend =
class
private
FName:
string;
FMsg:
string;
FErrorCode: DWORD;
private
function NetSendMsg(
const Name, Text:
string): DWORD;
function ErrorCodeToStr:
string;
public
constructor Create(
const Receiver, Text:
string);
function MessengerSvcRunning(Machine:
String = '
'): Boolean;
function StartMessengerSvc(Machine:
String = '
'): Boolean;
function StopMessengerSvc(Machine:
String = '
'): Boolean;
procedure Send;
property ErrorCode: DWORD
read FErrorCode;
property ErrorStr:
string read ErrorCodeToStr;
property Receiver:
string read FName;
property MessageText:
string read FMsg;
end;
implementation
////////////////////////////////////////////////////////////////////////////////
// Procedure : ServiceGetStatus
// Comment : Author: DieHardMan
function ServiceGetStatus(sMachine, sService: PChar): DWORD;
{******************************************}
{*** Parameters: ***}
{*** sService: specifies the name of the service to open
{*** sMachine: specifies the name of the target computer
{*** ***}
{*** Return Values: ***}
{*** -1 = Error opening service ***}
{*** 1 = SERVICE_STOPPED ***}
{*** 2 = SERVICE_START_PENDING ***}
{*** 3 = SERVICE_STOP_PENDING ***}
{*** 4 = SERVICE_RUNNING ***}
{*** 5 = SERVICE_CONTINUE_PENDING ***}
{*** 6 = SERVICE_PAUSE_PENDING ***}
{*** 7 = SERVICE_PAUSED ***}
{******************************************}
var
SCManHandle, SvcHandle: SC_Handle;
SS: TServiceStatus;
dwStat: DWORD;
begin
dwStat := 0;
// Open service manager handle.
SCManHandle := OpenSCManager(sMachine,
nil, SC_MANAGER_CONNECT);
if (SCManHandle > 0)
then
begin
SvcHandle := OpenService(SCManHandle, sService, SERVICE_QUERY_STATUS);
// if Service installed
if (SvcHandle > 0)
then
begin
// SS structure holds the service status (TServiceStatus);
if (QueryServiceStatus(SvcHandle, SS))
then
dwStat := ss.dwCurrentState;
CloseServiceHandle(SvcHandle);
end;
CloseServiceHandle(SCManHandle);
end;
Result := dwStat;
end;
function ServiceRunning(sMachine, sService: PChar): Boolean;
begin
Result := SERVICE_RUNNING = ServiceGetStatus(sMachine, sService);
end;
function ServiceStart(Machine, ServiceName:
string): Boolean;
// Machine is UNC path or local machine if empty
var
h_manager, h_svc: SC_Handle;
ServiceStatus: TServiceStatus;
dwCheckPoint: DWORD;
ServiceArgVectors: PChar;
begin
h_manager := OpenSCManager(PChar(Machine),
nil, SC_MANAGER_CONNECT);
if h_manager > 0
then
begin
h_svc := OpenService(h_manager, PChar(ServiceName),
SERVICE_START
or SERVICE_QUERY_STATUS);
if h_svc > 0
then
begin
if (StartService(h_svc, 0, ServiceArgVectors))
then { succeeded }
begin
if (QueryServiceStatus(h_svc, ServiceStatus))
then
begin
while (SERVICE_RUNNING <> ServiceStatus.dwCurrentState)
do
begin
dwCheckPoint := ServiceStatus.dwCheckPoint;
Sleep(ServiceStatus.dwWaitHint);
if (
not QueryServiceStatus(h_svc, ServiceStatus))
then
// couldn't check status
break;
if (ServiceStatus.dwCheckPoint < dwCheckPoint)
then
break;
end;
end;
end;
CloseServiceHandle(h_svc);
end;
CloseServiceHandle(h_manager);
end;
Result := (SERVICE_RUNNING = ServiceStatus.dwCurrentState);
end;
function ServiceStop(Machine, ServiceName:
string): Boolean;
// Machine is UNC path or local machine if empty
var
h_manager, h_svc: SC_Handle;
ServiceStatus: TServiceStatus;
dwCheckPoint: DWORD;
begin
h_manager := OpenSCManager(PChar(Machine),
nil, SC_MANAGER_CONNECT);
if h_manager > 0
then
begin
h_svc := OpenService(h_manager, PChar(ServiceName),
SERVICE_STOP
or SERVICE_QUERY_STATUS);
if h_svc > 0
then
begin
if (ControlService(h_svc, SERVICE_CONTROL_STOP, ServiceStatus))
then
begin
if (QueryServiceStatus(h_svc, ServiceStatus))
then
begin
while (SERVICE_STOPPED <> ServiceStatus.dwCurrentState)
do
begin
dwCheckPoint := ServiceStatus.dwCheckPoint;
Sleep(ServiceStatus.dwWaitHint);
if (
not QueryServiceStatus(h_svc, ServiceStatus))
then
// couldn't check status
break;
if (ServiceStatus.dwCheckPoint < dwCheckPoint)
then
break;
end;
end;
end;
CloseServiceHandle(h_svc);
end;
CloseServiceHandle(h_manager);
end;
Result := (SERVICE_STOPPED = ServiceStatus.dwCurrentState);
end;
// TNetSend
constructor TNetSend.Create(
const Receiver, Text:
string);
begin
FName := Receiver;
FMsg := Text;
FErrorCode := 0;
end;
function TNetSend.MessengerSvcRunning(Machine:
String = '
'): Boolean;
begin
result := ServiceRunning(pointer(Machine), '
Messenger');
end;
function TNetSend.StartMessengerSvc(Machine:
String = '
'): Boolean;
begin
result := ServiceStart(Machine, '
Messenger');
if not result
then
FErrorCode := ERROR_FAILED_STARTING_SERVICE;
end;
function TNetSend.StopMessengerSvc(Machine:
String = '
'): Boolean;
begin
result := ServiceStop(Machine, '
Messenger');
if not result
then
FErrorCode := ERROR_FAILED_STOPPING_SERVICE;
end;
procedure TNetSend.Send;
begin
FErrorCode := NetSendMsg(FName, FMsg)
end;
function TNetSend.ErrorCodeToStr:
string;
resourcestring
InvalidParameter = '
Ungültiger Parameter';
CallNotImplemented = '
Aufruf nicht implementiert';
NotEnoughMemory = '
Nicht genug Speicher';
InternalError = '
Interner Fehler';
NerrSuccess = '
Nachricht gesendet';
AccessDenied = '
Zugriff verweigert';
NotSupported = '
Funktion nicht unterstützt';
MachineNotFound = '
Computer nicht gefunden';
NetworkError = '
Fehler im Netzwerk';
UnKnownError = '
Unbekannter Fehler';
FailedStartingService = '
Nachrichtendienst konnte nicht gestartet werden';
FailedStoppingService = '
Nachrichtendienst konnte nicht beendet werden';
begin
case FErrorCode
of
ERROR_INVALID_PARAMETER: result := InvalidParameter;
ERROR_CALL_NOT_IMPLEMENTED: result := CallNotImplemented;
ERROR_NOT_ENOUGH_MEMORY: result := NotEnoughMemory;
ERROR_INTERNAL_ERROR: result := InternalError;
NERR_Success: result := NerrSuccess;
ERROR_ACCESS_DENIED: result := AccessDenied;
ERROR_NOT_SUPPORTED: result := NotSupported;
NERR_NameNotFound: result := MachineNotFound;
NERR_NetworkError: result := NetworkError;
ERROR_FAILED_STARTING_SERVICE: result := FailedStartingService;
ERROR_FAILED_STOPPING_SERVICE: result := FailedStoppingService;
else
result := UnKnownError;
end;
end;
////////////////////////////////////////////////////////////////////////////////
// Procedure : TNetSend.NetSendMsg
// Comment : Author: Nico Bendlin
function TNetSend.NetSendMsg(
const Name, Text:
string): DWORD;
const
NetApi32Lib = '
netapi32.dll';
NERR_Success = 0;
type
LPBYTE = PByte;
LPVOID = Pointer;
NET_API_STATUS = Integer;
TFNNetMessageBufferSend =
function(servername, msgname, fromname: LPCWSTR;
buf: LPBYTE; buflen: DWORD): NET_API_STATUS;
stdcall;
TFNNetApiBufferAllocate =
function(ByteCount: DWORD;
out Buffer: LPVOID
): NET_API_STATUS;
stdcall;
TFNNetApiBufferFree =
function(Buffer: LPVOID): NET_API_STATUS;
stdcall;
var
NetApi32: HMODULE;
NetMessageBufferSend: TFNNetMessageBufferSend;
NetApiBufferAllocate: TFNNetApiBufferAllocate;
NetApiBufferFree: TFNNetApiBufferFree;
MsgName: LPCWSTR;
MsgLen: DWORD;
Buffer: LPBYTE;
BufLen: DWORD;
begin
Result := ERROR_INVALID_PARAMETER;
if (Length(
Name) <= 0)
or (Length(Text) <= 0)
then
Exit;
Result := ERROR_CALL_NOT_IMPLEMENTED;
NetApi32 := LoadLibrary(NetApi32Lib);
if NetApi32 <> 0
then
try
NetMessageBufferSend := TFNNetMessageBufferSend(
GetProcAddress(NetApi32, '
NetMessageBufferSend'));
NetApiBufferAllocate := TFNNetApiBufferAllocate(
GetProcAddress(NetApi32, '
NetApiBufferAllocate'));
NetApiBufferFree := TFNNetApiBufferFree(
GetProcAddress(NetApi32, '
NetApiBufferFree'));
if Assigned(NetMessageBufferSend)
and
Assigned(NetApiBufferAllocate)
and
Assigned(NetApiBufferFree)
then
begin
Result := ERROR_NOT_ENOUGH_MEMORY;
MsgName :=
nil;
MsgLen := (Length(
Name) + 1) * SizeOf(WideChar);
Buffer :=
nil;
BufLen := (Length(Text) + 1) * SizeOf(WideChar);
if (NetApiBufferAllocate(MsgLen, Pointer(MsgName)) = NERR_Success)
and
(NetApiBufferAllocate(BufLen, Pointer(Buffer)) = NERR_Success)
then
try
StringToWideChar(
Name, MsgName, MsgLen);
StringToWideChar(Text, PWideChar(Buffer), BufLen);
Result := DWORD(
NetMessageBufferSend(
nil, MsgName,
nil, Buffer, BufLen));
except
Result := ERROR_INTERNAL_ERROR;
end;
if Assigned(MsgName)
then
NetApiBufferFree(Pointer(MsgName));
if Assigned(Buffer)
then
NetApiBufferFree(Pointer(Buffer));
end;
finally
FreeLibrary(NetApi32)
end;
end;
end.