如何在启动机器时自动运行adsl拨号(2)[1]

[入库:2005年8月18日] [更新:2007年3月25日]

本文简介:选择自 zhujunfeng 的 blog

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

本文关键:adsl 拨号 服务
 

本站最佳浏览方式为 分辨率 1024x768 IE 6.0(或更高版本的 IE浏览器)

go top