NetSend + Multithread

[Piro]

Moin,

ich verwende, die unten aufgeführte Funktion, um eine NetSend Nachricht zu versenden. Ich möchte an ca. 1000 Computer etwas versenden. Da auch Computer Offline sein können, dauert das ewig und das Programm hängt sich auch auf. Nun habe ich mir überlegt, dass ich die Funktion in Thread übergeben könnte, der dann alleine läuft und das Hauptprogramm davon nichts mehr mitbekommt. Ich habe mir einige Tutorials zum Thread angeschaut. Werde aber nicht schlau draus.

Delphi-Quellcode:

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;

Wenn mir einer einen Ansatz verraten würde, wäre ich erfreut. Ich habs mal mit:
CreateThread(nil, 0, TFNThreadStartRoutine(NetMessageBufferSendSubstA(Memo1.Lines[i], 'MsgName', 'FromName', 'Msg: AnsiString')), nil, 0, ThreadID); probiert aber das will nicht. Beim 2. Durchlauf kommt erscheint die CPU Seite bei Delphi. Warum auch immer und das Program hängt.

Gruß, Sven

[Luckie]

Dann guck mal wie TFNThreadStartRoutine definiert ist und vergleich mal die Parameter.

Davon mal abgesehen, wann muss man mittels des Nachrichtendienstes eine Nachricht an 1.000 (!) Computer schicken?

[Piro]

Man braucht das für einen Domänenrundruf. Früher haben wir das mit dem Dos Befehl gemacht. Jetzt sind wir Teil einer großen Domäne und in einer bestimmten OU und so können wir den Dos Befehl nicht mehr verwenden, da es sonst an alle geht.

TFNThreadStartRoutine habe ich mal gegooglet aber da ich mich überhaupt nicht damit auskenne, weiß ich gar nicht, wonach ich schauen soll, warum es nicht geht.

Habe meine Code einwenig verändert:

Delphi-Quellcode:

ThreadHandle := CreateThread(nil, 0, TFNThreadStartRoutine(NetMessageBufferSendSubstA(Memo1.Lines[i], Memo1.Lines[i], 'User', 'Hallo')), nil, 0, ThreadID);
//wenn der Thread erfolgreich gestartet wurde (ThreadHandle<>0), können wir ThreadHandle wieder freigeben:
if ThreadHandle<>0 then
  CloseHandle(ThreadHandle);

Brauche doch etwas mehr Hilfe bei dem Thema.

[Piro]

Normalerweise steht auch ein "@" vor der Funktion aber dann sagt der Compiler: "Variable erforderlich".

???

[Piro]

Vielleicht muss ja auch einen anderen Lösungsweg wählen. Ahnungslos...

[Luckie]

Lies mal das: http://www.michael-puff.de/Developer/Delphi/Tutorials/

[Piro]

Habe dein Tutorial gelesen. Sehr interessant. Gibt es irgendwo eine Beispielanwendung, wo man sieht wie man:
1. Thread deklariert
2. Thread erstellt (mehre Trhread erstellt)
3. Thread sich automatisch beendet

Wäre echt gut.

[Luckie]

Hast du dir die Demos in den Archiven angeguckt?

[Piro]

Ich habe es wie folgt umgesetzt aber ich habe das Gefühl, dass die Threads nacheinander und nicht parallel abgearbeitet werden. Die Hauptansicht = Hauptprogramm friert auch ein.

Hier mein Hauptprogram - uMain.pas

Delphi-Quellcode:

...
uses uThread;

procedure Tfrm_main.btn_sendenClick(Sender: TObject);
var
  i : Integer;
  Thread: MyThread;
begin
  computer := '';
  if edt_nachricht.Text <> '' then
  begin
    if MessageDlg('Wollen Sie wirklich diese Nachricht versenden?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    begin
      for i:= 0 to m_liste.Lines.Count - 1 do
        begin
          computer := m_liste.Lines[i];
          if computer <> '' then
          begin
            Application.ProcessMessages;

            if computer <> '' then
            begin
              Thread := MyThread.Create(False);
              Thread.ServerName := computer;
              Thread.MsgName    := computer;
              Thread.FromName   := 'Absender';
              Thread.Msg        := edt_nachricht.Text;
              Thread.FreeOnTerminate := True;
              //Thread.OnTerminate := OnThreadTerminate;
              Thread.Resume; // Falls der Thread suspended gestartet wurde sorgt dies dafür, dass er anfängt mit arbeiten.
            end;
          end;
        end;
      end;
      MessageDlg(DateToStr(Now)+' '+TimeToStr(Time)+ ' - Nachricht versendet.', mtInformation, [mbOK],0);
    end;
  end
  else
    MessageDlg('Bitte geben Sie eine Nachricht zum Versenden ein.', mtInformation, [mbOK],0);
end;

Hier mein die Thread Unit - uThread.pas

Delphi-Quellcode:

unit uThread;

interface

uses
  Classes, SysUtils, Windows;

type
  MyThread = class(TThread)
  procedure DoSomething;
  procedure NetSend;
  private
    { Private-Deklarationen }
  protected
    procedure Execute; override;
  public
    ServerName, MsgName, FromName, Msg: AnsiString;
  end;

implementation

uses uMain;

{ Wichtig: Methoden und Eigenschaften von Objekten in visuellen Komponenten dürfen
  nur in einer Methode namens Synchronize aufgerufen werden, z.B.

      Synchronize(UpdateCaption);

  und UpdateCaption könnte folgendermaßen aussehen:

    procedure MyThread.UpdateCaption;
    begin
      Form1.Caption := 'Aktualisiert in einem Thread';
    end; }

{ MyThread }

procedure MyThread.Execute;
begin
 try
   { Thread-Code hier einfügen }
   DoSomething();
 except
    on e: exception do begin
      // mache hier irgendetwas mit dem Fehler.
    end;
 end;
end;

procedure MyThread.DoSomething;
begin
 Synchronize(NetSend);
end;

procedure MyThread.NetSend;
{.$DEFINE SYNCHRONOUS}
const
  szService = '\mailslot\messngr';
  MaxBufLen = $700;
var
  hFile: THandle;
  WrittenBytes: DWORD;
{$IFNDEF SYNCHRONOUS}
  ovs: OVERLAPPED;
  EventName:String;
{$ENDIF}
begin
  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}
  finally
{$IFNDEF SYNCHRONOUS}
    if WaitForSingleObject(ovs.hEvent, INFINITE) <> WAIT_TIMEOUT then
{$ENDIF}
      CloseHandle(hFile);
  end;
end;

end.

Was muss ich denn noch ändern, dass das Hauptprogramm nicht einfriert. Ein weiteres Phänomän ist, dass erst alle Threads erzeugt und dann erst ausgeführt werden. Warum? Ich habe doch beim Create False gesetzt.

Fragen über Fragen. Ich hoffe einer kann mir weiter helfen.

[Piro]

Keiner Idee oder Vorschläge wie man es eventuell besser machen kann? Wäre euch dankbar.