Solved

Dail up connection timer

Posted on 1998-07-31
8
460 Views
Last Modified: 2012-05-04
How do i start a timer in Delphi 1 when a dail up connection is established with my ISP and stop it when it disconnects, does anyone know a prodedure to calculate the elapsed time between two times, which takes into acount times on diferent days also?
0
Comment
Question by:dapple
  • 4
  • 3
8 Comments
 
LVL 5

Expert Comment

by:inter
ID: 1359307
Hi,
1 - Declare two global variables as
var
  StTime,
  EndTime  : TDateTime;
2 - When connecting

  StTime := Now;

3 - After closing connections
 
  EndTime := Now;

4 - Compute the difference and display as

  Form1.Caption := 'Last connection last '+TimeToStr(EndTime - StTime);


Regards, Igor
0
 
LVL 1

Author Comment

by:dapple
ID: 1359308
inter thanks for the help,
i tried what you said, i subtracted the start time from the end time but for some reason  the elapsed time is sometimes one second out.
Also could you still answer the first part of my question how do i automatically start a timer when my DUN connection starts and stop the timer when i disconnect from the DUN
I want to create a online timer, but without having to start the timer my self manually
david
0
 
LVL 1

Accepted Solution

by:
venks earned 100 total points
ID: 1359309
Dear Dapple
I presume you are using RAS for connecting to the internet.
There is a component available which automatically detects when you are connected to the server and when you are disconnected from the server.
You can start the timer when the onconnected event fires and stop the timer when the ondisconnected event fires.
The best way to do will be to make a table with the following structure
Start Date :Tdatetime
Start time :Tdatetime
finish Date :Tdatetime
finsih time : tdatetime
duration    :tdatetime (calculated field)

The following is the component(most probably in Delphi super page) help file for finding more.I have already written a completee application for connecting to the ISP(with database support) and finding the time spent on the net.If you are interested in that application send me your e mail address and i will try to post you a demo version.If you want a legal version do let me know.
best wishes
Venks

TFnugryRASNotify Component

Overview

Fnugry RASNotify Component can be used to notify your application when RAS connection becomes available or  lost. It also allows developer to easily enumerate all RAS connections, query name, device or status of any connection, etc.

Component Reference

Properties

Enabled      

property Enabled :Boolean;

Use Enabled to enable/disable notifications.

PollInterval

property PollInterval :Integer;

The PollInterval property specifies a number of milliseconds between connection stack polls. Set it to a smaller value for application that should quickly respond to connection state changes.


ConnCount

property ConnCount :Integer;

Read ConnCount to determine a number of RAS connections in the system.

ConnHandle

property ConnHandle[Index :Integer] :THandle;

Read ConnHandle to retrieve RAS connection handle.

ConnName

property ConnName[Index :Integer] :String;

ConnName returns name of the specified connection.

DeviceType

property DeviceType[Index :Integer] :String;

Use DeviceType to get type of the device associated with the connection.

DeviceName

property DeviceName[Index :Integer] :String;

DeviceName returns name of the device.
 
Online

property Online :Boolean;

Online property is true if there is at least one connection with the ‘Connected’ state.

Events

OnConnected

property OnConnected :TRASConnectedEvent;

  TRASConnectedEvent = procedure(Sender :TObject;
    hConn :THandle; const EntryName,
    DeviceType, DeviceName :String) of object;

OnConnected event is generated when a new RAS connection is established.

OnDisconnected

property OnDisconnected :TRASDisconnectedEvent;

  TRASDisconnectedEvent = procedure(Sender :TObject;
    hConn :THandle ) of object;

OnDisconnected is called when connection is lost.


 Interface Declaration

