Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.10.2017, 09:06   #1
Sairox
 
Регистрация: 10.10.2017
Сообщений: 9
По умолчанию Ping

Добрый день! Пишу программу на 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)
Модератор

Последний раз редактировалось Serge_Bliznykov; 10.10.2017 в 09:36.
Sairox вне форума Ответить с цитированием
Старый 10.10.2017, 09:37   #2
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 10.10.2017, 09:44   #3
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от Sairox Посмотреть сообщение
Код:
procedure TfmMain.Button1Click(Sender: TObject);
begin
  sleep(10000)
end;
ОМГ! Зачем? Зачем на кнопку вызов sleep'а?! Вы хотите проверить, реально ли sleep полностью замораживает форму и она перестаёт отвечать на все запросы? или что-то другое?
Serge_Bliznykov вне форума Ответить с цитированием
Старый 10.10.2017, 10:29   #4
Sairox
 
Регистрация: 10.10.2017
Сообщений: 9
По умолчанию

Вы меня не поняли раскрасить получилось, мне нужно создать цикл проверки если есть пинг то зеленый, если нету то красный.
Sairox вне форума Ответить с цитированием
Старый 10.10.2017, 10:34   #5
Sairox
 
Регистрация: 10.10.2017
Сообщений: 9
По умолчанию

Да хотел проверить перестанет отвечать на запрос или нет.
Sairox вне форума Ответить с цитированием
Старый 10.10.2017, 10:50   #6
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от Sairox Посмотреть сообщение
Да хотел проверить перестанет отвечать на запрос или нет.
и как - перестало? а зачем Вы это делали? Какой смысл?
И почему не убрали это безумие из своего кода после того, как проверили?


Цитата:
Сообщение от Sairox Посмотреть сообщение
Вы меня не поняли раскрасить получилось, мне нужно создать цикл проверки
Вы адрес для пинга берёте из текстового контрола edtAddress

А если делать цикл, то от чего и до чего его делать? Все возможные IP в сети Интернет хотите пингануть? Так это многовато, не дождётесь окончания.
Или есть какой-то конкретный диапазон?
Serge_Bliznykov вне форума Ответить с цитированием
Старый 10.10.2017, 11:02   #7
Sairox
 
Регистрация: 10.10.2017
Сообщений: 9
По умолчанию

Есть конкретный диапозон берется с текстового документа.
Sairox вне форума Ответить с цитированием
Старый 10.10.2017, 11:22   #8
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от 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);
Serge_Bliznykov вне форума Ответить с цитированием
Старый 10.10.2017, 12:07   #9
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию


10.png
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 10.10.2017, 16:21   #10
Black Fregat
Программист
Участник клуба
 
Аватар для Black Fregat
 
Регистрация: 23.06.2009
Сообщений: 1,772
По умолчанию

Что за поветрие пошло - постить всё картинками
Black Fregat вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ping ramm_89 Работа с сетью в Delphi 2 31.07.2016 22:46
Ping Drago56 C/C++ Сетевое программирование 2 02.02.2016 15:41
[ping] unbanned Работа с сетью в Delphi 6 09.07.2013 14:06
ping на c++ маришка001 Помощь студентам 3 30.10.2011 11:51
ping TaTT DoGG Общие вопросы .NET 2 06.10.2008 12:48