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';