Delphi的拨号连接类

原创 2004年09月23日 22:38:00

前一阵因为工作需要写了一个类来进行windows拨号,整理了一下,多封装了几个windows ras api,放上来大家提提意见。现在支持读取windows拨号连接列表、拨号、挂断、创建/删除连接,可以适用98/2000/XP,windows me 和NT没测试过,想来应该是可以的。以后有时间写成component,加入对拨号事件的支持。

uses
  ras, Classes, SysUtils, StrUtils, Windows, Forms;

type
  ERasError = Exception;

type
  TRASConnection = class
  private
    FPlatForm: integer;
    FConnected: Boolean;
    FRasEntries: TStringList;
    FRasConn: HRASCONN;
    FParams: RasDialParams;
    Ferrno: integer;
    function GetPassword: string;
    procedure SetPassword(Password: string);
    function GetPhoneNo: string;
    procedure SetPhoneNo(Number: string);
    function GetCallBack: string;
    procedure SetCallBack(Number: string);
    function GetDomain: string;
    procedure SetDomain(Domain: string);
    function GetUserName: string;
    procedure SetUserName(UserName: string);
    function GetEntryName: string;
    procedure SetEntryName(Entry: string);
    function GetConnected: Boolean;
    procedure SetConnected(AValue: Boolean);
    function GetRasEntries: TStringList;
  public
    property RasEntries: TStringList read GetRasEntries;
    property PhoneNumber: string read GetPhoneNo write SetPhoneNo;
    property CallBackNumber: string read GetCallBack write SetCallBack;
    property Domain: string read GetDomain write SetDomain;
    property EntryName: string read GetEntryName write SetEntryName;
    property username: string read GetUsername write SetUsername;
    property password: string read GetPassword write SetPassword;
    property Active: Boolean read GetConnected write SetConnected;
    procedure Connect;
    procedure DisConnect;
    function GetErrorCode: integer;
    procedure FreeAndHangup;
    constructor Create; reintroduce;
    destructor Destroy; override;
    procedure CreateRasEntry;
    procedure DeleteRasEntry(AEntryName: string);
      //function GetErrorReason: integer;
  end;

implementation

{ TRASConnection }

procedure TRASConnection.Connect;
var
  i: integer;
  s: string;
begin
  FParams.dwSize := sizeof(RasDialParams);
  i := RasDial(nil, nil, @FParams, 0, nil, @FRasConn);
  if i <> 0 then begin
    Ferrno := i;
    case i of
      691: s := '身分验证失败!';
      692: s := '打开端口失败!';
      676: s := '线路忙,请稍候再拨!';
      677: s := '语音响应错误!';
      678: s := '没有应答!';
      679: s := '无载波信号!';
      680: s := '无拨号音!';
    else
      s := '未知错误!';
    end;
    RasHangUp(FRasConn);
    raise ERasError.Create(s);
  end
  else FConnected := True;
end;

procedure TRASConnection.DisConnect;
begin
  RasHangup(FRasConn);
  FRasConn := 0;
end;

function TRASConnection.GetCallBack: string;
begin
  Result := string(FParams.szCallbackNumber);
end;

function TRASConnection.GetConnected: Boolean;
var
  i, len, num: integer;
  x: array of RASCONN;
begin
  Result := False;
  SetLength(x, 1);
  x[0].dwSize := sizeof(RASCONN);
  len := x[0].dwSize;
  num := 0;
  RasEnumConnections(@x[0], @len, @num);
  if num > 0 then begin
    SetLength(x, num);
    x[0].dwSize := sizeof(RASCONN);
    len := x[0].dwSize; num := 0;
    RasEnumConnections(@x[0], @len, @num);
    for i := 1 to num do
      if StrComp(x[i - 1].szEntryName, PChar(EntryName)) = 0 then begin
        FRasConn := x[i - 1].hrasconn;
        Result := True;
        Break;
      end;
  end;
  SetLength(x, 0);
end;

function TRASConnection.GetDomain: string;
begin
  Result := string(FParams.szDomain);
end;

function TRASConnection.GetErrorCode: integer;
begin
  Result := FErrno;
end;

function TRASConnection.GetPassword: string;
begin
  Result := '**********';
end;

function TRASConnection.GetPhoneNo: string;
begin
  Result := string(FParams.szPhoneNumber);
end;

function TRASConnection.GetEntryName: string;
begin
  Result := string(FParams.szEntryName);
end;

function TRASConnection.GetUserName: string;
begin
  Result := string(FParams.szUserName);
end;

procedure TRASConnection.SetCallBack(Number: string);
begin
  StrLCopy(FParams.szCallbackNumber, PChar(Number), sizeof(FParams.szCallbackNumber) - 1);
end;

procedure TRASConnection.SetConnected(AValue: Boolean);
begin
  if AValue and not GetConnected then Connect
  else if not AValue and GetConnected then DisConnect;
end;

