by Dr Morphin (8 Submissions)
Category: Internet/HTML
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Sat 20th October 2007
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Get Remote IP Address From HTTP Force
API Declarations
'Your Fomrs named [ IPFORM ]
VBcoders
' Author Dr Morphin
' Email me : [email protected]
' Get Local IP Address and HTTP Win Header
' Shout'z Be Enough
' Date Create 20 October 2007
'====================================
Option Explicit
Dim Moving As Boolean 'X Melta
Dim mX As Long 'Y Clash
Dim mY As Long 'MY True
Private Sub Command1_Click()
Dim lngPtrToHOSTENT As Long
Dim udtHostent As HOSTENT ' Local IP
Dim lngPtrToIP As Long ' Convert
Dim arrIpAddress() As Byte
Dim strIpAddress As String
'
'----------------------------------------------------
IP.Clear
lngPtrToHOSTENT = gethostbyname(Trim$(Text1.Text))
If lngPtrToHOSTENT = 0 Then
ShowErrorMsg (Err.LastDllError)
Else
RtlMoveMemory udtHostent, lngPtrToHOSTENT, LenB(udtHostent)
RtlMoveMemory lngPtrToIP, udtHostent.hAddrList, 4
Do Until lngPtrToIP = 0
ReDim arrIpAddress(1 To udtHostent.hLength)
RtlMoveMemory arrIpAddress(1), lngPtrToIP, udtHostent.hLength
For i = 1 To udtHostent.hLength
strIpAddress = strIpAddress & arrIpAddress(i) & "."
Next
strIpAddress = Left$(strIpAddress, Len(strIpAddress) - 1)
IP.AddItem strIpAddress
strIpAddress = ""
udtHostent.hAddrList = udtHostent.hAddrList + LenB(udtHostent.hAddrList)
RtlMoveMemory lngPtrToIP, udtHostent.hAddrList, 4
'
Loop
'
End If
'
End Sub
Private Sub Form_Activate()
Text1.SetFocus
End Sub
Private Sub Form_Load()
IPFORM.Height = 3975
'
Dim lngRetVal As Long
Dim strErrorMsg As String
Dim udtWinsockData As WSAData
Dim lngType As Long
Dim lngProtocol As Long
'
lngRetVal = WSAStartup(&H101, udtWinsockData)
'
If lngRetVal <> 0 Then
'
'
Select Case lngRetVal
Case WSASYSNOTREADY
strErrorMsg = "The underlying network subsystem is not " & _
"ready for network communication."
Case WSAVERNOTSUPPORTED
strErrorMsg = "The version of Windows Sockets API support " & _
"requested is not provided by this particular " & _
"Windows Sockets implementation."
Case WSAEINVAL
strErrorMsg = "The Windows Sockets version specified by the " & _
"application is not supported by this DLL."
End Select
'
MsgBox strErrorMsg, vbCritical
'
End If
'
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call WSACleanup
End Sub
Private Sub ShowErrorMsg(lngError As Long)
'
Dim strMessage As String
'
Select Case lngError
Case WSANOTINITIALISED
strMessage = "A successful WSAStartup call must occur " & _
"before using this function."
Case WSAENETDOWN
strMessage = "The network subsystem has failed."
Case WSAHOST_NOT_FOUND
strMessage = "Authoritative answer host not found."
Case WSATRY_AGAIN
strMessage = "Nonauthoritative host not found, or server failure."
Case WSANO_RECOVERY
strMessage = "A nonrecoverable error occurred."
Case WSANO_DATA
strMessage = "Record Not Found"
Case WSAEINPROGRESS
strMessage = "A blocking Windows Sockets 1.1 call is in " & _
"progress, or the service provider is still " & _
"processing a callback function."
Case WSAEFAULT
strMessage = "The name parameter is not a valid part of " & _
"the user address space."
Case WSAEINTR
strMessage = "A blocking Windows Socket 1.1 call was " & _
"canceled through WSACancelBlockingCall."
End Select
'
MsgBox strMessage, vbExclamation
'
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
