Topic: Помогите с PINGом

Добрый день все!
Есть кнопка и поле на форме Edit:
Edit.Button3 и Edit.Edit3

В поле Edit3 вручную записано имя компьютера, например 'test-pc'.
Можно ли сделать так, что бы по нажатию кнопки Button3 происходил пинг 1 пакетом и если результат положительный подкрашивал поле Edit3 другим цветом?

Re: Помогите с PINGом

Здравствуйте.


К сожалению в последних версиях Windows стало проблемно делать ping из собственной программы, т.к. для этого требуются права администратора.

Dmitry.

Re: Помогите с PINGом

С правами администратора проблем нет. Планируется использовать программу на компьютере с правами администратора.

Re: Помогите с PINGом

Необходимо будет запускать программы с правами администратора, т.е. нажимать на exe файле правой кнопкой мыши и выбирать пункт "Запуск от имени администратора"


Если это приемлемо для вас, тогда могу добавить функцию ping

Dmitry.

Re: Помогите с PINGом

Будет более чем приемлемо.

Re: Помогите с PINGом

Скачайте пожалуйста последнюю версию программы
http://myvisualdatabase.com/download/myvisualdb.exe


пример использования

procedure Form1_Button6_OnClick (Sender: TObject; var Cancel: boolean);
begin
    if Ping('google.com') then ShowMessage('Ok') else ShowMessage('Failed');
end;

procedure Form1_Button4_OnClick (Sender: TObject; var Cancel: boolean);
var
    AvgMs: Double;
begin
    // позволяет сделать ping заданное число раз и получить среднее время отклика
    if PingEx('google.com', 5, AvgMs) then
        ShowMessage('Average ping: '+FloatToStr(AvgMs)+'ms')
     else ShowMessage('Failed');
end;
Dmitry.

Re: Помогите с PINGом

Да получилось, извиняюсь за совсем глупый вопрос.
Но как подставить вместо google.com данные из поля Edit.Edit3???

8 (edited by mcsimm 2017-11-16 14:39:56)

Re: Помогите с PINGом