procedure TRASConnection.SetDomain(Domain: string);
begin
  StrLCopy(FParams.szDomain, PChar(Domain), sizeof(FParams.szDomain) - 1);
end;

procedure TRASConnection.SetPassword(Password: string);
begin
  StrLCopy(FParams.szPassword, PChar(Password), sizeof(FParams.szPassword) - 1);
end;

procedure TRASConnection.SetPhoneNo(Number: string);
begin
  StrLCopy(FParams.szPhoneNumber, PChar(Number), sizeof(FParams.szPhoneNumber) - 1);
end;

procedure TRASConnection.SetEntryName(Entry: string);
var
  i: integer;
begin
  for i := 0 to FRasEntries.Count - 1 do
    if FRasEntries.Strings[i] = Entry then begin
      StrCopy(FParams.szEntryName, PChar(Entry));
      Exit;
    end;
  StrCopy(FParams.szEntryName, '');
end;

procedure TRASConnection.SetUserName(UserName: string);
begin
  StrLCopy(FParams.szUserName, PChar(UserName), sizeof(FPArams.szUserName) - 1);
end;

procedure TRASConnection.FreeAndHangup;
begin
  if Active then DisConnect;
  Free;
end;

function TRASConnection.GetRasEntries: TStringList;
var
  ren: array of RASEntryName;
  ren98: array of RASEntryName98;
  c, l: integer;
begin
  FRasEntries.Clear;
  c := 0;
  case FPlatForm of
  VER_PLATFORM_WIN32_WINDOWS:
    begin
      setlength(ren98, 1);
      ren98[0].dwSize := sizeof(RASENTRYNAME98);
      l := sizeof(RASENTRYNAME98);
      if RasEnumEntries(nil, nil, @ren98[0], @l, @c) = ERROR_BUFFER_TOO_SMALL then begin
        setlength(ren, c);
        RasEnumEntries(nil, nil, @ren98[0], @l, @c);
      end;
      while c > 0 do begin
        FRasEntries.Add(string(ren98[c - 1].szEntryName));
        Dec(c);
      end;
      SetLength(ren98, 0);
    end;
  VER_PLATFORM_WIN32_NT:
    begin
      setlength(ren, 1);
      ren[0].dwSize := sizeof(RASENTRYNAME);
      l := sizeof(RASENTRYNAME);
      if RasEnumEntries(nil, nil, @ren[0], @l, @c) = ERROR_BUFFER_TOO_SMALL then begin
        setlength(ren, c);
        RasEnumEntries(nil, nil, @ren[0], @l, @c);
      end;
      while c > 0 do begin
        FRasEntries.Add(string(ren[c - 1].szEntryName));
        Dec(c);
      end;
      SetLength(ren, 0);
    end;
  end;
  if FRasEntries.Count>0 then EntryName:=FRasEntries.Strings[0];
  Result := FRasEntries;
end;

constructor TRASConnection.Create;
var
  OS: OSVersionInfoA;
begin
  inherited;
  OS.dwOSVersionInfoSize:=sizeof(OSVersionInfoA);
  GetVersionEx(OS);
  FPlatForm:=OS.dwPlatformId;
  FRasEntries := TStringList.Create;
  GetRasEntries;
end;

destructor TRASConnection.Destroy;
begin
  FRasEntries.Free;
  inherited;
end;

procedure TRASConnection.CreateRasEntry;
begin
  RasCreatePhonebookEntry(Application.Handle,nil);
end;

procedure TRASConnection.DeleteRasEntry(AEntryName: string);
var
  i: integer;
begin
  i:=FRasEntries.IndexOf(AEntryName);
  if i=-1 then Exit;
  FRasEntries.Delete(i);
  if AEntryName=EntryName then
    if FRasEntries.Count>0 then EntryName:=FRasEntries.Strings[0]
    else EntryName:='';
  RasDeleteEntry(nil,PChar(AEntryName));
end;

Api声明:

function RasDial(
  lpRasDialExtensions: PRASDIALEXTENSIONS;
  lpszPhonebook: LPCTSTR;
  lpRasDialParams: LPRASDIALPARAMS;
  dwNotifierType: DWORD;
  lpvNotifier: Pointer;
  lphRasConn: LPHRASCONN): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasDialA';

function RasHangUp(rasconn: HRASCONN): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasHangUpA';

function RasGetEntryDialParams(
  lpszPhonebook: LPCTSTR;
  lprasdialparams: LPRASDIALPARAMS;
  lpfPassword: LPBOOL): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasGetEntryDialParamsA';

function RasEnumEntries(
  reserved: LPCTSTR;
  lpszPhonebook: LPCTSTR;
  lprasentryname: LPRASENTRYNAME;
  lpcb: LPDWORD;
  lpcEntries: LPDWORD): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasEnumEntriesA';

function RasEditPhonebookEntry(
  hwnd: HWND;
  lpszPhonebook: LPCTSTR;
  lpszEntryName: LPCTSTR): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasEditPhonebookEntryA';

