Pc'ns IP-adresse

Jeg anbefaler at du download API-guide, der er meget hjælp at hente
http://www.mentalis.org/agnet/apiguide.shtml

Eksempel fra API-guide:
//Public Function GetIPAddress() As String

'In a form
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    MsgBox "IP-address: " + GetIPAddress
End Sub
'In a module
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Public Const SOCKET_ERROR As Long = -1
Public Const WSADESCRIPTION_LEN = 257
Public Const WSASYS_STATUS_LEN = 129
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
Type WSADataInfo
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSADESCRIPTION_LEN
    szSystemStatus As String * WSASYS_STATUS_LEN
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As String
End Type
Public Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLen As Integer
    hAddrList As Long
End Type
Declare Function WSAStartupInfo Lib "WSOCK32" Alias "WSAStartup" (ByVal wVersionRequested As Integer, lpWSADATA As WSADataInfo) As Long
Declare Function WSACleanup Lib "WSOCK32" () As Long
Declare Function WSAGetLastError Lib "WSOCK32" () As Long
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)
Public 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
    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
    GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
    SocketsCleanup
End Function
Public 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
Public Function HiByte(ByVal wParam As Integer)
    HiByte = wParam \ &H100 And &HFF&
End Function
Public Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF&
End Function
Public Sub SocketsCleanup()
    If WSACleanup() <> ERROR_SUCCESS Then
        MsgBox "Socket error occurred in Cleanup."
    End If
End Sub
Public 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
    'must be OK, so lets do it
    SocketsInitialize = True
End Function

Nå ja, der står jo en URL i eksemplet http://www.allapi.net/

UPS, det var da noget af een kode, men den giver fejl når den køres.
mvh
alj

Der er et lidt simplere eksempel i samme program:
(jeg har ikke selv prøvet noget af det, men du kan nok få hjælp her (evt. i et nyt spørgsmål, der er vist ikke andre der deltager her)

'This project requires the following components:
' - a form (Form1) with a textbox (Text1, Multiline=True)
'  and a command button (Command1)
' - a module (Module1)

'in Form1:
Private Sub Command1_Click()
    Module1.Start
End Sub

'In Module1:

'******************************************************************
'Created By Verburgh Peter.
' 07-23-2001
' verburgh.peter@skynet.be
'-------------------------------------
'With this small application , you can detect the IP's installed on your computer,
'including subnet mask , BroadcastAddr..
'
'I've wrote this because i've a programm that uses the winsock control, but,
'if you have multiple ip's  installed on your pc , you could get by using the Listen
' method the wrong ip ...
'Because Winsock.Localip => detects the default ip installed on your PC ,
' and in most of the cases it could be the LAN (nic) not the WAN (nic)
'So then you have to use the Bind function ,to bind to your right ip..
'but how do you know & find that ip ?
'you can find it now by this appl.. it check's in the api.. IP Table..
'******************************************************************


Const MAX_IP = 5  'To make a buffer... i dont think you have more than 5 ip on your pc..

Type IPINFO
    dwAddr As Long  ' IP address
    dwIndex As Long '  interface index
    dwMask As Long ' subnet mask
    dwBCastAddr As Long ' broadcast address
    dwReasmSize  As Long ' assembly size
    unused1 As Integer ' not currently used
    unused2 As Integer '; not currently used
End Type

Type MIB_IPADDRTABLE
    dEntrys As Long  'number of entries in the table
    mIPInfo(MAX_IP) As IPINFO  'array of IP address entries
End Type

Type IP_Array
    mBuffer As MIB_IPADDRTABLE
    BufferLen As Long
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Sub main()
Form1.Show
End Sub

'converts a Long  to a string
Public Function ConvertAddressToString(longAddr As Long) As String
    Dim myByte(3) As Byte
    Dim Cnt As Long
    CopyMemory myByte(0), longAddr, 4
    For Cnt = 0 To 3
        ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
    Next Cnt
    ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function

Public Sub Start()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE

Form1.Text1 = ""

On Error GoTo END1
    GetIpAddrTable ByVal 0&, Ret, True

    If Ret <= 0 Then Exit Sub
    ReDim bBytes(0 To Ret - 1) As Byte
    'retrieve the data
    GetIpAddrTable bBytes(0), Ret, False
     
    'Get the first 4 bytes to get the entry's.. ip installed
    CopyMemory Listing.dEntrys, bBytes(0), 4
    'MsgBox "IP's found : " & Listing.dEntrys    => Founded ip installed on your PC..
    Form1.Text1 = Listing.dEntrys & "  IP addresses found on your PC !!" & vbCrLf
    Form1.Text1 = Form1.Text1 & "----------------------------------------" & vbCrLf
    For Tel = 0 To Listing.dEntrys - 1
        'Copy whole structure to Listing..
      ' MsgBox bBytes(tel) & "."
        CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
        Form1.Text1 = Form1.Text1 & "IP address                  : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
        Form1.Text1 = Form1.Text1 & "IP Subnetmask            : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf
        Form1.Text1 = Form1.Text1 & "BroadCast IP address  : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf
        Form1.Text1 = Form1.Text1 & "**************************************" & vbCrLf
    Next

'MsgBox ConvertAddressToString(Listing.mIPInfo(1).dwAddr)
Exit Sub
END1:
MsgBox "ERROR"
End Sub

Hejsa "stefanfuglsang",
tak mange gange, prøver den sidste også, men har valgt at "do-it-the-old-way" via dos og derefter indlæsning i Excel.
mvh
alj