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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 28.07.2016, 07:13   #1
ramm_89
Новичок
Джуниор
 
Регистрация: 08.06.2012
Сообщений: 1
По умолчанию ping

Всем привет! Помогите пожалуйста!!!. Хочу написать программу что бы пинговать компьютер свой и в окне видел надпись " компьютер в сети".
ramm_89 вне форума Ответить с цитированием
Старый 28.07.2016, 07:22   #2
TaLadno
Форумчанин
 
Регистрация: 03.06.2015
Сообщений: 393
По умолчанию

TIdICMPClient

Код:
TIdICMPClient.Host
TIdICMPClient.Ping
TIdICMPClient.OnReply
http://citforum.ck.ua/nets/articles/ping/ (Лучше прочитать всё, но если лень, то долистай хотя бы до "Использование Indy")
Вы там держитесь.
TaLadno вне форума Ответить с цитированием
Старый 31.07.2016, 22:46   #3
Баламут
Баламучу слегка...
Участник клуба
 
Аватар для Баламут
 
Регистрация: 01.11.2006
Сообщений: 1,585
По умолчанию

Не, ну это не серьезно...
Надо так!
Код:
unit icmp;

interface

uses jwaICMPAPI, jwaIPExport, jwaWinsock2, SysUtils, jwaWinError;

resourcestring
    stHostNotFound = 'Не удалось обнаружить узел';
    stERRORINVALIDPARAMETER = 'Неверный параметр';
    stERRORNOTENOUGHMEMORY = 'Недостаточно памяти для завершения операции';
    stERRORUnknown = 'Неизвестная ошибка';

const
  BaseStatus = 11000;
  StatusString: array[0..18] of string =
  ('The status was success',
   'The reply buffer was too small',
   'Заданная сеть недоступна',
   'The destination host was unreachable',
   'The destination protocol was unreachable',
   'The destination port was unreachable',
   'Insufficient IP resources were available',
   'A bad IP option was specified',
   'A hardware error occurred',
   'Слишком большая длинна пакета',
   'Превышен интервал ожидания для запроса',
   'A bad request',
   'A bad route',
   'The time to live (TTL) expired in transit',
   'The time to live expired during fragment reassembly',
   'A parameter problem',
   'Datagrams are arriving too fast to be processed and datagrams may have been discarded',
   'An IP option was too big',
   'Указан неправильный адрес');

type TPing = class(TObject)
private
  fIcmpHandle: THandle;
  fIPINFO:     TIPOPTIONINFORMATION;
  fReply:      TICMPECHOREPLY;
  fHostName:   string;
  fHostIP:     LONGWORD;
  fTTL:        byte;
  fTOS:        byte;
  fPacketLen:  LONGWORD;
  fTimeWait:   LONGWORD;
  FFragmented: boolean;

  fErrString:    string;
  FReplyBufSize: LONGWORD;
  pReqData:      pointer;
  pData:         pointer;
  pEchoReply:    PICMPECHOREPLY;

  function GetHostName: string;
  procedure SetHostName(const Value: string);
  function GetIPFromName(AName: string): LONGWORD;

public
  constructor Create();
  destructor Destroy; override;
  function Ping: integer;
  procedure Free;
  property HostName: string read GetHostName write SetHostName;
  property TTL: byte read fTTL write fTTL;
  property TOS: byte read fTOS write fTOS;
  property TimeWait: LONGWORD read fTimeWait write fTimeWait;
  property ErrorString: string read FErrString;
  property Fragmented: boolean read FFragmented Write FFragmented;
  property Reply: TICMPECHOREPLY read FReply;
  property PacketLen: LONGWORD read FPacketLen write FPacketLen;
  end;

implementation

{ TPing }

constructor TPing.Create;
begin
  inherited;
  FIcmpHandle := IcmpCreateFile();
  FTTL        := 128;
  FTOS        := 0;
  FPacketLen  := 32;
  FTimeWait   := 1000;
  FErrString  := '';
  FFragmented := true;
  FHostIP      := 0;
end;

destructor TPing.Destroy;
begin
  IcmpCloseHandle(fIcmpHandle);
end;

procedure TPing.Free;
begin
   if Self <> nil then Destroy;
end;

function TPing.GetHostName: string;
begin
  Result := FHostName;
end;

function TPing.GetIPFromName(AName: string): LONGWORD;
var
  Host: PHostEnt;
  WSADATA: TWSADATA;
  s: AnsiString;
begin
  Result := 0;
  s := aName;
  WSAStartup(WINSOCK_VERSION, WSADATA);
  Host := GetHostByName(PAnsiChar(s));
  if Host <> nil then
                    Result := LONGINT(pLONGINT(Host^.h_addr_list^)^);
  WSACleanup();                    
end;


function TPing.Ping: integer;
begin
Result := 0;
if FHostIP = 0 then begin
  Result := -1;
  FErrString := stHostNotFound;
end;

FReplyBufSize := SizeOf(TICMPECHOREPLY) + FPacketLen;

GetMem(pReqData, FPacketLen);
GetMem(pData, FPacketLen);
GetMem(pEchoReply, FReplyBufSize);

FillChar(pReqData^, FPacketLen, 0);
FillChar(pEchoReply^, SizeOf(pEchoReply^),0);
FillChar(FIPINFO, SizeOf(TIPOPTIONINFORMATION),0);

pEchoReply.Data := pData;

with FIPINFO do begin
  TTL := FTTL;
  TOS := FTOS;
  OptionsSize := 0;
  OptionsData := nil;
  if FFragmented then Flags := 0
  else Flags := 2;
end;

{Ф-ия IcmpEchoReply возвращает 0 в случае НЕУДАЧИ!
 В противном случае возвращает кол-во записей типа TIcmpEchoReply
}

if IcmpSendEcho(FIcmpHandle, FHostIP, pReqData, FPacketLen,
                @FIPINFO, pEchoReply, FReplyBufSize, FTimeWait) = 0
then begin
  Result := -1;
  case GetLastError of
    ERROR_INVALID_PARAMETER: FErrString := STERRORINVALIDPARAMETER;
    ERROR_NOT_ENOUGH_MEMORY: FErrString := stERRORNOTENOUGHMEMORY;
    ERROR_NOT_SUPPORTED    : FErrString := stERRORUnknown;
  else
    begin
    if pEchoReply^.Status <> 0 then
    fErrString := StatusString[pEchoReply^.Status - BaseStatus];
    Result := pEchoReply^.Status; 
    end;
  end;//case..else
  FreeMem(pReqData);
  FreeMem(pEchoReply);
  FreeMem(pData);
  Exit;
end;//if..then
FReply := pEchoReply^;

if pEchoReply^.Status <> 0 then
begin
FErrString := StatusString[pEchoReply^.Status - BaseStatus];
Result := pEchoReply^.Status - BaseStatus;
end;

FreeMem(pReqData);
FreeMem(pEchoReply);
FreeMem(pData);
end;//function Ping

procedure TPing.SetHostName(const Value: string);
begin
  FHostName := Value;
  FHostIP := GetIPFromName(Value);
end;

end.
Баламут вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
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
Ping Баламут Работа с сетью в Delphi 5 23.08.2007 15:17