Buscar por:

Online

Código

Unit OnLine;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  ExtCtrls, Dialup;

type

  TOnChange = procedure (Sender: TObject) of Object;

  TOnLineDetect = class(TComponent)

  private

    FOnChange:TOnChange;

    FStatus:TRasConnStatusA;

    FConnections:TStringList;

  protected

    FTimer:TTimer;

    FDialup:TDialup;

    FOldConnections:Byte;

    procedure CheckConnectionsTimer(Sender: TObject);

    procedure DialUpEntryGet(Sender: TObject; EntryName: array of Char);

    procedure DialUpActiveConnection(Sender: TObject; Handle: Integer;

    Status: TRasConnStatusA; StatusString: String; EntryName, DeviceType,

    DeviceName: array of Char);

    function GetInterval:Integer;

    procedure SetInterval(I:Integer);

  public

    function OnLine:bool;

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    property Status:TRasConnStatusA read FStatus write FStatus;

    property Connections:TStringList read FConnections write FConnections;

  published

    property Interval:Integer read GetInterval write SetInterval default 250;

    property OnChange:TOnChange read FOnChange write FOnChange;

  end;

procedure Register;

implementation

procedure Register;

begin

  RegisterComponents('Delphi Dev', [TOnLineDetect]);

end;

constructor TOnLineDetect.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  FDialup := TDialup.Create(Self);

  FDialup.OnActiveConnection := DialupActiveConnection;

  FDialup.OnEntryGet := DialupEntryGet;

  FDialup.GetEntries;

  FTimer := TTimer.Create(Self);

  FTimer.Interval := 250;

  FTimer.OnTimer := CheckConnectionsTimer;

  FConnections := TStringList.Create;

  if not (csDesigning in ComponentState) then

  begin

    FTimer.Enabled := True;

  end;

end;

destructor TOnLineDetect.Destroy;

begin

  inherited Destroy;

  FConnections.Free;

end;

procedure TOnLineDetect.CheckConnectionsTimer(Sender: TObject);

begin

  FTimer.enabled := false;

  FOldConnections := FConnections.Count;

  FConnections.Clear;

  FDialup.GetConnections;

  if FConnections.Count <> FOldConnections then

    if Assigned(FOnChange) then FOnChange(Sender);

  FTimer.enabled := true;

end;

procedure TOnLineDetect.DialUpEntryGet(Sender: TObject;

  EntryName: array of Char);

begin

  FDialup.Entries.Add(EntryName);

end;

procedure TOnLineDetect.DialUpActiveConnection(Sender: TObject; Handle: Integer;

  Status: TRasConnStatusA; StatusString: String; EntryName, DeviceType,

  DeviceName: array of Char);

begin

  FConnections.Add(EntryName);

  FStatus := Status;

end;

function TOnLineDetect.OnLine:bool;

Begin

  Result := (FConnections.Count>0);

end;

function TOnLineDetect.GetInterval:Integer;

begin

  Result := FTimer.Interval;

end;

procedure TOnLineDetect.SetInterval(I:Integer);

begin

  FTimer.Interval := I;

end;

end.