'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 |