您的位置：程序门 -> delphi -> windows sdk/api

用代码创建vpn连接的问题，vb的已经搞定，delphi的咋就搞不定了，大虾们帮我看看（附vb和delphi的代码）

[收藏此页] [打印本页]选择字色：背景色：字体：[大][中][小]

用代码创建vpn连接的问题，vb的已经搞定，delphi的咋就搞不定了，大虾们帮我看看（附vb和delphi的代码）[已结贴,结贴人:gdhyj]

发表于：2008-01-07 16:01:51 楼主

程序都非常简单，在新工程里的form里放一个button后把下面代码拷过去就行了

delphi的代码

unit unit1;

interface

uses
windows, messages, sysutils, variants, classes, graphics, controls, forms,
dialogs, stdctrls;

type
tform1 = class（tform)
button1: tbutton;
procedure button1click（sender: tobject);
private
{ private declarations }
public
{ public declarations }
end;

var
form1: tform1;

type
guid = record //申明调用ras（创建vpn连接用）函数所需结构体
data1 : integer;
data2 : shortint;
data3 : shortint;
data4 : array[0..6] of byte;
end;
type
rasipaddr = record //申明调用ras（创建vpn连接用）函数所需结构体
a : byte;
b : byte;
c : byte;
d : byte;
end;
type
rasentry = record //申明调用ras（创建vpn连接用）函数所需结构体
dwsize : integer;
dwfoptions : integer;
dwcountryid : integer;
dwcountrycode : integer;
szareacode : array[0..9] of byte;
szlocalphonenumber : array[0..127] of byte;
dwalternateoffset : integer;
ipaddr : rasipaddr;
ipaddrdns : rasipaddr;
ipaddrdnsalt : rasipaddr;
ipaddrwins : rasipaddr;
ipaddrwinsalt : rasipaddr;
dwframesize : integer;
dwfnetprotocols : integer;
dwframingprotocol : integer;
szscript : array[0..258] of char;
szautodialdll : array[0..258] of char;
szautodialfunc : array[0..258] of char;
szdevicetype : array[0..15] of char;
szdevicename : array[0..127] of char;
szx25padtype : array[0..31] of char;
szx25address : array[0..199] of char;
szx25facilities : array[0..199] of char;
szx25userdata : array[0..199] of char;
dwchannels : integer;
dwreserved1 : integer;
dwreserved2 : integer;
dwsubentries : integer;
dwdialmode : integer;
dwdialextrapercent : integer;
dwdialextrasampleseconds : integer;
dwhangupextrapercent : integer;
dwhangupextrasampleseconds : integer;
dwidledisconnectseconds : integer;
dwtype : integer;
dwencryptiontype : integer;
dwcustomauthkey : integer;
guidid : guid;
szcustomdialdll : array[0..258] of char;
dwvpnstrategy : integer;
dwfoptions2 : integer;
dwfoptions3 : integer;
szdnssuffix : array[0..254] of char;
dwtcpwindowsize : integer;
szprerequisitepbk : array[0..258] of char;
szprerequisiteentry : array[0..255] of char;
dwredialcount : integer;
dwredialpause : integer;
end;
type
rascredentials = record //申明调用ras（创建vpn连接用）函数所需结构体
dwsize : integer;
dwmask : integer;
szusername : array[0..255] of char;
szpassword : array[0..255] of char;
szdomain : array[0..14] of char;
end;

implementation

{$r *.dfm}

function rtlmovememory（destination,source :pointer;length:integer):integer; stdcall;external 'kernel32.dll'
function rassetentrypropertiesa（lpszphonebook , lpszentry:string; lprasentry : rasentry; dwentryinfosize,lpbdeviceinfo,dwdeviceinfosize:integer): longint; stdcall;external 'rasapi32.dll'
function rassetcredentialsa（ lpszphonebook , lpszentry:string; lpcredentials : rascredentials ;fclearcredentials : integer): longint; stdcall;external 'rasapi32.dll'

