unit RASComponent;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, URAS;
const
  RasUnidentifiedError = 'Unidentified Error';
  Start_ENTRY_COUNT = 10;
  Start_CONN_COUNT = 10;
type
  TRASEntries = array[0..Start_ENTRY_COUNT] of TRasEntryName;
  PRASEntries = ^TRASEntries;
  TRASConns   = array[0..Start_CONN_COUNT] of TRasConn;
  PRASConns   = ^TRASConns;
  TDialEvent = procedure(Sender: TObject; RASConnState: longint;
    ErrorCode: longint; RASConnString: string) of Object;
  ERasError = Exception;
  TRAS = class(TComponent)
  private
    { Private declarations }
    FConnection    : THandle;
    FOnDialEvent   : TDialEvent;
    FPhoneNr       : string;
    FUsername      : string;
    FPassword      : string;
    FConnected     : Boolean;
    FRasModuleLoaded : Boolean;
    FRasName       : string;
    FRasEvent       : THandle;
    FRefCnt         : Integer;
    FSynchroon: Boolean;
    FIdleTimeOut: Integer;
    FOnIdleTimeOut: TNotifyEvent;
    procedure SetConnected(const Value: Boolean);
    procedure SetRasName(const Value: string);
    procedure SetSynchroon(const Value: Boolean);
    procedure SetIdleTimeOut(const Value: Integer);
    procedure SetOnIdleTimeOut(const Value: TNotifyEvent);
  protected
    procedure RasModuleNeeded;
    { Protected declarations }
  public
    procedure DoOnIdle;
    procedure Open;
    procedure Close;
    { Public declarations }
    property Connection: THandle read FConnection;
//    function CheckForConnection: string;
    function CheckEntry(Entry: string): Boolean;
    function CheckForPassword(Entry: string): string;
    procedure GetRASEntries(EntryList : TStrings);
    function GetRASConnectStatus(var RASConnState: longint;
      var RASConnString: String; var RASDeviceName: String): longint;
    function GetRASError(dwError: DWORD): string;
    function DialRASEntry: longint;
    function HangUpRAS: longint;
    function GetIPAddress: string;
    destructor Destroy; override;
    constructor Create(Owner: TComponent); override;
    function IsConnected(Wait: Boolean): Boolean;
    function CountConnections(var FirstRasname: string): Integer;
  published
    { Published declarations }
    property  IdleTimeOut   : Integer read FIdleTimeOut write SetIdleTimeOut;
    property Synchroon: Boolean read FSynchroon write SetSynchroon;
    property Rasname: string read FRasName write SetRasName;
    property Connected: Boolean read FConnected write SetConnected;
    property PhoneNumber:string read FPhoneNr write FPhoneNr;
    property Password: string read FPassword write FPassword;
    property Username: string read FUsername write FUsername;
    property OnIdleTimeOut: TNotifyEvent read FOnIdleTimeOut write SetOnIdleTimeOut;
    property OnDialEvent: TDialEvent read FOnDialEvent write FOnDialEvent;
  end;

implementation
var
  RAS: TRas;

function GetRASConnString(RASConnState: longint) : string;
begin
Case RASConnState of
  RASCS_OpenPort             : Result := 'Opening Port...';
  RASCS_PortOpened           : Result := 'Port Opened...';
  RASCS_ConnectDevice        : Result := 'Dialling...';
  RASCS_DeviceConnected      : Result := 'Modem connect...';
  RASCS_AllDevicesConnnected : Result := 'Attempting to sign on...';
  RASCS_StartAuthentication  : Result := 'Sending username and password...';
  RASCS_Authenticate         : Result := 'Verifying username and password...';
  RASCS_Authenticated        : Result := 'Authentication complete...';
  RASCS_CONNECTED            : Result := 'Connected...';
  RASCS_DISCONNECTED         : Result := 'Disconnected...';
  end;
end;

destructor TRAS.destroy;
begin
HangUpRAS;
if FRasModuleLoaded then
  UnLoadRasModule;
inherited;
end;
procedure RasDialFunc(unMsg: Integer;	// type of event that has occurred
    rasconnstate: Integer;	// connection state about to be entered
    dwError: Integer 	// error that may have occurred
   );  stdcall;
var
  Evnt : Integer;
