我想做一个ａｄｓｌ拨号程序。求教？（１００）

Question

我想做一个ａｄｓｌ拨号程序。请高手指教啊。分不够再加。

Answer 1

建议下载‘delphi网络通信协议分析与应用实现‘看一下，那里边都是这方面的东西。没有的话我发给你。

Answer 2

能发给我吗
[email protected]

Answer 3

驱动开发网去问吧
主要是用NIDS实现PPPoE

Answer 4

如何在启动机器时自动运行adsl拨号（1）    zhujunfeng（原作）  
  
我们通常希望有一台机器能经常挂在网上，现在有了adsl包月服务，这已经不是问题。但是最近adsl总是会断线，当我回家想从公司的机器上拷贝一些文件的时候，有时会发现已经连接不上了。所以我做个程序所要实现的功能有这么两个，一是用程序来实现adsl拨号，二是要定时检测网络状态，三是要在启动机器时运行（既注册为服务）
我们先看一下如何做一个拨号程序
首先建一个ras拨号的单元文件（这是网上搜集的）
unit Ras;interfaceuses
    Windows, SysUtils;{$DEFINE WINVER400}
const
    RasUnitVersion        = 110;
    CopyRight    : String = ' RasUnit (c) 97-98 F. Piette V1.10 ';
    rasapi32              = 'rasapi32.dll';    UNLEN                 = 256;    // Maximum user name length
    PWLEN                 = 256;    // Maximum password length
    CNLEN                 = 15;     // Computer name length
    DNLEN                 = CNLEN;  // Maximum domain name length    RAS_MaxDeviceType     = 16;
    RAS_MaxPhoneNumber    = 128;
    RAS_MaxIpAddress      = 15;
    RAS_MaxIpxAddress     = 21;{$IFDEF WINVER400}
    RAS_MaxEntryName      = 256;
    RAS_MaxDeviceName     = 128;
    RAS_MaxCallbackNumber = RAS_MaxPhoneNumber;
{$ELSE}
    RAS_MaxEntryName      = 20;
    RAS_MaxDeviceName     = 32;
    RAS_MaxCallbackNumber = 48;
{$ENDIF}    RAS_MaxAreaCode       = 10;
    RAS_MaxPadType        = 32;
    RAS_MaxX25Address     = 200;
    RAS_MaxFacilities     = 200;
    RAS_MaxUserData       = 200;    RASCS_OpenPort            = 0;
    RASCS_PortOpened          = 1;
    RASCS_ConnectDevice       = 2;
    RASCS_DeviceConnected     = 3;
    RASCS_AllDevicesConnected = 4;
    RASCS_Authenticate        = 5;
    RASCS_AuthNotify          = 6;
    RASCS_AuthRetry           = 7;
    RASCS_AuthCallback        = 8;
    RASCS_AuthChangePassword  = 9;
    RASCS_AuthProject         = 10;
    RASCS_AuthLinkSpeed       = 11;
    RASCS_AuthAck             = 12;
    RASCS_ReAuthenticate      = 13;
    RASCS_Authenticated       = 14;
    RASCS_PrepareForCallback  = 15;
    RASCS_WaitForModemReset   = 16;
    RASCS_WaitForCallback     = 17;
    RASCS_Projected           = 18;{$IFDEF WINVER400}
    RASCS_StartAuthentication = 19;
    RASCS_CallbackComplete    = 20;
    RASCS_LogonNetwork        = 21;
{$ENDIF}
    RASCS_SubEntryConnected   = 22;
    RASCS_SubEntryDisconnected= 23;    RASCS_PAUSED              = $1000;
    RASCS_Interactive         = RASCS_PAUSED;
    RASCS_RetryAuthentication = (RASCS_PAUSED + 1);
    RASCS_CallbackSetByCaller = (RASCS_PAUSED + 2);
    RASCS_PasswordExpired     = (RASCS_PAUSED + 3);    RASCS_DONE                = $2000;
    RASCS_Connected           = RASCS_DONE;
    RASCS_Disconnected        = (RASCS_DONE + 1);    // If using RasDial message notifications, get the notification message code
    // by passing this string to the RegisterWindowMessageA() API.
    // WM_RASDIALEVENT is used only if a unique message cannot be registered.
    RASDIALEVENT    = 'RasDialEvent';
    WM_RASDIALEVENT = $CCCD;    // TRASPROJECTION
    RASP_Amb        = $10000;
    RASP_PppNbf     = $0803F;
    RASP_PppIpx     = $0802B;
    RASP_PppIp      = $08021;
    RASP_Slip       = $20000;type
    THRASCONN     = THandle;
    PHRASCONN     = ^THRASCONN;
    TRASCONNSTATE = DWORD;
    PDWORD        = ^DWORD;
    PBOOL         = ^BOOL;    TRASDIALPARAMS = packed record
        dwSize           : DWORD;
        szEntryName      : array [0..RAS_MaxEntryName] of Char;
        szPhoneNumber    : array [0..RAS_MaxPhoneNumber] of Char;
        szCallbackNumber : array [0..RAS_MaxCallbackNumber] of Char;
        szUserName       : array [0..UNLEN] of Char;
        szPassword       : array [0..PWLEN] of Char;
        szDomain         : array [0..DNLEN] of Char;
{$IFDEF WINVER401}
        dwSubEntry       : DWORD;
        dwCallbackId     : DWORD;
{$ENDIF}
        szPadding        : array [0..2] of Char;
    end;
    PRASDIALPARAMS = ^TRASDIALPARAMS;    TRASDIALEXTENSIONS = packed record
        dwSize     : DWORD;
        dwfOptions : DWORD;
        hwndParent : HWND;
        reserved   : DWORD;
    end;
    PRASDIALEXTENSIONS = ^TRASDIALEXTENSIONS;

Answer 5

TRASCONNSTATUS = packed record
        dwSize       : DWORD;
        RasConnState : TRASCONNSTATE;
        dwError      : DWORD;
        szDeviceType : array [0..RAS_MaxDeviceType] of char;
        szDeviceName : array [0..RAS_MaxDeviceName] of char;
        szPadding    : array [0..1] of Char;
    end;
    PRASCONNSTATUS = ^TRASCONNSTATUS;    TRASCONN = packed record
        dwSize       : DWORD;
        hRasConn     : THRASCONN;
        szEntryName  : array [0..RAS_MaxEntryName] of char;
{$IFDEF WINVER400}
        szDeviceType : array [0..RAS_MaxDeviceType] of char;
        szDeviceName : array [0..RAS_MaxDeviceName] of char;
{$ENDIF}
        szPadding    : array [0..0] of Char;
    end;
    PRASCONN = ^TRASCONN;    TRASENTRYNAME = packed record
        dwSize       : DWORD;
        szEntryName  : array [0..RAS_MaxEntryName] of char;
        szPadding    : array [0..2] of Char;
    end;
    PRASENTRYNAME = ^TRASENTRYNAME;    TRASENTRYDLG = packed record
        dwSize       : DWORD;
        hWndOwner    : HWND;
        dwFlags      : DWORD;
        xDlg         : LongInt;
        yDlg         : LongInt;
        szEntry      : array [0..RAS_MaxEntryName] of char;
        dwError      : DWORD;
        Reserved     : DWORD;
        Reserved2    : DWORD;
        szPadding    : array [0..2] of Char;
    end;
    PRASENTRYDLG = ^TRASENTRYDLG;    TRASPROJECTION = integer;
    TRASPPPIP = record
        dwSize  : DWORD;
        dwError : DWORD;
        szIpAddress : array [0..RAS_MaxIpAddress] of char;
    end;
function RasDialA(RasDialExtensions: PRASDIALEXTENSIONS;
                  PhoneBook     : PChar;
                  RasDialParams : PRASDIALPARAMS;
                  NotifierType  : DWORD;
                  Notifier      : Pointer;
                  RasConn       : PHRASCONN
                 ): DWORD; stdcall;
function RasGetErrorStringA(
                  uErrorValue   : DWORD; // error to get string for
                  szErrorString : PChar; // buffer to hold error string
                  cBufSize      : DWORD  // size, in characters, of buffer
                 ): DWORD; stdcall;
function RasHangupA(RasConn: THRASCONN): DWORD; stdcall;
function RasConnectionStateToString(nState : Integer) : String;
function RasGetConnectStatusA(
                  hRasConn: THRASCONN;   // handle to RAS connection of interest
                  lpRasConnStatus : PRASCONNSTATUS // buffer to receive status data
                 ): DWORD; stdcall;
function RasEnumConnectionsA(
                  pRasConn : PRASCONN;  // buffer to receive connections data
                  pCB      : PDWORD;  // size in bytes of buffer
                  pcConnections : PDWORD // number of connections written to buffer
                 ) : DWORD; stdcall
function RasEnumEntriesA(
                  Reserved : Pointer;  // reserved, must be NIL
                  szPhonebook : PChar;  // full path and filename of phonebook file
                  lpRasEntryName : PRASENTRYNAME; // buffer to receive entries
                  lpcb : PDWORD;  // size in bytes of buffer
                  lpcEntries : PDWORD  // number of entries written to buffer
                 ) : DWORD; stdcall;
function RasGetEntryDialParamsA(
                  lpszPhonebook : PChar; // pointer to the full path and filename of the phonebook file
                  lprasdialparams : PRASDIALPARAMS; // pointer to a structure that receives the connection parameters
                  lpfPassword : PBOOL    // indicates whether the user's password was retrieved
                 ) : DWORD; stdcall;
function RasEditPhonebookEntryA(
                   hWndParent : HWND;     // handle to the parent window of the dialog box
                   lpszPhonebook : PChar; // pointer to the full path and filename of the phonebook file
                   lpszEntryName : PChar  // pointer to the phonebook entry name
                 ) : DWORD; stdcall;
//function RasEntryDlgA(
//                   lpszPhonebook : PChar; // pointer to the full path and filename of the phone-book file
//                   lpszEntry : PChar;     // pointer to the name of the phone-book entry to edit, copy, or create
//                   lpInfo : PRASENTRYDLG  // pointer to a structure that contains additional parameters
//                 ) : DWORD; stdcall;
function RasCreatePhonebookEntryA(
                     hWndParent : HWND;    // handle to the parent window of the dialog box
                     lpszPhonebook : PChar // pointer to the full path and filename of the phonebook file
                   ) : DWORD; stdcall;function RasGetProjectionInfoA(
                    hRasConn      : THRASCONN;      // handle that specifies remote access connection of interest
                    RasProjection : TRASPROJECTION; // specifies type of projection information to obtain
                    lpProjection  : Pointer;        // points to buffer that receives projection information
                    lpcb          : PDWORD          // points to variable that specifies buffer size
                   ) : DWORD; stdcall;
function RasGetIPAddress: string;implementation{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function RasConnectionStateToString(nState : Integer) : String;
begin
    case nState of
    RASCS_OpenPort:             Result := 'Opening Port';
    RASCS_PortOpened:           Result := 'Port Opened';
    RASCS_ConnectDevice:        Result := 'Connecting Device';
    RASCS_DeviceConnected:      Result := 'Device Connected';
    RASCS_AllDevicesConnected:  Result := 'All Devices Connected';
    RASCS_Authenticate:         Result := 'Starting Authentication';
    RASCS_AuthNotify:           Result := 'Authentication Notify';
    RASCS_AuthRetry:            Result := 'Authentication Retry';
    RASCS_AuthCallback:         Result := 'Callback Requested';
    RASCS_AuthChangePassword:   Result := 'Change Password Requested';
    RASCS_AuthProject:          Result := 'Projection Phase Started';
    RASCS_AuthLinkSpeed:        Result := 'Link Speed Calculation';
    RASCS_AuthAck:              Result := 'Authentication Acknowledged';
    RASCS_ReAuthenticate:       Result := 'Reauthentication Started';
    RASCS_Authenticated:        Result := 'Authenticated';
    RASCS_PrepareForCallback:   Result := 'Preparation For Callback';
    RASCS_WaitForModemReset:    Result := 'Waiting For Modem Reset';
    RASCS_WaitForCallback:      Result := 'Waiting For Callback';
    RASCS_Projected:            Result := 'Projected';
{$IFDEF WINVER400}
    RASCS_StartAuthentication:  Result := 'Start Authentication';
    RASCS_CallbackComplete:     Result := 'Callback Complete';
    RASCS_LogonNetwork:         Result := 'Logon Network';
{$ENDIF}
    RASCS_SubEntryConnected:    Result := '';
    RASCS_SubEntryDisconnected: Result := '';
    RASCS_Interactive:          Result := 'Interactive';
    RASCS_RetryAuthentication:  Result := 'Retry Authentication';
    RASCS_CallbackSetByCaller:  Result := 'Callback Set By Caller';
    RASCS_PasswordExpired:      Result := 'Password Expired';
    RASCS_Connected:            Result := 'Connected';
    RASCS_Disconnected:         Result := 'Disconnected';
    else
        Result := 'Connection state #' + IntToStr(nState);
    end;
end;

Answer 6

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function RasGetIPAddress: string;
var
    RASConns   : TRasConn;
    dwSize     : DWORD;
    dwCount    : DWORD;
    RASpppIP   : TRASPPPIP;
begin
    Result          := '';
    RASConns.dwSize := SizeOf(TRASConn);
    RASpppIP.dwSize := SizeOf(RASpppIP);
    dwSize          := SizeOf(RASConns);
    if RASEnumConnectionsA(@RASConns, @dwSize, @dwCount) = 0 then begin
        if dwCount > 0 then begin
            dwSize := SizeOf(RASpppIP);
            RASpppIP.dwSize := SizeOf(RASpppIP);
            if RASGetProjectionInfoA(RASConns.hRasConn,
                                     RASP_PppIp,
                                     @RasPPPIP,
                                     @dwSize) = 0 then
                Result := StrPas(RASpppIP.szIPAddress);
       end;
    end;
end; 
function RasDialA; external rasapi32 name 'RasDialA';
function RasGetErrorStringA; external rasapi32 name 'RasGetErrorStringA';
function RasHangUpA; external rasapi32 name 'RasHangUpA';
function RasGetConnectStatusA; external rasapi32 name 'RasGetConnectStatusA';
function RasEnumConnectionsA; external rasapi32 name 'RasEnumConnectionsA';
function RasEnumEntriesA; external rasapi32 name 'RasEnumEntriesA';
function RasGetEntryDialParamsA; external rasapi32 name 'RasGetEntryDialParamsA';
function RasEditPhonebookEntryA; external rasapi32 name 'RasEditPhonebookEntryA';
//function RasEntryDlgA; external rasapi32 name 'RasEntryDlgA';
function RasCreatePhonebookEntryA; external rasapi32 name 'RasCreatePhonebookEntryA';
function RasGetProjectionInfoA; external rasapi32 name 'RasGetProjectionInfoA';{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}end.有了这些函数，然后可以做自己的拨号程序了program AutoDial;{$APPTYPE CONSOLE}uses
  SysUtils,IniFiles,Windows,Winsock,
  Ras in 'ras.pas';
var
  DirPath,EntryName,UserName,PassWord,VisitHost,VisitUrl,VisitParam:string;
  CheckVisit:Boolean;
  nRasConnCount: DWORD;
  aRasConn:array [0..10] of TRASCONN;
  hRasConn:THRASCONN;
  f:TIniFile;
  IsConnected:boolean;
  
procedure LogMessage(Msg:string);
var
  LogFile:TextFile;
begin
  try
    AssignFile(LogFile,DirPath+'Log.txt');
    Append(LogFile);
    WriteLn(LogFile,DateTimeToStr(Now)+','+Msg);
    CloseFile(LogFile);
    WriteLn(DateTimeToStr(Now)+','+Msg);
  except
  end;end;function GetIP:string;
var
    IPAddr : String;
begin
    IPAddr := RasGetIPAddress;
    if IPAddr > '' then
        result:=IPAddr
    else
        result:='Unknown';
end;function InitSocket(var ASocket:TSocket;AAddr:string;APort:integer;ATimeOut:integer):integer;
var
  MyWSA: WSAData;
  SIN: TSockAddr;
begin
  Result:=0;
  If WSAStartup(MAKEWORD(2,2), MyWSA) <> 0 Then  //初始化
  Begin
    WSACleanup;
    Result:=1;
    Exit;
  end;
  ASocket:=Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); //创建socket
  If ASocket = INVALID_SOCKET Then
  Begin
    WSACleanup;
    Result:=2;
    Exit;
  End;
  SIN.sin_family := AF_INET;
  SIN.sin_port := htons(APort);
  SIN.sin_addr.S_addr := inet_addr(PChar(AAddr));
  If connect(ASocket, SIN, SizeOf(SIN)) = SOCKET_ERROR Then
  Begin
    CloseSocket(ASocket);
    WSACleanup;
    Result:=9;
    Exit;
  end;
  if SetSockOpt(ASocket,SOL_SOCKET,SO_RCVTIMEO,PChar(@ATimeOut),SizeOf(ATimeOut))=SOCKET_ERROR then //设置接收超时为3秒
  begin
    CloseSocket(ASocket);
    WSACleanup;
    Result:=6;
    Exit;
  end;
  if SetSockOpt(ASocket,SOL_SOCKET,SO_SNDTIMEO,PChar(@ATimeOut),SizeOf(ATimeOut))=SOCKET_ERROR then //设置发送超时为3秒
  begin
    CloseSocket(ASocket);
    WSACleanup;
    Result:=7;
    Exit;
  end;
end;

Answer 7

procedure UninitSocket(ASocket:TSocket);
begin
  try
    CloseSocket(ASocket); //关闭socket
    WSACleanup;
  except
  end;
end;procedure AfterConnect;//等拨号完成后，访问指定页面，借此将ip地址记录下来，这样我们就可以在其他地方知道拨号后新的ip地址了
var
  hSocket: TSocket;
  SAddr,sendtext:string;
  Sendbuf:array[0..1024] of char;
  HostEnt:PHostEnt;
begin
  try
    if not CheckVisit then
    begin
      LogMessage('----------'+GetIp+'----------');
      IsConnected:=True;
      exit;
    end;    HostEnt:=gethostbyname(pchar(VisitHost));
    if HostEnt<>nil then
    begin
     with HostEnt^ do
        SAddr:=Format('%d.%d.%d.%d',[byte(h_addr^[0]),byte(h_addr^[1]),byte(h_addr^[2]),byte(h_addr^[3])]);
    end;    InitSocket(hSocket,SAddr,80,10000);
    sendtext:='POST '+VisitUrl+' HTTP/1.1'+#13#10
               +'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*'+#13#10
               +'Referer: '+#13#10
               +'Accept-Language: zh-cn'+#13#10
               +'Content-Type: application/x-www-form-urlencoded'+#13#10
               +'Accept-Encoding: gzip, deflate'+#13#10
               +'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10
               +'Host: '+VisitHost+#13#10
               +'Content-Length: '+inttostr(length(VisitParam))+#13#10
               +'Connection: Keep-Alive'+#13#10
               +'Cache-Control: no-cache'+#13#10
               +'Cookie: '+#13#10
               +#13#10
               +VisitParam+#13#10;
    FillChar(sendbuf,sizeof(sendbuf),0);
    StrLCopy(sendbuf,PChar(sendtext),length(sendtext));
    Send(hSocket,sendbuf,length(sendtext),0);    UninitSocket(hSocket);    LogMessage('----------'+GetIp+'----------');
    IsConnected:=True;
  except
  end;
end;procedure Disconnected;
begin
  try
    if hRasConn <> 0 then
    begin
      RasHangUpA(hRasConn);
      hRasConn:= 0;
    end;
  except
  end;
end;procedure GetActiveConn;
var
    dwRet    : DWORD;
    nCB      : DWORD;
    Buf      : array [0..255] of Char;
begin
  try
    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;
  except
  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;procedure RasDialFunc(unMsg : DWORD;FRasConnState : TRASCONNSTATE;FdwError : DWORD); stdcall;
var
  Buf: array [0..255] of Char;
begin
  try
    LogMessage(RasConnectionStateToString(FRasConnState));
    if FRasConnState = RASCS_Connected then begin
        AfterConnect;
    end
    else if FRasConnState = RASCS_Disconnected then begin
        RasGetErrorStringA(FdwError, @Buf[0], SizeOf(Buf));
        LogMessage(Buf);
        Disconnected;
    end;
  except
  end;end;procedure Dial(FEntryName, FUserName, FPassword : String);
var
    rdParams : TRASDIALPARAMS;
    dwRet    : DWORD;
    Buf      : array [0..255] of Char;
begin
  try
    hRasConn := GetActiveConnHandle(FEntryName);
    if hRasConn <> 0 then begin
        LogMessage('Connection already active');
        Exit;
    end;    // setup RAS Dial Parameters
    FillChar(rdParams, SizeOf(rdParams), 0);
    rdParams.dwSize              := SizeOf(TRASDIALPARAMS);
    strCopy(rdParams.szUserName,  PChar(FUserName));
    strCopy(rdParams.szPassword,  PChar(FPassword));
    strCopy(rdParams.szEntryName, PChar(FEntryName));
    rdParams.szPhoneNumber[0]    := #0;
    rdParams.szCallbackNumber[0] := '*';
    rdParams.szDomain            := '*';    hRasConn := 0;;
    dwRet  := RasDialA(nil, nil, @rdParams, 0, @RasDialFunc, @hRasConn);
    if dwRet <> 0 then
    begin
        RasGetErrorStringA(dwRet, @Buf[0], SizeOf(Buf));
        LogMessage(IntToStr(dwRet) + ' ' + Buf);
        Disconnected;
    end
    else
    begin
        LogMessage('Dialing ''' + FEntryName + '''');
    end;
  except
  end;
end;begin
  try
    DirPath:=ExtractFilePath(ParamStr(0));
    f:=TiniFile.Create(DirPath+'conf.ini');
    EntryName:=f.ReadString('RasDial','EntryName','');
    UserName:=f.ReadString('RasDial','UserName','');
    PassWord:=f.ReadString('RasDial','PassWord','');
    CheckVisit:=f.ReadBool('RasDial','Visit',False);
    VisitHost:=f.ReadString('RasDial','Host','');
    VisitUrl:=f.ReadString('RasDial','Url','');
    VisitParam:=f.ReadString('RasDial','Param','');
    f.Free;    if not CheckConn(EntryName) then
    begin
        Dial(EntryName,UserName,PassWord);
    end
    else
    begin
      LogMessage('----------'+GetIp+'----------');
      IsConnected:=True;
    end;
    while not IsConnected do
      sleep(1000);
  except
  end;    
end.

Answer 8

然后编译后产生一个console application，
编写自己的conf.ini，填入自己的连接名称，用户名，密码等参数
运行该程序，就可以自动拨号了。
 
自动拨号的程序做完了，接下来的任务就是如何建一个服务在开机时运行，并定时检测网络
unit Unit1;interfaceuses
  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.