function create_vpn_connection（sentryname , sserver , susername , spassword : string) : boolean;
var
sdevicename,sdevicetype :string;
re : rasentry;
rc : rascredentials;
begin
result :=false;
sdevicename := 'wan 微型端口（l2tp)';
sdevicetype := 'vpn';
re.dwsize := sizeof（re);
re.dwcountrycode := 86;
re.dwcountryid := 86;
re.dwdialextrapercent := 75;
re.dwdialextrasampleseconds := 120;
re.dwdialmode := 1;
re.dwencryptiontype := 3;
re.dwfnetprotocols := 4;
re.dwfoptions := 1024262928;
re.dwfoptions2 := 367;
re.dwframingprotocol := 1;
re.dwhangupextrapercent := 10;
re.dwhangupextrasampleseconds := 120;
re.dwredialcount := 3;
re.dwredialpause := 60;
re.dwtype := 5;
rtlmovememory（@re.szdevicename, @sdevicename,length（sdevicename));
rtlmovememory（@re.szdevicename,@sdevicetype,length（sdevicetype));
re.dwvpnstrategy :=0;
re.dwencryptiontype :=3;
rc.dwsize := sizeof（rc);
rc.dwmask := 11;
rtlmovememory（@rc.szusername, @susername,length（susername));
rtlmovememory（@rc.szpassword,@spassword,length（spassword));
if rassetentrypropertiesa（'', sentryname, re, sizeof（re), 0, 0) = 0 then
if rassetcredentialsa（'', sentryname, rc, 0) = 0 then
result :=true;

end;

procedure tform1.button1click（sender: tobject);

var
sdevicetype,sserver,sentryname,susername,spassword : string;
begin
sdevicetype := 'pppoe';
sserver :='www.vpn.com';
sentryname :='vpn连接';
susername :='';
spassword :='';
if create_vpn_connection（sentryname, sserver, susername, spassword)=true then
showmessage（'vpn连接建立成功')
else
showmessage（'vpn连接建立失败');
end;

end.

发表于：2008-01-07 16:03:351楼得分:0

vb的代码：

version 5.00
begin vb.form form1
caption = "form1"
clientheight = 3930
clientleft = 60
clienttop = 450
clientwidth = 4650
linktopic = "form1"
scaleheight = 3930
scalewidth = 4650
startupposition = 3 '窗口缺省
begin vb.commandbutton command1
caption = "建立vpn连接"
height = 495
left = 1080
tabindex = 0
top = 1440
width = 1935
end
end
attribute vb_name = "form1"
attribute vb_globalnamespace = false
attribute vb_creatable = false
attribute vb_predeclaredid = true
attribute vb_exposed = false
private type guid
data1 as long
data2 as integer
data3 as integer
data4（7) as byte
end type
private type rasipaddr
a as byte
b as byte
c as byte
d as byte
end type
private type rasentry
dwsize as long
dwfoptions as long
dwcountryid as long
dwcountrycode as long
szareacode（10) as byte
szlocalphonenumber（128) as byte
dwalternateoffset as long
ipaddr as rasipaddr
ipaddrdns as rasipaddr
ipaddrdnsalt as rasipaddr
ipaddrwins as rasipaddr
ipaddrwinsalt as rasipaddr
dwframesize as long
dwfnetprotocols as long
dwframingprotocol as long
szscript（259) as byte
szautodialdll（259) as byte
szautodialfunc（259) as byte
szdevicetype（16) as byte
szdevicename（128) as byte
szx25padtype（32) as byte
szx25address（200) as byte
szx25facilities（200) as byte
szx25userdata（200) as byte
dwchannels as long
dwreserved1 as long
dwreserved2 as long
dwsubentries as long
dwdialmode as long
dwdialextrapercent as long
dwdialextrasampleseconds as long
dwhangupextrapercent as long
dwhangupextrasampleseconds as long
dwidledisconnectseconds as long
dwtype as long
dwencryptiontype as long
dwcustomauthkey as long
guidid as guid
szcustomdialdll（259) as byte
dwvpnstrategy as long
dwfoptions2 as long
dwfoptions3 as long
szdnssuffix（255) as byte
dwtcpwindowsize as long
szprerequisitepbk（259) as byte
szprerequisiteentry（256) as byte
dwredialcount as long
dwredialpause as long
end type
private type rascredentials
dwsize as long
dwmask as long
szusername（256) as byte
szpassword（256) as byte
szdomain（15) as byte
end type
private declare sub copymemory lib "kernel32" alias "rtlmovememory" （destination as any, source as any, byval length as long)
private declare function rassetentryproperties lib "rasapi32" alias "rassetentrypropertiesa" （byval lpszphonebook as string, byval lpszentry as string, lprasentry as rasentry, byval dwentryinfosize as long, byval lpbdeviceinfo as long, byval dwdeviceinfosize as long) as long
private declare function rassetcredentials lib "rasapi32" alias "rassetcredentialsa" （byval lpszphonebook as string, byval lpszentry as string, lpcredentials as rascredentials, byval fclearcredentials as long) as long

