Solved

Dail up connection timer

Posted on 1998-07-31
8
454 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 1

Author Comment

by:dapple
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
OK thanks for your time and effort, there was alot of help there
David
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

744 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

15 Experts available now in Live!

Get 1:1 Help Now