Сканер портов
Подскажите как сделать его более быстрым!
P.S. Использовал потоки(мб не правильно:))
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Sockets, ComCtrls;
type
TForm1 = class(TForm)
TcpClient1: TTcpClient;
host: TEdit;
port2: TEdit;
port1: TEdit;
OpenPort: TMemo;
Start: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ProgressBar: TProgressBar;
procedure StartClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TClThread = class(TThread)
TcpClient1: TTcpClient;
host:string;
minPort,maxPort:string;
procedure Execute; override;
procedure LinesAdd;
private
public
end;
var
Form1: TForm1;
skan:string;
x,y:integer;
implementation
{$R *.dfm}
{ TClThread }
procedure TClThread.LinesAdd(); //добавляем порт в мемо
begin
Form1.OpenPort.Lines.Add(IntToStr(x));
end;
procedure TClThread.Execute;
var
Client:TTcpClient;
begin
inherited;
Client:=TTcpClient.Create(nil); //выделение памяти под переменную
Client.RemoteHost:=host; //Установка адреса хоста
x:=StrToInt(minPort); //начальное и конечное значения портов
y:=StrToInt(maxPort);
//для красявости сделаем прогресбар
Form1.ProgressBar.Min:=x;
Form1.ProgressBar.Max:=y;
while x<=y do //порбегаем по всем портам
begin
Client.RemotePort:=IntToStr(x); //установка значения порта дла коннекта
Client.Active:=true;
if Client.Connect=true then //если порт открыт то порт добавляется в мемо
begin
Synchronize ( LinesAdd );
client.Disconnect;
end
else client.Disconnect;
Form1.ProgressBar.Position:=x;
x:=x+1;
end;
end;
procedure TForm1.StartClick(Sender: TObject);
var
trd:TClThread;
begin
if Start.Tag=0 then
begin
trd:=TClThread.Create(true);
start.Caption:='Stop';
host.Enabled:=false;
port1.Enabled:=false;
port2.Enabled:=false;
trd.host:=host.Text;
trd.minPort:=port1.Text;
trd.maxPort:=port2.Text;
start.Tag:=1;
trd.Resume;
end
else
begin
start.Caption:='Start';
host.Enabled:=true;
port1.Enabled:=true;
port2.Enabled:=true;
start.Tag:=0;
exit;
end;
end;
end.
2. Вы используете не потоки а поток! всего один, это равносильно его неиспользованию :) делите диапазон портов на несколько, например если он - 0 - 90, то делите на его на 3 потока по 30 портов каждому, и получите прирост скорости в 3 раза, либо вообще можете использовать по потоку на порт :)
Успехов!
У меня вот вопрос возник. Как собственно разделить порты по потокам?
Пробовал сделать чтобы в Execute передавались параметры, но что то ничего не получается.
Примерчик бы очень помог. )
TForm1:
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CheckThread, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Edit1: TEdit;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
ProgressBar1.Max:=150;
// From 1 to 50
TCheckThread.Create(Edit1.Text,1,50,Memo1,ProgressBar1).Resume();
// From 50 to 100
TCheckThread.Create(Edit1.Text,50,100,Memo1,ProgressBar1).Resume();
// From 100 to 150
TCheckThread.Create(Edit1.Text,100,150,Memo1,ProgressBar1).Resume();
end;
end.
TCheckThread:
interface
uses Classes, StdCtrls, SysUtils, Sockets, ComCtrls;
type TCheckThread = class(TThread)
private
FFromPort: integer;
FToPort: integer;
FOutput: TMemo;
FHost: string;
FTCP: TTcpClient;
FProgress: TProgressBar;
public
procedure TryOutput();
procedure FoundOutput();
procedure Progress();
procedure Execute(); override;
published
constructor Create(AHost: string; AFromPort, AToPort: integer; AOutput: TMemo; AProgress: TProgressBar); overload;
end;
implementation
{ TCheckThread }
constructor TCheckThread.Create(AHost: string; AFromPort, AToPort: integer; AOutput: TMemo; AProgress: TProgressBar);
begin
inherited Create(true);
Priority:=tpLowest;
FFromPort:=AFromPort;
FToPort:=AToPort;
FOutput:=AOutput;
FHost:=AHost;
FProgress:=AProgress;
FTCP:=TTcpClient.Create(nil);
end;
procedure TCheckThread.Execute;
begin
while not Terminated do begin
// You may to handle termination by OnTeminate Event
if FFromPort = FToPort then Terminate;
//Synchronize(TryOutput);
Synchronize(Progress);
FTCP.RemoteHost:=FHost;
FTCP.RemotePort:=IntToStr(FFromPort);
try
FTCP.Connect();
if FTCP.Connected then begin
Synchronize(FoundOutput);
FTCP.Disconnect();
end;
except
end;
// Next port
Inc(FFromPort);
Sleep(10);
end;
end;
procedure TCheckThread.FoundOutput;
begin
FOutput.Lines.Add('Found port: '+IntToStr(FFromPort));
end;
procedure TCheckThread.Progress;
begin
FProgress.Position:=FProgress.Position+1;
end;
procedure TCheckThread.TryOutput;
begin
FOutput.Lines.Add('Check port: '+IntToStr(FFromPort));
end;
end.
Здесь диапазон сканирования делится на 3 части (это я думаю Вы сможете реализовать) и каждая часть скармливается отдельному потоку. Так же в конструктор потока передается ссылка на объект вывода (Memo) и объект прогресса (ProgressBar). Надеюсь все будет понятно.
Успехов!
А это домашнее задание :)
Хотя я думаю, что достаточно будет в конструкторе добавить FreeOnTerminate:=true;
public_morozov, зачем столько вызовов Synchronize в коде? Я уже где-то писал, что частое использование данного метода сводит на нет само понятие паралельного выполнения. Если уж хочется отобразить информацию о ходе выполнения потока, то нужно это сделать максимум одним вызовом Synchronize. Кроме того, не совсем ясно предназначение Sleep в конце цикла...
Столько? их всего лишь 2, и все они обращаются к разным контролам и при разных условиях, и в вызываемых процедурах нет каких-либо вычислений чтобы они вдруг свели на нет параллельное выполнение. А Sleep в конце я считаю хорошей привычкой при использовании `бесконечных` циклов в потоках чтобы не загружать на 100% процессор при отсутствии из них выхода.
А TCPClient и правда из пушки по воробьям, но на данном этапе (создание представления о решении/работе) вполне нормальное явление
Правда? А что по твоему происходит, скажем, вот здесь:
...и до того как мы сюда попадем.
Здесь он не к чему. А если поток простаивает, то не слипами надо его разгружать, а функциями ожидания.
Я уже выше писал, почему он здесь не желателен.