unit1.~pas

此软件是用来监控网络设备的连网情况

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdMessage, IdBaseComponent, IdComponent,Inifiles,Winsock,
  IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, ExtCtrls, Buttons,NB30,
  ComCtrls;

type
  TForm1 = class(TForm)
    SMTP1: TIdSMTP;
    IdMsg: TIdMessage;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label3: TLabel;
    Memo1: TMemo;
    Edit3: TEdit;
    Button2: TButton;
    Label6: TLabel;
    Edit4: TEdit;
    Label7: TLabel;
    Edit5: TEdit;
    Label8: TLabel;
    Edit6: TEdit;
    OpenDialog1: TOpenDialog;
    Edit7: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Bevel1: TBevel;
    Button3: TButton;
    Label9: TLabel;
    Edit8: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Timer1: TTimer;
    CheckBox1: TCheckBox;
    Button4: TButton;
    Label10: TLabel;
    Edit9: TEdit;
    Label11: TLabel;
    UpDown1: TUpDown;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    function  NBGetAdapterAddress(a: integer):String;
    procedure CheckBox1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure UpDown1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
    mInifile:Tinifile;
  end;



    TIP_Option_Information = packed record
    TTL: Byte;				// 存活时间 (用于路由跟踪)
    TOS: Byte;				// 服务类型（通常为0）
    Flags: Byte;			// IP头标志（通常为0）
    OptionsSize: Byte;			// 附加数据大小（通常为0，最大为40）
    OptionsData: PChar;			// 附加数据
  end;
  TIcmp_Echo_Reply = packed record
    Address: DWord;			// 应答的主机地址
    Status: DWord;			// IP状态码
    RTT: DWord;				// 往返旅行时间（以毫秒计）
    DataSize: Word;			// 回波应答数据大小（以字节计）
    Reserved: Word;			// 系统保留
    Data: Pointer;			// 回波应答数据指针
    Options: TIP_Option_Information;	// 回波应答参数
  end;
  PIP_Option_Information = ^TIP_Option_Information;
  PIcmp_Echo_Reply = ^TIcmp_Echo_Reply;

  function IcmpCreateFile: THandle; stdcall; external 'ICMP.DLL';
  function IcmpCloseHandle(IcmpHandle: THandle): Boolean; stdcall; external 'ICMP.DLL';
  function IcmpSendEcho(
    IcmpHandle: THandle;		 // 用ICMPCreateFile函数打开的ICMP句柄
    DestinationAddress: DWord;		 // 目标主机地址
    RequestData: Pointer;		 // 回波请求所发数据的缓冲区
    RequestSize: Word;			 // 回波请求数据缓冲区大小（以字节计）
    RequestOptions: PIP_Option_Information;  // 回波请求中IP报头选项地址，可以为空
    ReplyBuffer: Pointer;		 // 用于存储回波应答数据的缓冲区
    ReplySize: DWord;			 // 回波应答缓冲区大小（以字节计）
    Timeout: Dword			 // 等待回应的时间（以毫秒计）
  ): DWord; stdcall; external 'ICMP.DLL';




var
  Form1: TForm1;
  PHostEntry: PHostEnt;
  IcmpHandle: THandle;

implementation

{$R *.dfm}

const
  PacketSize = 32;			// 发送的数据包大小（以字节计）
  TimeOut = 3000;			// 超时设定（以毫秒计）


//定义测试PING函数
procedure Ping(TheIPAddress: string);
var
  WSAData: TWSAData;			// Winsock数据结构
  DestAddress: DWord;			// 目标主机IP地址
  RequestDataBuffer: Pointer;		// 请求数据缓冲区指针
  ReplyDataBuffer: Pointer;		// 应答数据缓冲区指针
  ICMPEchoReplyBuffer: PIcmp_Echo_Reply;// ICMP回波应答缓冲区
  IPOptionInfo: TIP_Option_Information;	// 待发送数据包的IP选项