begin
with Ras do
  begin
  if (rasconnstate and RASCS_DONE) = RASCS_DONE then
    begin
    Evnt := FRasEvent;
    FRasEvent := 0;
    SetEvent(Evnt);
    CloseHandle(Evnt);
    end;
  if dwError=0 then
    begin
    if (Assigned(FOnDialEvent)) then
      OnDialEvent(Ras, rasconnstate, dwError, GetRASConnString(rasconnstate));
    end
  else
    begin
    SetEvent(FRasEvent);
    HangUpRAS;
    if (Assigned(FOnDialEvent)) then
      OnDialEvent(Ras, rasconnstate, dwError, GetRASError(rasconnstate));
    end;
  end;
end;
function TRAS.CheckEntry(Entry: string): Boolean;
var
  EntryList : TStringList;
begin
EntryList := TStringList.Create;
try
  GetRASEntries(EntryList);
  Result := EntryList.IndexOf(Entry) <> -1;
finally
  EntryList.Free;
  end;
end;
function TRAS.CheckForPassword(Entry: string): string;
var
  DialParams: TRasDialParams;
  rc: LongInt;
  GotPassword: LongBool;
begin
  Result := '';
  with DialParams do
    begin
    StrPCopy(szEntryName, Entry);
    szPhoneNumber := '';
    szCallbackNumber := '';
    szUserName := '';
    szPassword := '';
    szDomain := '';
    dwSize := SizeOf(DialParams);
    end;
  RasModuleNeeded;
  rc := RASGetEntryDialParams(nil, DialParams, GotPassword);
  // "GotPassword" is niet te vertrouwen!
  if rc = 0 then
  begin
    Result := DialParams.szPassword;
  end;
end;
procedure TRAS.GetRASEntries(EntryList : TStrings);
var
  RASEntries  : PRASEntries ;
  BufferSize  : DWORD;
  rc          : LongInt;
  EntryCount  : DWORD;
  I           : Integer;
  TryCnt      : Integer;
begin
RasModuleNeeded;
TryCnt := 1;
repeat
  BufferSize := SizeOf(TRASEntries)* TryCnt;
  GetMem(RASEntries, BufferSize);
  try
    RASEntries^[0].dwSize := SizeOf(TRasEntryName);
    rc := RASEnumEntries(nil, nil, RASEntries, BufferSize, EntryCount);
    if rc = 0 then
      begin
      for I := 0 to Pred(EntryCount) do
        EntryList.Add(RASEntries[I].szEntryName);
      end;
    Inc(TryCnt);
  finally
    FreeMem(RASEntries, BufferSize);
    end;
until (TryCnt = 1000) or (rc <> ERROR_BUFFER_TOO_SMALL);
end;
function TRAS.GetRASConnectStatus(var RASConnState: longint;
  var RASConnString: String; var RASDeviceName: String): longint;
var
  rc:            longint;
  RasConnStatus: TRasConnStatus;
begin
  RasModuleNeeded;
  RasConnStatus.dwSize := SizeOf(RasConnStatus);
  rc := RASGetConnectStatus(FConnection, RasConnStatus);
  if rc = 0 then begin
    RASConnState  := RasConnStatus.RasConnState;
    RASDeviceName := RasConnStatus.szDeviceName;
  end
  else begin
    RASConnState  := RASCS_DISCONNECTED;
  end;
  RASConnString := GetRASConnString(RASConnState);
  GetRASConnectStatus := rc;
end;
function TRAS.HangUpRAS: longint;
var
  Status: TRasConnStatus;
begin
if (FConnection <> 0) then
  begin
  RasModuleNeeded;
  Result := RASHangUp(FConnection);
  if FRasEvent <> 0 then
    CloseHandle(FRasEvent);
  FRasEvent := 0;
  Status.dwSize := SizeOf(TRasConnStatus);
  while not RasGetConnectStatus(FConnection, Status) = ERROR_INVALID_HANDLE do
    Sleep(0);
  FConnection := 0;
  end
else
  Result := 0;
end;
function TRAS.GetRASError(dwError : DWORD) : string;
var
  ErrorString: TRASErrorString;
  ErrorSize:   longInt;
  rc:          longInt;
begin
RasModuleNeeded;
ErrorSize := 255;
rc := RASGetErrorString(dwError, ErrorString, ErrorSize);
if rc = 0 then
  GetRASError := ErrorString
else
  GetRASError := RasUnidentifiedError;
end;
function TRAS.DialRASEntry : longint;
var
  DialParams:     TRasDialParams;
  rc:             longint;
  GotPassword:    longbool;
