Delphi的撥號連接類

　　前一陣因為工作需要寫了一個類來進行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';