unit1.pas

自动检测网络通断的程序.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    connected:bool;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function LIP : string;  //得到本地IP
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe : PHostEnt;
  pptr : PaPInAddr;
  Buffer : array [0..63] of char;
  I : Integer;
  GInitData : TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe :=GetHostByName(buffer);
  if phe = nil then Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do
  begin
    result:=StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;
function getnet:bool ;    //检查网络通断，
begin
  if(LIP='127.0.0.1')then
  begin
    Result:=false;
  end
  else
  begin
    Result:=true;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  if(getnet)then
  begin
      showmessage('网络已经连接');
  end
  else
  begin
     showmessage('网络已经断开');
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if(getnet)then
  begin
    if(not self.connected)then
    begin
       self.Label1.Font.Color:=clGreen;
       self.Label1.Caption:='网络已经连接'
    end;
    self.connected:=true;
  end
  else
  begin
    if(self.connected)then
    begin
       self.Label1.Font.Color:=clRed;
       self.Label1.Caption:='网络已经断开';
    end;
    self.connected:=false;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
connected:=false;
end;

end.