begin
  if WSAStartup($102,WSAdata) <> 0 then	           // 初始化Winsock
  begin
    ShowMessage('Winsock初始化失败！');
    Exit;
  end;
  ICMPHandle := IcmpCreateFile;		           // 打开ICMP句柄
  if ICMPHandle = INVALID_HANDLE_VALUE then	   // 错误处理
  begin
    ShowMessage('无法获得ICMP句柄！');
    Exit;
  end;
  DestAddress := inet_addr(PChar(TheIPAddress));   // 将目标地址转换成网络格式
  GetMem(RequestDataBuffer, PacketSize);	   // 分配请求数据缓冲区
  FillChar(RequestDataBuffer^, PacketSize, $FF);   // 填充请求数据缓冲区
  FillChar(IPOptionInfo, SizeOf(IPOptionInfo), 0); // 填充IP选项数据
  IPOptionInfo.TTL := 64;			   // 设置存活期
  GetMem(ReplyDataBuffer, PacketSize);		   // 分配应答数据缓冲区
    												// 分配回波应答结构缓冲区
  GetMem(ICMPEchoReplyBuffer, SizeOf(TIcmp_Echo_Reply) + PacketSize);
  ICMPEchoReplyBuffer^.Data := ReplyDataBuffer;	   // 填入缓冲区指针
  if IcmpSendEcho(ICMPHandle, DestAddress, 	   // 发送回波请求，并等待回波应答
                RequestDataBuffer, PacketSize,
                @IPOptionInfo, ICMPEchoReplyBuffer,
                SizeOf(TIcmp_Echo_Reply) + PacketSize, TimeOut) <> 0 then
    ShowMessage('向' + TheIPAddress + 		   // 显示测试结果
                '地址发送了' + IntToStr(PacketSize) + '字节数据,'+ #10#13 +
                '在' + IntToStr(ICMPEchoReplyBuffer^.RTT) + ' 毫秒内从' +
                StrPas(inet_ntoa(TInAddr(ICMPEchoReplyBuffer^.Address))) +
                '接收了' + IntToStr(ICMPEchoReplyBuffer^.DataSize) + '字节.')
  else
    ShowMessage('无法连接主机' + TheIPAddress + '!');
  FreeMem(ICMPEchoReplyBuffer);			   // 释放分配的内存空间
  FreeMem(ReplyDataBuffer);
  FreeMem(RequestDataBuffer);
  IcmpCloseHandle(ICMPHandle);			   // 关闭ICMP句柄
  if WSACleanup <> 0 then			   // 关闭Winsock
    ShowMessage('无法关闭winsock！');
end;


//定义获取IP地址、计算机名、MAC地址
 function   TForm1.NBGetAdapterAddress(a: integer):String;
  //a指定多个网卡适配器中的哪一个0，1，2...
  Var
      NCB:TNCB;   //   Netbios   control   block   file://NetBios控制块
      ADAPTER:TADAPTERSTATUS;   //   Netbios   adapter   status//取网卡状态
      LANAENUM:TLANAENUM;   //   Netbios   lana
      intIdx:Integer;   //   Temporary   work   value//临时变量
      cRC:Char;   //   Netbios   return   code//NetBios返回值
      strTemp:String;   //   Temporary   string//临时变量
  Begin   
      //   Initialize   
      Result:='';
      Try   
          //   Zero   control   blocl   
          ZeroMemory(@NCB,SizeOf(NCB));
          //   Issue   enum   command   
          NCB.ncb_command:=Chr(NCBENUM);   
          cRC :=NetBios(@NCB);
          //   Reissue   enum   command   
    
          NCB.ncb_buffer:= @LANAENUM;
    
          NCB.ncb_length:=SizeOf(LANAENUM);

          cRC:= NetBios(@NCB);
    
          If Ord(cRC)<>0  Then
    
              exit;   

          //   Reset   adapter   

          ZeroMemory(@NCB, SizeOf(NCB));
    
          NCB.ncb_command :=Chr(NCBRESET);

          NCB.ncb_lana_num :=LANAENUM.lana[a];
    
          cRC := NetBios(@NCB);
    
          If Ord(cRC)<>0  Then
              exit;

          //   Get   adapter   address   

          ZeroMemory(@NCB, SizeOf(NCB));
    
          NCB.ncb_command := Chr(NCBASTAT);
    
          NCB.ncb_lana_num := LANAENUM.lana[a];
    
          StrPCopy(NCB.ncb_callname, '*');
    
          NCB.ncb_buffer := @ADAPTER;

          NCB.ncb_length := SizeOf(ADAPTER);

          cRC := NetBios(@NCB);

          //   Convert   it   to   string

          strTemp  := '';

          For intIdx := 0  To 5  Do

              strTemp:=strTemp+InttoHex(Integer(ADAPTER.adapter_address[intIdx]),2);

          Result:= strTemp;

      Finally

      End;
  end;






procedure TForm1.Button1Click(Sender: TObject);
begin

if (trim(Edit1.Text)='') or (trim(Edit2.Text)='') or (trim(Edit3.Text)='') or
 (trim(Edit4.Text)='') or (trim(Edit5.Text)='') or (trim(Edit6.Text)='') or
 (trim(Edit8.Text)='') then
    showmessage('请先设置‘服务器’、‘帐号密码’、‘发件人’、‘收件人’、‘主题’、‘监控地址’等信息！')
 else
   begin