如何在启动机器时自动运行adsl拨号（2）

自动拨号的程序做完了，接下来的任务就是如何建一个服务在开机时运行，并定时检测网络
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

本文地址：http://com.8s8s.com/it/it5431.htm