Gönderen Konu: Ping ve Network Scanner (Okunma sayısı 1588 defa)

dynamo · « : 12 Şubat 2010 09:05:24 »

Program girilen ip aralığını tarayarak yerel ağa bağlı PC ve ip üzerinden çalışan elektronik cihazlar(printer,kart okuma terminalleri) bir listede gösterir. Ayrıca Edit1 e girilen ip adresine ping atar (Komut satırında ping 192.168.0.1 işleminin görsel hali).

Kod: [Seç]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Winsock, StdCtrls,uping, ComCtrls;

type
 ip_option_information = record
  Ttl : byte;
  Tos : byte;
  Flags : byte;
  OptionsSize : byte;
  OptionsData : pointer;
 end;

 ICMP_ECHO_REPLY =
 record
      Address : IPAddr;
      Status : ULONG;
      RoundTripTime : ULONG;
      DataSize : Word;
      Reserved : Word;
      Data : Pointer;
      Options : IP_OPTION_INFORMATION;
 end;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  gw:Boolean;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 Handle : THandle;
 InAddr : IPAddr;
 DW     : DWORD;
 cnt    : integer;
 SAddr  : string;
 pnum   : integer;
 minTime: longint;
 maxTime: longint;
 allTime: longint;
 stat   : longint;
 PingBuf: array[0..31] of char;
 Reply  : ICMP_ECHO_REPLY;

 ipadr:string;
begin

try
   Button1.Enabled:=false;
   Screen.Cursor:=crHourGlass;

   //Memo1.Lines.Clear;
   ipadr:=trim(Edit1.Text);

  if ipadr = '' then
  begin
     Memo1.Lines.Add((Format('Usage: %s <ip address or host name>',[ipadr])));
     showmessage('ip adresini giriniz...');
     edit1.SetFocus;
     exit;
  end;

  //simple way:
  if ping(ipadr) then
     Memo1.Lines.Add(( Format('%s is online', [ipadr])))
  else
     Memo1.Lines.Add(( Format('%s is offline', [ipadr])));

  //more compex way:
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then
  begin
     showmessage(inttostr(INVALID_HANDLE_VALUE));
     exit;
  end;

  TranslateStringToTInAddr(ipadr, InAddr);

  SAddr := Format('%d.%d.%d.%d',[InAddr.S_un_b.s_b1, InAddr.S_un_b.s_b2,
     InAddr.S_un_b.s_b3, InAddr.S_un_b.s_b4]);

  Memo1.Lines.Add((Format ('Pinging %s [%s]',[ipadr, SAddr]) ));

  pnum := 0;
  minTime := MaxInt -1;
  maxTime := 0;
  AllTime := 0;

  Reply.Data := @pingBuf;
  Reply.DataSize := 32;

  for cnt := 1 to 4 do
   begin
     DW := IcmpSendEcho(Handle, InAddr, @PingBuf, 32, nil, @reply, SizeOf(icmp_echo_reply) + 32 , 3000);
     if DW = 0 then
      Memo1.Lines.Add('Request timed out')
        else
         begin
          Memo1.Lines.Add(Format('Reply from %s: bytes = 32 time=%dms TTL=%d',[SAddr, Reply.RoundTripTime, Reply.Options.Ttl]));
          stat := Reply.RoundTripTime;
          inc(pnum);
          if minTime > stat then
            minTime := stat;
          if maxTime < stat then
            maxTime := stat;
          AllTime := AllTime + stat;
         end;
      Sleep(500);
   end;
  IcmpCloseHandle(Handle);

  if pnum=0 then pnum:=1; //hata vermesin

  Memo1.Lines.Add('Ping statistics for '+SAddr+':');
  Memo1.Lines.Add('     Packets: Sent = 10, Received = '+inttostr(pnum)+' Lost = '+ inttostr(10-pnum));
  Memo1.Lines.Add('Approximate round trip times in milli-seconds:');
  Memo1.Lines.Add('     Minimum = '+inttostr(minTime)+ ' ms Maximum = '+inttostr( maxTime)+' ms Average =  '+inttostr( round(AllTime / pnum)) +' ms');

finally
  Button1.Enabled:=true;
  Screen.Cursor:=crDefault;
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
 Handle : THandle;
 InAddr : IPAddr;
 DW     : DWORD;
 cnt    : integer;
 SAddr  : string;
 pnum   : integer;
 minTime: longint;
 maxTime: longint;
 allTime: longint;
 stat   : longint;
 PingBuf: array[0..31] of char;
 Reply  : ICMP_ECHO_REPLY;

 ipadr:string;
 i:integer;