private sub command1_click（)
dim sentryname as string, susername as string, spassword as string

dim sserver as string
sserver = "www.vpn.com"
sentryname = "vpn连接"
susername = ""
spassword = ""
if create_vpn_connection（sentryname, sserver, susername, spassword) then
msgbox "vpn连接建立成功！"
else
msgbox "vpn连接建立失败！"
end if
end sub

function create_vpn_connection（byval sentryname as string, byval sserver as string, byval susername as string, byval spassword as string) as boolean
create_vpn_connection = false
dim re as rasentry
dim sdevicename as string, sdevicetype as string
sdevicename = "wan 微型端口（l2tp)"
sdevicetype = "vpn"
with re
.dwsize = lenb（re)
.dwcountrycode = 86
.dwcountryid = 86
.dwdialextrapercent = 75
.dwdialextrasampleseconds = 120
.dwdialmode = 1
.dwfnetprotocols = 4
.dwfoptions = 1024262928
.dwfoptions2 = 367
.dwframingprotocol = 1
.dwhangupextrapercent = 10
.dwhangupextrasampleseconds = 120
.dwredialcount = 3
.dwredialpause = 60
.dwtype = raset_vpn
copymemory .szdevicename（0), byval sdevicename, len（sdevicename)
copymemory .szdevicetype（0), byval sdevicetype, len（sdevicetype)
copymemory .szlocalphonenumber（0), byval sserver, len（sserver) '服务器地址
.dwvpnstrategy = vs_default 'vpn类型
.dwencryptiontype = et_optional '数据加密类型
end with
dim rc as rascredentials
with rc
.dwsize = lenb（rc)
.dwmask = 11
copymemory .szusername（0), byval susername, len（susername)
copymemory .szpassword（0), byval spassword, len（spassword)
end with

dim rtn as long
if rassetentryproperties（vbnullstring, sentryname, re, lenb（re), 0, 0) = 0 then
if rassetcredentials（vbnullstring, sentryname, rc, 0) = 0 then
create_vpn_connection = true
end if
end if
end function

发表于：2008-01-07 17:22:102楼得分:0

我认为是string的原因,delphi的dll里用到了string类型时,在工程文件的uses处要第一个sharemem单元
我找了一下rassetentrypropertiesa的原形
function rassetentrypropertiesa（lpszphonebook, szentry: pansichar; lpbentry: pointer;
dwentrysize: longint; lpbdeviceinfo: pointer;
与你给出的不一样

发表于：2008-01-07 17:24:443楼得分:0

rtlmovememory（@re.szdevicename,@sdevicetype,length（sdevicetype));
是不是应该改为rtlmovememory（@re.szdevicetype,@sdevicetype,length（sdevicetype));

发表于：2008-01-07 17:38:284楼得分:0

改为
function rassetentrypropertiesa（lpszphonebook, szentry: pansichar; lpbentry: pointer;
dwentrysize: longint; lpbdeviceinfo: pointer;
dwdeviceinfosize: longint): longint; stdcall; external 'rasapi32.dll';
后,提示:vpn连接建立失败

没有找到rassetcredentialsa原型,所以不能继续了

