![]() |
NetSend + Multithread
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:
Wenn mir einer einen Ansatz verraten würde, wäre ich erfreut. Ich habs mal mit:
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;
Delphi-Quellcode:
probiert aber das will nicht. Beim 2. Durchlauf kommt erscheint die CPU Seite bei Delphi. Warum auch immer und das Program hängt.
CreateThread(nil, 0, TFNThreadStartRoutine(NetMessageBufferSendSubstA(Memo1.Lines[i], 'MsgName', 'FromName', 'Msg: AnsiString')), nil, 0, ThreadID);
Gruß, Sven |
Re: NetSend + Multithread
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? |
Re: NetSend + Multithread
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:
Brauche doch etwas mehr Hilfe bei dem Thema.
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); |
Re: NetSend + Multithread
Normalerweise steht auch ein "@" vor der Funktion aber dann sagt der Compiler: "Variable erforderlich".
??? |
Re: NetSend + Multithread
Vielleicht muss ja auch einen anderen Lösungsweg wählen. Ahnungslos...
|
Re: NetSend + Multithread
Lies mal das:
![]() |
Re: NetSend + Multithread
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. |
Re: NetSend + Multithread
Hast du dir die Demos in den Archiven angeguckt?
|
Re: NetSend + Multithread
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:
Hier mein die Thread Unit - uThread.pas
...
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;
Delphi-Quellcode:
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.
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. Fragen über Fragen. Ich hoffe einer kann mir weiter helfen. |
Re: NetSend + Multithread
Keiner Idee oder Vorschläge wie man es eventuell besser machen kann? Wäre euch dankbar.
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:38 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz