main_f.pas

一个拨号的组件

{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O-,P+,Q+,R+,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE GUI}

unit Main_F;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DialUp, ExtCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Label1: TLabel;
    Status: TLabel;
    Status2: TLabel;
    CheckBox1: TCheckBox;
    DialUp: TDialUp;
    Button6: TButton;
    ListBox2: TListBox;
    Button8: TButton;
    Label2: TLabel;
    RecvL: TLabel;
    Label4: TLabel;
    XmitL: TLabel;
    SpeedL: TLabel;
    SpeedLL: TLabel;
    Bevel1: TBevel;
    Label3: TLabel;
    Label5: TLabel;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure DialUpEntryGet(Sender: TObject; EntryName: array of Char);
    procedure Button3Click(Sender: TObject);
    procedure DialUpConnect(Sender: TObject);
    procedure DialUpError(Sender: TObject; ErrorCode: Integer;
      ErrorMessage: String);
    procedure DialUpDialing(Sender: TObject);
    procedure DialUpNotConnected(Sender: TObject; ErrorCode: Integer;
      ErrorMessage: String);
    procedure DialUpAsyncEvent(Sender: TObject; State, Error: Integer;
      MessageText: String);
    procedure Button4Click(Sender: TObject);
    procedure DialUpActiveConnection(Sender: TObject; Handle: Integer;
      Status: TRasConnStatusA; StatusString: String; EntryName, DeviceType,
      DeviceName: array of Char);
    procedure Button8Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Clear; Button2.Enabled:=True;
  DialUp.GetEntries;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if ListBox1.Items.Count=0 then
  begin
    ShowMessage('Choose entry with get entries first');
    Exit;
  end;
  if RadioButton1.Checked then DialUp.DialMode:=dmAsync else DialUp.DialMode:=dmSync;
  DialUp.Entry:=ListBox1.Items[ListBox1.ItemIndex];
  DialUp.Dial;
end;

procedure TForm1.DialUpEntryGet(Sender: TObject; EntryName: array of Char);
begin
  ListBox1.Items.Add(PChar(@EntryName[0]));
  ListBox1.ItemIndex:=0;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  DialUp.HangUp;
end;

procedure TForm1.DialUpConnect(Sender: TObject);
begin
  Status2.Caption:='Connected.';
end;

procedure TForm1.DialUpError(Sender: TObject; ErrorCode: Integer;
  ErrorMessage: String);
begin
  Status2.Caption:='Error';
end;

procedure TForm1.DialUpDialing(Sender: TObject);
begin
  Status2.Caption:='Dialing...'; Application.ProcessMessages;
end;

procedure TForm1.DialUpNotConnected(Sender: TObject; ErrorCode: Integer;
  ErrorMessage: String);
begin
  Status2.Caption:='Not Connected';
end;

procedure TForm1.DialUpAsyncEvent(Sender: TObject; State, Error: Integer;
  MessageText: String);
begin
  Status.Caption:=MessageText;
  if Error<>0 then Status2.Caption:='Error. Press Hangup button next to Dial button.';
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  ListBox1.Clear; Button2.Enabled:=False;
  DialUp.GetConnections;
end;

procedure TForm1.DialUpActiveConnection(Sender: TObject; Handle: Integer;
  Status: TRasConnStatusA; StatusString: String; EntryName, DeviceType,
  DeviceName: array of Char);
begin
  ListBox1.Items.Add(EntryName+' | '+DeviceName+' || '+StatusString+'('+IntTOStr(Status.rasconnstate)+')');
  DialUp.GetIP(DialUp.hRAS);
  ListBox1.Items.Add('Server IP: "'+DialUp.ServerIP+'" Client IP:"'+DialUp.ClientIP+'"');

  if CheckBox1.Checked then DialUp.HangUpConn(Handle);
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  DialUp.SearchDUNA;
  ListBox2.Items.Assign(DialUp.DUNA);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  DialUp.InitializePerfStats(True,True);
  Timer1.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if not DialUp.GetPerfStats then
  begin
    Beep;
    XmitL.Caption:='ERROR';
    RecvL.Caption:='ERROR';
    SpeedL.Caption:='ERROR';
  end else
  begin
    XmitL.Caption:=IntToStr(DialUp.BytesXmit);
    RecvL.Caption:=IntToStr(DialUp.BytesRecv);
    SpeedL.Caption:=IntToStr(DialUp.ConnectionSpeed);
  end;
end;

end.