发表于：2008-01-07 18:05:485楼得分:0

申明改为function rassetentrypropertiesa（lpszphonebook, szentry: pansichar; lpbentry: pointer;
dwentrysize: longint; lpbdeviceinfo: pointer;
dwdeviceinfosize: longint): longint; stdcall; external 'rasapi32.dll';

后调用要如何改？
我把 if rassetentryproperties（vbnullstring, sentryname, re, lenb（re), 0, 0) = 0 then
改为
function rassetentrypropertiesa（lpszphonebook, szentry: pansichar; lpbentry: pointer;
dwentrysize: longint; lpbdeviceinfo: pointer;
dwdeviceinfosize: longint): longint; stdcall; external 'rasapi32.dll';
后一样出错，出同样的错

另外
rtlmovememory（@re.szdevicename,@sdevicetype,length（sdevicetype));
是不是应该改为rtlmovememory（@re.szdevicetype,@sdevicetype,length（sdevicetype));

这确实是我写错了，已经改过来了

发表于：2008-01-07 18:13:086楼得分:0

function create_vpn_connection（sentryname, sserver, susername, spassword: string): boolean;
var
sdevicename, sdevicetype: string;
re: rasentry;
rc: trascredentialsa;
begin
result := false;
fillchar（rc.szusername, length（rc.szusername), #0);
fillchar（rc.zpassword, length（rc.zpassword), #0);
fillchar（re.szscript, length（re.szscript), #0);
fillchar（re.szautodialdll, length（re.szautodialdll), #0);
fillchar（re.szareacode, length（re.szareacode), #0);
fillchar（re.szlocalphonenumber, length（re.szlocalphonenumber), #0);
fillchar（re.szautodialfunc, length（re.szautodialfunc), #0);
fillchar（re.szautodialdll, length（re.szautodialdll), #0);
fillchar（re.szdevicetype, length（re.szdevicetype), #0);
fillchar（re.szdevicename, length（re.szdevicename), #0);
fillchar（re.szx25padtype, length（re.szx25padtype), #0);
fillchar（re.szx25address, length（re.szx25address), #0);
fillchar（re.szx25facilities, length（re.szx25facilities), #0);
fillchar（re.szx25userdata, length（re.szx25userdata), #0);
fillchar（re.szcustomdialdll, length（re.szcustomdialdll), #0);
fillchar（re.szdnssuffix, length（re.szdnssuffix), #0);
fillchar（re.szprerequisitepbk, length（re.szprerequisitepbk), #0);
fillchar（re.szprerequisiteentry, length（re.szprerequisiteentry), #0);
sdevicename := 'wan 微型端口（l2tp)';
sdevicetype := 'vpn';
re.dwsize := sizeof（re);
re.dwcountrycode := 86;
re.dwcountryid := 86;
re.dwdialextrapercent := 75;
re.dwdialextrasampleseconds := 120;
re.dwdialmode := 1;
re.dwencryptiontype := 3;
re.dwfnetprotocols := 4;
re.dwfoptions := 1024262928;
re.dwfoptions2 := 367;
re.dwframingprotocol := 1;
re.dwhangupextrapercent := 10;
re.dwhangupextrasampleseconds := 120;
re.dwredialcount := 3;
re.dwredialpause := 60;
re.dwtype := 5;
strcopy（re.szdevicename, pchar（sdevicename));
strcopy（re.szdevicetype, pchar（sdevicetype));
re.dwvpnstrategy := 0;
re.dwencryptiontype := 3;
fillchar（rc.szusername, length（rc.szusername), #0);
fillchar（rc.szdomain, length（rc.szdomain), #0);
rc.dwsize := sizeof（rc);
rc.dwmask := 11;
strcopy（rc.szusername, pchar（susername));
strcopy（rc.zpassword, pchar（spassword));
if rassetentrypropertiesa（pchar（''), pchar（sentryname), @re, sizeof（rasentry), 0, 0) = 0 then
if rassetcredentialsa（'', sentryname, rc, 0) = 0 then
result :=true;