function RasGetEntryProperties(
  lpszPhonebook: LPCTSTR;
  lpszEntry: LPCTSTR;
  lpRasEntry: LPRASENTRY;
  lpdwEntryInfoSize: LPDWORD;
  lpbDeviceInfo: PBYTE;
  lpdwDeviceInfoSize: LPDWORD): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasGetEntryPropertiesA';

function RasSetEntryProperties(
  lpszPhonebook: LPCTSTR;
  lpszEntry: LPCTSTR;
  lpRasEntry: LPRASENTRY;
  dwEntryInfoSize: DWORD;
  lpbDeviceInfo: PByte;
  dwDeviceInfoSize: DWORD): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasSetEntryPropertiesA';

function RasEnumConnections(
  lprasconn: LPRASCONN;
  lpcb: LPDWORD;
  lpcConnections: LPDWORD): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasEnumConnectionsA';

function RasEnumDevices(
  lpRasDevInfo: LpRasDevInfo;
  lpcb: LPDWORD;
  lpcdevices: LPDWORD): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasEnumDevicesA';

function RasCreatePhonebookEntry(
  Handle: Hwnd; LpszPhoneBook: PChar): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasCreatePhonebookEntryA';

function RasDeleteEntry(
  lpszPhonebook: PChar;
  lpszEntry: PChar): DWORD;
stdcall; external 'RASAPI32.dll' name 'RasDeleteEntryA';

 

关于WIN7下,DELPHI利用RAS去创建拨号网络的问题解决

项目背景:        因项目需要,需要通过程序利用3G卡,去拨号上网,在利用RAS在WINXP 下可以正常拨号,但是在WIN7下却没有效果,经过分析,是因为创建的拨号器WINXP 下与WIN7上...
  • snowyqian
  • snowyqian
  • 2012年02月09日 09:28
  • 2523

Delphi的拨号连接类

Delphi的拨号连接类  前一阵因为工作需要写了一个类来进行windows拨号,整理了一下,多封装了几个windows ras api,放上来大家提提意见。现在支持读取windows拨号连接列表、拨...
  • eulb
  • eulb
  • 2006年12月08日 22:30
  • 596

已创建的VPN连接,调用,断开

unit u_publicDefine;interfaceUses WinTypes, WinProcs, Dialogs,SysUtils,Forms,Controls;Const   UNLEN ...
  • emailqjc
  • emailqjc
  • 2009年10月14日 16:28
  • 6725

delphi实现modem自动拨号

如果能在我们的应用程序中启动拨号  连接(如IE浏览器程序中的自动拨号功能),无疑将会方便我们的软件用户(不用再切换应用程序,  运行拨号网络),提高我们的软件的友好性从而提高软件的竞争力.    在...
  • xzknet
  • xzknet
  • 2006年05月25日 11:56
  • 2623

delphi 拨号上网代码

转贴用MODEM拨号上网,仍是大多数个人网民选择上网的方式.如果能在我们的应用程序中管理拨号网络(如Foxmail、Sygate中的拨号功能),无疑将会方便我们的软件用户(不用再切换应用程序,运行拨号...
  • CometNet
  • CometNet
  • 2009年04月03日 01:27
  • 3110

在Delphi中使用RAS实现对系统拨号的控制

 在Delphi中使用RAS实现对系统拨号的控制  在企业应用中有时候希望能在程序中实现对拨号网络的控制,以实现自动拨号、自动断开网络。在尝试了多种方式之后,认为RAS是一种比较稳定的方式。在goog...
  • lfw802250
  • lfw802250
  • 2009年11月12日 22:15
  • 3334

C# 连接自动拨号与断开分析

C#的自动拨号和断开当前连接的代码网上很多,可是没有一个是真正自动的,就算我指明了对那个连接进行拨号,也只是弹出那个拨号连接的窗口,想要拨号还需要自己手动点击“拨号”按钮,才能开始拨号。 到网上找了很...
  • hinyunsin
  • hinyunsin
  • 2009年03月29日 14:36
  • 10042

代码实现VPN连接

Imports System.Runtime.InteropServices Imports System.Data.OleDb Public Class Class1     Private De...
  • emailqjc
  • emailqjc
  • 2009年10月01日 15:19
  • 3632

双网卡、内外网同时连接,如何指定使用哪个连接?

双网卡、内外网同时连接,如何指定使用哪个连接?  网络状况:无线路由(用于访问外网):    IP地址:192.168.1.XX 自动分配    网  关:192.168.1.1 网卡(用于访问内网)...
  • ked
  • ked
  • 2009年05月18日 22:51
  • 2198

ADSL自动更换IP的方法

打开记事本 输入@rasdial adsl /DISCONNECT@rasdial adsl user password保存为bat文件即可说明:  adsl:宽带连接名字  user:ADSL账号 ...
  • sibang
  • sibang
  • 2014年08月21日 16:45
  • 752
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:Delphi的拨号连接类
举报原因:
原因补充:

(最多只允许输入30个字)