NetSend Code aus der Library - Win2000=OK WinXP=Probleme

[Piro]

Irgendwie funzt das nicht unter WinXP: Warum?

Delphi-Quellcode:

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 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;

Der Aufruf im Programm:

Delphi-Quellcode:

procedure Tfrm_main.btn_sendenClick(Sender: TObject);
var
 absender : string;
 status, versand: boolean;
begin
 case rg_absender.ItemIndex of
   0: absender := DataModule1.PJSysInfo1.UserName;
   1: absender := DataModule1.PJSysInfo1.ComputerName;
   2: absender := '###';
 end;

 status := ServiceRunning(PCHar(edt_netsend_pc.Text), 'Messenger');
 if (edt_netsend_pc.Text <> '') and (redt_netsend_nachricht.Lines.Count > 0) and (status = true) then
   versand := NetMessageBufferSendSubstA(edt_netsend_pc.Text,         // ServerName
                                         edt_netsend_pc.Text,         // Anzeige "an"
                                         absender,                    // Anzeige "von"
                                         redt_netsend_nachricht.Text) // Nachricht

 else
 begin
 //...  
 end;

 if versand = true then
   MessageDlg('Die Nachricht wurde erfolgreich versendet.', mtInformation, [mbOK], 0);
End;

Tja, ich haben keine Ahnung. Unter Win2000 geht es. Vielleicht könnt ihr es mal testen bzw. wisst Rat.

Danke.