Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi NetSend Code aus der Library - Win2000=OK WinXP=Probleme (https://www.delphipraxis.net/34963-netsend-code-aus-der-library-win2000%3Dok-winxp%3Dprobleme.html)

Piro 30. Nov 2004 19:30


NetSend Code aus der Library - Win2000=OK WinXP=Probleme
 
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.

jim_raynor 30. Nov 2004 19:48

Re: NetSend Code aus der Library - Win2000 und WinXP Problem
 
Vielleicht liegt es daran, dass unter XP Service Pack 2 der Nachrichtendienst deaktiviert wurde?

Ansonsten, kommt irgendeine Fehlermeldung?

Piro 30. Nov 2004 20:10

Re: NetSend Code aus der Library - Win2000 und WinXP Problem
 
Der Dienst ist an. Und wenn man normal mit net send es macht geht es auch. Bloß nicht mit diesem Code. Aber auch nur unter WinXP.

Seltsam.

Luckie 30. Nov 2004 20:43

Re: NetSend Code aus der Library - Win2000 und WinXP Problem
 
Zitat:

Zitat von daywalker299
Irgendwie funzt das nicht unter WinXP

Ich wollte mir eigentlich angewöhnen auf Postings mit so dermaßen aussagekräftigen Fehlerbeschreibungenb nicht mehr zu antworten. :roll:

Zitat:

Warum?
Schon mal Schritt für Schritt durchgegangen? GetLastError mal aufgerufen? Irgendwelche Fehlermeldungen? ....

Was sollen wir, bei denen es funktioniert, deiner Meinung nach jetzt machen ohne eine genaue Fehlerbeschreibung deiner seits? Das ist hier jetzt wieder nur ein Rumgerate ins Blaue.

Piro 30. Nov 2004 21:57

Re: NetSend Code aus der Library - Win2000 und WinXP Problem
 
@Lukie:

ich findes es immer wieder erstaunlich, wie freundlich du bist. Ich wollte nur mal wissen, ob diesen Problem, so wie ich es geschildert haben, bekannt ist.

So fern, es nicht der Fall ist, werde ich mich anders ausdrücken. Außerdem hätte vielleicht ein WinXP User dieses Problem schon mal gehabt und hätte gewußt, was man ändern muss.

Es kommt keine Fehlermeldung. Es erscheint auch kein Nachrichtenfenster. Es passiert einfach nichts. Ich habe selber nur Win2000.

Zwei Kollegen von mir haben es getestet und die hatten beide WinXP.

Luckie 30. Nov 2004 22:20

Re: NetSend Code aus der Library - Win2000 und WinXP Problem
 
Zitat:

Zitat von daywalker299
Ich wollte nur mal wissen, ob diesen Problem, so wie ich es geschildert haben, bekannt ist.

Sorry, aber das:
Zitat:

Irgendwie funzt das nicht unter WinXP
Ist für mich keine Fehlerbeschreibung.

Piro 2. Dez 2004 20:31

Re: NetSend Code aus der Library - Win2000=OK WinXP=Probleme
 
Liste der Anhänge anzeigen (Anzahl: 1)
Moin, ich kann jetzt das Problem etwas genauer schildern und ich hoffe mir kann einer sagen, warum das so ist.

Ich habe mir das Netznachrichtentool seperat programmiert. Des weiteren habe ich folgendes eingebaurt:
Delphi-Quellcode:
ShowMessage('Letzte Windows-Meldung: ' + SysErrorMessage(GetLastError));
Leider sind die Fehlermeldungen etwas wirr. Folgende sind aufgetreten.

WinXP:
1.Meldung: Das system kann die angegebene datei nicht finden.
2.Meldung: Zugriff verweigert.
3.Meldung: Erfolgreich ausgeführt (kam leider nur bei einem vor)

1 WinXP User konnte sich selbst eine NAchricht schicken aber dann an einen anderen XP Netzwerkuser ging es nicht. Meldung 1 kam.

Da ich keine WinXp Umgebung zum Testen habe, würde ich gerne einen von Euch bitten, der natürlich auch Zeit hätte, dies mal zu testen.

Ich gebe das Tool und den Code mit.

Wenn ich in meiner Umgebung teste, funktioniert es, aber er gibt nicht die Meldung aus, das es erfolgreich versendet wurde, sondern sagt, "das system konnte die gesuchte Datei nicht finden.

Das ist alles sehr verwirrend.


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:17 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz