我們通常希望有一台機器能經常掛在網上，現在有了adsl包月服務，這已經不是問題。但是最近adsl總是會斷線，當我回家想從公司的機器上拷貝一些文件的時候，有時會發現已經連接不上了。所以我做個程序所要實現的功能有這麼兩個，一是用程序來實現adsl撥號，二是要定時檢測網絡狀態，三是要在啟動機器時運行（既注冊為服務）
我們先看一下如何做一個撥號程序
首先建一個ras撥號的單元文件（這是網上搜集的）
unit Ras;
interface
uses
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;
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;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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;
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.
然後編譯後產生一個console application，
編寫自己的conf.ini，填入自己的連接名稱，用戶名，密碼等參數
運行該程序，就可以自動撥號了。
