ConnectNetwork




'call IsPcAll to connect

'call ispHaNguP to disconnect

'call IsConnected to get connected state..returns true/false


Public hRasConnected As Long
'Declarations for checking active Internet-connection

Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32
Public Const RAS95_MaxParamKey = 32
Public Const RAS95_MaxParamValue = 128
Public Const RAS95_MaxPhoneNumber = 128
Public Const RAS95_MaxCallbackNumber = 48
Public Const UNLEN = 21
Public Const PWLEN = 14
Public Const DNLEN = 15

Public Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Public Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Public Type RASDIALPARAMS
dwSize As Long
szEntryName(RAS95_MaxEntryName + 1) As Byte
szPhoneNumber(RAS95_MaxPhoneNumber + 1) As Byte
szCallbackNumber(RAS95_MaxCallbackNumber + 1) As Byte
szUserName(UNLEN + 1) As Byte
szPassword(PWLEN + 1) As Byte
szDomain(DNLEN + 1) As Byte
End Type

Public Const RASCS_DONE = &H2000
Public Const RASCS_Connected = RASCS_DONE
Public Const RASCS_Disconnected = RASCS_DONE + 1
Public Const RASCS_PAUSED = &H1000
Public Const RASCS_OpenPort = 0
Public Const RASCS_PortOpened = 1
Public Const RASCS_ConnectDevice = 2
Public Const RASCS_DeviceConnected = 3
Public Const RASCS_AllDevicesConnected = 4

Public Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long

Public Declare Function RasGetConnectStatus Lib "rasapi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long

Public Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal RasExtension As Any, ByVal lpszPhonebookPath As Any, lpRasDialParams As RASDIALPARAMS, ByVal TypeHandleNotifier As Long, ByVal hWndNotifier As Long, hRasConn As Long) As Long

Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long

'End of RAS-declarations'reg functions


Public Const HKEY_CURRENT_USER = &H80000001

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal
hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public retval As Variant

Public Function GetiSPnaMe(keyroot As Long, subkey As String, valname As
String)
Const KEY_ALL_ACCESS As Long = &HF00e'
Const ERROR_SUCCESS As Long = 0
Const REG_SZ As Long = 1

Dim hsubkey As Long, dwtype As Long, sz As Long
Dim R As Long
R = RegOpenKeyEx(keyroot, subkey, 0, KEY_ALL_ACCESS, hsubkey)
sz = 256
v$ = String$(sz, 0)
R = RegQueryValueEx(hsubkey, valname, 0, dwtype, ByVal v$, sz)
If R = ERROR_SUCCESS And dwtype = REG_SZ Then
retval = Left$(v$, sz)
'''Debug.Print retval

GetiSPnaMe = retval
Else
retval = "wahhhhh"
End If
R = RegCloseKey(hsubkey)
End Function

Public Function IsConnected() As Boolean

Dim TRasCon(255) As RASCONN95
Dim lg As Long, hMenu As Long, hSubMenu As Long
Dim lpcon As Long
Dim retval As Long
Dim Tstatus As RASCONNSTATUS95

TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize

retval = RasEnumConnections(TRasCon(0), lg, lpcon)
If retval <> 0 Then
MsgBox "ERROR"
Exit Function
End If

Tstatus.dwSize = 160
retval = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = RASCS_Connected Then
IsConnected = True
'Save the RAS-handle for the active connection

hRasConnected = TRasCon(0).hRasCon

Else
IsConnected = False
End If

End Function

Public Function CloseConnection() As Integer

Dim Result As Long

On Error GoTo ErrHandler

CloseConnection = False
Result = RasHangUp(hRasConnected)
If Result = 0 Then
CloseConnection = True
End If

Exit Function

ErrHandler:
CloseConnection = False
Exit Function

End Function

Public Function IsPcAll()
Dim iSpConN As String
iSpConN = GetiSPnaMe(HKEY_CURRENT_USER, "RemoteAccess", "Default")
If iSpConN <> "wahhhhh" Then
Dim X
X = Shell("rundll32.exe rnaui.dll,RnaDial " & iSpConN, 1)
DoEvents
SendKeys "{enter}", True
End If

End Function

Public Function ispHaNguP()
Dim z As Boolean
z = IsConnected
If z = True Then
CloseConnection
End If
End Function










( connectnetwork.html )- by Paolo Puglisi - Modifica del 17/12/2023