1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:

{*******************************************************************************
 Project       : -
 Filename      : NetSend
 Date          : 2004-01-17
 Version       :
 Last modified :
 Author        : Michael Puff
 URL           : www.luckie-online.de
 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.