PDA

View Full Version : ping ,netstat,...



khafanovich
سه شنبه 09 دی 1382, 22:40 عصر
چگونه میتوان توسط دلفی عملیات ping , netstat را انجام داد؟
از چه کامپوننت هایی باید استفاده کنیم.
ممنون.

Gladiator
سه شنبه 09 دی 1382, 22:55 عصر
ساده ترین روش استفاده از Winexec .

ولی برای پینگ من قبلا سوال کرده بودم و آقای رحیمی فراهانی ( Amirrf ) جواب داده بود . جستجو کن .

موفق باشی .

N_D
یک شنبه 14 دی 1382, 21:04 عصر
کد زیر را اجرا کن


unit pingUnit;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

type
TSunB = packed record
s_b1, s_b2, s_b3, s_b4: byte;
end;

TSunW = packed record
s_w1, s_w2: word;
end;

PIPAddr = ^TIPAddr;
TIPAddr = record
case integer of
0: (S_un_b: TSunB);
1: (S_un_w: TSunW);
2: (S_addr: longword);
end;

IPAddr = TIPAddr;



var
Form1: TForm1;


function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) :boolean; stdcall;
external 'icmp.dll'
function IcmpSendEcho (IcmpHandle : THandle;
DestinationAddress : IPAddr;
RequestData : Pointer; RequestSize : Smallint;
RequestOptions : pointer;
ReplyBuffer : Pointer;
ReplySize : DWORD;
Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';


function Ping(InetAddress : string) : boolean;

implementation

{$R *.dfm}
uses
WinSock;

function Fetch(var AInput: string;const ADelim: string = ' ';const ADelete: Boolean = true) : string;
var
iPos: Integer;
begin
if ADelim = #0 then begin
// AnsiPos does not work with #0
iPos := Pos(ADelim, AInput);
end else begin
iPos := Pos(ADelim, AInput);
end;
if iPos = 0 then begin
Result := AInput;
if ADelete then begin
AInput := '';
end;
end else begin
result := Copy(AInput, 1, iPos - 1);
if ADelete then begin
Delete(AInput, 1, iPos + Length(ADelim) - 1);
end;
end;
end;

procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
phe: PHostEnt;
pac: PChar;
GInitData: TWSAData;
aa:WSAData;
begin
WSAStartup($101, GInitData);
try
phe := GetHostByName(PChar(AIP));
if Assigned(phe) then
begin
pac := phe^.h_addr_list^;
if Assigned(pac) then
begin
with TIPAddr(AInAddr).S_un_b do begin
s_b1 := Byte(pac[0]);
s_b2 := Byte(pac[1]);
s_b3 := Byte(pac[2]);
s_b4 := Byte(pac[3]);
end;
end
else
begin
raise Exception.Create('Error getting IP from HostName');
end;
end
else
begin
raise Exception.Create('Error getting HostName');
end;
except
FillChar(AInAddr, SizeOf(AInAddr), #0);
end;
WSACleanup;
end;

function Ping(InetAddress : string) : boolean;
var
Handle : THandle;
InAddr : IPAddr;
DW : DWORD;
rep : array[1..128] of byte;
begin
result := false;
Handle := IcmpCreateFile;
if Handle = INVALID_HANDLE_VALUE then
Exit;
TranslateStringToTInAddr(InetAddress, InAddr);
DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep,128, 0);
Result := (DW <> 0);
IcmpCloseHandle(Handle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if Ping(Edit2.Text) = false then
Label2.Caption:='False'
else Label2.Caption:='True';
end;

end.