发表于：2008-01-07 18:16:117楼得分:0

申明改为
function rassetentrypropertiesa（lpszphonebook, szentry: pansichar; lpbentry: pointer; dwentrysize: longint; lpbdeviceinfo: pointer;dwdeviceinfosize: longint): longint; stdcall; external 'rasapi32.dll';
后调用要如何改？
我改为
if rassetentrypropertiesa（nil, @sentryname, @re, sizeof（re), 0, 0) = 0 then
后一样出错

另外
rtlmovememory（@re.szdevicename,@sdevicetype,length（sdevicetype));
是不是应该改为rtlmovememory（@re.szdevicetype,@sdevicetype,length（sdevicetype));

这确实是我写错了，已经改过来了

发表于：2008-01-07 18:29:208楼得分:0

改为6楼的调用后执行的时候不出错了，但退出程序的时候还有报错

发表于：2008-01-07 20:54:449楼得分:100

呵呵,退出的时候,报什么错啊?

下面的代码是我测试时的代码，退出时没有抱错。

unit unit1;

interface

uses
windows, messages, sysutils, variants, classes, graphics, controls, forms,
dialogs, stdctrls, strutils;

type
tform1 = class（tform)
button1: tbutton;
button2: tbutton;
memo1: tmemo;

procedure button1click（sender: tobject);
procedure button2click（sender: tobject);
private
{ private declarations }
public
{ public declarations }
end;

var
form1: tform1;

type
guid = record //申明调用ras（创建vpn连接用）函数所需结构体
data1: integer;
data2: shortint;
data3: shortint;
data4: array[0..6] of byte;
end;
type
rasipaddr = record //申明调用ras（创建vpn连接用）函数所需结构体
a: byte;
b: byte;
c: byte;
d: byte;
end;
type
rasentry = record //申明调用ras（创建vpn连接用）函数所需结构体
dwsize: integer;
dwfoptions: integer;
dwcountryid: integer;
dwcountrycode: integer;
szareacode: array[0..9] of byte;
szlocalphonenumber: array[0..127] of byte;
dwalternateoffset: integer;
ipaddr: rasipaddr;
ipaddrdns: rasipaddr;
ipaddrdnsalt: rasipaddr;
ipaddrwins: rasipaddr;
ipaddrwinsalt: rasipaddr;
dwframesize: integer;
dwfnetprotocols: integer;
dwframingprotocol: integer;
szscript: array[0..258] of char;
szautodialdll: array[0..258] of char;
szautodialfunc: array[0..258] of char;
szdevicetype: array[0..15] of char;
szdevicename: array[0..127] of char;
szx25padtype: array[0..31] of char;
szx25address: array[0..199] of char;
szx25facilities: array[0..199] of char;
szx25userdata: array[0..199] of char;
dwchannels: integer;
dwreserved1: integer;
dwreserved2: integer;
dwsubentries: integer;
dwdialmode: integer;
dwdialextrapercent: integer;
dwdialextrasampleseconds: integer;
dwhangupextrapercent: integer;
dwhangupextrasampleseconds: integer;
dwidledisconnectseconds: integer;
dwtype: integer;
dwencryptiontype: integer;
dwcustomauthkey: integer;
guidid: guid;
szcustomdialdll: array[0..258] of char;
dwvpnstrategy: integer;
dwfoptions2: integer;
dwfoptions3: integer;
szdnssuffix: array[0..254] of char;
dwtcpwindowsize: integer;
szprerequisitepbk: array[0..258] of char;
szprerequisiteentry: array[0..255] of char;
dwredialcount: integer;
dwredialpause: integer;
end;

trascredentialsa = record
dwsize,
dwmask: longint;
szusername: array[0..255] of ansichar;
zpassword: array[0..255] of ansichar;
szdomain: array[0..14] of ansichar;
end;
implementation

{$r *.dfm}

function rtlmovememory（destination, source: pointer; length: integer): integer; stdcall; external 'kernel32.dll'

