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:
|
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
function ServiceGetStatus(sMachine, sService: PChar): DWORD; var SCManHandle, SvcHandle: SC_Handle; SS: TServiceStatus; dwStat: DWORD; begin dwStat := 0; SCManHandle := OpenSCManager(sMachine, nil, SC_MANAGER_CONNECT); if (SCManHandle > 0) then begin SvcHandle := OpenService(SCManHandle, sService, SERVICE_QUERY_STATUS); if (SvcHandle > 0) then begin 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; 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 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 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; 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 break; if (ServiceStatus.dwCheckPoint < dwCheckPoint) then break; end; end; end; CloseServiceHandle(h_svc); end; CloseServiceHandle(h_manager); end;
Result := (SERVICE_STOPPED = ServiceStatus.dwCurrentState); end;
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;
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. |