Server im LAN finden mittels IdTCPClient

[Kill0r]

Hi Leute
Für einen LAN-Messenger suche ich nach einer Möglichkeit um zuverlässig und relativ schnell mittels TCP Protokoll einen Server auf einem bestimmten Port zu finden. Ich habe schon ca. 2 Tage rumprobiert und bin einfach nicht auf eine vernünftige Lösung gekommen, deshalb seid ihr meine letzte Hoffnung!

Also... ich will alle IPs von 192.168.1.1 bis 192.168.1.255 auf dem Port 6000 ab scannen ob da meine Software (also der Messenger läuft). Ich habe es bisher mit mehreren Threads (TThread) versucht, zuerst mit 255 Threads die GLEICHZEITIG verbunden haben, dies schlug fehl. Dann alle 255 Threads mit Suspended = True erstellt und dann nacheinander gestartet... dies funktionierte ebenfalls nicht.

Nun hab ich es so gemacht, dass ich zuerst eine Art Jobliste erstelle mit allen IPs drin.
Dann noch eine Art Threadliste (keine TThreadList!) welche am Anfang 5 Threads zugewiesen bekommt, welche dann überwacht werden und sobald einer beendet ist, ein neuer Thread erstellt wird mit dem nächsten "Job" (IP). So das immer genau 5 Threads arbeiten
Naja... dies will jedoch auch weder zuverlässig noch genügend schnell arbeiten
Genauer gesagt arbeitet er so für ca. 10 Threads korrekt, bleibt dann aber etwa 20 Sekunden hängen bevor er weiterarbeitet, das Problem ist gelöst wenn ich ein Sleep mit 1 Sekunden reinsetze. Aber es sollte doch schneller gehen oder?
Ich habe das Gefühl dass mir die TIdThreads dazwischenfunken

Ich muss noch anmerken, dass ich zum 1. Mal mit Threads arbeite, habe da noch keine Erfahrungen.

Hier noch bisschen Code damit ihr euch auch mehr darunter vorstellen könnt als bei meiner Erklärung

Hier sind mal die Klassendefinitionen:
TSearchThread = Der "Chef"-Thread, er wird vom Hauptprogramm instanziert und steuert den ganzen Ablauf.
TWorkers = Die Liste der laufenden Threads
TWorker = Der "Arbeiter"-Thread, der Thread der den eigentlichen Verbindungsversuch ausführt. Er enthält den IdTCPClient und sollte dann eigentlich auch zurückliefern ob die Verbindung erfolgreich war oder nicht. Hatte ich bei meinem 1. Anlauf noch drin, später wieder rausgenommen weils vorerst unwichtig war. (Habt ihr da auch eine Idee wie ich das am besten realisieren könnte?)
TJobList = Die oben erwähnte Jobliste. Sie wird mit den IPs von 192.168.1.1 bis 192.168.1.255 aufgefüllt welche dann einzeln abgearbeitet werden.

Delphi-Quellcode:

TWorker = class(TThread)
  private
    client: TIdTCPClient;
  protected
    procedure Execute; override;
  public
    IP: string;
    Connected: boolean;
    Running: boolean;
  end;

  TWorkers = class(TObject)
  private
  protected
  public
    Threads: Array of TWorker;
  end;

  TJobList = class(TStringList)
  private
  protected
  public
    function GetNextJob: String;
  end;

  TSearchThread = class(TThread)
  private
    NewItem: string;
    JobList: TJobList;
    Workers: TWorkers;
  protected
    procedure Execute; override;
    procedure AddTreeItem;
    procedure RunCheck(Index: integer);
  public
    IP: string;
    Connected: boolean;
  end;

Und noch die einzelnen Prozeduren:

Delphi-Quellcode:

procedure TSearchThread.Execute;
var
  i: Integer;
begin
  JobList := TJobList.Create;
  Workers := TWorkers.Create;
  for i := 0 to 255 do
  begin
    JobList.Add('192.168.1.'+IntToStr(i));
  end;

  for i := 0 to 5 do
  begin
    SetLength(Workers.Threads, Length(Workers.Threads)+1);
    Workers.Threads[i] := TWorker.Create(true);
    Workers.Threads[i].IP := JobList.GetNextJob;
    Workers.Threads[i].Resume;
  end;

  while JobList.Count > 0 do
  begin
    for i := 0 to Length(Workers.Threads)-1 do
    begin
      if not Workers.Threads[i].Running then
      begin
        NewItem := 'Thread '+IntToStr(i)+' wurde beendet';
        Synchronize(AddTreeItem);
        Workers.Threads[i] := TWorker.Create(true);
        Workers.Threads[i].IP := JobList.GetNextJob;
        Workers.Threads[i].Resume;
      end;
      Sleep(500);
    end;
  end;
end;

