注册 登录
编程论坛 → Delphi论坛

dialup拨号，如何显示拨号状态信息

rogersgb 发布于 2017-09-13 16:30， 2653 次点击
dialup拨号，如何显示拨号状态信息
1 回复
#2
rogersgb2017-09-13 17:03
拨号代码如下
unit vpn;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, StdCtrls, WinSkinData, DB, ADODB,StrUtils, ExtCtrls,DialUp;

type
  TForm1= class(TForm)
    DialUp: TDialUp;
    GroupBox1: TGroupBox;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Label1: TLabel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    StatusBar1: TStatusBar;
    Label8: TLabel;
    ADOQuery1: TADOQuery;
    N9: TMenuItem;
    ADOConnection1: TADOConnection;
     procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure DialUpVPN;
    procedure DialUpActiveConnection(Sender: TObject; Handle: Integer;
      Status: TRasConnStatusA; StatusString: String; EntryName, DeviceType,
      DeviceName: array of Char);
    procedure DialUpError(Sender: TObject; ErrorCode: Integer;
      ErrorMessage: String);
    procedure DialUpNotConnected(Sender: TObject; ErrorCode: Integer;
      ErrorMessage: String);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }

  private
    { Private declarations }
  public
    { Public declarations }
  end;
  type
 GUID = record
  Data1: Integer;
  Data2: ShortInt;
  Data3: ShortInt;
  Data4: array[0..7] of Byte;
end;
type
  TRasIPAddr = record
   a: byte;
   b: byte;
   c: byte;
   d: byte;
end;
type
 TRasEntry = record
  dwSize,
  dwfOptions,
  dwCountryID,
  dwCountryCode          : Longint;
  szAreaCode             : array[0.. 10] of Byte;
  szLocalPhoneNumber     : array[0..128] of Byte;
  dwAlternatesOffset     : Longint;
  ipaddr,
  ipaddrDns,
  ipaddrDnsAlt,
  ipaddrWins,
  ipaddrWinsAlt          : TRasIPAddr;
  dwFrameSize,
  dwfNetProtocols,
  dwFramingProtocol      : Longint;
  szScript               : Array [0..259] of Byte;
  szAutodialDll          : Array [0..259] of Byte;
  szAutodialFunc         : Array [0..259] of Byte;
  szDeviceType           : Array [0..16] of Byte;
  szDeviceName           : Array [0..128] of Byte;
  szX25PadType           : Array [0..32] of Byte;
  szX25Address           : Array [0..200] of Byte;
  szX25Facilities        : Array [0..200] of Byte;
  szX25UserData          : Array [0..200] of Byte;
  dwChannels,
  dwReserved1,
  dwReserved2,
  dwSubEntries,
  dwDialMode,
  dwDialExtraPercent,
  dwDialExtraSampleSeconds,
  dwHangUpExtraPercent,
  dwHangUpExtraSampleSeconds,
  dwIdleDisconnectSeconds,
  dwType,
  dwEncryptionType,
  dwCustomAuthKey       : Longint;
  guidId                : GUID;
  szCustomDialDll       : Array [0..259] of Byte;
  dwVpnStrategy,
  dwfOptions2,
  dwfOptions3           : Longint;
  szDnsSuffix           : Array [0..255] of Byte;
  dwTcpWindowSize       : Longint;
  szPrerequisitePbk     : Array [0..259] of Byte;
  szPrerequisiteEntry   : Array [0..256] of Byte;
  dwRedialCount,
  dwRedialPause         : Longint;
end;

TRasCredentialsA = record
  dwSize, dwMask: Longint;
  szUserName: array[0..256] of Byte;
  szPassword: array[0..256] of Byte;
  szDomain: array[0..15] of Byte;
end;
function RasSetEntryPropertiesA(lpszPhonebook, lpszEntry: PAnsichar; lpRasEntry: Pointer; dwEntryInfoSize: LongInt;lpbDeviceInfo:Pointer;dwDeviceInfoSize: Longint): Longint; stdcall;
function RasSetCredentialsA(lpszPhoneBook, lpszEntry: PAnsichar; lpCredentials: Pointer; fClearCredentials: Longint): Longint; stdcall;
procedure CopyMemory(Destination, Source: Pointer; Length:Integer) stdcall;

var
  Form1: TForm1;
  var conn:string;
implementation

{$R *.dfm}
function RasSetEntryPropertiesA; external 'Rasapi32.dll' name 'RasSetEntryPropertiesA'
function RasSetCredentialsA; external 'Rasapi32.dll' name 'RasSetCredentialsA';
procedure CopyMemory; external 'Kernel32.dll' name 'RtlMoveMemory';

function Create_VPN_Connection(sEntryName, sServer, sUsername, sPassword: string): Boolean;
var
  sDeviceName, sDeviceType: string;
  re: TRasEntry;
  rc: TRasCredentialsA;
