Delphi-PRAXiS - Delphi Klasse für "Net Send"

Ich habe mir mal die Mühe gemacht und NetMessageBufferSend zur einfacheren Handhabung in eine Klasse gekapselt. Zusätzlich kann die Klasse überprüfen, ob der Nachrichtendienst gestartet ist und ihn bei bedarf starten und / oder beenden.
Hier der Code:
Delphi-Quellcode:
			{*******************************************************************************

 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.
Download:
TNetSend.zip [5 KBytes]
In dem Archiv ist noch ein kleines Demo drin.