procedure TSearchThread.AddTreeItem;
begin
  frmMain.treeContacts.Items.AddChild(nil, NewItem);
end;

procedure TWorker.Execute;
begin
  Running := true;
  client := TIdTCPClient.Create;
  client.Port := 60000;
  client.ConnectTimeout := 500;
  client.Host := IP;
  try
    client.Connect;
  except
  end;
  if client.Connected then
  begin
    Connected := true;
  end
  else
  begin
    Connected := false;
  end;
  client.Free;
  Running := false;
end;

function TJobList.GetNextJob:string;
begin
  Result := self.Get(0);
  self.Delete(0);
end;

Ich hoffe ihr Profis *gg* könnt etwas damit anfangen und mir helfen... Wär echt toll

Danke im voraus!

Cu
Schönen Abend noch
Kill0r

[gsh]

du könntest des auch einfach (profesioneller) mit UDP machen
damit kannst du einfach einen broadcast senden der an alle computer in einem subnetz geht

Informationen dafür findest du sicher im forum

[Kill0r]

Nein, leider nicht... UDP kann ich aus Firewall-technischen Gründen nicht verwenden.
Aber danke für deine Antwort (hab es wohl vergessen zu erwähnen )

Cu
Kill0r

[DataCool]

Hi,

Dein Thread-Code ist nicht Thread-Safe !!!!!!!!!!!

Deine Function GetNextJob muss innerhalb einer CriticalSection laufen,
den überleg mal was passiert wenn 2 oder mehr Threads gleichzeitig GetNextJob aufrufen.

Außerdem prüfst Du ob das Ende der Jobliste erreicht ist indem Du .ount der Stringliste prüfst,
das ist so auh nicht Threadsafe.
Da solltest Du, um beim Deinem jetzigen Code zu bleiben, Deine TJoblist um eine Function isEmpty : Boolean erweitern.
In dieser Function darfst Du auch nur innerhalb der CritialSection auf .Count der TStringList zugreifen.

Das war nur ne "optimierung" auf die Schnelle, das kann man noch schöner machen

Greetz DataCool

[Kill0r]

Okay danke, ich werde es mal versuchen ob ich das hinkriege
Aber denkst du, dass die Symptome vom "Hängenbleiben" damit zu tun haben? Oder ist dir das einfach gerade aufgefallen?

Cu
Kill0r

[DataCool]

Hi,

ich habe das ganze mal eben auf die Schnelle programmiert(ohne Test und gewährleistung):

Delphi-Quellcode:

unit Unit1;

interface

uses Classes, SyncObjs, IdTcpClient;

type

  TWorker = class(TThread)
    private
      client: TIdTCPClient;
    protected
      procedure Execute; override;
    public
      IP: string;
      Connected: boolean;
      Running: boolean;
  end;

  TWorkers = class(TObject)
    private
      {}
    protected
      {}
    public
      Threads: Array of TWorker;
  end;

  TJobList = class(TStringList)
    private
      FCS : TCriticalSection;
    protected
      {}
    public
      Constructor Create;
      Destructor Destroy;
      function GetNextJob: String;
      function isEmpty : boolean;
      procedure SaveAdd(sIP : String);
  end;

  TSearchThread = class(TThread)
  private
    NewItem: string;
    JobList: TJobList;
    Workers: TWorkers;
  protected
    procedure Execute; override;
    procedure AddTreeItem;
    procedure RunCheck(Index: integer);
  public
    IP: string;
    Connected: boolean;
  end;

implementation


procedure TSearchThread.Execute;
var
  i: Integer;
  bBreak : Boolean;
begin
  JobList := TJobList.Create;
  Workers := TWorkers.Create;
  for i := 0 to 255 do
  begin
    JobList.SaveAdd('192.168.1.'+IntToStr(i));
  end;

  for i := 0 to 5 do
  begin
    SetLength(Workers.Threads, Length(Workers.Threads)+1);
    Workers.Threads[i] := TWorker.Create(true);
    Workers.Threads[i].IP := JobList.GetNextJob;
    Workers.Threads[i].Resume;
  end;

  bBreak := false;
  while (not JobList.isEmpty) and (not bBreak) do
  begin
    for i := 0 to Length(Workers.Threads)-1 do
    begin
      if not Workers.Threads[i].Running then
      begin
        NewItem := 'Thread '+IntToStr(i)+' wurde beendet';
        Synchronize(AddTreeItem);
        Workers.Threads[i] := TWorker.Create(true);
        Workers.Threads[i].IP := JobList.GetNextJob;
        bBreak := Workers.Threads[i].IP <> '';
        if not bBreak then
          Workers.Threads[i].Resume;
      end;
      // Sleep(500);  <<<- unnötig
    end;
  end;
end;

procedure TSearchThread.AddTreeItem;
begin
  frmMain.treeContacts.Items.AddChild(nil, NewItem);