begin
  sDeviceName := 'WAN 微型端口 (PPTP)';
  sDeviceType := 'VPN';
  with re do
  begin
  Result := False;
  ZeroMemory(@re,SizeOf(re));
  dwSize := Sizeof(re);
  dwCountryCode := 86;
  dwCountryID := 86;
  dwDialExtraPercent := 75;
  dwDialExtraSampleSeconds := 120;
  dwDialMode := 1;
  dwEncryptionType :=0;
  dwfNetProtocols := 4;
  dwfOptions := 1024262928 - $4000000 - $4000 - $80000 - $10000000 - $20000000 - $100 - $10;
  dwfOptions2 := 367 - 256;
  dwFramingProtocol := 1;
  dwHangUpExtraPercent := 10;
  dwHangUpExtraSampleSeconds := 120;
  dwRedialCount := 0;
  dwRedialPause := 1;
  dwType := 2;
  dwVpnStrategy := 3;
  dwEncryptionType := 0;  //0 无  1 VPN 默认值 3 拨号默认值 可选
  StrCopy(@szDeviceName[0], PansiChar(sDeviceName));
  StrCopy(@szDeviceType[0], PansiChar(sDeviceType));
  StrCopy(@szLocalPhoneNumber[0], PansiChar(sServer));
  end;
  with rc do
  begin
  ZeroMemory(@rc,Sizeof(rc));
  dwSize := sizeof(rc);
  dwMask := 11;
  StrCopy(@szUserName[0],PansiChar(sUsername));
  StrCopy(@szPassword[0],PansiChar(sPassword));
  end;
  if RasSetEntryPropertiesA(Nil, PChar(sEntryName),@re, SizeOf(re), nil, 0)=0 then
  if RasSetCredentialsA(Nil, PChar(sEntryName),@rc,0) = 0 then
  Result := True;
end;
procedure TForm1.DialUpVPN;
begin
  DialUp.GetConnections;
  DialUp.DialMode:=dmsync;
  DialUp.GetEntries;
  DialUp.Entry:='VPN';
  DialUp.Dial;
end;
procedure TForm1.DialUpActiveConnection(Sender: TObject; Handle: Integer;
  Status: TRasConnStatusA; StatusString: String; EntryName, DeviceType,
  DeviceName: array of Char);
begin
  if Trim(EntryName)='VPN' then DialUp.HangUpConn(Handle);
end;

procedure TForm1.DialUpError(Sender: TObject; ErrorCode: Integer;
  ErrorMessage: String);
begin
  Application.MessageBox(PChar('与VPN服务器连接失败! '+ErrorMessage),'VPN连接',MB_OK+MB_ICONWARNING+MB_TOPMOST);
end;

procedure TForm1.DialUpNotConnected(Sender: TObject; ErrorCode: Integer;
  ErrorMessage: String);
begin
  Application.MessageBox(PChar('与VPN服务器连接失败! '+ErrorMessage),'VPN连接',MB_OK+MB_ICONWARNING+MB_TOPMOST);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
  DialUp.GetConnections;
  DialUp.DialMode:=dmsync;
  DialUp.GetEntries;
  DialUp.Entry:='VPN';
  DialUp.DeleteEntry;
close
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
radiobutton1.Checked:=true;
//数据库连接
Adoconnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=13516767586;Data Source='+ExtractFilePath(Application.ExeName)+'vpdn.dat'+';Persist Security Info=false';
Adoconnection1.LoginPrompt:=False;
Adoconnection1.Connected:=True;
with ADOQuery1 do

    begin
      SQL.Text:='select distinct * from vpdn order by name';
      open;
      while not EOF do begin
        ComboBox2.Items.Append(ADOQuery1['name']);
        next;
      end;
    end;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  if radiobutton1.checked then
   begin
  combobox1.Clear;
  combobox1.items.Add('202.96.97.241');
  combobox1.items.Add('202.96.97.240');
  combobox1.items.Add('61.164.1.37');
  ComboBox1.ItemIndex:=0;
  end
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
 if radiobutton2.checked then
   begin
  combobox1.Clear;
  combobox1.items.Add('218.205.54.52');
  ComboBox1.ItemIndex:=0;
  end
end;

procedure TForm1.RadioButton3Click(Sender: TObject);
begin
   if radiobutton3.checked then
   begin
  combobox1.Clear;
  combobox1.items.Add('124.130.209.10');
  ComboBox1.ItemIndex:=0;
  end
end;

procedure (Sender: TObject);
begin
    with ADOQuery1 do
     begin
      SQL.Text:='select * from vpdn where name='+QuotedStr(Combobox2.Text);
      open;
      while not EOF do begin
      Edit1.text:=ADOQuery1.FieldByName('userName').Asstring;
      Edit2.text:=ADOQuery1.FieldByName('password').Asstring;
      Edit3.text:=ADOQuery1.FieldByName('WSSBYHM').Asstring;
      Edit4.text:=ADOQuery1.FieldByName('WSSBMM').Asstring;
        next;
        end
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 sServer, sEntryName, sUsername, sPassword: string;
begin
 sEntryName := 'VPN';
 sServer := combobox1.Text;
 sUsername := edit1.Text;
 sPassword := edit2.Text;
 if Create_VPN_Connection(sEntryName, sServer, sUsername, sPassword) then
  begin
   DialUpVPN;
   end else
  begin
   Application.MessageBox('VPN连接建立失败!','VPN连接',MB_OK+MB_ICONWARNING+MB_TOPMOST);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DialUp.GetConnections;
  DialUp.DialMode:=dmsync;
  DialUp.GetEntries;
  DialUp.Entry:='VPN';
  DialUp.DeleteEntry;
end;

end.
1
©2025, BC-CN.NET
电脑版