• Home
 · 
• Internet/HTML
 · 
• Get Remote IP Address From HTTP Force

Get Remote IP Address From HTTP Force

Get Remote IP Address From HTTP Force

API Declarations


'Your Fomrs named [ IPFORM ]



Rate Get Remote IP Address From HTTP Force

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

' 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