[-=Virus=-]

Суть проблемы такова:
Я пишу плагин для чата, нужно пропинговать определённые адреса и проверить на открытость порта, затем вывести всё в определённый канал, но это всё фигня. Пингую адреса и получается так что весь сервер подвисает в то время пока идёт проверка адресов. Понял что это происходит в этом коде:

Код:

procedure TForm1.DCPing();
var
  i:integer;
  s,app:string;
begin
 App := ExtractFilePath( ParamStr(0));
 memo1.Lines.LoadFromFile(app+option+'Privetstvie.txt');
 begin
 for I:=0 to Listbox1.Count-1 do
  begin
   s:=listbox1.items[i];
 try
  IdTCPClient1.Host:=s;
  IdTCPClient1.Port:=411;
  IdTCPClient1.Connect;
   if IdTCPClient1.Connected
    then 
     //подключились
 Memo1.Lines.Add('* '+s+' '+'online');
 IdTCPClient1.Disconnect;
   except
//не подключились
 Memo1.Lines.add('* '+s+' '+'offline');
 end;
 end;
end;

И так вопрос таков, как можно сделать так что бы этот код не так сильно грузил программу? Или подскажите пожалуйста другой способ проверить адрес и узнать открыт ли порт.

[Assistant]

в цикле попробуй сделать: Application.ProcessMessages;
(можно конечно это всё сделать на потоках, но чуть сложнее будет)

[-=Virus=-]

Сообщение от Assistant

в цикле попробуй сделать: Application.ProcessMessages;
(можно конечно это всё сделать на потоках, но чуть сложнее будет)

Расскажите а как именно можно на потоках сделать?

[Assistant]

самый простой и примитивный способ:

Код:

 type
   TMyThread = class(TThread)
     host: string;
     port: integer;
     isalive: boolean;
   public
     procedure ToLog;
   protected
     procedure Execute; override;
   end;

..........................

procedure TMyThread.ToLog;
begin
  if isalive then
    Form1.Memo1.Lines.Add(host + ' at port ' + IntToStr(port) + ' is alive')
  else
    Form1.Memo1.Lines.Add(host + ' at port ' + IntToStr(port) + ' is NOT alive');
end;

procedure TMyThread.Execute;
var
  IdTCPClient: TIdTCPClient;
begin
  isalive := False;
  FreeOnTerminate := True;
    IdTCPClient := TIdTCPClient.Create(nil);
    IdTCPClient.Host := host;
    IdTCPClient.Port := port;
    try
      IdTCPClient.Connect;
      if IdTCPClient.Connected then
        isalive := True
    except
      isalive := False;
    end;
    IdTCPClient.Free;
    Synchronize(ToLog);
end;

Код:

var
  ping: TMyThread;
  i: integer;
begin
  for i:=1 to 100 do
  begin
    ping := TMyThread.Create(True);
    ping.host := 'localhost';
    ping.port := i;
    ping.Resume;
  end;

[-=Virus=-]

Код:

procedure Execute; override;

Ругается на строчку

[Assistant]

Сообщение от -=Virus=-

Ругается на строчку

копировал из своего рабочего кода

[-=Virus=-]

Скинь целиком,посмотрю.

[Assistant]

прикрепил файл

[-=Virus=-]

Сообщение от Assistant

прикрепил файл

Спасибо исходник работает. Странно почему то у меня не работал,щу буду глядеть почему.