'Make one List as named [ IP ] 'Your Fomrs named [ IPFORM ]

' Get IP Forced as HTTP Win ' Author Dr Morphin ' Email me : Dr_M0rphin@yahoo.com ' 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