//function rassetentrypropertiesa（lpszphonebook, lpszentry: string; lprasentry: rasentry; dwentryinfosize, lpbdeviceinfo, dwdeviceinfosize: integer): longint; stdcall; external 'rasapi32.dll'

function rassetentrypropertiesa（lpszphonebook, szentry: pansichar; lpbentry: pointer;
dwentrysize: longint; lpbdeviceinfo: pointer;
dwdeviceinfosize: longint): longint; stdcall; external 'rasapi32.dll';

//function rassetcredentialsa（lpszphonebook, lpszentry: pansichar; lpcredentials: pointer; fclearcredentials: integer): longint; stdcall; external 'rasapi32.dll';

function rassetcredentialsa（
lpszphonebook,
lpszentry: pansichar;
var lpcredentials: trascredentialsa;
fremovepassword: longbool
): longint; stdcall; external 'rasapi32.dll';

function create_vpn_connection（sentryname, sserver, susername, spassword: string): boolean;
var
sdevicename, sdevicetype: string;
re: rasentry;
rc: trascredentialsa;
begin
result := false;
fillchar（rc.szusername, length（rc.szusername), #0);
fillchar（rc.zpassword, length（rc.zpassword), #0);
fillchar（re.szscript, length（re.szscript), #0);
fillchar（re.szautodialdll, length（re.szautodialdll), #0);
fillchar（re.szareacode, length（re.szareacode), #0);
fillchar（re.szlocalphonenumber, length（re.szlocalphonenumber), #0);
fillchar（re.szautodialfunc, length（re.szautodialfunc), #0);
fillchar（re.szautodialdll, length（re.szautodialdll), #0);
fillchar（re.szdevicetype, length（re.szdevicetype), #0);
fillchar（re.szdevicename, length（re.szdevicename), #0);
fillchar（re.szx25padtype, length（re.szx25padtype), #0);
fillchar（re.szx25address, length（re.szx25address), #0);
fillchar（re.szx25facilities, length（re.szx25facilities), #0);
fillchar（re.szx25userdata, length（re.szx25userdata), #0);
fillchar（re.szcustomdialdll, length（re.szcustomdialdll), #0);
fillchar（re.szdnssuffix, length（re.szdnssuffix), #0);
fillchar（re.szprerequisitepbk, length（re.szprerequisitepbk), #0);
fillchar（re.szprerequisiteentry, length（re.szprerequisiteentry), #0);
sdevicename := 'wan 微型端口（l2tp)';
sdevicetype := 'vpn';
re.dwsize := sizeof（re);
re.dwcountrycode := 86;
re.dwcountryid := 86;
re.dwdialextrapercent := 75;
re.dwdialextrasampleseconds := 120;
re.dwdialmode := 1;
re.dwencryptiontype := 3;
re.dwfnetprotocols := 4;
re.dwfoptions := 1024262928;
re.dwfoptions2 := 367;
re.dwframingprotocol := 1;
re.dwhangupextrapercent := 10;
re.dwhangupextrasampleseconds := 120;
re.dwredialcount := 3;
re.dwredialpause := 60;
re.dwtype := 5;
strcopy（re.szdevicename, pchar（sdevicename));
strcopy（re.szdevicetype, pchar（sdevicetype));
re.dwvpnstrategy := 0;
re.dwencryptiontype := 3;
fillchar（rc.szusername, length（rc.szusername), #0);
fillchar（rc.szdomain, length（rc.szdomain), #0);
rc.dwsize := sizeof（rc);
rc.dwmask := 11;
strcopy（rc.szusername, pchar（susername));
strcopy（rc.zpassword, pchar（spassword));
if rassetentrypropertiesa（pchar（''), pchar（sentryname), @re, sizeof（rasentry), 0, 0) = 0 then
if rassetcredentialsa（pchar（''), pchar（sentryname), rc, true) = 0 then
result := true;
end;

procedure tform1.button1click（sender: tobject);

var
sdevicetype, sserver, sentryname, susername, spassword: string;
begin
sdevicetype := 'pppoe';
sserver := 'www.vpn.com';
sentryname := 'vpn连接';
susername := '';
spassword := '';
if create_vpn_connection（sentryname, sserver, susername, spassword) = true then
showmessage（'vpn连接建立成功')
else
showmessage（'vpn连接建立失败');
end;

