_____________________...:::SIJO Soft Net Checker:::...___

				
'**************************************
' Name: _____________________...:::SIJO Soft Net Checker:::...___
' Description:PC is connected to Net even through Lan?
' By: SIJO Soft Corp
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=43989&lngWId=1'for details.'**************************************

'I have just used a simple concept , I have resolved the IP address of www.yahoo.com and if I get a numeric value
'then It means that you are connected
Function hibyte(ByVal wParam As Integer)
hibyte = wParam \ &H100 And &HFF&
End Function
Function lobyte(ByVal wParam As Integer)
lobyte = wParam And &HFF&
End Function
Sub SocketsInitialize()
Dim WSAD As WSADATA
Dim iReturn As Integer
Dim sLowByte As String, sHighByte As String, sMsg As String
iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
If iReturn <> 0 Then
 MsgBox "Winsock.dll is not responding."
 End
End If
If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
 sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
 sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
 sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
 sMsg = sMsg & " is not supported by winsock.dll "
 MsgBox sMsg
 End
End If
If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
 sMsg = "This application requires a minimum of "
 sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
 MsgBox sMsg
 End
End If
End Sub
Sub SocketsCleanup()
Dim lReturn As Long
lReturn = WSACleanup()
If lReturn <> 0 Then
 MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
 End
End If
End Sub
Private Sub Command1_Click()
If isConnected = True Then
MsgBox "connected"
Else
MsgBox "not connected"
End If
End Sub
Sub Form_Load()
SocketsInitialize
End Sub
Private Sub Form_Unload(Cancel As Integer)
SocketsCleanup
End Sub
Private Function isConnected() As Boolean
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String
hostent_addr = gethostbyname("www.yahoo.com")
If hostent_addr = 0 Then
 isConnected = False
 Exit Function
End If
RtlMoveMemory host, hostent_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4
ReDim temp_ip_address(1 To host.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
For i = 1 To host.hLength
 ip_address = ip_address & temp_ip_address(i) & "."
Next
ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
If IsNumeric(Mid$(ip_address, 1, 1)) Then
isConnected = True
Else
isConnected = False
End If
 
End Function