检测本机同Internet之间的连接是否畅通(0分)

公司规定上网要先申请，我懒得填单，写了下面的程序，当有别人上网时，我可以蹭一下。

//******************************************************************************
//1、本系统用于检测本机同Internet之间的连接是否畅通（每隔5分钟检测一次）
//2、本系统使用了以下几种技术：
//2。1、TTS发音技术；使用TTS发音引擎将指定文字内容（英文）转换成语音信号；
//2。2、Ping技术：使用ICS控件包中的Ping控件测试本机到指定地址的远程终端是否连通；
//2。3、将wave文件做到exe文件里；
//2。4、缩小图标到系统托盘。
//2。5、写注册表，是本系统在操作系统启动后自行启动；
//******************************************************************************

unit uTestNetwork;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Ping, CoolTrayIcon, StdCtrls, OleCtrls, VTxtAuto_TLB, comobj,
ActiveX, Menus, mmsystem, Registry, AMAboutDialog;

type
TfrmMain = class(TForm)
CoolTrayIcon1: TCoolTrayIcon;
Ping1: TPing;
Timer1: TTimer;
Panel1: TPanel;
PopupMenu1: TPopupMenu;
Close1: TMenuItem;
N1: TMenuItem;
About1: TMenuItem;
AboutDlg: TAMAboutDialog;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
private
{ Private declarations }
Connected: Boolean;
PtrSound : PChar;
hRes : THandle; {handle to the loaded resource if 0 indicates nothing playing}
procedure WriteRegistry;
procedure TellAll;
procedure TestConnect;
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
IVTxtAuto1:IVTxtAuto;
implementation

{$R *.DFM}
{$R Ring.RES}

//写注册表
procedure TfrmMain.WriteRegistry;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('/Software/Microsoft/Windows/CurrentVersion/Run', True)
then Reg.WriteString('TestConnect','"' + ParamStr(0) + '"');
finally
Reg.CloseKey;
Reg.Free;
inherited;
end;
end;

//发音
procedure TfrmMain.TellAll;
begin
IVTxtAuto1:=nil;
CoInitialize(nil);//初始化COM库
OleCheck(CoCreateInstance(CLASS_VTxtAuto_, nil, CLSCTX_ALL, IID_IVTxtAuto, IVTxtAuto1));
//创建IVTxtAuto接口
IVTxtAuto1.Register('Demo1',Application.ExeName);
//向服务器注册
IVTxtAuto1.Set_Enabled(1);//使能TTS功能
IVTxtAuto1.Set_Speed(150);//设置语音速度
IVTxtAuto1.Speak('Net is Connected!',vtxtsp_VERYHIGH);//发声
end;

//测试连通状态
procedure TfrmMain.TestConnect;
var
i:integer;
bConnect:boolean;
begin
//连续测试四次，如果有一次Ping通，就认为网络是通的
bConnect:=False;
i:=1;
while (not bConnect) and (i<=4) do
begin
Ping1.Ping;
if Ping1.ErrorCode=0 then bConnect:=True
Inc(i);
end;
//状态处理
if not bConnect
then Connected:=False
else begin
if not Connected
then begin
//如果是第一次Ping通，先播放一段音乐，再使用语音提示
SndPlaySound(PtrSound,SND_ASYNC or SND_MEMORY);
TellAll;
Connected:=True;
end
end;
end;

//每五分钟测试一次
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
TestConnect;
end;

//初始化
procedure TfrmMain.FormCreate(Sender: TObject);
var
hResInfo : THandle;
begin
Connected:=False;

Ping1.Address:='202.96.209.5'; //上海热线DNS服务器地址
Ping1.TimeOut:=5000;
Ping1.Size :=32;

CoolTrayIcon1.Icon:= Application.Icon;
CoolTrayIcon1.Hint:= Application.Title;

hResInfo := FindResource(HInstance, 'ring', 'WAVE');
hRes := LoadResource(HInstance, hResInfo);
if hRes > 32 then {its a good load}
PtrSound:=LockResource(hRes); {lock the resource}

WriteRegistry;
TestConnect;
end;

//退出系统
procedure TfrmMain.Close1Click(Sender: TObject);
begin
Application.Terminate;
end;

//显示系统关于对话框：使用AMAboutDialog控件
procedure TfrmMain.About1Click(Sender: TObject);
begin
AboutDlg.AppName :='三宝爱踢 版权所有!';
AboutDlg.Caption :=Application.Title;
AboutDlg.Icon :=Application.Icon ;
AboutDlg.ExtraInfo :='本系统可以检测网络的连通状况';
AboutDlg.Execute ;
end;

end.

up

up

哪位路过的兄弟发个言，我好结束

up

还行，编程风格比我好：）

finish