前一段时间写的一个小玩意,或许可以参考一下。
//******************************************************************************
//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, ImgList;
const
Msg = '网通啦!!!!!!!!!' + #13 +
'网通啦!!!!!!!!!' + #13 +
'网通啦!!!!!!!!!' + #13 +
'网通啦!!!!!!!!!' + #13 +
'网通啦!!!!!!!!!' + #13 +
'网通啦!!!!!!!!!';
type
TfrmMain = class(TForm)
CoolTrayIcon1: TCoolTrayIcon;
Ping1: TPing;
Timer1: TTimer;
Panel1: TPanel;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
Close1: TMenuItem;
About1: TMenuItem;
AboutDlg: TAMAboutDialog;
Info1: TMenuItem;
ImageList1: TImageList;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Info1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Connected: Boolean; //网络是否接通
PtrSound : PChar; //定位wave资源
hRes : THandle; {handle to the loaded resource if 0 indicates nothing playing}
procedure WriteRegistry;
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.TestConnect;
var
i:integer;
bConnect:boolean;
begin
//连续测试四次,如果有一次Ping通,就认为网络是通的
bConnect:=False;
i:=1;
repeat
Ping1.Ping;
if Ping1.ErrorCode=0 then bConnect:=True;
Inc(i);
until bConnect or (i>5);
CoolTrayIcon1.IconIndex := Ord(bConnect);
//状态处理
if not bConnect
then Connected:=False
else begin
if not Connected
then begin
//如果网络已经连通,先播放一段音乐,再使用语音提示
Connected:=True;
SndPlaySound(PtrSound,SND_ASYNC or SND_MEMORY); //播放资源文件所定位的Wave
IVTxtAuto1.Set_Enabled(1);//使能TTS功能
IVTxtAuto1.Set_Speed(150);//设置语音速度
IVTxtAuto1.Speak('Net is Connected!',vtxtsp_VERYHIGH);//发声
Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_OK or MB_ICONWARNING);
end
end;
end;
//每五分钟测试一次
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
TestConnect;
end;
//初始化
procedure TfrmMain.FormCreate(Sender: TObject);
var
hResInfo : THandle;
begin
Connected:=False;
//ping参数
Ping1.Address := '202.96.209.5'; //上海热线DNS服务器地址
Ping1.TimeOut := 3000;
Ping1.Size := 32;
//系统托盘图标参数
CoolTrayIcon1.Icon := Application.Icon;
CoolTrayIcon1.Hint := Application.Title;
//wave资源
hResInfo := FindResource(HInstance, 'Ring', 'WAVE');
hRes := LoadResource(HInstance, hResInfo);
if hRes > 32 then {its a good load}
PtrSound := LockResource(hRes); {lock the resource}
//TTS初始化
IVTxtAuto1 := nil;
CoInitialize(nil);//初始化COM库
OleCheck(CoCreateInstance(CLASS_VTxtAuto_, nil, CLSCTX_ALL, IID_IVTxtAuto, IVTxtAuto1));
//创建IVTxtAuto接口
IVTxtAuto1.Register('Demo1',Application.ExeName); //向服务器注册
WriteRegistry;
TestConnect;
end;
//退出系统
procedure TfrmMain.Close1Click(Sender: TObject);
begin
Application.Terminate;
end;
//显示系统关于对话框:使用AMAboutDialog控件
procedure TfrmMain.About1Click(Sender: TObject);
begin
AboutDlg.AppName := 'Samle-IT 版权所有!';
AboutDlg.Caption := Application.Title;
AboutDlg.Icon := Application.Icon ;
AboutDlg.ExtraInfo :='本系统可以检测网络的连通状况';
AboutDlg.Execute ;
end;
//提示
procedure TfrmMain.Info1Click(Sender: TObject);
var
strInfo:string;
begin
strInfo:= '一、本系统用于检测本机同Internet之间的连接是否畅通(每隔5分钟检测一次);' +#13;
strInfo:=strInfo+'二、本系统使用了以下几种技术:' +#13;
strInfo:=strInfo+' 2.1、缩小图标到系统托盘;' +#13;
strInfo:=strInfo+' 2.2、将wave文件做到exe文件里;' +#13;
strInfo:=strInfo+' 2.3、写注册表,是本系统在操作系统启动后自行启动。' +#13;
strInfo:=strInfo+' 2.4、TTS发音技术;使用TTS发音引擎将指定文字内容(英文)转换成语音信号;' +#13;
strInfo:=strInfo+' 2.5、Ping技术:使用ICS控件包中的Ping控件测试本机到指定地址的远程终端是否连通;';
ShowMessage(strInfo);
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
CoUnInitialize;
end;
end.