begin


  //Memo1.Lines.Clear;
  ipadr:=trim(Edit1.Text);

  if ipadr = '' then
  begin
     Memo1.Lines.Add((Format('Usage: %s <ip address or host name>',[ipadr])));
     showmessage('başlangıç ip adresini giriniz...');
     edit1.SetFocus;
     exit;
  end;

  Label2.Caption:='Scan ip:  ';
  gw:=true;
  if gw=true then
  for i:=1 to 254 do
  begin
    Application.ProcessMessages;
    if gw=false then break;
    ipadr:= Copy(trim(Edit1.Text),1,10)+inttostr(i);
    Label2.Caption:='Scan ip:  '+ ipadr;
    Label2.Refresh;
    Label2.Repaint;
    if ping(ipadr) then
       Memo1.Lines.Add(( Format('%s is online', [ipadr])))
    else
       //Memo1.Lines.Add(( Format('%s is offline', [ipadr])));
    Application.ProcessMessages;
  end;
  showmessage('tamamlandı...');
  Label2.Caption:='Scan ip:  ';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  gw:=false;
end;

end.

örnek uygulama ektedir.

Ghostcoder · « **Yanıtla #1 :** 13 Şubat 2010 17:25:52 »

güzel oolmus eline saglık cmd yi delphiye gömmenin başka bi yöntemi eline saglık mantıklı

cakirr42 · « **Yanıtla #2 :** 13 Şubat 2010 19:52:23 »

güzel olmuş ama: Scan iptal yerinede ingilizce olarak cancel scan deseymişin ya

ama güzel bi paylaşım işimi görecektir ...

dynamo · « **Yanıtla #3 :** 13 Şubat 2010 23:11:09 »

örnekteki uygulama yarım kalmış.Son düzeltmeleri yapıp tekrar ekledim.

IPv4 (IP Version 4) Adreslemesinde bir ip adresi 4 oktetten oluşur.IP taraması için son oktetleri kullanıyoruz.Normal bir Edit kutusundan alınan ip adresinin uzunluğu değişken olduğundan (192.168.0.1 -> 11 karakter,192.168.40.101 -> 14 karakter) son okteti bulacak fonsiyonu kullanalım:

Kod: [Seç]

function IPsonOktet(const IP: string): string;
var
  c, i, l: integer;
  s: string;
begin
  c := 1;
  l := Length(IP);
  s:='';
  for i := 1 to l do begin
    if IP[i] = '.' then
      inc(c);
    if (IP[i] <> '.') and (c = 4) then
      s := s + IP[i];

  end;

  result:=s;
end;

Başlangıç ve bitiş ip adreslerini Edit kutularından alıp tarama işlemi yaparsak son durum:

Kod: [Seç]

procedure TForm1.Button2Click(Sender: TObject);
var

 ipadr,ipadrTur:string;
 baslama,bitis:integer;
 i:integer;

begin


  Memo1.Lines.Clear;

  if trim(Edit2.Text) = '' then
  begin
     showmessage('başlangıç ip adresini giriniz...');
     edit2.SetFocus;
     exit;
  end;

  if trim(Edit3.Text) = '' then
  begin
     showmessage('bitiş ip adresini giriniz...');
     edit3.SetFocus;
     exit;
  end;

  //başlangıç ve bitiş ip adreslerinin son oktetini al

  baslama:=strtoint(IPsonOktet(trim(Edit2.Text)));
  bitis:=strtoint(IPsonOktet(trim(Edit3.Text)));

  //ip adres türü
  ipadrTur:= Copy(trim(Edit2.Text),1,10) ;

  Label2.Caption:='Scan ip:  ';
  gw:=true;
  if gw=true then
    for i:=baslama to bitis do
    begin
      Application.ProcessMessages;
      if gw=false then break;
      ipadr:= ipadrTur + inttostr(i);
      Label2.Caption:='Scan ip:  '+ ipadr;
      Label2.Refresh;
      Label2.Repaint;
      if ping(ipadr) then
         Memo1.Lines.Add(( Format('%s is online', [ipadr])));
      //else
        //Memo1.Lines.Add(( Format('%s is offline', [ipadr])));
      Application.ProcessMessages;
    end;

  showmessage('tamamlandı...');
  Label2.Caption:='Scan ip:  ';
end;

dynamo · « **Yanıtla #4 :** 14 Kasım 2011 16:46:33 »

dosya silinmiş.aşağıdaki linke eklendi:

http://www.mediafire.com/?upr6db4cgkg3dcs

Joker · « **Yanıtla #5 :** 14 Kasım 2011 17:16:16 »

Eğitimsel açıcan çok güzel bir çalışma olmuş.bunu paylaşmanızda ayrı bir güzellik.
Teşekkürler...

Kodbank İndir

Gönderen Konu: Ping ve Network Scanner (Okunma sayısı 1588 defa)

dynamo

Ping ve Network Scanner

Ghostcoder

Ynt: Ping ve Network Scanner

cakirr42

Ynt: Ping ve Network Scanner

dynamo

Ynt: Ping ve Network Scanner

dynamo

Ynt: Ping ve Network Scanner

Joker

Ynt: Ping ve Network Scanner