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.