Ping IP dengan Delphi

Ping IP dengan Delphi

       Setelah kemaren kita belajar cara mengambil informasi yang didapatkan dari perintah yang kita ketikkan di command prompt, Sekarang saya coba membagi hasil temuan saya didunia maya, yaitu cara melakukan cek koneksi ke nomor IP tertentu dalam suatu jaringan. Seperti halnya di command prompt jika kita ingin mengetahui komputer dengan nomor IP tertentu tersambung dengan jariangan komputer kita kettikkan "ping nomor_IP' dicommand prompt. Pada kesempatan kali ini kita coba akab belajar cara melakukan ping nomor IP tertentu dalam sebuah jaringan dengan program Visual yaitu dengan Delphi tidak lagi dengan mengetikkan perintah di DOS.

      Pertama siapkan beberapa komponen diantaranya :

1. Button,

2. Edit

3. Timer

4. Label

     dengan tampilan program sebagai contoh seperti ini:

     Sekarang kita kettikan subroutin program seperti dibawah ini:

unit UContoh;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSock, StdCtrls, ExtCtrls, WinSkinData, SUIForm;

type
  TForm1 = class(TForm)
    suiForm1: TsuiForm;
    Label1: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    Memo1: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    Timer1: TTimer;
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  IPINFO = record
  Ttl     :char;
  Tos     :char;
  IPFlags :char;
  OptSize :char;
  Options :^char;
end;

type
  ICMPECHO = record
  Source  :longint;
  Status  :longint;
  RTTime  :longint;
  DataSize:Shortint;
  Reserved:Shortint;
  pData   :^variant;
  i_ipinfo:IPINFO;
end;

TIcmpCreateFile = function():integer; {$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpCloseHandle = procedure(var handle:integer);{$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpSendEcho = function(var handle:integer; endereco:DWORD; buffer:variant; tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD; tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
    Close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
wsadt     : wsadata;
icmp      : icmpecho;
HNDicmp   : integer;
Host      : PHostEnt;
Destino   : in_addr;
IP        : ipinfo;
Retorno   : integer;
x         : integer;

IcmpCreateFile  : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho    : TIcmpSendEcho;

begin

Memo1.Clear;

if (edit1.Text = '') then
  begin
      edit1.Text:='localhost';
  exit;
  end;  


HNDicmp := LoadLibrary('ICMP.DLL');

if (HNDicmp <> 0) then
  begin

  @IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');
  @IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');
  @IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');

  if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or (@IcmpSendEcho=nil) then
    begin

    Application.MessageBox('Error getting ICMP Adress','error', MB_OK);
    FreeLibrary(HNDicmp);

    end;

  end;

Retorno := WSAStartup($0101,wsadt);

if (Retorno <> 0) then
  begin

  Application.MessageBox('Can´t Load WinSockets','WSAStartup', MB_OK);
  WSACleanup();
  FreeLibrary(HNDicmp);

  end;

Destino.S_addr := inet_addr(Pchar(Edit1.text));

if (Destino.S_addr = 0) then
  Host := GetHostbyName(PChar(Edit1.text))
else
  Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);

if (host = nil) then
  begin
  memo1.Clear;
  //MessageDlg('IP yang anda maksudkan tidak diketemukan...',mtInformation,[mbOK],0);
  memo1.Lines.Add('Tidak bisa koneksi ke '+ edit1.Text );
  memo1.Lines.Add('Tidak bisa koneksi ke '+ edit1.Text );
  memo1.Lines.Add('Tidak bisa koneksi ke '+ edit1.Text );
  memo1.Lines.Add('Tidak bisa koneksi ke '+ edit1.Text );
  memo1.Lines.Add('Tidak bisa koneksi ke '+ edit1.Text );
  WSACleanup();
  FreeLibrary(HNDicmp);
  exit;

  end;

for x:= 0 to 4 do
  begin
    Ip.Ttl := char(255);
    Ip.Tos := char(0);
    Ip.IPFlags := char(0);
    Ip.OptSize := char(0);
    Ip.Options := nil;
    Destino.S_addr := icmp.source;
    if (edit1.Text = '') then
      Memo1.Lines.Add('Cek Koneksi IP localhost Lancar')
    else
      Memo1.Lines.Add('Cek Koneksi IP ' + Edit1.text + ' Lancar');
  end;

FreeLibrary(HNDicmp);
WSACleanup();
end;

end.
  
          Sekarang rekan-rekan bisa mencobanya semoga bermanfaat.

Read more »

Command Prompt di delphi

Command Prompt di delphi            

             Pada tutorial singkat ini saya coba bagi-bagi sedikit info. Masih berhubngan dengan delphi. Pada contoh program ini saya bikin aplikasi command prompt di visual Delphi. Sederhananya saya hanya mengambil informasi yang dihasilkan perintah dalam DOS. Misal kita ketik help di command prompt maka akan di hasilkan perintah-perintah help di layar command prompt... Nah perintah-perintah itu yang nantinya ditampilkan didelphi dengan bantuan komponen Memo. Bingung? Apa yang mau diketik lagi, langsung aja deh saya sertakan routinnya..

             Pertama siapkan beberapa komponen diantarnya:

1. Button

2. Edit

3. Memo

         Ini routin lengkapnya :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, ZAbstractRODataset, ZAbstractDataset,
  ZDataset, ZConnection, StdCtrls, ExtCtrls, SUIForm, SUITitleBar, DBCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.GetDosOutput(CommandLine, Work: string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handlee: Boolean;
begin
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handlee := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handlee then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     memo1.Text:=GetDosOutput(edit1.text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     close;
end;

end.

Nah ini dia hasilnya..

           Tutorial nanti yang akan saya posting gimana caranya bikin aplikasi PING IP dalam suatu jaringan, sehingga kita bisa tahu IP tersebut terkoneksi dalam jaringan..

Read more »