msrascls.pas

允许你控制Windows 95/98及Windows NT的拨号网络。使用TmsRas控件来建立与远程登录服务（RAS）的连接。功能没有限制。源代码：包含。适用语言：D2 D3 D4 D5

unit msRasCls;

interface

uses Windows, Classes, Messages, Forms, Controls;

type
  TmsTimer = class
  private
    FInterval: Cardinal;
    FWindowHandle: HWND;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure Timer; dynamic;
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: Cardinal read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  end;

 TmsTimeCounter = class
 private
   FTimer : TmsTimer;
   FCount : Integer;
   FTimeOut : Integer;
   FTimedOut : boolean;
 protected
   procedure TimerOnTimer(Sender : TObject);
 public
   constructor Create;
   destructor Destroy; override;
   procedure TimerOn;
   procedure TimerOff;
   procedure TimerReset;
   property TimedOut : boolean read FTimedOut write FTimedOut;
   property TimeOut : Integer read FTimeOut write FTimeOut;
 end;

implementation

constructor TmsTimer.Create;
begin
  inherited Create;
  FEnabled := True;
  FInterval := 1000;
  FWindowHandle := AllocateHWnd(WndProc);
end;

destructor TmsTimer.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TmsTimer.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then
      try
        Timer;
      except
        Application.HandleException(Self);
      end
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TmsTimer.UpdateTimer;
begin
  KillTimer(FWindowHandle, 1);
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
    if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
      raise EOutOfResources.Create('Not enough timers');
end;

procedure TmsTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    UpdateTimer;
  end;
end;

procedure TmsTimer.SetInterval(Value: Cardinal);
begin
  if Value <> FInterval then
  begin
    FInterval := Value;
    UpdateTimer;
  end;
end;

procedure TmsTimer.SetOnTimer(Value: TNotifyEvent);
begin
  FOnTimer := Value;
  UpdateTimer;
end;

procedure TmsTimer.Timer;
begin
  if Assigned(FOnTimer) then FOnTimer(Self);
end;

{TmsTimeCounter}
constructor TmsTimeCounter.Create;
begin
  inherited Create;
  FTimer:=TmsTimer.Create;
  FTimer.Enabled:=false;
  FTimeOut:=60;
  FTimer.OnTimer:=TimerOnTimer;
end;

destructor TmsTimeCounter.Destroy;
begin
  FTimer.Free;
  inherited Destroy;
end;

procedure TmsTimeCounter.TimerOnTimer(Sender : TObject);
begin
  Dec(FCount);
  if FCount<=0 then
    FTimedOut:=true;
end;

procedure TmsTimeCounter.TimerOn;
begin
  FCount:=FTimeOut;
  FTimer.Enabled:=true;
end;

procedure TmsTimeCounter.TimerOff;
begin
  FTimer.Enabled:=false;
end;

procedure TmsTimeCounter.TimerReset;
begin
  FCount:=FTimeOut;
  if not FTimer.Enabled then
    FTimer.Enabled:=true;
end;

end.