end;

procedure TWorker.Execute;
begin
  Running := true;
  client := TIdTCPClient.Create;
  client.Port := 60000;
  client.ConnectTimeout := 500;
  client.Host := IP;
  try
    client.Connect;
  except
  end;
  if client.Connected then
  begin
    Connected := true;
  end
  else
  begin
    Connected := false;
  end;
  client.Free;
  Running := false;
end;

constructor TJobList.Create;
begin
  FCS := TCriticalSection.Create;
end;

destructor TJobList.Destroy;
begin
  FreeAndNil(FCS);
end;

function TJobList.GetNextJob:string;
begin
  fCS.Enter;
  try
    if self.Count > 0 then begin
      Result := self.Get(0);
      self.Delete(0);
    end
    else
      result := '';
  finally
    FCS.Leave;
  end;
end;

function TJobList.isEmpty: boolean;
begin
  fCS.Enter;
  try
    Result := self.Count = 0;
  finally
    FCS.Leave;
  end;
end;

procedure TJobList.SaveAdd(sIP: String);
begin
  fCS.Enter;
  try
    self.Add(sIP);
  finally
    FCS.Leave;
  end;
end;

end.

Greetz DataCool

[Kill0r]

Hi!
Vielen Dank für die Mühe die du dir für den Code gemacht hast
Hab mir den Code gründlich durchgeschaut um zu verstehen was er genau macht... nur bei bBreak blick ich nicht ganz durch...
Wofür hast du bBreak eingebaut? Was soll der genaue Nutzen sein?

Der Code scheint jedenfalls schon besser zu laufen als meiner Allerdings nur wenn ich die bBreak Überprüfung in der FOR und WHILE Schleife raus nehme, ansonsten hört er nach 5 IPs auf (also erstellt nur die 5 Threads am Anfang und hört dann auf) Aber das Problem scheint dennoch nicht gelöst zu sein...
Zum einen erstellt er jetzt meinem Anschein nach zu viele Threads schon von Anfang an und ausserdem läuft er zwar alle IPs recht zügig durch, aber findet den Server nicht. Es ist also so als würde er gar nicht erst verbinden

Ach herrje... worauf hab ich mich da nur eingelassen

Ich hoffe ihr findet trotzdem noch eine Lösung für dieses Problem Bis jetzt liefs ja schon recht gut

Danke für eure (oder DataCool, deine ) Hilfe

Cu
Kill0r

[DataCool]

Hi,

in meinem Code hat sich auch ein kleiner aber bedeutener Fehler eingeschlichen :

Es muss :

Delphi-Quellcode:

bBreak := Workers.Threads[i].IP = '';
// nicht !!!
// bBreak := Workers.Threads[i].IP <> '';

heissen, das bBreak ist dazu da, das die Threads nicht weiterarbeiten, wenn kein Eintrag mehr in der Joblist ist oder aus irgentwelchen Gründen keine IP aus der Joblist geliefert wird.

Ih habe mir gestern Deinen Code etwas genauer angeschaut, leider hast Du in dem Code einen weiteren Denkfehler :

Wenn ein Thread einen Server findet setzt Du conected auf True, aber irgentwann bekommt der Thread die nächste IP die er prüfen soll, und dann wird connected wieder auf false gesetzt.
Er kann also keinen Server finden, es sei den in den letzten 5 IPs läuft zufällig ein Server.

Poste hier mal bitte Deinen ganzen Code, dann kann ih das ganze auch compilieren und testen dann werde ich Dir das entsprechend umschreiben.

Greetz Dataool

[Kill0r]

Hi!
Ich habe die gesamten Sources angehängt (das Programm heisst übrigens MesSIE) anbei hab ich noch NetTest angehängt, das war ein kleines Testprogramm um zu überprüfen ob eine direkte Verbindung zwischen den PCs möglich ist. Mit diesem hab ich auch getestet ob MesSIE funktioniert (tat es aber eben nicht). Connected hab ich bei MesSIE noch gar nicht ausgewertet

Thx for your help!

So nun muss ich aber schleunigst ins Bett... morgen wieder Arbeit!

Cu
Kill0r

[DataCool]

Hi,

ich habe das ganze ein wenig umgeschrieben. (s. Anhang ohne .Exe)

Trotzdem ist das ganze bestimmt nicht so schnell wie Du es haben möchtest.
Du möchtest also einen Messenger fürs Netzwerk programmieren,
Warum muss immer das ganze Netzwerk nach dem Server durchsucht werden ?
Kann man nicht eine IP als Server festlegen oder 3 zur Auswahl die getestet werden ?!

So wie es jetzt ist, ist das auf keinen Fall zufriedenstellend.

Und warum funktioniert UDP netz intern niht ?!

Greetz DataCool