private
{ Private declarations }
public
{ Public declarations }
end;
var
VpnForm: TVpnForm;
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; 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 := 3;
dwfNetProtocols := 4;
dwfOptions := 1024262928-16;
dwfOptions2 := 367;
dwFramingProtocol := 1;
dwHangUpExtraPercent := 10;
dwHangUpExtraSampleSeconds := 120;
dwRedialCount := 3;
dwRedialPause := 60;
dwType := 5;
dwVpnStrategy := 0;
dwEncryptionType := 3; //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 TVpnForm.Button1Click(Sender: TObject);
var
sServer, sEntryName, sUsername, sPassword: string;
begin
sEntryName := 'VPN';
sServer := ServerIPEd.Text;
sUsername := UserEd.Text;
sPassword := PwdEd.Text;
if Create_VPN_Connection(sEntryName, sServer, sUsername, sPassword) then
begin
Application.MessageBox('VPN连接建立成功!','VPN连接',MB_OK+MB_ICONWARNING+MB_TOPMOST);
private
{ Private declarations }
public
{ Public declarations }
end;
var
VpnForm: TVpnForm;
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; 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 := 3;
dwfNetProtocols := 4;
dwfOptions := 1024262928-16;
dwfOptions2 := 367;
dwFramingProtocol := 1;
dwHangUpExtraPercent := 10;
dwHangUpExtraSampleSeconds := 120;
dwRedialCount := 3;
dwRedialPause := 60;
dwType := 5;
dwVpnStrategy := 0;
dwEncryptionType := 3; //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 TVpnForm.Button1Click(Sender: TObject);
var
sServer, sEntryName, sUsername, sPassword: string;
begin
sEntryName := 'VPN';
sServer := ServerIPEd.Text;
sUsername := UserEd.Text;
sPassword := PwdEd.Text;
if Create_VPN_Connection(sEntryName, sServer, sUsername, sPassword) then
begin
Application.MessageBox('VPN连接建立成功!','VPN连接',MB_OK+MB_ICONWARNING+MB_TOPMOST);
function RasSetCredentialsA(lpszPhoneBook, lpszEntry: PAnsichar; lpCredentials: Pointer; fClearCredentials: Longint): Longint; stdcall;
function RasSetCredentialsA; external 'Rasapi32.dll' name 'RasSetCredentialsA';
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: Longint;
dwfOptions: Longint;
dwCountryID: Longint;
dwCountryCode: Longint;
szAreaCode: array[0..10] of Byte;
szLocalPhoneNumber: array[0..128] of Byte;
dwAlternatesOffset: Longint;
ipaddr: TRasIPAddr;
ipaddrDns: TRasIPAddr;
ipaddrDnsAlt: TRasIPAddr;
ipaddrWins: TRasIPAddr;
ipaddrWinsAlt: TRasIPAddr;
dwFrameSize: Longint;
dwfNetProtocols: Longint;
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: Longint;
dwReserved1: Longint;
dwReserved2: Longint;
dwSubEntries: Longint;
dwDialMode: Longint;
dwDialExtraPercent: Longint;
dwDialExtraSampleSeconds: Longint;
dwHangUpExtraPercent: Longint;
dwHangUpExtraSampleSeconds: Longint;
dwIdleDisconnectSeconds: Longint;
dwType: Longint;
dwEncryptionType: Longint;
dwCustomAuthKey: Longint;
guidId: GUID;
szCustomDialDll: array[0..259] of Byte;
dwVpnStrategy: Longint;
dwfOptions2: Longint;
dwfOptions3: Longint;
szDnsSuffix: array[0..255] of Byte;
dwTcpWindowSize: Longint;
szPrerequisitePbk: array[0..259] of Byte;
szPrerequisiteEntry: array[0..256] of Byte;
dwRedialCount: Longint;
dwRedialPause: Longint;
end;
TRasCredentialsA = record
dwSize: Longint;
dwMask: LongInt;
szUserName: array[0..256] of Byte;
szPassword: array[0..256] of Byte;
szDomain: array[0..15] of Byte;
end;
function Create_ISDN_Connection(sDeviceName, sEntryName, sLocalPhoneNumber, sUsername, sPassword: string; iRedialCount, iRedialPause: Integer): Boolean;
var
sDeviceType: string;
re: TRasEntry;
rc: TRasCredentialsA;
begin
//sDeviceName := 'TP-Link EC5658V V92 External Modem';//'WAN 微型端口 (PPTP)'; //'WAN Minport (PPPOE)';
sDeviceType := RASDT_Isdn; //'RASDT_PPPoE';//'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 := 3;
dwfNetProtocols := 4;
dwfOptions := 1024262928 - 16;
dwfOptions2 := 367;
dwFramingProtocol := 1;
dwHangUpExtraPercent := 10;
dwHangUpExtraSampleSeconds := 120;
dwRedialCount := iRedialCount;
dwRedialPause := iRedialPause;
dwType := 5;
dwVpnStrategy := 0;
dwEncryptionType := 3; //0 无 1 VPN 默认值 3 拨号默认值 可选
StrCopy(@szDeviceName[0], PansiChar(sDeviceName));
StrCopy(@szDeviceType[0], PansiChar(sDeviceType));
StrCopy(@szLocalPhoneNumber[0], PansiChar(sLocalPhoneNumber));
end;
with rc do
begin
ZeroMemory(@rc, Sizeof(rc));
dwSize := sizeof(rc);
dwMask := 7; //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;