Delphi的拨号连接类

【 tulaoshi.com - 编程语言 】

　　前一阵因为工作需要写了一个类来进行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.Count0 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.Count0 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';