Delphi下实现adsl自动拨号的两种方法
作者:互联网
目录
1.利用rasphone.exe
这里直接贴一个断网、联网更换ip的函数,虽然简陋但是还算稳定。
procedure ChangeIp(ConnName: string; Delay1, Delay2: Integer);
begin
winexec(PChar('rasphone -h "' + ConnName + '"'), sw_hide);
Sleep(Delay1);
winexec(PChar('rasphone -d "' + ConnName + '"'), sw_hide);
Sleep(Delay2);
end;
2.利用系统api函数
之前看cnpack里面有相关的单元,后来在网上又找到一个,并且自己修改了下更加符合我的需求。
unit DialUp;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
const
DNLEN = 15;
UNLEN = 256;
PWLEN = 256;
RAS_MaxEntryName = 256;
RAS_MaxDeviceType = 16;
RAS_MaxDeviceName = 128;
RAS_MaxPhoneNumber = 128;
RAS_MaxCallbackNumber = RAS_MaxPhoneNumber;
RASCS_PAUSED = $1000;
RASCS_DONE = $2000;
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;
RASCS_StartAuthentication = 19;
RASCS_CallbackComplete = 20;
RASCS_LogonNetwork = 21;
RASCS_Interactive = RASCS_PAUSED;
RASCS_RetryAuthentication = RASCS_PAUSED + 1;
RASCS_CallbackSetByCaller = RASCS_PAUSED + 2;
RASCS_PasswordExpired = RASCS_PAUSED + 3;
RASCS_Connected = RASCS_DONE;
RASCS_Disconnected = RASCS_DONE + 1;
type
THRasConn = Longint;
LPRasConnW = ^TRasConnW;
TRasConnW = record
dwSize: Longint;
hrasconn: THRasConn;
szEntryName: array[0..RAS_MaxEntryName] of WideChar;
szDeviceType: array[0..RAS_MaxDeviceType] of WideChar;
szDeviceName: array[0..RAS_MaxDeviceName] of WideChar;
end;
LPRasConn = ^TRasConn;
TRasConn = TRasConnW;
LPRasConnState = ^TRasConnState;
TRasConnState = Integer;
LPRasConnStatusW = ^TRasConnStatusW;
TRasConnStatusW = record
dwSize: Longint;
rasconnstate: TRasConnState;
dwError: LongInt;
szDeviceType: array[0..RAS_MaxDeviceType] of WideChar;
szDeviceName: array[0..RAS_MaxDeviceName] of WideChar;
end;
LPRasConnStatus = ^TRasConnStatus;
TRasConnStatus = TRasConnStatusW;
LPRasEntryNameW = ^TRasEntryNameW;
TRasEntryNameW = record
dwSize: Longint;
szEntryName: array[0..RAS_MaxEntryName] of WideChar;
end;
LPRasEntryName = ^TRasEntryName;
TRasEntryName = TRasEntryNameW;
LPRasDialParamsW = ^TRasDialParamsW;
TRasDialParamsW = record
dwSize: LongInt;
szEntryName: array[0..RAS_MaxEntryName] of WideChar;
szPhoneNumber: array[0..RAS_MaxPhoneNumber] of WideChar;
szCallbackNumber: array[0..RAS_MaxCallbackNumber] of WideChar;
szUserName: array[0..UNLEN] of WideChar;
szPassword: array[0..PWLEN] of WideChar;
szDomain: array[0..DNLEN] of WideChar;
end;
LPRasDialParams = ^TRasDialParams;
TRasDialParams = TRasDialParamsW;
LPRasDialExtensions = ^TRasDialExtensions;
TRasDialExtensions = record
dwSize: LongInt;
dwfOptions: LongInt;
hwndParent: HWnd;
reserved: LongInt;
end;
type
TOnStatusEvent = procedure(MessageText: WideString) of object;
TDialUp = class(TComponent)
private
FConnectTo: WideString;
hRasDLL: THandle;
StatusStr: WideString;
FPossibleConnections: TStringList;
FOnStatusEvent: TOnStatusEvent;
function StatusWideString(State: TRasConnState; Error: Integer): WideString;
function GetPossibleConnections: TStringList;
procedure GetConnections(var SL: TStringList);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GoOnline: Boolean;
procedure GoOffline;
procedure PrintMsg(MessageText: WideString);
published
property ConnectTo: WideString read FConnectTo write FConnectTo;
property PossibleConnections: TStringList read GetPossibleConnections;
property OnStatusEvent: TOnStatusEvent read FOnStatusEvent write FOnStatusEvent;
end;
var
MyDialUp: TDialUp;
implementation
var
xSelf: Pointer;
//断开拨号连接
RasHangUp: function(hConn: THRasConn): Longint; stdcall;
//获取当前活动连接
RasEnumConnections: function(RasConnArray: LPRasConn; var lpcb: Longint; var lpcConnections: Longint): Longint; stdcall;
//获取指定连接的连接状态
RasGetConnectStatus: function(hConn: THRasConn; var lpStatus: TRasConnStatus): Longint; stdcall;
//获取当前系统中可用的拨号连接名称
RasEnumEntries: function(Reserved: PWideChar; lpszPhoneBook: PWideChar; EntryNamesArray: LPRasEntryNameW; var lpcb: Longint; var lpcEntries: Longint): Longint; stdcall;
//获取拨号连接的拨号参数
RasGetEntryDialParams: function(lpszPhoneBook: PWideChar; var lpDialParams: TRasDialParams; var lpfPassword: LongBool): Longint; stdcall;
//设置拨号连接的拨号参数
RasSetEntryDialParams: function(lpszPhoneBook: PWideChar; var lpDialParams: TRasDialParams; fRemovePassword: LongBool): Longint; stdcall;
//根据错误标识符返回其错误描述信息
RasGetErrorWideString: function(ErrorValue: Integer; ErrorWideString: PWideChar; cBufSize: Longint): Longint; stdcall;
//开始创建一个拨号线程
RasDial: function(lpRasDialExt: LPRasDialExtensions; lpszPhoneBook: PWideChar; var Params: TRasDialParams; dwNotifierType: Longint; lpNotifier: Pointer; var RasConn: THRasConn): Longint; stdcall;
procedure TDialUp.PrintMsg(MessageText: WideString);
begin
if (not Assigned(FOnStatusEvent)) then
begin
Exit;
end;
FOnStatusEvent(MessageText);
end;
//拨号的线程
procedure RasCallback(Msg: Integer; State: TRasConnState; Error: Integer); stdcall;
begin
Exit;
TDialUp(xSelf).StatusStr := TDialUp(xSelf).StatusWideString(State, Error);
TDialUp(xSelf).PrintMsg(TDialUp(xSelf).StatusStr);
end;
constructor TDialUp.Create(AOwner: TComponent);
begin
FPossibleConnections := TStringList.Create;
hRasDLL := LoadLibrary('RASAPI32.dll');
@RasEnumConnections := GetProcAddress(hRasDLL, 'RasEnumConnectionsW');
@RasHangUp := GetProcAddress(hRasDLL, 'RasHangUpW');
@RasGetConnectStatus := GetProcAddress(hRasDLL, 'RasGetConnectStatusW');
@RasEnumEntries := GetProcAddress(hRasDLL, 'RasEnumEntriesW');
@RasGetEntryDialParams := GetProcAddress(hRasDLL, 'RasGetEntryDialParamsW');
@RasGetErrorWideString := GetProcAddress(hRasDLL, 'RasGetErrorWideStringW');
@RasDial := GetProcAddress(hRasDLL, 'RasDialW');
@RasSetEntryDialParams := GetProcAddress(hRasDLL, 'RasSetEntryDialParamsW');
FOnStatusEvent := nil;
end;
destructor TDialUp.Destroy;
begin
FreeLibrary(hRasDLL);
FPossibleConnections.Free;
end;
function TDialUp.GetPossibleConnections: TStringList;
begin
FPossibleConnections.Clear;
GetConnections(FPossibleConnections);
Result := FPossibleConnections;
end;
procedure TDialUp.GoOffline;
var
BufSize, NumEntries, I, dwResult: Integer;
Entries: array[1..11] of TRasConn;
Stat: TRasConnStatus;
WName: WideString;
begin
Entries[1].dwSize := SizeOf(TRasConn);
BufSize := SizeOf(TRasConn) * 10;
FillChar(Stat, Sizeof(TRasConnStatus), 0);
Stat.dwSize := Sizeof(TRasConnStatus);
//遍历拨号连接
dwResult := RasEnumConnections(@Entries[1], BufSize, NumEntries);
if dwResult = 0 then
begin
if NumEntries > 0 then
for I := 1 to NumEntries do
begin
//查看拨号连接状态
RasGetConnectStatus(Entries[I].HRasConn, Stat);
if Stat.RasConnState = RASCS_Connected then
begin
WName := Entries[I].szEntryName;
if FConnectTo = WName then
//if FConnectTo = Entries[I].szEntryName then
//断开拨号连接
RasHangUp(Entries[I].HRasConn);
end;
end;
end;
end;
//开始拨号
function TDialUp.GoOnline: Boolean;
var
hRAS: ThRASConn;
dwResult: Integer;
DialParams: TRasDialParams;
NeedPWD: LongBool;
begin
if FConnectTo = '' then
begin
raise exception.Create('请设置要连接的宽带名称');
end;
Result := False;
try
GoOffline;
FillChar(DialParams, SizeOf(TRasDialParams), 0);
DialParams.dwSize := Sizeof(TRasDialParams);
lstrcpyW(DialParams.szEntryName, PWideChar(FConnectTo));
//需要用户密码
NeedPWD := FALSE;
dwResult := RasGetEntryDialParams(nil, DialParams, NeedPWD);
if dwResult <> 0 then
begin
Result := False;
Exit;
end;
PrintMsg(DialParams.szEntryName);
PrintMsg(DialParams.szUserName);
PrintMsg(DialParams.szPassword);
//DialParams.szPassword := '123456';
(*
DialParams.szPassword[0] := '1';
DialParams.szPassword[1] := '2';
DialParams.szPassword[2] := '3';
DialParams.szPassword[3] := '4';
DialParams.szPassword[4] := '5';
DialParams.szPassword[5] := '6';
*)
dwResult := RasSetEntryDialParams(nil, DialParams, False);
if dwResult <> 0 then
begin
Result := False;
Exit;
end;
xSelf := Self;
hRAS := 0;
dwResult := RasDial(nil, nil, DialParams, 0, @RasCallback, hRAS);
if dwResult <> 0 then
begin
Result := False;
Exit;
end
else
PrintMsg('开始拨号...');
except
on E: Exception do
begin
PrintMsg(E.Message);
end;
end;
end;
//获取所有拨号连接
procedure TDialUp.GetConnections(var SL: TStringList);
var
BuffSize, Entries, R, I: Integer;
Entry: array[1..100] of TRasEntryName;
begin
SL.Clear;
Entry[1].dwSize := SizeOf(TRasEntryName);
BuffSize := SizeOf(TRasEntryName) * 100;
R := RasEnumEntries(nil, nil, @Entry[1], BuffSize, Entries);
if (R = 0) and (Entries > 0) then
for I := 1 to Entries do
SL.Add(Entry[I].szEntryName);
end;
//拨号状态
function TDialUp.StatusWideString(State: TRasConnState; Error: Integer): WideString;
var
C: array[0..100] of WideChar;
S: WideString;
begin
S := 'Something went wrong...';
if Error <> 0 then
begin
RasGetErrorWideString(Error, C, 100);
S := C;
end
else
begin
case State of
RASCS_OpenPort:
S := 'Opening Port';
RASCS_PortOpened:
S := 'Port Opened';
RASCS_ConnectDevice:
S := 'Connecting Device';
RASCS_DeviceConnected:
S := 'Device Connected';
RASCS_AllDevicesConnected:
S := 'All Devices Connected';
RASCS_Authenticate:
S := 'Starting Authentication';
RASCS_AuthNotify:
S := 'Authentication Notify';
RASCS_AuthRetry:
S := 'Authentication Retry';
RASCS_AuthCallback:
S := 'Callback Requested';
RASCS_AuthChangePassword:
S := 'Change Password Requested';
RASCS_AuthProject:
S := 'Projection Phase Started';
RASCS_AuthLinkSpeed:
S := 'Link Speed Calculation';
RASCS_AuthAck:
S := 'Authentication Acknowledged';
RASCS_ReAuthenticate:
S := 'Reauthentication Started';
RASCS_Authenticated:
S := 'Authenticated';
RASCS_PrepareForCallback:
S := 'Preparation For Callback';
RASCS_WaitForModemReset:
S := 'Waiting For Modem Reset';
RASCS_WaitForCallback:
S := 'Waiting For Call back';
RASCS_Projected:
S := 'Projected';
RASCS_Interactive:
S := 'Interactive';
RASCS_RetryAuthentication:
S := 'Retry Authentication';
RASCS_CallbackSetByCaller:
S := 'Call back Set By Caller';
RASCS_PasswordExpired:
S := 'Password Expired';
RASCS_Connected:
S := 'Connected';
RASCS_Disconnected:
S := 'Disconnected';
else
S := 'Connectionstate#' + IntToStr(State);
end;
end;
Result := S;
end;
end.
调用单元Demo:
private里面塞一个处理状态消息的函数:procedure OnStatusMsg(MessageText: WideString);
实现代码:
//初始化
procedure TfrmADSLAuto.FormCreate(Sender: TObject);
begin
MyDialUp := TDialUp.Create(Self);
MyDialUp.OnStatusEvent := OnStatusMsg;
MyDialUp.ConnectTo := '';
cbConnNames.Items.Assign(MyDialUp.PossibleConnections);
if cbConnNames.Items.Count > 0 then
cbConnNames.ItemIndex := 0;
btnConnect.Enabled := cbConnNames.Items.Count > 0;
btnDisConnet.Enabled := cbConnNames.Items.Count > 0;
end;
//断开网络
procedure TfrmADSLAuto.btnDisConnetClick(Sender: TObject);
begin
MyDialup.ConnectTo := cbConnNames.Text;
MyDialUp.GoOffline();
end;
//连接网络
procedure TfrmADSLAuto.btnConnectClick(Sender: TObject);
begin
MyDialup.ConnectTo := cbConnNames.Text;
MyDialUp.GoOnline();
end;
//接收状态消息
procedure TfrmADSLAuto.OnStatusMsg(MessageText: WideString);
begin
Memo1.Lines.Add(MessageText);
end;
//销毁
procedure TfrmADSLAuto.FormDestroy(Sender: TObject);
begin
MyDialUp.Destroy;
end;
标签:begin,end,Delphi,拨号,Longint,RASCS,var,adsl,DialParams 来源: https://www.cnblogs.com/YXGust/p/16541084.html