type


  ERASNotifyError = class(Exception);

  TRASConnectedEvent = procedure(Sender :TObject;
    hConn :THandle; const EntryName,
    DeviceType, DeviceName :String) of object;

  TRASDisconnectedEvent = procedure(Sender :TObject;
    hConn :THandle ) of object;


  TFnugryRASNotify = class(TComponent)
  protected
    procedure ValidateEntryIndex(Value :Integer);
    procedure Loaded; override;
    procedure Connected(hConn :THandle;
      const EntryName, DeviceType, DeviceName :String); virtual;
    procedure Disconnected(hConn :THandle); virtual;
    procedure DoEnable; virtual;
    procedure DoDisable; virtual;
    procedure ResetList;
    procedure ClearList;
    procedure UpdateList;
  public
    constructor Create(AOwner :TComponent); override;
    destructor Destroy; override;
    property ConnCount :Integer;
    property ConnHandle[Index :Integer] :THandle
    property ConnName[Index :Integer] :String
    property DeviceType[Index :Integer] :String
    property DeviceName[Index :Integer] :String
    property Online :Boolean
  published
    property Enabled :Boolean
    property PollInterval :Integer;
    property OnConnected :TRASConnectedEvent;
    property OnDisconnected :TRASDisconnectedEvent;
    property OnEnable :TNotifyEvent;
    property OnDisable :TNotifyEvent;
  end;


0
 
LVL 1

Expert Comment