end.

发表于：2008-01-07 22:33:5210楼得分:0

按老兄帮我改过后的代码执行确实没有报错，但为什么delphi执行返回就会是失败而vb可以返回成功呢？

我单步跟踪了一下，还没执行到下面的这句
if rassetcredentialsa（pchar（''), pchar（sentryname), rc, true) = 0 then

发表于：2008-01-07 22:46:4111楼得分:0

我网上搜了一下返回代码632的意思，应该是error_invalid_size，我猜是传入结构大小不对吧，后来我发现我对vb数组理解有误导致翻译到delphi后数据都少了一个，全部改好后代码如下，几个结构的size都跟vb里测得一样了（rasentry=2884）,但执就就跳到汇编跟踪调试界面了，不知什么原因

unit unit1;

interface

uses
windows, messages, sysutils, variants, classes, graphics, controls, forms,
dialogs, stdctrls, strutils;

type
tform1 = class（tform)
button1: tbutton;

procedure button1click（sender: tobject);
private
{ private declarations }
public
{ public declarations }
end;

var
form1: tform1;

type
guid = record //申明调用ras（创建vpn连接用）函数所需结构体
data1: integer;
data2: shortint;
data3: shortint;
data4: array[0..7] of byte;
end;
type
rasipaddr = record //申明调用ras（创建vpn连接用）函数所需结构体
a: byte;
b: byte;
c: byte;
d: byte;
end;
type
rasentry = record //申明调用ras（创建vpn连接用）函数所需结构体
dwsize: integer;
dwfoptions: integer;
dwcountryid: integer;
dwcountrycode: integer;
szareacode: array[0..10] of byte;
szlocalphonenumber: array[0..128] of byte;
dwalternateoffset: integer;
ipaddr: rasipaddr;
ipaddrdns: rasipaddr;
ipaddrdnsalt: rasipaddr;
ipaddrwins: rasipaddr;
ipaddrwinsalt: rasipaddr;
dwframesize: integer;
dwfnetprotocols: integer;
dwframingprotocol: integer;
szscript: array[0..259] of byte;
szautodialdll: array[0..259] of byte;
szautodialfunc: array[0..259] of byte;
szdevicetype: array[0..16] of char;
szdevicename: array[0..128] of char;
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: integer;
dwreserved1: integer;
dwreserved2: integer;
dwsubentries: integer;
dwdialmode: integer;
dwdialextrapercent: integer;
dwdialextrasampleseconds: integer;
dwhangupextrapercent: integer;
dwhangupextrasampleseconds: integer;
dwidledisconnectseconds: integer;
dwtype: integer;
dwencryptiontype: integer;
dwcustomauthkey: integer;
guidid: guid;
szcustomdialdll: array[0..259] of byte;
dwvpnstrategy: integer;
dwfoptions2: integer;
dwfoptions3: integer;
szdnssuffix: array[0..255] of byte;
dwtcpwindowsize: integer;
szprerequisitepbk: array[0..259] of byte;
szprerequisiteentry: array[0..256] of byte;
dwredialcount: integer;
dwredialpause: integer;
end;

trascredentialsa = record
dwsize, dwmask: longint;
szusername: array[0..256] of ansichar;
zpassword: array[0..256] of ansichar;
szdomain: array[0..15] of ansichar;
end;
implementation

{$r *.dfm}

function rtlmovememory（destination, source: pointer; length: integer): integer; stdcall; external 'kernel32.dll'
function rassetentrypropertiesa（lpszphonebook, szentry: pansichar; lpbentry: pointer; dwentrysize: longint; lpbdeviceinfo: pointer; dwdeviceinfosize: longint): longint; stdcall; external 'rasapi32.dll';
function rassetcredentialsa（lpszphonebook,lpszentry: pansichar;var lpcredentials: trascredentialsa; fremovepassword: longbool): longint; stdcall; external 'rasapi32.dll';

