今天在论坛看到一个关于VPN的贴子
原地址http://topic.csdn.net/u/20080107/16/5842d5ca-fb60-42db-9c3b-88a8ed8d3585.html
我用了里面的代码 也把PChar('')换成nil 
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(nil, PChar(sEntryName), @re, sizeof(RASENTRY), 0, 0);
    if    hyj= 0 then 
        if  RasSetCredentialsA(nil, 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.但是程序运行 点按妞的时候就提示
project project1.exe raised exception class eaccessViolation with message
'access violation at address 76EB9F01 in module' Rasapi32.dll Read of address
7CA7A13C Process stoppde  Use Step or Run to continue 其中有一次 竟然好使了 在网上邻居属性里 看到了 新建连接
双点 就出现了 VPN的连接
希望高手指点一下 是那里错了
还想问下 有没有办法 在点按钮的时候 成功连接后 就直接运行 新建连接的方法

解决方案 »

  1.   

    其實你的創建連接的函數做了不少沒有必要的步驟,如下即可:function CreateRasEntry(sEntryName, sServer, sUsername, sPassword: string): Boolean; 
    var 
    rasEntry : TRasEntry; 
    rc : TRasDialParams; 
    dwResult,dwRet:DWORD; 
    begin 
    ZeroMemory(@rasEntry, sizeof(rasEntry)); 
    rasEntry.dwType := 2; 
    rasEntry.dwRedialCount := 3; 
    rasEntry.dwRedialPause := 1; 
    rasEntry.dwSize := sizeof(rasEntry); 
    rasEntry.dwfOptions := RASEO_RequireMsEncryptedPw or RASEO_RequireDataEncryption or RASEO_ModemLights or RASEO_ShowDialingProgress; 
    strcopy(rasEntry.szLocalPhoneNumber, Pchar(sServer)); 
    strcopy(rasEntry.szDeviceType, Pchar('vpn')); 
    strcopy(rasEntry.szDeviceName, Pchar('游戏专用 VPN 连接')); 
    dwResult := RasSetEntryProperties(nil, PChar(sEntryName), @rasEntry, sizeof(TRasEntry), nil, 0); 
    if dwResult<>0 then 
    begin 
    Result:=FALSE; 
    end; 
    ZeroMemory(@rc, sizeof(rc)); 
    rc.dwSize := sizeof(rc); 
    StrCopy(rc.szEntryName, PChar(sEntryName)); 
    StrCopy(rc.szUserName, PChar(sUsername)); 
    StrCopy(rc.szPassword, PChar(sPassword)); 
    dwRet := RasSetEntryDialParams(nil, rc, false); if dwRet = 0 then 
    Result:=TRUE 
    else 
    Result := FALSE; 
    end;關于你說的直接撥號,你可以使用以下函數:procedure TForm1.connectVPN(); 
    var 
    RasDialParams:TRasDialParams; 
    Ret:DWORD; 
    Buf : array [0..255] of Char; 
    begin 
    RasDialParams.dwSize := sizeof(TRasDialParams); strcopy(RasDialParams.szEntryName, Pchar(strEntryname)); 
    strcopy(RasDialParams.szPhoneNumber, Pchar(Edit3.Text)); 
    strcopy(RasDialParams.szUserName, Pchar(Edit1.Text)); 
    strcopy(RasDialParams.szPassword, Pchar(Edit2.Text)); 
    RasDialParams.szCallbackNumber[0] := '*'; 
    RasDialParams.szDomain := '*'; 
    if CreateRasEntry(RasDialParams.szEntryName, '127.0.0.1', 
    'user', 'password')=true then 
    begin 
    LogMessage('正在连接... '+RasDialParams.szEntryName); 
    StatusBar1.Panels[0].Text:=' '+ComboBox1.Text+ComboBox2.Text; 
    hRasConn := 0; 
    if not CheckConn(strEntryname) then 
    begin 
    Ret := RasDial(nil, nil, RasDialParams, 0, @RasDialFunc, hRasConn); 
    if Ret <> 0 then 
    begin 
    RasGetErrorStringA(Ret, @Buf[0], SizeOf(Buf)); 
    StatusBar1.Panels[1].Text:=IntToStr(Ret) + ' ' + Buf; 
    Button2.Click; 
    end 
    else 
    begin 
    StatusBar1.Panels[1].Text:='正在连接'; 
    Button1.Enabled:=false; 
    end; 
    end 
    else 
    begin 
    IsConnected:=True; 
    StatusBar1.Panels[1].Text:='连接成功'; 
    end; end; 
    end;
      

  2.   

    用了你的函说
    提示  TRasEntry; TRasDialParams; 没声明
    比较菜 多指点一下
      

  3.   

    这个属于应用问题,跟本身提供的接口有关系,VPN厂家应该有相应的说明.
      

  4.   

    仔细看看MSDN的资料就可以了,,例子找C++的,google上有,翻译成D就OK了
      

  5.   


    忘记说了 你需要引用 Ras.pas 单元,这里有 http://www.koders.com/delphi/fidA0EBAC0ABBDA970F24C35401B15D0E0B6C7A94EF.aspx?s=xml
      

  6.   

    引用之后还是有点问题
      [Error] Unit1.pas(114): Undeclared identifier: 'dwType'
      [Error] Unit1.pas(115): Undeclared identifier: 'dwRedialCount'
      [Error] Unit1.pas(116): Undeclared identifier: 'dwRedialPause'
      [Error] Unit1.pas(118): Undeclared identifier: 'RASEO_ShowDialingProgress'
    有点迷糊
      

  7.   

    这个你最好看看 msdn 因为这个 ras 有很多个版本,因为操作系统的不同,我记得我之前是修改过的 ras,如果你需要可以留下你的邮箱,我发你一份 
      

  8.   

    好的 太谢谢你了
    我的油箱:  [email protected]
      

  9.   

    给个你我成功的demouses RAS,RASAPI;
     Procedure createconnect(); //创建加速连接
     var
       szEntryName: string;
       RasEntry: TRasEntryA;
       rasEntrySize: DWORD;
       nResult: Integer;
    begin
      RasHangUp(nRas);
      //Disconn; //根据连接名断开连接
      rasdeleteentry(nil,'网络加速连接');   //删除连接
      szEntryName := '网络加速连接';
      RasEntrySize := SizeOf(TRasEntry);
      FillChar(RasEntry, SizeOf(TRasEntry), #0);
      RasEntry.dwSize := RasEntrySize;
      RasEntry.dwfOptions := RASEO_RequireMsEncryptedPw or RASEO_RequireDataEncryption;
      StrPCopy(RasEntry.szLocalPhoneNumber,main.vpnipaddrforconnection);
      StrPCopy(RasEntry.szDeviceName, 'RAS VPN Line 0');
      StrPCopy(RasEntry.szDeviceType, RASDT_VPN);
      nResult := RasSetEntryProperties(nil, Pchar(szEntryName), @RasEntry, SizeOf(TRasEntry), nil, 0);
    end;procedure RasCallback(msg: Integer; state: TRasConnState;
        error: Longint); stdcall      //信息回调函数
    begin
      main.Loginingnow.Caption := StatusString(state, error);
     { if main.Loginingnow.Caption = '' then
       begin
      main.Loginingnow.Caption := '正在准备连接,请稍后...';
      end; }
    end;Procedure Vpning(); //拨号
    var
     nResult: Integer;
      RasDialParams: TRasDialParams;
      sError:array [0..255] of char;begin
       RasHangUp(nRas); //挂断连接
       //Disconn; //根据连接名断开连接
       main.GifTimer.Enabled:=false;
       main.Loginingnow.Visible:=true;
    if nRas <> 0 then RasHangUp(nRas);
      FillChar(RasDialParams, SizeOf(RasDialParams), #0);
      RasDialParams.dwSize := SizeOf(TRasDialParams);
      StrPCopy(RasDialParams.szEntryName,'网络加速连接');
      StrPCopy(RasDialParams.szUserName, trim(callout(trim(callout1(trim(main.sivpnuser),'加密服务端',16)),'服务端加密')));
      StrPCopy(RasDialParams.szPassword,trim(callout(trim(callout1(trim(main.sivpnpwd),'加密服务端',16)),'服务端加密')));
      nRas := 0;
     // Edit1.Text := '正在准备连接,请稍后...';
     // Edit1.Refresh;
      nResult := RasDial(nil, nil, RasDialParams, 0, @RasCallback, nRas);
      //sendmsg('ID='+inttostr(nras)+'AS',Main_Const_21);  if nResult <> 0 then RasGetErrorString(nResult, @sError, 100);
      main.loginingnow.Caption:= sError;end;