by:venks
ID: 1359310
Dear dapple
Further to my previous answer,I am further adding the source of another delphi component
for calculating time between two events.
Best wishes
Venks
{------------------------------------------------------------------------------}
{ Copyright             : © Copyright 1995 by Y. Rochat                        }
{ Date de creation      : 20/10/1995                                           }
{ Last Update           : 08/11/1995                                           }
{ Version Number        : 1.10                                                 }
{ Langage Programmation : DELPHI 1.01                                          }
{------------------------------------------------------------------------------}
{ YRCHRONO.PAS                               : A CHRONOMETER COMPONENT for DELPHI that let you      }
{                         calculate the time elapsed between two events even   }
{                         if they do not happen the same day.                  }
{                                                                              }
{ HOW TO USE IT : 1) Put a TYRChronometre (by ex. MyChrono) in you Delphi form }
{                 2) Make a call to MyChrono.Reset to reset the chronometer    }
{                 3) Make a call to MyChrono.Start to start the chronometer    }
{                 4) Make a call to MyChrono.Stop to stop the chronometer      }
{                 5) Make a call to MyChrono.TimeElapsed to calculate the time }
{                    elapsed between the last call to MyChrono.Start           }
{                 6) Make a call to MyChrono.TotalTimeElapsed to calculate the }
{                    time elapsed between all call to MyChrono Start and Stop  }
{                 7) Make a call to MyChrono.Time2Str to display a formated    }
{                    string (HHHHH:MM:SS.CC) of TimeElapsed or TotalTimeElapsed}
{                 8) A call to MyChrono.Jours_Ecoule let you calculate the nb. }
{                    of days which separate date D1 from date D2 (Di:TDateTime)}
{------------------------------------------------------------------------------}
{                               IMPORTANT                                      }
{                                                                              }
{ You can use this code as is and you are FREE to copy/distribute provided that}
{ this notice is not modified and included in the distrubution pack.           }
{ I'll be more than happy to hear from you for your comments about a real-life }
{ use of this code. Please send your comments to " rochat@dma.epfl.ch " with   }
{ subject field starting with the words 'TYRCHRONO'.                           }
{------------------------------------------------------------------------------}
{:DISCLAIMER:                                                                  }
{------------                                                                  }
{  THIS SOURCE CODE IS DELIVERED AS IS. THERE IS NO REASON TO THINK THAT IT    }
{  SHOULD NOT WORK AS CLAIMED. BUT JUST IN CASE, LET ME DISCLAIM THAT YVES     }
{  ROCHAT CAN NOT BE HELD LIABLE IF YOU LOOSE TIME OR MONEY USING THIS CODE.   }
{------------------------------------------------------------------------------}

UNIT YRChrono ;

{---------------------------------------------------------------------------}
{                                                                           }
{         PARTIE INTERFACE : SECTION PUBLIQUE OU VISIBLE DE L'UNITE         }
{                                                                           }
{---------------------------------------------------------------------------}

INTERFACE

USES
  WinTypes, WinProcs, Messages, Classes, Graphics,
      Controls, Forms, Dialogs, SysUtils ;

TYPE
  ChronoStr                        = String[14] ;

      TYRChronometre      = class(TComponent)
  private
        FTimeStart      : TDateTime ;
    FDateStart      : TDateTime ;
    FTimeStop            : TDateTime ;
    FDateStop            : TDateTime ;
    FTimeTotal      : TDateTime ;
    FChronoOn            : Boolean ;
      protected
        { Protected declaration }
  public
    constructor      Create(AOwner: TComponent); override;
    destructor      Destroy; override;
    procedure            Reset ;
    procedure            Start ;
    procedure            Stop  ;
            function            Jours_Ecoule(D1,D2 : TDateTime) : WORD ;
    function            TimeElapsed : TDateTime ;
    function            TotalTimeElapsed : TDateTime ;
    function            Time2Str(Le_Time : TDateTime) : ChronoStr ;
      published
        { Published declaration }
      end;

procedure Register;

{---------------------------------------------------------------------------}
{                                                                           }
{        PARTIE IMPLEMENTATION : SECTION PRIVEE OU CACHEE DE L'UNITE        }
{                                                                           }
{---------------------------------------------------------------------------}

IMPLEMENTATION

procedure Register;
begin
  RegisterComponents('ToolsY', [TYRChronometre]);
end;

{------------------------------------------------------------------------------}
{-                        Création de de l'objet                              -}
{------------------------------------------------------------------------------}
constructor      TYRChronometre.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Reset ;
end;

{------------------------------------------------------------------------------}
{-                      Destruction de de l'objet                             -}
{------------------------------------------------------------------------------}
destructor      TYRChronometre.Destroy;
begin
  inherited Destroy;
end;

{------------------------------------------------------------------------------}
{-  Cette procedure reinitialise le chronometre. Elle doit etre appelee au    -}
{-  moins une fois avant l'appel des autres methodes de l'objet.              -}
{------------------------------------------------------------------------------}
procedure      TYRChronometre.Reset ;
begin
  FTimeStart      := 0.0 ;
  FDateStart      := 0.0 ;
  FTimeStop            := 0.0 ;
  FDateStop            := 0.0 ;
      FTimeTotal      := 0.0 ;
  FChronoOn            := False ;
end ;

{------------------------------------------------------------------------------}
{-  Cette procedure active le chronometre si c'est la premiere fois qu'elle   -}
{-  est appelee ou bien reactive celui-ci apres un appel a la methode Stop.   -}
{-  Si le chonometre est en marche, alors cette procedure ne fait rien.       -}
{------------------------------------------------------------------------------}
procedure TYRChronometre.Start ;
begin
      If FChronoOn
            then Exit ;
  FDateStart      := Date ;
  FTimeStart      := Time ;
  FChronoOn            := True ;
  FTimeStop            := 0.0 ;
  FDateStop            := 0.0 ;
end;

{------------------------------------------------------------------------------}
{-    Cette procedure calcule le nombre de jours qui separe Date1 de Date2    -}
{-    Il faut noter qu'une annee AAAA est bissextile si AAAA MOD 4 = 0. Les   -}
{-    exceptions sont les annees multiplent de 100 qui ne sont pas divisibles -}
{-    par 400. (Exemple 1900. Le prochain siecle bissextile est l'an 2000)    -}
{------------------------------------------------------------------------------}
function      TYRChronometre.Jours_Ecoule(D1,D2 : TDateTime) : WORD ;
{
Var
  Y,YY,
  M,MM,
  J,JJ,
      DY,DM,
  JE,I      : WORD ;

      FUNCTION Jour_Mois(AD,MD : WORD) : WORD ;
  BEGIN
    Case MD of
          1,3,5,7,8,10,12 : Jour_Mois := 31 ;
                  4,6,9,11                        : Jour_Mois := 30 ;
      2                                                : If (AD MOD 4) <> 0
                                                                              then      Jour_Mois := 28
                                                                              else  Begin
                                                                                                      If (AD MOD 100) <> 0
                                                                                                            then      Jour_Mois := 29
                                                                                                            else  Begin
                                                                        If (AD MOD 400) = 0
                                                                              then      Jour_Mois := 29
                                                                          else      Jour_Mois := 28 ;
                                                                                                                              End ;
                                                End ;
    End ;
  END ;

  FUNCTION Jour_Annee(AD : WORD) : WORD ;
  BEGIN
    If (AD MOD 4) <> 0
                  then      Jour_Annee := 365
                  else  Begin
                                          If (AD MOD 100) <> 0
                                                then      Jour_Annee := 366
                                                else  Begin
                                                If (AD MOD 400) = 0
                                      then      Jour_Annee := 366
                                                                              else      Jour_Annee := 365 ;
                                                                  End ;
                        End ;
  END ;
}
begin
  {
  JE := 0 ;
  DecodeDate(D2,YY,MM,JJ) ;
  DecodeDate(D1,Y,M,J) ;
  DY := YY - Y ;
      If DY = 0
        then      BEGIN
                                    DM := MM - M ;
                                    If DM = 0
                                      then      JE := JJ - J
                                  else      BEGIN
                                          JE := Jour_Mois(Y,M) - J + JJ ;
                                                                  If DM > 1
                                                                        then      For I := M+1 to MM-1 do
                                                                    JE := JE + Jour_Mois(Y,I) ;
                                                    END ;
                      END
    else      BEGIN
            JE := Jour_Mois(Y,M) - J ;
                                    For I := M+1 to 12 do
                  JE := JE + Jour_Mois(Y,I) ;
            If DY > 1
                                          then      For I := Y+1 to YY-1 do
                                          JE := JE + Jour_Annee(I) ;
            For I := 1 to MM-1 do
                  JE := JE + Jour_Mois(YY,I) ;
            JE := JE + JJ ;
                      END ;
  Jours_Ecoule := JE ;
  }
  Jours_Ecoule      := Round(D2 - D1) ;
end ;

{------------------------------------------------------------------------------}
{- Cette procedure arrete le chronometre, ajoute le temps passe depuis l'appel-}
{- de la methode Start au temps total. Si le chronometre est arrete, alors la -}
{- la methode ne fait rien.                                                   -}
{------------------------------------------------------------------------------}
procedure TYRChronometre.Stop ;

var JoursEcoule : WORD ;

begin
  If not FChronoOn
            then Exit ;
  FDateStop      := Date ;
  FTimeStop := Time ;
  FChronoOn := False ;
  { Calcul du temps ecoule depuis l'appel de la methode Start }
  JoursEcoule := Jours_Ecoule(FDateStart,FDateStop) ;
  FTimeTotal      := FTimeTotal + (24*3600*(FTimeStop - FTimeStart)) ;
  If JoursEcoule > 0      { Chrono. arrete un jour different du jour de départ }
        then  FTimeTotal := FTimeTotal + (24*3600*JoursEcoule) ;
end ;

{------------------------------------------------------------------------------}
{- Cette procedure retourne le temps ecoule depuis l'appel de la methode Start-}
{- Si le chronometre est arrete alors la methode retourne le temps ecoule     -}
{- entre les deux appels des methodes Start et Stop.                          -}
{------------------------------------------------------------------------------}
function  TYRChronometre.TimeElapsed : TDateTime ;

var      DateStopTmp : TDateTime ;
            TimeStopTmp,
            TEcoule                   : Real ;
        JoursEcoule : Word ;

begin
  If FChronoOn
        then      begin
                        TimeStopTmp      := Time ;
                                DateStopTmp      := Date ;
                      end
        else  begin
                        DateStopTmp := FDateStop ;
                        TimeStopTmp := FTimeStop ;
                      end ;
  { Calcul du temps ecoule depuis l'appel de la methode Start }
  TEcoule                  := 24*3600*(TimeStopTmp - FTimeStart) ;
  JoursEcoule := Jours_Ecoule(FDateStart,DateStopTmp) ;
  If JoursEcoule > 0      { Chrono. arrete un jour different du jour de départ }
        then      TEcoule := TEcoule + (24*3600*JoursEcoule) ;
  TimeElapsed := TEcoule ;
end ;

{------------------------------------------------------------------------------}
{-  Cette procedure retourne le temps qui s'est ecoule depuis le moment ou    -}
{-  le chronometre a ete active pour la premiere fois par la methode Start.   -}
{-  Le temps retourne est celui ou le chronometre a ete en marche. Les moments-}
{-  ou le chronometre est arrete ne sont pas calcules.                        -}
{------------------------------------------------------------------------------}
function  TYRChronometre.TotalTimeElapsed : TDateTime ;

var      DateStopTmp : TDateTime ;
        TimeStopTmp      : Real ;
        JoursEcoule : Word ;

begin
  If FChronoOn      then
  begin
            TimeStopTmp      := Time ;
        DateStopTmp      := Date ;
    { Calcul du temps ecoule depuis le debut }
    JoursEcoule                        := Jours_Ecoule(FDateStart,DateStopTmp) ;
        TotalTimeElapsed      := FTimeTotal + (24*3600*(TimeStopTmp - FTimeStart)) ;
    If JoursEcoule > 0    { Chrono. arrete un jour different du jour de départ }
                  then  TotalTimeElapsed :=      TotalTimeElapsed + (24*3600*JoursEcoule) ;
  end else
  TotalTimeElapsed := FTimeTotal ;
end ;

{------------------------------------------------------------------------------}
{-   Cette procedure convertit le parametre Le_Time en un String prenant la   -}
{-   forme suivante : HHHHH:MM:SS.CC (Heure:Minute:Seconde.Centieme).         -}
{------------------------------------------------------------------------------}
function TYRChronometre.Time2Str (Le_Time : TDateTime) : ChronoStr ;

VAR Hour                        : STRING[5] ;
            Minute,
    Sec,Sec100  : STRING[2] ;
        Vow_Hour,
        Vow_Minute,
        Vow_Second,
        Vow_Sec100  : WORD ;

BEGIN
  Vow_Sec100      := Round(Frac(Le_Time) * 100) ;
  Le_Time                  := Int(Le_Time) ;
  Vow_Hour            := Round(Int(Le_Time / 3600)) ;
  Le_Time                  := Le_Time - (LongInt(Vow_Hour) * 3600) ;
  Vow_Minute       := Round(Int(Le_Time / 60)) ;
  Le_Time         := Le_Time - (LongInt(Vow_Minute) * 60) ;
  Vow_Second       := Round(Int(Le_Time)) ;

  Time2Str := '' ;
  Str(Vow_Hour,Hour) ;
      If Length(Hour) = 1
        then Hour := '0' + Hour ;
  Str(Vow_Minute,Minute) ;
      If Length(Minute) = 1
        then Minute := '0' + Minute ;
  Str(Vow_Second,Sec) ;
  If Length(Sec) = 1
        then Sec := '0' + Sec ;
  Str(Vow_Sec100,Sec100) ;
  If Length(Sec100) = 1
        then Sec100 := '0' + Sec100 ;
      Time2Str      := Hour + ':' + Minute + ':' + Sec + '.' + Sec100 ;
END ;

END.   { FIN DE LA LIBRAIRIE YRCHRONO }

0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 1

Author Comment

by:dapple
ID: 1359311
thanks for your answer
do you know where i can get this component exactly, i have searched but an not find it, could you email me a copy if you have it, then i will grade your answer.
dapple@globalnet.co.uk
0
 
LVL 1

Expert Comment

by:venks
ID: 1359312
Dear dapple
I am not able to remember where I downloaded it.hence I am sending you a copy of what I have
Hope this solves your problem
Venks

{
  FNGRASNOTIFY.PAS
  FnugryRASNotify Component
  Copyright (C) 1997 Gleb Yourchenko
  Version 1.0.0.3


  E-Mail: eip__@hotmail.com
  Please specify 'FnugryRASNotify' in the subject string
}


unit FngRASNotify;

interface
uses
  Windows, SysUtils, RAS, Classes, ExtCtrls, Dialogs;

const

  RAS_MAX_CONN   = 8192;

type

  PRASConnList = ^TRASConnList;
  TRASConnList = array[0..RAS_MAX_CONN-1] of TRASCONN;

  PRASHandleArray = ^TRASHandleArray;
  TRASHandleArray = array[0..RAS_MAX_CONN-1] of THandle;


  ERASNotifyError = class(Exception);

  TRASConnectedEvent = procedure(Sender :TObject;
    hConn :THandle; const EntryName,
    DeviceType, DeviceName :String) of object;

  TRASDisconnectedEvent = procedure(Sender :TObject;
    hConn :THandle ) of object;


  TFnugryRASNotify = class(TComponent)
  private
    FEnabled        :Boolean;
    FPollInterval   :Integer;
    FPollTimer      :TTimer;
    FConnList       :PRASConnList;
    FConnCount      :Integer;
    FOnConnected    :TRASConnectedEvent;
    FOnDisconnected :TRASDisconnectedEvent;
    FOnEnable       :TNotifyEvent;
    FOnDisable      :TNotifyEvent;
    procedure HandlePollTimerEvent(Sender :TObject);
    procedure SetEnabled(Value :Boolean);
    procedure SetPollInterval(Value :Integer);
    function GetCOnnCount :Integer;
    function GetConnHandle(Index :Integer):THandle;
    function GetConnName(Index :Integer):String;
    function GetDeviceType(Index :Integer):String;
    function GetDeviceName(Index :Integer):String;
    function GetConnList(out lpList :PRASConnList):Integer;
    function GetOnline :Boolean;
  protected
    procedure ValidateEntryIndex(Value :Integer);
    procedure Loaded; override;
    procedure Connected(hConn :THandle;
      const EntryName, DeviceType, DeviceName :String); virtual;
    procedure Disconnected(hConn :THandle); virtual;
    procedure DoEnable; virtual;
    procedure DoDisable; virtual;
    procedure ResetList;
    procedure ClearList;
    procedure UpdateList;
  public
    constructor Create(AOwner :TComponent); override;
    destructor Destroy; override;
    property ConnCount :Integer
      read GetConnCount;
    property ConnHandle[Index :Integer] :THandle
      read GetConnHandle;
    property ConnName[Index :Integer] :String
      read GetConnName;
    property DeviceType[Index :Integer] :String
      read GetDeviceType;
    property DeviceName[Index :Integer] :String
      read GetDeviceName;
    property Online :Boolean
      read GetOnline;
  published
    property Enabled :Boolean
      read FEnabled write SetEnabled;
    property PollInterval :Integer
      read FPollInterval write SetPollInterval;
    property OnConnected :TRASConnectedEvent
      read FOnConnected write FOnConnected;
    property OnDisconnected :TRASDisconnectedEvent
      read FOnDisconnected write FOnDisconnected;
    property OnEnable :TNotifyEvent
      read FOnEnable write FOnEnable;
    property OnDisable :TNotifyEvent
      read FOnDisable write FOnDisable;
  end;

procedure Register;


implementation


procedure Register;
begin
  RegisterComponents('Fnugry Tools', [TFnugryRASNotify]);
end;


{  TFnugryRASNotify }

const

  POLL_INTERVAL_MIN    = 200;
  POLL_INTERVAL_MAX    = 60000;
  POLL_INTERVAL_DEF    = 2000;


  SErrInvalidInterval  = 'Invalid poll interval';
  SErrOOM              = 'Not enough memory to complete operation';
  SErrRAS              = 'Could not enumerate connections.'#13#10'Error Code %d';
  SErrIndex            = 'Invalid index';


procedure TFnugryRASNotify.Connected(hConn :THandle;
  const EntryName, DeviceType, DeviceName :String);
begin
  if assigned(FOnConnected) then FOnConnected(Self,
    hConn, EntryName, DeviceType, DeviceName);
end;


procedure TFnugryRASNotify.Disconnected(hConn :THandle);
begin
  if assigned(FOnDisconnected) then FOnDisconnected(Self, hConn);
end;

procedure TFnugryRASNotify.DoEnable;
begin
  if assigned(FOnEnable) then FOnEnable(Self);
end;

procedure TFnugryRASNotify.DoDisable;
begin
  if assigned(FOnDisable) then FOnDisable(Self);
end;

procedure TFnugryRASNotify.SetEnabled(Value :Boolean);
begin
  if FEnabled <> Value then
    begin
      if FPollTimer <> Nil then
        begin
          if Value then ResetList else ClearList;
          FPollTimer.Enabled := Value;
        end;
      FEnabled := Value;
      if Value then DoEnable else DoDisable;
    end;
end;

procedure TFnugryRASNotify.SetPollInterval(Value :Integer);
begin
  if Value <> FPollInterval then
    if (Value >= POLL_INTERVAL_MIN) and (Value <= POLL_INTERVAL_MAX)
      then
        begin
          if FPollTimer <> Nil then FPollTimer.Interval := Value;
          FPollInterval := Value;
        end
      else
        if csDesigning in ComponentState
          then MessageDlg(SErrInvalidInterval, mtError, [mbOk], 0);
end;



function TFnugryRASNotify.GetConnCount :Integer;
begin
  result := 0;
  if FConnList <> Nil then result := FConnCount;
end;


function TFnugryRASNotify.GetConnHandle(Index :Integer):THandle;
begin
  result := INVALID_HANDLE_VALUE;
  ValidateEntryIndex(Index);
  if FConnList <> Nil then result := FConnList^[Index].hrasconn;
end;


function TFnugryRASNotify.GetConnName(Index :Integer):String;
begin
  result := '';
  ValidateEntryIndex(Index);
  if FConnList <> Nil then result := FConnList^[Index].szEntryName;
end;


function TFnugryRASNotify.GetDeviceType(Index :Integer):String;
begin
  result := '';
  ValidateEntryIndex(Index);
  if FConnList <> Nil then result := FConnList^[Index].szdeviceType;
end;


function TFnugryRASNotify.GetDeviceName(Index :Integer):String;
begin
  result := '';
  ValidateEntryIndex(Index);
  if FConnList <> Nil then result := FConnList^[Index].szDeviceName;
end;


constructor TFnugryRASNotify.Create(AOwner :TComponent);
begin
  inherited Create(Aowner);
  FPollInterval := POLL_INTERVAL_DEF;
  FEnabled := true;
end;


destructor TFnugryRASNotify.Destroy;
begin
  if FPollTimer <> Nil then FPollTimer.Enabled := false;
  if FConnList <> Nil then
    begin
      FreeMem(FConnList);
      FConnList := Nil;
    end;
  inherited Destroy;
end;

procedure TFnugryRASNotify.Loaded;
begin
  inherited Loaded;
  if not (csDesigning in ComponentState) then
    begin
      if FEnabled then FConnCount := GetConnList(FConnList);
      FPollTimer := TTimer.Create(Self);
      FPollTimer.OnTimer := HandlePollTimerEvent;
      FPollTimer.Interval := FPollInterval;
      FPollTimer.Enabled := FEnabled;
    end;
end;


{ Retrieves list of active connections.
 Returns number of entries in the list.}

function TFnugryRASNotify.GetConnList(
  out lpList :PRASConnList):Integer;
var
  cbList :Integer;
  Err    :Integer;
  ConnStatus :TRASCONNSTATUS;
  I :Integer;
begin
  Result := 0;
  cbList := 16 * SizeOf(TRASCONN);
  GetMem(lpList, cbList);
  try
    lpList^[0].dwSize := sizeof(TRASCONN);
    Err := RASEnumConnections(LPRASCONN(lpList), cbList, Result);
    case Err of
      //
      // success - do nothing
      //
      0 :;
      //
      // out of memory - throw exception
      //
      ERROR_NOT_ENOUGH_MEMORY : raise EOutOfMemory.Create(SErrOOM);
      //
      // buffer to small - reallocate
      // buffer and try once more
      //
      ERROR_BUFFER_TOO_SMALL :
        begin
          FreeMem(lpList);
          GetMem(lpList, cbList);
          lpList^[0].dwSize := sizeof(TRASCONN);
          Err := RASEnumConnections(LPRASCONN(lpList), cbList, Result);
          case Err of
            0 :;
            ERROR_BUFFER_TOO_SMALL,
            ERROR_NOT_ENOUGH_MEMORY :
              raise EOutOfMemory.Create(SErrOOM);
            else
              raise ERASNotifyError.CreateFmt(SErrRAS, [Err]);
          end;
        end;
      else
        raise ERASNotifyError.CreateFmt(SErrRAS, [Err]);
    end;
  except
    if lpList <> Nil then
      begin
        FreeMem(lpList);
        lpList := Nil;
      end;
    raise;
  end;
  { retrieve connections status }
  for I := 0 to Result-1 do
    begin
      ConnStatus.dwSize := sizeof(ConnStatus);
      if RasGetConnectStatus(lpList^[I].hrasconn, ConnStatus) = 0
        then lpList^[I].dwSize := ConnStatus.rasconnstate
        else raise ERASNotifyError.CreateFmt(SErrRAS, [Err]);
    end;
end;


procedure TFnugryRASNotify.ClearList;
begin
  if FConnList <> Nil then
    begin
      FreeMem(FConnList);
      FConnList := Nil;
      FConnCount := 0;
    end;
end;


procedure TFnugryRASNotify.ResetList;
begin
  ClearList;
  FConnCount := GetConnList(FConnList);
end;


procedure TFnugryRASNotify.HandlePollTimerEvent(Sender :TObject);
begin
  UpdateList;
end;


procedure TFnugryRASNotify.ValidateEntryIndex(Value :Integer);
begin
  if (Value < 0) or (Value >= ConnCount) then
    raise ERASNotifyError.Create(SErrIndex);
end;

procedure TFnugryRASNotify.UpdateList;
var
  S :TRASCONNSTATUS;
  N, I, J, C, E :Integer;
  L :PRASCONNLIST;
  F :Boolean;
begin
  { check connections status }
  for I := 0 to ConnCount do
    begin
      S.dwsize := sizeof(S);
      N := 0;
      E := RasGetConnectStatus(FConnList^[I].hrasconn, s);
      case E of
        0 :
          begin
            if (FConnList^[I].dwSize = RASCS_CONNECTED)
            and (s.rasconnstate <> RASCS_CONNECTED) then N := -1;
            if (FConnList^[I].dwSize <> RASCS_CONNECTED)
            and (s.rasconnstate = RASCS_CONNECTED) then N := 1;
          end;
        ERROR_INVALID_HANDLE,
        ERROR_INVALID_PORT_HANDLE :
          begin
            if FConnList^[I].dwSize = RASCS_CONNECTED then N := -1;
            FConnList^[I].dwSize := -1;
            FConnList^[I].hrasconn := -1;
          end;
        else raise ERASNotifyError.CreateFmt(SErrRAS, [E]);
      end;
      if N <> 0 then
       with FConnList^[I] do
        if N > 0
          then Connected(hrasconn, szEntryName, szDeviceType, szDeviceName)
          else Disconnected(hrasconn);
    end;

    C := GetConnList(L);
    try
      for I := 0 to C-1 do
        begin
          //
          // Check for a new entry
          //
          F := false;
          for J := 0 to ConnCount-1 do
            if L^[I].hrasconn = FConnList^[J].hrasconn then
              begin
                F := true;
                break;
              end;
          //
          // Notify if entry is new and connected
          //
          if (not F) and (L^[I].dwSize = RASCS_CONNECTED) then
            with L^[I] do Connected(hrasconn, szEntryName, szDeviceType, szDeviceName);
        end;

      //
      // Swap connection lists
      //
      asm
        mov  ebx, self
        mov  eax, L
        xchg eax, [ebx].TFnugryRASNotify.FConnList
        mov  L, eax
        mov  eax, C
        mov  [ebx].TFnugryRASNotify.FConnCount, eax
      end;
    finally
      if L <> Nil then FreeMem(L);
    end;
end;

function TFnugryRASNotify.GetOnline :Boolean;
var I :Integer;
begin
  result := false;
  for I := 0 to ConnCount-1 do
   if FConnList^[I].dwSize = RASCS_CONNECTED then
     begin
       result := true;
       break;
     end;
end;



end.


0
 
LVL 1

Expert Comment

by:venks
ID: 1359313
Dear dapple
You have now confrimed whether you are using RAS.You will certainly require RAS available from Delphi Super Page or from other delphi sites
Venks
0
 
LVL 1

Author Comment

by:dapple
ID: 1359314
OK thanks for your time and effort, there was alot of help there
David
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
ddeman not working in activex 3 93
Communication Between RC4 Delphi <-> PHP 3 100
oracle global variables 4 63
Tembedded WB animatid gifs not animated on some pcs 2 72
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
This is used to tweak the memory usage for your computer, it is used for servers more so than workstations but just be careful editing registry settings as it may cause irreversible results. I hold no responsibility for anything you do to the regist…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

912 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now