begin
with DialParams do
  begin
  StrPCopy(szEntryName,RasName);
  szPhoneNumber     := '';
  szCallbackNumber  := '';
  szUserName        := '';
  szPassword        := '';
  szDomain          := '';
  dwSize            := SizeOf(DialParams);
  end;
RasModuleNeeded;
rc := RASGetEntryDialParams( nil, DialParams, GotPassword );
with DialParams do
  begin
  if PhoneNumber <> '' then
    StrPCopy(szPhoneNumber,PhoneNumber);
  if Username <> '' then
    StrPCopy(szUsername, Username);
  if Password <> '' then
    StrPCopy(szPassword, Password);
  end;
if rc = 0 then
  begin
  RAS := Self;
  HangUpRAS;
  if FSynchroon then
    rc := RASDial(nil, nil, DialParams, 0, nil, FConnection)
  else
    begin
    FRasEvent := CreateEvent(nil, True, False, nil);
    if FRasEvent = 0 then
      RaiseLastWin32Error;
    //rc := RASDial(nil, nil, DialParams, RAS_NOTIFY_HWND, Pointer(FWindowHandle), FConnection);
    rc := RASDial(nil, nil, DialParams, RAS_NOTIFY_FUNC1, @RasDialFunc, FConnection);
    end;
  if rc <> 0 then
    HangUpRAS;
  end;
Result := rc;
end;
function TRAS.GetIPAddress: string;
var
  rc:             longint;
  RasPPPIP:       TRasPPPIP;
  size:           DWORD;
begin
RasModuleNeeded;
RasPPPIP.dwsize := sizeof(RasPPPIP);
size := sizeof(RasPPPIP);
rc := RASGetProjectionInfo(FConnection, RASP_PPPIP, RasPPPIP, size);
if rc = 0 then
  GetIPAddress := RasPPPIP.szlpAddress
else
  GetIPAddress := '';
end;

function TRAS.IsConnected(Wait: Boolean): Boolean;
var
  Status: TRasConnStatus;
begin
Result := FConnection <> 0;  // Geen connection handle..
if not Result then
  Exit;
if Wait then
  while (FRasEvent <> 0) and (WaitForSingleObject(FRasEvent, FIdleTimeOut) = WAIT_TIMEOUT) do
    DoOnIdle;
Status.dwSize := SizeOf(TRasConnStatus);
RasGetConnectStatus(FConnection, Status);
Result := Status.RasConnState=RASCS_CONNECTED;
end;
procedure TRAS.SetConnected(const Value: Boolean);
begin
if FConnected = Value then
  Exit;
FConnected := Value;
if FConnected then
  DialRASEntry
else
  HangUpRAS;
end;

procedure TRAS.SetRasName(const Value: string);
begin
if FRasName = Value then
  Exit;
Connected := False;
FRasName := Value;
end;
procedure TRAS.Open;
begin
Inc(FRefCnt);
Connected := FRefCnt > 0;
end;
procedure TRAS.Close;
begin
Dec(FRefCnt);
Connected := FRefCnt > 0;
end;
procedure TRAS.DoOnIdle;
begin
if Assigned(FOnIdleTimeOut) then
  FOnIdleTimeOut(Self);
end;
procedure TRAS.SetSynchroon(const Value: Boolean);
begin
  FSynchroon := Value;
end;

procedure TRAS.RasModuleNeeded;
begin
if FRasModuleLoaded then
  Exit;
try
  LoadRasModule;
except
  raise ERasError.Create('Kon RAS api niet laden');
  end;
FRasModuleLoaded := True;
end;

procedure TRAS.SetIdleTimeOut(const Value: Integer);
begin
  FIdleTimeOut := Value;
end;
constructor TRAS.Create(Owner: TComponent);
begin
inherited;
IdleTimeOut := 1000;
end;
procedure TRAS.SetOnIdleTimeOut(const Value: TNotifyEvent);
begin
  FOnIdleTimeOut := Value;
end;
function TRas.CountConnections(var FirstRasname: string): Integer;
var
  lpRasConn   : PRasConn;
  lpcb        : cardinal;
begin
GetMem(lpRasConn, SizeOf(TRasConn));
try
  RasModuleNeeded;
  lpRasConn.dwSize:=SizeOf(TRasConn);
  RASEnumConnections(lprasConn,lpcb, Cardinal(Result));// hierin staat ook wie de verbinding heeft gemaakt
  FirstRasname := lprasConn^.szEntryName;//lpConnections>=1;
finally
  FreeMem(lpRasconn, SizeOf(TRasConn));
  end;
end;
end.