Архив форумов ЦИТФорума

[TV]

Если не трудно, то примерчиком.

[Stan]

Используй API-функции: gethostbyname, gethostname

Например, на VB это будет выглядеть так:

' Форма
Private Sub Form_Load()
MsgBox "IP-address: " + GetIPAddr
End Sub

' Модуль
Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type

Declare Function gethostname Lib "WSOCK32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Declare Function gethostbyname Lib "WSOCK32" (ByVal szHost As String) As Long
Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Function GetIPAddr() 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 gethostname(sHostName, 256) = -1 Then
MsgBox "Unable to successfully get Host Name."
GetIPAddr = ""
Exit Function
End If

sHostName = Trim$(sHostName)
lpHost = gethostbyname(sHostName)
If lpHost = Then
MsgBox "Unable to successfully get Host Name."
GetIPAddr = ""
Exit Function
End If

CopyMemoryIP HOST, lpHost, Len(HOST)
CopyMemoryIP dwIPAddr, HOST.hAddrList, 4
ReDim tmpIPAddr(1 To HOST.hLen)
CopyMemoryIP tmpIPAddr(1), dwIPAddr, HOST.hLen
For I = 1 To HOST.hLen
sIPAddr = sIPAddr & tmpIPAddr(I) & "."
Next
GetIPAddr = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
End Function

[Stan]

На самом деле модуль должен выглядеть так!

' Модуль
Public Const WS_VERSION_REQD As Long = &H101
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128

Public 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

Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type

Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long
Declare Function gethostname Lib "WSOCK32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Declare Function gethostbyname Lib "WSOCK32" (ByVal szHost As String) As Long
Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Function GetIPAddr() As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As HOSTENT
Dim WSAD As WSAData

Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim I As Integer
Dim sIPAddr As String
Dim a As Boolean

Call WSAStartup(WS_VERSION_REQD, WSAD)

If gethostname(sHostName, 256) = -1 Then
MsgBox "Unable to successfully get Host Name."
GetIPAddr = ""
Exit Function
End If

sHostName = Trim$(sHostName)
lpHost = gethostbyname(sHostName)
If lpHost = Then
MsgBox "Unable to successfully get Host Name."
GetIPAddr = ""
Exit Function
End If

CopyMemoryIP HOST, lpHost, Len(HOST)
CopyMemoryIP dwIPAddr, HOST.hAddrList, 4
ReDim tmpIPAddr(1 To HOST.hLen)
CopyMemoryIP tmpIPAddr(1), dwIPAddr, HOST.hLen
For I = 1 To HOST.hLen
sIPAddr = sIPAddr & tmpIPAddr(I) & "."
Next
GetIPAddr = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
End Function