Tweet
Moin!<BR>
Ich habe mal angefangen mit Threads zu programmieren.<BR>
Mein erster Test war ein Programm, in dem 6 Progressbars gleichzeigt hochgezählt wurden. - Klappte auch soweit auch ganz gut.<BR>
Als zweite Übung wollte ich eine Art 'Portscanner' basteln. Also: Tclientsocket.port=x+1; .open; ... Bei keiner Exception merken, etc.<BR>
Da das open ja länger dauert (da Timeout), dachte ich, ich mache einfach viele Threads, so das die ganze Arbeit schneller geht. Es dürfte ja kein Problem sein, wenn so hundert Threads auf die Fehlermeldung warten.<BR>
Nur: Unter Delphi klappt das bis ca. 150 Threads, danach, geht das System in die Knie. Ohne Delphi (direkt gestartet) mach das System schon bei 50 Threads schlapp.<BR>
Das sieht so aus: Im Taskmanager zeigt der plötzlich 100% Systemlast (Delphi-Test 100 Threads war max. 75% Last), ca. 90% Kernel-Zeit, das Formular baut sich nicht mehr auf, und das System ist mehr als träge.<BR>
Hier mein Code: (Sorry, für die sparsame Kommentierung, sollte 'nur' eine Übung sein).<BR>
<PRE>
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
ListBox1: TListBox;
ProgressBar1: TProgressBar;
Label1: TLabel;
Button2: TButton;
ListBox2: TListBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
abbruch:boolean;
end;
tp=procedure;
tf=function:boolean;
Tmytread=class(TTHread)
private
tcs:TClientsocket;
tl:TListBox;
von,bis,akt:integer;
eip:string;
proc:tp;
abbruch:boolean;
ab:tf;
protected
procedure Execute; override;
procedure hinzu;
procedure abf;
public
constructor create(lb:TListBox;zaehl:tp; abbr:tf; ip: string; v, b: integer);
destructor destroy; override;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ Tmytread }
procedure Tmytread.abf;
begin
proc;
abbruch:=ab;
end;
constructor Tmytread.create(lb:TListBox; zaehl:tp; abbr:tf; ip: string; v, b: integer);
begin
inherited create(True);
von:=v;
bis:=b;
akt:=v;
tl:=lb;
eip:=ip;
proc:=zaehl;
ab:=abbr;
tcs:=TClientSocket.Create(NIL);
tcs.Address:=eip;
tcs.ClientType:=ctBlocking;
FreeOnTerminate:=True;
end;
destructor Tmytread.destroy;
begin
tcs.free;
tcs:=NIL;
inherited;
end;
procedure Tmytread.Execute;
begin
akt:=von;
while (akt<=bis) and (not abbruch) do begin
tcs.Port:=akt;
try
tcs.Open;
Synchronize(hinzu);
except
end;
tcs.close;
inc(akt);
Synchronize(abf);
end;
end;
procedure Tmytread.hinzu;
begin
tl.Items.Add(IntToStr(akt)+' OK')
end;
procedure zaehl;
var x:integer;
begin
x:=Form1.ProgressBar1.Position+1;
Form1.ProgressBar1.Position:=x;
Form1.Label1.Caption:=IntToStr(x);
Application.ProcessMessages;
end;
function abbr:boolean;
begin
result:=form1.abbruch;
end;
</PRE>
...to be continued...
Ich habe mal angefangen mit Threads zu programmieren.<BR>
Mein erster Test war ein Programm, in dem 6 Progressbars gleichzeigt hochgezählt wurden. - Klappte auch soweit auch ganz gut.<BR>
Als zweite Übung wollte ich eine Art 'Portscanner' basteln. Also: Tclientsocket.port=x+1; .open; ... Bei keiner Exception merken, etc.<BR>
Da das open ja länger dauert (da Timeout), dachte ich, ich mache einfach viele Threads, so das die ganze Arbeit schneller geht. Es dürfte ja kein Problem sein, wenn so hundert Threads auf die Fehlermeldung warten.<BR>
Nur: Unter Delphi klappt das bis ca. 150 Threads, danach, geht das System in die Knie. Ohne Delphi (direkt gestartet) mach das System schon bei 50 Threads schlapp.<BR>
Das sieht so aus: Im Taskmanager zeigt der plötzlich 100% Systemlast (Delphi-Test 100 Threads war max. 75% Last), ca. 90% Kernel-Zeit, das Formular baut sich nicht mehr auf, und das System ist mehr als träge.<BR>
Hier mein Code: (Sorry, für die sparsame Kommentierung, sollte 'nur' eine Übung sein).<BR>
<PRE>
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
ListBox1: TListBox;
ProgressBar1: TProgressBar;
Label1: TLabel;
Button2: TButton;
ListBox2: TListBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
abbruch:boolean;
end;
tp=procedure;
tf=function:boolean;
Tmytread=class(TTHread)
private
tcs:TClientsocket;
tl:TListBox;
von,bis,akt:integer;
eip:string;
proc:tp;
abbruch:boolean;
ab:tf;
protected
procedure Execute; override;
procedure hinzu;
procedure abf;
public
constructor create(lb:TListBox;zaehl:tp; abbr:tf; ip: string; v, b: integer);
destructor destroy; override;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ Tmytread }
procedure Tmytread.abf;
begin
proc;
abbruch:=ab;
end;
constructor Tmytread.create(lb:TListBox; zaehl:tp; abbr:tf; ip: string; v, b: integer);
begin
inherited create(True);
von:=v;
bis:=b;
akt:=v;
tl:=lb;
eip:=ip;
proc:=zaehl;
ab:=abbr;
tcs:=TClientSocket.Create(NIL);
tcs.Address:=eip;
tcs.ClientType:=ctBlocking;
FreeOnTerminate:=True;
end;
destructor Tmytread.destroy;
begin
tcs.free;
tcs:=NIL;
inherited;
end;
procedure Tmytread.Execute;
begin
akt:=von;
while (akt<=bis) and (not abbruch) do begin
tcs.Port:=akt;
try
tcs.Open;
Synchronize(hinzu);
except
end;
tcs.close;
inc(akt);
Synchronize(abf);
end;
end;
procedure Tmytread.hinzu;
begin
tl.Items.Add(IntToStr(akt)+' OK')
end;
procedure zaehl;
var x:integer;
begin
x:=Form1.ProgressBar1.Position+1;
Form1.ProgressBar1.Position:=x;
Form1.Label1.Caption:=IntToStr(x);
Application.ProcessMessages;
end;
function abbr:boolean;
begin
result:=form1.abbruch;
end;
</PRE>
...to be continued...
<BR>
Comment