khafanovich
سه شنبه 09 دی 1382, 23:40 عصر
چگونه میتوان توسط دلفی عملیات ping , netstat را انجام داد؟
از چه کامپوننت هایی باید استفاده کنیم.
ممنون.
Gladiator
سه شنبه 09 دی 1382, 23:55 عصر
ساده ترین روش استفاده از Winexec .
ولی برای پینگ من قبلا سوال کرده بودم و آقای رحیمی فراهانی ( Amirrf ) جواب داده بود . جستجو کن .
موفق باشی .
N_D
یک شنبه 14 دی 1382, 22: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.
vBulletin® v4.2.5, Copyright ©2000-1404, Jelsoft Enterprises Ltd.