rastest.pas

TRasObject实现了一些主要的函数

{
*****************************************************************************
* TRasObject test program. Implements all component methods and properties  *
* (C) Copyright 2001, Serge Ryvkin <[e-mail]>                          *
*                                                                           *
* Uses TRasObject component                                                 *
* (C) Copyright 2001, Serge Ryvkin <[e-mail]>                          *
*                                                                           *
*              Based on Delphi conversion of Microsoft ras.h                *
*              by Davide Moretti <[e-mail]>                        *
*                                                                           *
*****************************************************************************
}

unit RasTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ImgList, StdCtrls, ExtCtrls, RASObject, ComCtrls;

type
  TfMain = class(TForm)
    lbRas: TListBox;
    Label1: TLabel;
    PopUpConnections: TPopupMenu;
    Create: TMenuItem;
    Edit: TMenuItem;
    Rename: TMenuItem;
    Delete: TMenuItem;
    N1: TMenuItem;
    SetParameters: TMenuItem;
    GetParameters: TMenuItem;
    N2: TMenuItem;
    DialAsync: TMenuItem;
    Hangup: TMenuItem;
    Ras: TRasObject;
    SB: TStatusBar;
    Label2: TLabel;
    lName: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    lDeviceType: TLabel;
    lDeviceName: TLabel;
    lStatus: TLabel;
    Circle: TShape;
    btnUpdate: TButton;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    eUserName: TEdit;
    ePassword: TEdit;
    eDomain: TEdit;
    ePhone: TEdit;
    eCallback: TEdit;
    DialSync: TMenuItem;
    btnClearFields: TButton;
    chUse: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure lbRasClick(Sender: TObject);
    procedure CreateClick(Sender: TObject);
    procedure EditClick(Sender: TObject);
    procedure RasStatusChange(Sender: TObject; IsError: Boolean;
      StatusString: String);
    procedure RenameClick(Sender: TObject);
    procedure DeleteClick(Sender: TObject);
    procedure btnUpdateClick(Sender: TObject);
    procedure SetParametersClick(Sender: TObject);
    procedure GetParametersClick(Sender: TObject);
    procedure DialSyncClick(Sender: TObject);
    procedure DialAsyncClick(Sender: TObject);
    procedure HangupClick(Sender: TObject);
    procedure btnClearFieldsClick(Sender: TObject);
  private
    { Private declarations }
    procedure ListUpdate;
    procedure GUIUpdate(Rc: boolean);
  public
    { Public declarations }
  end;

var
  fMain: TfMain;

implementation

{$R *.DFM}

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Updates phonebook list during form create
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.FormCreate(Sender: TObject);
begin
     ListUpdate;
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Updates selected active connectioninformation
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.lbRasClick(Sender: TObject);
var
   i: integer;
begin
     for i:=0 to Length(Ras.ActiveConnections)-1 do
     begin
          if Ras.ActiveConnections[i].Name = lbRas.Items[lbRas.ItemIndex] then
          begin
          end;
              lName.Caption := Ras.ActiveConnections[i].Name;
              lDeviceType.Caption := Ras.ActiveConnections[i].DeviceType;
              lDeviceName.Caption := Ras.ActiveConnections[i].DeviceName;
              lStatus.Caption := Ras.ActiveConnections[i].Status;
     end;
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Status change event implementation
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.RasStatusChange(Sender: TObject; IsError: Boolean;
  StatusString: String);
begin
     SB.SimpleText := StatusString;
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Create phonebook entry
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.CreateClick(Sender: TObject);
begin
      GUIUpdate(Ras.CreateEntry);
      ListUpdate;
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Edit phonebook entry
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.EditClick(Sender: TObject);
begin
      GUIUpdate(Ras.EditEntry(lbRas.Items[lbRas.ItemIndex]));
      ListUpdate;
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Rename phonebook entry
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.RenameClick(Sender: TObject);
var
   s: string;
