其他分享
首页 > 其他分享> > Delphi下实现adsl自动拨号的两种方法

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