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