function create_vpn_connection（sentryname, sserver, susername, spassword: string): boolean;
var
sdevicename, sdevicetype: string;
re: rasentry;
rc: trascredentialsa;
hyj:longint;
begin
result := false;
//showmessage（inttostr（sizeof（re)));
//exit;
fillchar（rc.szusername, length（rc.szusername), #0);
fillchar（rc.zpassword, length（rc.zpassword), #0);
fillchar（re.szscript, length（re.szscript), #0);
fillchar（re.szautodialdll, length（re.szautodialdll), #0);
fillchar（re.szareacode, length（re.szareacode), #0);
fillchar（re.szlocalphonenumber, length（re.szlocalphonenumber), #0);
fillchar（re.szautodialfunc, length（re.szautodialfunc), #0);
fillchar（re.szautodialdll, length（re.szautodialdll), #0);
fillchar（re.szdevicetype, length（re.szdevicetype), #0);
fillchar（re.szdevicename, length（re.szdevicename), #0);
fillchar（re.szx25padtype, length（re.szx25padtype), #0);
fillchar（re.szx25address, length（re.szx25address), #0);
fillchar（re.szx25facilities, length（re.szx25facilities), #0);
fillchar（re.szx25userdata, length（re.szx25userdata), #0);
fillchar（re.szcustomdialdll, length（re.szcustomdialdll), #0);
fillchar（re.szdnssuffix, length（re.szdnssuffix), #0);
fillchar（re.szprerequisitepbk, length（re.szprerequisitepbk), #0);
fillchar（re.szprerequisiteentry, length（re.szprerequisiteentry), #0);
sdevicename := 'wan 微型端口（l2tp)';
sdevicetype := 'vpn';
re.dwsize := sizeof（re);
re.dwcountrycode := 86;
re.dwcountryid := 86;
re.dwdialextrapercent := 75;
re.dwdialextrasampleseconds := 120;
re.dwdialmode := 1;
re.dwencryptiontype := 3;
re.dwfnetprotocols := 4;
re.dwfoptions := 1024262928;
re.dwfoptions2 := 367;
re.dwframingprotocol := 1;
re.dwhangupextrapercent := 10;
re.dwhangupextrasampleseconds := 120;
re.dwredialcount := 3;
re.dwredialpause := 60;
re.dwtype := 5;
strcopy（re.szdevicename, pchar（sdevicename));
strcopy（re.szdevicetype, pchar（sdevicetype));
re.dwvpnstrategy := 0;
re.dwencryptiontype := 3;
fillchar（rc.szusername, length（rc.szusername), #0);
fillchar（rc.szdomain, length（rc.szdomain), #0);
rc.dwsize := sizeof（rc);
rc.dwmask := 11;
strcopy（rc.szusername, pchar（susername));
strcopy（rc.zpassword, pchar（spassword));
hyj :=rassetentrypropertiesa（pchar（''), pchar（sentryname), @re, sizeof（rasentry), 0, 0);
if hyj= 0 then
if rassetcredentialsa（pchar（''), pchar（sentryname), rc, true) = 0 then
result := true;
end;

procedure tform1.button1click（sender: tobject);

var
sdevicetype, sserver, sentryname, susername, spassword: string;
begin
sdevicetype := 'pppoe';
sserver := 'www.vpn.com';
sentryname := 'vpn连接';
susername := '';
spassword := '';
if create_vpn_connection（sentryname, sserver, susername, spassword) = true then
showmessage（'vpn连接建立成功')
else
showmessage（'vpn连接建立失败');
end;

end.

发表于：2008-01-08 00:02:3012楼得分:0

我这里返回值是621,代表什么意思啊?

发表于：2008-01-08 08:55:4313楼得分:0

error 621 cannot open the phone book file

发表于：2008-01-08 09:51:4314楼得分:0

终于成功了，谢谢zhongme_007
报621错的时候把pchar（'')换成nil就可以了

下一篇：专门讲解用c或c++写的开源软件的书籍
上一篇：如何向其他窗口发送组合键？ctrl+f

其他资讯