اخواني هذا الكود
Private Const MAX_WSADescription = 256 Private Const MAX_WSASYSStatus = 128 Private Const ERROR_SUCCESS As Long = 0 Private Const WS_VERSION_REQD As Long = &H101 Private Const WS_VERSION_MAJOR As Long = _ WS_VERSION_REQD \ &H100 And &HFF& Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF& Private Const MIN_SOCKETS_REQD As Long = 1 Private Const SOCKET_ERROR As Long = -1 Private Type HOSTENT hName As Long hAliases As Long hAddrType As Integer hLen As Integer hAddrList As Long End Type Private Type WSADATA wVersion As Integer wHighVersion As Integer szDescription(0 To MAX_WSADescription) As Byte szSystemStatus(0 To MAX_WSASYSStatus) As Byte wMaxSockets As Integer wMaxUDPDG As Integer dwVendorInfo As Long End Type Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long Private Declare Function WSAStartup Lib "WSOCK32.DLL" _ (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long Private Declare Function gethostname Lib "WSOCK32.DLL" _ (ByVal szHost As String, ByVal dwHostLen As Long) As Long Private Declare Function gethostbyname Lib "WSOCK32.DLL" _ (ByVal szHost As String) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long) Private Function GetIPAddress() As String Dim sHostName As String * 256 Dim lpHost As Long Dim HOST As HOSTENT Dim dwIPAddr As Long Dim tmpIPAddr() As Byte Dim i As Integer Dim sIPAddr As String If Not SocketsInitialize() Then GetIPAddress = "" Exit Function End If If gethostname(sHostName, 256) = SOCKET_ERROR Then GetIPAddress = "" MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _ " has occurred. Unable to successfully get Host Name." SocketsCleanup Exit Function End If sHostName = Trim$(sHostName) lpHost = gethostbyname(sHostName) If lpHost = 0 Then GetIPAddress = "" MsgBox "Windows Sockets are not responding. " & _ "Unable to successfully get Host Name." SocketsCleanup Exit Function End If CopyMemory HOST, lpHost, Len(HOST) CopyMemory dwIPAddr, HOST.hAddrList, 4 ReDim tmpIPAddr(1 To HOST.hLen) CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen For i = 1 To HOST.hLen sIPAddr = sIPAddr & tmpIPAddr(i) & "." Next GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1) SocketsCleanup End Function Private Function GetIPHostName() As String Dim sHostName As String * 256 If Not SocketsInitialize() Then GetIPHostName = "" Exit Function End If If gethostname(sHostName, 256) = SOCKET_ERROR Then GetIPHostName = "" MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _ " has occurred. Unable to successfully get Host Name." SocketsCleanup Exit Function End If GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1) SocketsCleanup End Function Private Function HiByte(ByVal wParam As Integer) HiByte = wParam \ &H100 And &HFF& End Function Private Function LoByte(ByVal wParam As Integer) LoByte = wParam And &HFF& End Function Private Sub SocketsCleanup() If WSACleanup() <> ERROR_SUCCESS Then MsgBox "Socket error occurred in Cleanup." End If End Sub Private Function SocketsInitialize() As Boolean Dim WSAD As WSADATA Dim sLoByte As String Dim sHiByte As String If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then MsgBox "The 32-bit Windows Socket is not responding." SocketsInitialize = False Exit Function End If If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then MsgBox "This application requires a minimum of " & _ CStr(MIN_SOCKETS_REQD) & " supported sockets." SocketsInitialize = False Exit Function End If If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _ (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _ HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then sHiByte = CStr(HiByte(WSAD.wVersion)) sLoByte = CStr(LoByte(WSAD.wVersion)) MsgBox "Sockets version " & sLoByte & "." & sHiByte & _ " is not supported by 32-bit Windows Sockets." SocketsInitialize = False Exit Function End If SocketsInitialize = True End Function 'Insert this code to your form: Private Sub Form_Load() MsgBox "IP Host Name: " & GetIPHostName() MsgBox "IP Address: " & GetIPAddress() End Sub
يأتي بال ip من الجهاز اذا فاذا كنت عضو في شبكة lan او تستخدم adsl فلن تحصل على الاي بي الصحيح لك و لكي تحصل علية عليك دخول احد المواقع كهذة http://www.mediacollege.com/internet/utilities/show-ip.shtml لكي تعرف الاي بي الحقيقي الخاص بك
فما هو الكود الذي يمكني من عرض الاي بي الحقيقي من داخل برنامجي