Подскажите, пожалуйста, возможно ли расширить действие скрипта так, что бы он выдавал разные сообщения в случае, если сайт вообще не удаётся найти (аналог в выводе консольной PING.EXE  "При проверке связи не удалось обнаружить узел tratatata.ta Проверьте имя узла и повторите попытку" и когда сайт или ip-адрес просто не отвечает  по каким-нибудь причинам ("Превышен интервал ожидания для запроса")?

Re: Помогите с PINGом

lameska wrote:

Да получилось, извиняюсь за совсем глупый вопрос.
Но как подставить вместо google.com данные из поля Edit.Edit3???

if Ping(Edit.Edit3.Text) then ShowMessage('Ok') else ShowMessage('Failed');
Dmitry.

Re: Помогите с PINGом

mcsimm wrote:

Подскажите, пожалуйста, возможно ли расширить действие скрипта так, что бы он выдавал разные сообщения в случае, если сайт вообще не удаётся найти (аналог в выводе консольной PING.EXE  "При проверке связи не удалось обнаружить узел tratatata.ta Проверьте имя узла и повторите попытку" и когда сайт или ip-адрес просто не отвечает  по каким-нибудь причинам ("Превышен интервал ожидания для запроса")?

Скачайте пожалуйста последнюю версию повторно, доработал функцию ping


описание функции

function Ping(Host: string; RaiseException: boolean = false; Timeout: integer = 1000): boolean

примеры

// включаем сообщения об ошибках (исключения)
if Ping('google.com', True) then ShowMessage('ok');


// устанавливаем желаемый TimeOut в милисекундах
if Ping('google.com', False, 2000) then ShowMessage('ok') else ShowMessage('Failed');


// ловим исключение
    try
        if Ping('google.com', True) then ShowMessage('Ok');
    except
        ShowMessage(ExceptionMessage);
    end;
// анализируя текст сообщения в ExceptionMessage можем например вывести сообщение об ошибке на русском
Dmitry.

11 (edited by lameska 2017-11-17 08:13:58)

Re: Помогите с PINGом

Добрый день!
Подскажите, почему не получается:

OpenFile('netdom renamecomputer '+Rename.Edit1.Text+' /newname:'+Rename.Edit2.Text+' /userd:* /passwordd:* /SecurePasswordPromt /force /reboot:1','C:\Windows\System32\cmd.exe');

С правами администратора.

Re: Помогите с PINGом

Увы не могу знать, должно было бы работать.

Dmitry.

Re: Помогите с PINGом

Я кажется понял, скрипт передает /newname и на этом останавливается, т.е. следующий /ключ не передается.
Это похоже особенность cmd.exe

Re: Помогите с PINGом

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

OpenFile('"netdom renamecomputer '+Rename.Edit1.Text+' /newname:'+Rename.Edit2.Text+' /userd:* /passwordd:* /SecurePasswordPromt /force /reboot:1"','C:\Windows\System32\cmd.exe');
Dmitry.

15 (edited by lameska 2017-11-17 13:01:22)

Re: Помогите с PINGом

Неа, не получается.
Раньше у меня это работало на с, вот пример:


private: System::Void button2_Click(System::Object^  sender, System::EventArgs^  e) {
                 char rename_command[300];   // Создаем переменную для сброка консольной компнды
                 int rename_time = 0 ;  // Соаздаем переменную для счетчики перезагрузки.
                     switch (comboBox1->SelectedIndex)   // Создаю свич для подстановки мноителя времени отработки команды
                     {
                     case 0: rename_time = (Convert::ToInt32(textBox3->Text)) * 1; break;   // Передаем секунды
                     case 1: rename_time = (Convert::ToInt32(textBox3->Text)) * 60; break;   // Передаем минуты
                     case 2: rename_time = (Convert::ToInt32(textBox3->Text)) * 3600; break;   // Передаем часы
                     }
                // Собираем компанду %s - подстановка символов, %d - подстановка чисел
                sprintf(rename_command, "netdom renamecomputer %s /newname:%s /userd:* /passwordd:* /SecurePasswordPrompt /force /reboot:%d > C:\\rename_pc.log",(Convert::ToString(textBox1->Text)),(Convert::ToString(textBox2->Text)),rename_time);
                if((system(rename_command))) {
                     MessageBox::Show("\tНе выполнено!\nВозможные причины:\n\n1. Не правильное имя компьютера\n2. Компьютер выключен\n3. Введены не верные учетные данные");
                }
             }

Но тут есть функция system()
Т.е. тут system() вызывало консоль, а все остальное передавалось как строка.

Re: Помогите с PINGом

Добрый день!
Может у кого-то появились идеи как осуществить эту функцию?

Re: Помогите с PINGом

DriveSoft wrote:

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

OpenFile('"netdom renamecomputer '+Rename.Edit1.Text+' /newname:'+Rename.Edit2.Text+' /userd:* /passwordd:* /SecurePasswordPromt /force /reboot:1"','C:\Windows\System32\cmd.exe');

Всем добрый день!
Получилось вот так:

    old_name := Edit.Edit5.Text;
    new_name := Edit.Edit4.Text;

OpenFile('/K netdom renamecomputer "'+old_name+'" /newname:"'+new_name+'" /userd:* /passwordd:* /SecurePasswordPrompt /force /reboot:1 > C:\rename_pc.log','C:\Windows\System32\cmd.exe');.

Единственное в Win7 можно отключить UAC и все работает, в Win10 нужно запускать от имени администратора.

Re: Помогите с PINGом

Здравствуйте. Помогите разобраться. Есть грид в котором имеется список IP адресов.
Можно ли сделать так что б брались по очереди данные из таблицы и соответственно в нее потом возвращались.
На данном этапе, на сколько я понимаю. берется одно значение и результат присваивается всем одинаковый...

procedure Form1_Button4_OnClick (Sender: TObject; var Cancel: boolean);
var
    AvgMs: Double;  s: string;
begin
    if PingEx(SQLExecute('SELECT ip FROM pings'), 5, AvgMs) then
    begin
     s:=(FloatToStr(AvgMs));
     SQLExecute ('UPDATE pings SET ping=1');
     SQLExecute ('UPDATE pings SET ms=("'+s+'")');
     end else
    begin
    SQLExecute ('UPDATE pings SET ping=0');
    SQLExecute ('UPDATE pings SET ms=("")');
    end;
    Form1.TableGrid2.dbUpdate;
end;

Re: Помогите с PINGом

33193
Сделал для вас проект с примером:

Post's attachments

Attachment icon Ping addresses.zip 5.6 kb, 223 downloads since 2018-02-07 

Dmitry.

Re: Помогите с PINGом

DriveSoft wrote:

33193
Сделал для вас проект с примером:

Здравствуйте. Спасибо. То что нужно.
Вот только не пойму, почему такая задерка большая.
К примеру пингую свой роутер, задержка 40мс.
cmd ping 192.168.5.1 = <1ms.

Re: Помогите с PINGом

У меня тоже такое наблюдается, к сожалению не знаю причину.

Dmitry.

Re: Помогите с PINGом

DriveSoft wrote:

У меня тоже такое наблюдается, к сожалению не знаю причину.

Добрый день. Поменял кусоче кода- задержку нормально показывает.

if PingEx(sHost, 5, AvgMs) then
        begin
           SQLExecute('UPDATE pings SET ms='+formatfloat('0.',AvgMs)+', ping = ("OK") WHERE id='+Results.FieldByName('id').asString);
        end else
        begin
            SQLExecute('UPDATE pings SET ms=NULL, ping = ("BAD") WHERE id='+Results.FieldByName('id').asString);
        end;

        Results.Next;

А именно вот тут

'+formatfloat('0.',AvgMs)+'

Re: Помогите с PINGом

Попутно. Пытаюсь организовать подобный функционал для поиска самого нового файла в папке с выводом даты его изменения и размера.
Но что то ругается на

FindFirst
TSearchRec
TSystemTime

Вот собственно сам код.Найдено на просторах.Подправил под себя но..

procedure Form1_Button5_OnClick;
var
 sr: TSearchRec;
  fn: string;
 st: TSystemTime;
  dt,ft: TDateTime;
  pach: string;
  filen: string;
  pfile: string;

begin
  fn := '';
  dt := 0;

   pach:= VarToStr(SQLExecute('SELECT pach FROM lastfile'));
   filen:= VarToStr(SQLExecute('SELECT filename FROM lastfile'));
   //if Right(path, 1) <> '\' then
   pfile:= pach + '\' + filen ;
   //else pfile:= path + filen;
  try               
    if FindFirst(pfile, faAnyFile, TSearchRec) = 0 then
    repeat
      if sr.Attr = faDirectory then Continue;      
      FileTimeToSystemTime(sr.FindData.ftCreationTime, TSystemTime);
      ft := SystemTimeToDateTime(TSystemTime);
      if ft > dt then
      begin
        dt := ft;
        fn := TSearchRec.Name;
      end;
    until (FindNext(TSearchRec) <> 0);
  finally
    FindClose(TSearchRec);
  end;
  if fn = '' then ShowMessage('Нет Файлов')
  else ShowMessage('Самый новый файл: ' + fn);
end;

Может можно это реализовать как то по другому?

Re: Помогите с PINGом

Список файлов в папке можно получить с помощью функции GetFilesList


Скачайте пожалуйста последнюю версию программы
https://www.dropbox.com/s/z733udos03ld1 … 1.zip?dl=0


Добавил функции для получения времени создания/изменения/доступа к файлу, возвращают тип TDateTime

GetFileCreationTime('d:\filename.jpg');
GetFileLastWriteTime('d:\filename.jpg');
GetFileLastAccessTime('d:\filename.jpg');
Dmitry.