Delphi's dial-up connection class

The ancestors need to write a class for Windows dialing because of work, I have filled it, and I have packaged several Windows Ras APIs, put it up to everyone. Now support the read Windows dial-up list, dial, hang up, create / delete connections, can apply 98/2000 / XP, Windows ME and NT have not been tested, and they should be possible. There is time to write to Component, join the support for dial-up events.

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: = 'Identity Verification Failed!'; 692: S: = 'Opening Port Failed!'; 676: S: = 'Line Busy, please call again!' ; 677: s: = 'speech response error!'; 678: s: = 'No answer!'; 679: s: = 'no carrier signal!'; 680: s: = 'no dial tone!'; Else s : = 'Unknown mistakes!'; End; rashangup (frasconn); rasEraserror.create (s); end else fconnected: = true; end; procedure traasconnection.disconnect; begin rashangup (frasconn); frasconn: = 0; end;

Function Trasconnection.getCallback: String; Begin Result: = String (fparams.szcallbacknumber);

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 strass (x [i - 1 ] .szentryname, Pchar (entryName)) = 0 dam Frasconn: = x [i - 1] .hrasconn; result: = true; Break; end; end; setLength (x, 0); END;

Function Trasconnection.getdomain: String; Begin Result: = String (fparams.szdomain);

Function Trasconnection.Geterror; Begin Result: = ferrno;

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

Function Trasconnection.getuserName: String; Begin Result: = String (fparams.szusername);

Procedure Trasconnection.SetCallback (Number: String); Begin Strlcopy (fParams.szcallbackNumber, Pchar (Number), SizeOf (fParams.szcallbackNumber) - 1);

Procedure trasconnection.setConnected (Avalue: Boolean); Begin if Avalue and not getConnected The 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);

Procedure Trasconnection.SetPassword (Password: string); Begin Strlcopy (fparams.szpassword, pchar (password), sizeof (fparams.szpassword) - 1);

Procedure Trasconnection.SETPHONENO (NUMBER: STRING); Begin Strlcopy (fParams.szphonenumber, Pchar (Number), SizeOf (fParams.szphonenumber) - 1);

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

Procedure trakers (username: string); begin strlcopy (fParams.szusername, Pchar (username), sizeof (fparams.szusername) - 1);

Procedure trasconnection.freeandHangup; begin if Active dam; refact;

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 RaseNurentries (NIL, NIL, @ Ren98 [0], @L, @c) = error_buffer_too_small the begin setlength (ren, c); RaseNumentries (NIL, NIL, @ Ren98 [0], @L, @C); end; while c> 0 do beg, 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 (RaseTryName); l: = sizeof (RasentryName); if RaseNumentries (NIL, NIL, @REN [0], @L, @c) = error dam setlength (ren, c); rasenumentries (nil, nil, @Ren [0], @L, @c); end; while c> 0 do begin Frasentries .Add (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;

DESTRUCTOR TRASCONNECTION.DESTROY; Begin Frasentries.Free; inherited;

Procedure trasconnection.createrasentry; begin rascreatephonebookntry (application.handle, nil);

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 statement: 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 RasgeTryDialParams (LPSZPHONEBOOK: LPCTSTSTSTSTSTSTSTSTSTSTSTSTSTSTSTSTSTSTSTSDIALPARAMS; LPFPASSWORD: LPBOOL): DWORD; stdcall; external 'raasapi32.dll' name 'raasgeTryDialParamsa';

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 rasdeletentry (lpszphonebook: pchar; lpszentry: pchar): dword; stdcall; external 'rasapi32.dll' name 'rasdeleteentrya;