VB creates a dial-up connection, performs dial-up, and disconnects the dial-up operation

Private declare sub copymemory lib "Kernel32" alias "rtlmovememory" (destination as any, source as any, byval length as long)

'Dial-up/network disconnection
Private declare function internetdial lib "wininet. dll" (byval hwndparent as long, byval lpszconnectoid as string, byval dwflags as long, lpdwconnection as long, byval dwreserved as long) as long
Private declare function internethangup lib "wininet. dll" (byval dwconnection as long, byval dwreserved as long) as long
Private declare function internetautodial lib "wininet. dll" (byval dwflags as long, byval dwreserved as long) as long
Private declare function internetautodialhangup lib "wininet. dll" (byval dwreserved as long) as long
Private const internet_dialstate_disconnected = 1
Private const internet_autodial_force_online = 1
Private const internet_autodial_force_unattended = 2
Private const internet_dial_unattended = & h8000
Private handle as long

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
Szergonomic ename (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 const et_none as long = 0' no encryption
Private const et_require as long = 1 'require Encryption
Private const et_requiremax as long = 2 'require Max Encryption
Private const et_optional as long = 3 'do encryption if possible. None OK.

Private const vs_default as long = 0 'default (PPTP for now)
Private const vs_pptponly as long = 1' only PPTP is attempted.
Private const vs_pptpfirst as long = 2 'pptp is tried first.
Private const vs_l2tponly as long = 3' only L2TP is attempted.
Private const vs_l2tpfirst as long = 4 'l2tp is tried first.

Private const raset_phone as long = 1 'phone lines: Modem, ISDN, X.25, etc
Private const raset_vpn as long = 2 'virtual Private Network
Private const raset_direct as long = 3 'direct CONNECT: serial, parallel
Private const raset_internet as long = 4' Basecamp Internet
Private const raset_broadband as long = 5' broadband

Private declare function rassetentryproperties lib "rasapi32" alias "alias" (byval encoded 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 "login" (byval lpszphonebook as string, byval lpszentry as string, lpcredentials as rascredentials, byval fclearcredentials as long) as long

Private sub commandementclick ()
Call dialup ("htpppoe ")
End sub

Private sub command2_click ()
Call hangup
End sub

Private sub form_load ()
Dim sentryname as string, susername as string, spassword as string

Goto pppoe

Pppoe:
'Create pppoe
Sentryname = "htpppoe"
Susername = "wangwb"
Spassword = "123"

If create_pppoe_connection (sentryname, susername, spassword) then
Msgbox "Connection established successfully! "
Else
Msgbox "connection setup failed! "
End if

'Vpn:
''Create a VPN
'Dim sserver as string
'Sserver = "10.1.32.98" 'or use the domain name sserver = "www.myserver.com"
'Sentryname = "VPN connection"
'Susername = "super"
'Spassword = "greenbean"
'
'If create_vpn_connection (sentryname, sserver, susername, spassword) then
The 'msgbox' connection is established successfully! "
'Else
An error occurred while establishing the 'msgbox' connection! "
'End if
End sub

Function create_pppoe_connection (byval sentryname as string, byval susername as string, byval spassword as string) as Boolean
Create_pppoe_connection = false

Dim re as rasentry
Dim sdevicename as string, sdevicetype as string
Sdevicename = "Wan micro port (pppoe )"
Sdevicetype = "pppoe"
With re
. Dwsize = lenb (re)
. Dwcountrycode = 86
. Dwcountryid = 86
. Dwdialextrapercent = 75
. Dwdialextrasampleseconds = 120
. Dwdialmode = 1
. Dwencryptiontype = 3
. Dwfnetprotocols = 4
. DwF Options = 1024262928
. Dwfoptions2 = 367
. Dwframingprotocol = 1
. Dwhangupextrapercent = 10
. Dwhangupextrasampleseconds = 120
. Dwredialcount = 3
. Dwredialpause = 60
. Dwtype = raset_broadband
Copymemory. szdevicename (0), byval sdevicename, Len (sdevicename)
Copymemory. szdevicetype (0), byval sdevicetype, Len (sdevicetype)
End

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

Dim RTN as long
If rassetentryproperties (vbnullstring, sentryname, re, lenb (RE), 0, 0) = 0 then
If rassetcredentials (vbnullstring, sentryname, RC, 0) = 0 then
Create_pppoe_connection = true
End if
End if
End Function
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 micro port (L2TP )"
Sdevicetype = "VPN"
With re
. Dwsize = lenb (re)
. Dwcountrycode = 86
. Dwcountryid = 86
. Dwdialextrapercent = 75
. Dwdialextrasampleseconds = 120
. Dwdialmode = 1
. Dwfnetprotocols = 4
. DwF Options = 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) 'server address
. Dwvpnstrategy = vs_default 'vpn type
. Dwencryptiontype = et_optional 'data encryption type
End

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

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

'Dialing
Public Function dialup (linkname as string) as Boolean
Internetdial 0, linkname, internet_autodial_force_unattended, handle, 0
Dialup = (handle <> 0)
End Function
'Network disconnection
Public sub hangup ()
If handle <> 0 then
Internethangup handle, 0
Handle = 0
End if
End sub

 

After searching for the Internet for a long time, I sorted it out, and the debugging was successful. There is still a problem, that is, the connection can be hung up, but the link cannot be deleted. I am looking for a solution.