begin
  s := InputBox('Rename entry', 'Enter new entry name', lbRas.Items[lbRas.ItemIndex]);
  if s <> '' then
  begin
      GUIUpdate(Ras.RenameEntry(lbRas.Items[lbRas.ItemIndex], s));
      ListUpdate;
  end;
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Delete phonebook entry
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.DeleteClick(Sender: TObject);
begin
      GUIUpdate(Ras.DeleteEntry(lbRas.Items[lbRas.ItemIndex]));
      ListUpdate;
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Store parameters for phonebook entry
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.SetParametersClick(Sender: TObject);
begin
     Ras.Parameters.Domain := eDomain.Text;
     Ras.Parameters.Username := eUsername.text;
     Ras.Parameters.Password := ePassword.Text;
     Ras.Parameters.PhoneNumber := ePhone.Text;
     Ras.Parameters.CallbackNumber := eCallback.Text;

     GUIUpdate(Ras.SetParameters(lbRas.Items[lbRas.ItemIndex]));
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Retrieve parameters from phonebook entry
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.GetParametersClick(Sender: TObject);
begin
      GUIUpdate(Ras.GetParameters(lbRas.Items[lbRas.ItemIndex]));
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Syncroneous dial
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.DialSyncClick(Sender: TObject);
begin
     if chUse.Checked then
     begin
          Ras.Parameters.Domain := eDomain.Text;
          Ras.Parameters.Username := eUsername.text;
          Ras.Parameters.Password := ePassword.Text;
          Ras.Parameters.PhoneNumber := ePhone.Text;
          Ras.Parameters.CallbackNumber := eCallback.Text;

          GUIUpdate(Ras.SetParameters(lbRas.Items[lbRas.ItemIndex]));
     end;
     GUIUpdate(Ras.Dial(lbRas.Items[lbRas.ItemIndex], rasSync));
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Asyncroneous dial
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.DialAsyncClick(Sender: TObject);
begin
     if chUse.Checked then
     begin
          Ras.Parameters.Domain := eDomain.Text;
          Ras.Parameters.Username := eUsername.text;
          Ras.Parameters.Password := ePassword.Text;
          Ras.Parameters.PhoneNumber := ePhone.Text;
          Ras.Parameters.CallbackNumber := eCallback.Text;

          GUIUpdate(Ras.SetParameters(lbRas.Items[lbRas.ItemIndex]));
     end;
     GUIUpdate(Ras.Dial(lbRas.Items[lbRas.ItemIndex], rasAsync));
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Hangup asyncroneous dial call
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.HangupClick(Sender: TObject);
begin
     GUIUpdate(Ras.Hangup(lbRas.Items[lbRas.ItemIndex]));
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Clear filelds
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.btnClearFieldsClick(Sender: TObject);
begin
          eDomain.Text := '';
          eUsername.text := '';
          ePassword.Text := '';
          ePhone.Text := '';
          eCallback.Text := '';
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Updates phonebook list
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.btnUpdateClick(Sender: TObject);
begin
     ListUpdate;
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Implementation of update phonebook list
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.ListUpdate;
var
   i: integer;
begin
     Ras.Wait(Ras.RefreshInterval);
     lbRas.Clear;
     for i:=0 to Ras.PhoneBook.Count-1 do
         lbRas.Items.Add(Ras.PhoneBook[i]);
     lbRas.ItemIndex := 0;
end;

{
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
  Updates GUI controls depending on result code
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
}
procedure TfMain.GUIUpdate(Rc: boolean);
var
   i: integer;
begin
      if not Rc then
          Circle.Brush.Color := ClRed
      else
          Circle.Brush.Color := ClGreen;

      MessageBeep($FFFF);
      for i:=0 to 100 do
      begin
           Application.ProcessMessages;
           Sleep(1);
      end;
      Circle.Brush.Color := ClWhite;
end;

end.