前一阵因为工作需要写了一个类来进行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 [1] [2] 下一页 没有相关教程
|