Ping

[Sairox]

Добрый день! Пишу программу на delphi ping ip адресов. Хочется реализовать чтобы если есть пинг то компонент TListView заносились адрес и в сети он или нет. Программу дописал но не могу это реазиловать. Что если есть пинг то заносился в строку и был зеленым , если нет пинга то красным. Вот исходный код программы. Подскажите пожалуйста.

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls,
  Vcl.XPMan;

type
  TfmMain = class(TForm)
    edtAddress: TEdit;
    butPing: TButton;
    memResult: TMemo;
    Memo1: TMemo;
    ListView1: TListView;
    Button1: TButton;
    Timer1: TTimer;
    XPManifest1: TXPManifest;
    ListBox1: TListBox;
    procedure butPingClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmMain: TfmMain;

implementation

{$R *.dfm}

procedure DoPing(Address: String; OutText: TStrings);
const
	READ_SIZE = 4096;
var
	SecAttr: TSecurityAttributes;
	hRP, hWP: THandle;
	StartInfo: TStartUpInfo;
	ProcInfo: TProcessInformation;
	buf: PAnsiChar;
	ReadSize: DWORD;
begin
  SecAttr.nlength := SizeOf(TSecurityAttributes);
  SecAttr.binherithandle := True;
  SecAttr.lpsecuritydescriptor := nil;
	if Createpipe(hRP, hWP, @SecAttr, 0) then
  try
		buf := AllocMem(READ_SIZE + 1);
		FillChar(StartInfo, SizeOf(TStartUpInfo), #0);
		StartInfo.cb := SizeOf(TStartUpInfo);
		StartInfo.hStdOutput := hWP;
		StartInfo.hStdInput := hRP;
		StartInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
		StartInfo.wShowWindow := SW_HIDE;
		if CreateProcess(nil, PChar('ping.exe ' + Address), @SecAttr, @SecAttr, True, NORMAL_PRIORITY_CLASS, nil, nil, StartInfo, ProcInfo) then
    try
      while WaitForSingleObject(ProcInfo.hProcess, 100) = WAIT_TIMEOUT do
        Application.ProcessMessages;
      ReadSize := READ_SIZE+1;
      while ReadSize > READ_SIZE do
      begin
				ReadFile(hRP, buf[0], READ_SIZE, ReadSize, nil);
				buf[ReadSize] := #0;
				OemToAnsi(buf, buf);
				OutText.Add(String(buf));
			end;
    finally
      CloseHandle(ProcInfo.hProcess);
		  CloseHandle(ProcInfo.hThread);
		end;
  finally
		FreeMem(buf);
		CloseHandle(hRP);
		CloseHandle(hWP);
	end;
end;

procedure TfmMain.butPingClick(Sender: TObject);
var a:integer;
    Item: TListItem;
  begin
  if Memo1.Lines.Count <> 0 then // проверяем, не пустое ли мемо
  begin
  Memo1.Lines.LoadFromFile('ip.conf');
  for a := 0 to Memo1.Lines.Count-1 do
  begin
  edtAddress.Text:= Memo1.Lines[a]; //копируем 1ю строку мемо в эдит
  begin
 if (edtAddress.text = '') then

 Item := TListItem.Create(ListView1.Items);
 Item.Caption := edtAddress.Text;
 listview1.Font.color:=clgreen;
 Item.SubItems.Add('В сети');
  ListView1.Items.Insert(0);
 ListView1.Items.Item[0] := Item;
 Item.Free;
  end;


  butPing.Enabled := False;
  try

    DoPing(edtAddress.Text, memResult.Lines);
  finally
    butPing.Enabled := True;
  end;
  end;
  end;
end;

procedure TfmMain.Button1Click(Sender: TObject);
begin
  sleep(10000)
end;

end.

_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

[min@y™]

[Serge_Bliznykov]

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

procedure TfmMain.Button1Click(Sender: TObject);
begin
  sleep(10000)
end;

ОМГ! Зачем? Зачем на кнопку вызов sleep'а?! Вы хотите проверить, реально ли sleep полностью замораживает форму и она перестаёт отвечать на все запросы? или что-то другое?

[Sairox]

Вы меня не поняли раскрасить получилось, мне нужно создать цикл проверки если есть пинг то зеленый, если нету то красный.

[Sairox]

Да хотел проверить перестанет отвечать на запрос или нет.

[Serge_Bliznykov]

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

Да хотел проверить перестанет отвечать на запрос или нет.

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

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

Вы меня не поняли раскрасить получилось, мне нужно создать цикл проверки

Вы адрес для пинга берёте из текстового контрола edtAddress

А если делать цикл, то от чего и до чего его делать? Все возможные IP в сети Интернет хотите пингануть? Так это многовато, не дождётесь окончания.
Или есть какой-то конкретный диапазон?

[Sairox]

Есть конкретный диапозон берется с текстового документа.

[Serge_Bliznykov]

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

Есть конкретный диапозон берется с текстового документа.

тогда в чём вопрос то?

примерно так:

var
  sl, slRez : TStringList;

.....


 sl :=  TStringList.Create;
 slRez := TStringList.Create; 
 sl.LoadFromFile('ПутьКВашемуТекстовомуФайлу.txt');
 butPing.Enabled := False;
 for i:=0 to sl.Count-1 do begin
   slRez.Clear;
   DoPing(sl.Strings[i], slRez);
   Item := ListView1.Items.Add;
   Item.Caption := sl.Strings[i]; 
   if slRez.Count>0 then
     Item.SubItems.Add('В сети')
   else
     Item.SubItems.Add('не в сети');
 end;

 ...

 FreeAndNil(sl);
 FreeAndNil(slRez);

[min@y™]

10.png

[Black Fregat]

Что за поветрие пошло - постить всё картинками