|
自动拨号的程序做完了，接下来的任务就是如何建一个服务在开机时运行，并定时检测网络
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,ras,IniFiles;
type
TAutoDialService = class(TService)
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServiceStart(Sender: TService; var Started: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
type
TChildParam=record
TrdId:integer;
end;
var
AutoDialService: TAutoDialService;
Run:boolean;
DirPath,EntryName:string;
aRasConn:array [0..10] of TRASCONN;
nRasConnCount: DWORD;
hRasConn:THRASCONN;
RetryInterval:integer;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
AutoDialService.Controller(CtrlCode);
end;
function TAutoDialService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure LogMessage(Msg:string);
var
LogFile:TextFile;
begin
AssignFile(LogFile,DirPath+''''Log.txt'''');
Append(LogFile);
WriteLn(LogFile,DateTimeToStr(Now)+'''',''''+Msg);
CloseFile(LogFile);
end;
procedure GetActiveConn;
var
dwRet : DWORD;
nCB : DWORD;
Buf : array [0..255] of Char;
begin
aRasConn[0].dwSize := SizeOf(aRasConn[0]);
nCB := SizeOf(aRasConn);
dwRet := RasEnumConnectionsA(@aRasConn, @nCB, @nRasConnCount);
if dwRet <> 0 then begin
RasGetErrorStringA(dwRet, @Buf[0], SizeOf(Buf));
LogMessage(Buf);
end;
end;
function GetActiveConnHandle(szName : String) : THRASCONN;
var
I : Integer;
begin
GetActiveConn;
if nRasConnCount > 0 then begin
for I := 0 to nRasConnCount - 1 do begin
if StrIComp(PChar(szName), aRasConn[I].szEntryName) = 0 then begin
Result := aRasConn[I].hRasConn;
Exit;
end;
end;
end;
Result := 0;
end;
function CheckConn(FEntryName:string):boolean;
begin
hRasConn := GetActiveConnHandle(FEntryName);
if hRasConn <> 0 then
result:=True
else
Result:=False;
end;
function ChildThrd(p:Pointer):LongInt;stdcall;//定时检测网络连接是否正常
var
ThreadId:integer;
begin
Result:=0;
ThreadId:=TChildParam(p^).TrdId;
while True do
begin
if Run then
begin
if not CheckConn(EntryName) then
begin
WinExec(PChar(DirPath+''''AutoDial.exe''''),SW_SHOW);//运行前面制作的的拨号程序
end;
sleep(RetryInterval);
end;
end;
Dispose(p);
end;
procedure TAutoDialService.ServicePause(Sender: TService; var Paused: Boolean);
begin
Run:=False;
Paused:=True;
end;
procedure TAutoDialService.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
Run:=True;
Continued:=True;
end;
procedure TAutoDialService.ServiceStart(Sender: TService;
var Started: Boolean);
var
hChildThread:Thandle;
ChildThreadId:DWord;
ChildParam:^TChildParam;
f:TIniFile;
begin
DirPath:=ExtractFilePath(ParamStr(0));
f:=TiniFile.Create(DirPath+''''conf.ini'''');
EntryName:=f.ReadString(''''RasDial'''',''''EntryName'''','''''''');
RetryInterval:=f.ReadInteger(''''RasDial'''',''''Interval'''',0)*1000;
f.Free;
Run:=True;
new(ChildParam);
ChildParam^.TrdId:=2;
hChildThread:=CreateThread(nil,0,@ChildThrd,ChildParam,0,ChildThreadID);
end;
end.
好了，现在只要重起一下机器后，就能自动拨号了
源码下载
http://ono.3322.org
[Delphi程序]如何在启动机器时自动运行adsl拨号（1）
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
