Detecte sin internet-ip HVER GANG ?

Åben en dos promt og skriv Route Print
Den sidste af de 4 kolonner indeholder din interne ip adresse

det skal jo detectes via VB.. jeg skal bruge det i et program..

Her kommer en l-a-n-g bid kode:

Forberedelser:
  lav en formular, og tilføj følgende elementer:
  1 knap \"Kommandoknap0\"
  1 Tekstboks \"CompName\"
  1 Liste \"IPAdr\"

Kode:

Option Compare Database
Option Explicit

Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \\ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128

Private Type HOSTENT
  hName As Long
  hAliases As Long
  hAddrType As Integer
  hLength As Integer
  hAddrList As Long
End Type
 
Private Type WSADATA
  wversion As Integer
  wHighVersion As Integer
  szDescription(0 To WSADescription_Len) As Byte
  szSystemStatus(0 To WSASYS_Status_Len) As Byte
  iMaxSockets As Integer
  iMaxUdpDg As Integer
  lpszVendorInfo As Long
End Type
 
Private Declare Function WSAGetLastError Lib \"WSOCK32.DLL\" () As Long
Private Declare Function WSAStartup Lib \"WSOCK32.DLL\" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib \"WSOCK32.DLL\" () As Long
Private Declare Function gethostname Lib \"WSOCK32.DLL\" (ByVal hostname$, ByVal HostLen As Long) As Long
Private Declare Function gethostbyname Lib \"WSOCK32.DLL\" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib \"Kernel32\" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)
Private Declare Function GetTickCount Lib \"kernel32.dll\" () As Long

Function hibyte(ByVal wParam As Integer)
  hibyte = wParam \\ &H100 And &HFF&
End Function
 
Function lobyte(ByVal wParam As Integer)
  lobyte = wParam And &HFF&
End Function

Sub SocketsInitialize()
  Dim WSAD As WSADATA
  Dim iReturn As Integer
  Dim sLowByte As String, sHighByte As String, sMsg As String
  iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
  If iReturn <> 0 Then
    MsgBox \"Winsock.dll is not responding.\"
    End
  End If
  If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
    sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
    sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
    sMsg = \"Windows Sockets version \" & sLowByte & \".\" & sHighByte
    sMsg = sMsg & \" is not supported by winsock.dll \"
    MsgBox sMsg
    End
  End If
  \'iMaxSockets is not used in winsock 2. So the following check is only
  \'necessary for winsock 1. If winsock 2 is requested,
  \'the following check can be skipped.
  If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
    sMsg = \"This application requires a minimum of \"
    sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & \" supported sockets.\"
    MsgBox sMsg
    End
  End If
End Sub
 
Sub SocketsCleanup()
  Dim lReturn As Long
  lReturn = WSACleanup()
  If lReturn <> 0 Then
    MsgBox \"Socket error \" & Trim$(Str$(lReturn)) & \" occurred in Cleanup \"
    End
  End If
End Sub

Sub Form_Load()
  SocketsInitialize
End Sub

Private Sub Form_Unload(Cancel As Integer)
  SocketsCleanup
End Sub

Private Sub Kommandoknap0_Click()
On Error GoTo Err_Kommandoknap0_Click
  Dim X As Long: X = GetTickCount
  Dim hostname As String * 256
  Dim hostent_addr As Long
  Dim host As HOSTENT
  Dim hostip_addr As Long
  Dim temp_ip_address() As Byte
  Dim i As Integer
  Dim ip_address As String
  If gethostname(hostname, 256) = SOCKET_ERROR Then
    MsgBox \"Windows Sockets error \" & Str(WSAGetLastError())
    Exit Sub
  Else
    hostname = Trim$(hostname)
  End If
  hostent_addr = gethostbyname(hostname)
  If hostent_addr = 0 Then
    MsgBox \"Winsock.dll is not responding.\"
    Exit Sub
  End If
  RtlMoveMemory host, hostent_addr, LenB(host)
  RtlMoveMemory hostip_addr, host.hAddrList, 4
  CompName = hostname
  \'get all of the IP address if machine is  multi-homed
  IPAdr.RowSource = \"\"
  Do
    ReDim temp_ip_address(1 To host.hLength)
    RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
    For i = 1 To host.hLength
      ip_address = ip_address & temp_ip_address(i) & \".\"
    Next
    ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
    IPAdr.RowSource = IPAdr.RowSource & ip_address & \";\"
    ip_address = \"\"
    host.hAddrList = host.hAddrList + LenB(host.hAddrList)
    RtlMoveMemory hostip_addr, host.hAddrList, 4
  Loop While (hostip_addr <> 0)
Exit_Kommandoknap0_Click:
  MsgBox Format((GetTickCount - X) / 1000, \"0.000\"), vbOKOnly, \"Seconds\"
  Exit Sub
Err_Kommandoknap0_Click:
  MsgBox Err.Description
  Resume Exit_Kommandoknap0_Click
End Sub



Jeg har \"lånt\" den på nettet, den er ikke særlig dokumenteret men den virker...

nopes..
det der er oxo Winsock..
da jeg prøvede den fandt den igen min netværks ip.. desværre :((

Ja, men hvis du er koblet \"op\" til nettet via modem, ville min løsning OGSÅ give den \"tildelte\" IP adresse...

Det vil sige: listen fyldes op med ALLE de IP adresser computeren er tildelt... og da du kender din netværks-adresse, kan du udelukke denne, og derefter bruge den eller de andre..


Hvis du går på internettet via netværk og gennem en firewall, mener jeg (som ikke er netværks-teknikker) at du ikke kan se IP-adressen... :-(

hm...
jeg er bag firewall..
men på andre computere hvor de fx. har en skiftende IP-adresse, finder den oxo netværksip\'en :O(
men det må da kunne gøres på en eller anden måde..
på hjemmesider kan man gøre sådan at man kan se det.. hvorfor så ikke i et program?
og ellers kunne man så ikke gøre noget med at den gik ind på en HP (php-side) hvor den skrev IP\'en, og så hentede den det derfra?

Grunden til at du kan gøre det på nettet er af den simple grund at en browser er på en maskine der har fået tildelt en ip adresse. Denne browser henveder sig til en web server med information om hvme der spørger samt hvor siden skal returneres tilbage til(header information), denne information bliver givet i forma af en ip adresse.
derfor kan man på serveren direkte få adgang til ipadressen.
Det er jo slet ikke samme sag du har gang i her, godt nok handler begge ting om netværk, men så ophører ligheden også.

kedde

tjo..
for jeg er ved at finde ud af hvordan man med en winsock-control kan gå ind og hente informationen på internettet.. dvs, at den kører et PHP-script på internettet, og så henter VB det..
nogen der ved hvordan man gør det? husk; det SKAL være med winsock.. ikke den der Inet

Det du gør at at lave php skrive ip adressen ned til en textfil på serveren, og så skal du bare have adgang til den textfil fra VB.

nej..
jeg ska ha adgang til .php-filen .

Nu må du endelig rette mig hvis jeg tager fejl, men jeg mener nu ikke du kan få noget som helst nyttigt ud af at kontakte php filen. Godt nok er det smart , meeeeen php siden kan da ikke returnere data til din vb pplication.

jo..
med den der inetcontrol kan du få outputtet af php-filen og outputtet kan jeg godt få til at være ens ip ..
men jeg må højst bruge winsock-controllen..
altså.. en slags browser hvis du forstår? der går ind på php-filen... og får ip\'en

Okay nu tror jeg at jeg har den.... dette er gennem testet hos mig og nogle andre PC\'er hvis det ikke giver den rigtige IP hos dig er der noget galt med din connection eller PC..... Okay :) her kommer den Laaaaaange kode......

forresten så er det ikke mig der har lavet den med det er vel et fedt...

Public Const MAX_HOSTNAME_LEN = 132
Public Const MAX_DOMAIN_NAME_LEN = 132
Public Const MAX_SCOPE_ID_LEN = 260
Public Const MAX_ADAPTER_NAME_LENGTH = 260
Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132
Public Const ERROR_BUFFER_OVERFLOW = 111
Public Const MIB_IF_TYPE_ETHERNET = 1
Public Const MIB_IF_TYPE_TOKENRING = 2
Public Const MIB_IF_TYPE_FDDI = 3
Public Const MIB_IF_TYPE_PPP = 4
Public Const MIB_IF_TYPE_LOOPBACK = 5
Public Const MIB_IF_TYPE_SLIP = 6

Type IP_ADDR_STRING
            Next As Long
            IpAddress As String * 16
            IpMask As String * 16
            Context As Long
End Type

Type IP_ADAPTER_INFO
            Next As Long
            ComboIndex As Long
            AdapterName As String * MAX_ADAPTER_NAME_LENGTH
            Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
            AddressLength As Long
            Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
            Index As Long
            Type As Long
            DhcpEnabled As Long
            CurrentIpAddress As Long
            IpAddressList As IP_ADDR_STRING
            GatewayList As IP_ADDR_STRING
            DhcpServer As IP_ADDR_STRING
            HaveWins As Boolean
            PrimaryWinsServer As IP_ADDR_STRING
            SecondaryWinsServer As IP_ADDR_STRING
            LeaseObtained As Long
            LeaseExpires As Long
End Type

Type FIXED_INFO
            HostName As String * MAX_HOSTNAME_LEN
            DomainName As String * MAX_DOMAIN_NAME_LEN
            CurrentDnsServer As Long
            DnsServerList As IP_ADDR_STRING
            NodeType As Long
            ScopeId  As String * MAX_SCOPE_ID_LEN
            EnableRouting As Long
            EnableProxy As Long
            EnableDns As Long
End Type

Public Declare Function GetNetworkParams Lib \"IPHlpApi\" (FixedInfo As Any, pOutBufLen As Long) As Long
Public Declare Function GetAdaptersInfo Lib \"IPHlpApi\" (IpAdapterInfo As Any, pOutBufLen As Long) As Long
Public Declare Sub CopyMemory Lib \"kernel32\" Alias \"RtlMoveMemory\" (Destination As Any, Source As Any, ByVal Length As Long)


Sub main()
    Dim error As Long
    Dim FixedInfoSize As Long
    Dim AdapterInfoSize As Long
    Dim i As Integer
    Dim PhysicalAddress  As String
    Dim NewTime As Date
    Dim AdapterInfo As IP_ADAPTER_INFO
    Dim Adapt As IP_ADAPTER_INFO
    Dim AddrStr As IP_ADDR_STRING
    Dim FixedInfo As FIXED_INFO
    Dim Buffer As IP_ADDR_STRING
    Dim pAddrStr As Long
    Dim pAdapt As Long
    Dim Buffer2 As IP_ADAPTER_INFO
    Dim FixedInfoBuffer() As Byte
    Dim AdapterInfoBuffer() As Byte
   
    \'Get the main IP configuration information for this machine using a FIXED_INFO structure
    FixedInfoSize = 0
    error = GetNetworkParams(ByVal 0&, FixedInfoSize)
    If error <> 0 Then
        If error <> ERROR_BUFFER_OVERFLOW Then
          MsgBox \"GetNetworkParams sizing failed with error \" & error
          Exit Sub
        End If
    End If
    ReDim FixedInfoBuffer(FixedInfoSize - 1)
   

    error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)
    If error = 0 Then
            CopyMemory FixedInfo, FixedInfoBuffer(0), Len(FixedInfo)
            MsgBox \"Host Name:  \" & FixedInfo.HostName
            MsgBox \"DNS Servers:  \" & FixedInfo.DnsServerList.IpAddress
            pAddrStr = FixedInfo.DnsServerList.Next
            Do While pAddrStr <> 0
                  CopyMemory Buffer, ByVal pAddrStr, Len(Buffer)
                  MsgBox \"DNS Servers:  \" & Buffer.IpAddress
                  pAddrStr = Buffer.Next
            Loop
           
            Select Case FixedInfo.NodeType
                      Case 1
                                  MsgBox \"Node type: Broadcast\"
                      Case 2
                                  MsgBox \"Node type: Peer to peer\"
                      Case 4
                                    MsgBox \"Node type: Mixed\"
                      Case 8
                                    MsgBox \"Node type: Hybrid\"
                      Case Else
                                    MsgBox \"Unknown node type\"
            End Select
           
            MsgBox \"NetBIOS Scope ID:  \" & FixedInfo.ScopeId
            If FixedInfo.EnableRouting Then
                      MsgBox \"IP Routing Enabled \"
            Else
                      MsgBox \"IP Routing not enabled\"
            End If
            If FixedInfo.EnableProxy Then
                      MsgBox \"WINS Proxy Enabled \"
            Else
                      MsgBox \"WINS Proxy not Enabled \"
            End If
            If FixedInfo.EnableDns Then
                      MsgBox \"NetBIOS Resolution Uses DNS \"
            Else
                      MsgBox \"NetBIOS Resolution Does not use DNS  \"
            End If
    Else
            MsgBox \"GetNetworkParams failed with error \" & error
            Exit Sub
    End If
   
    \'Enumerate all of the adapter specific information using the IP_ADAPTER_INFO structure.
    \'Note:  IP_ADAPTER_INFO contains a linked list of adapter entries.
   
    AdapterInfoSize = 0
    error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
    If error <> 0 Then
        If error <> ERROR_BUFFER_OVERFLOW Then
          MsgBox \"GetAdaptersInfo sizing failed with error \" & error
          Exit Sub
        End If
    End If
  ReDim AdapterInfoBuffer(AdapterInfoSize - 1)

\' Get actual adapter information
  error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
  If error <> 0 Then
      MsgBox \"GetAdaptersInfo failed with error \" & error
      Exit Sub
  End If
  CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)
  pAdapt = AdapterInfo.Next

  Do While pAdapt <> 0
        CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
          Select Case Buffer2.Type
                Case MIB_IF_TYPE_ETHERNET
                    MsgBox \"Ethernet adapter \"
                Case MIB_IF_TYPE_TOKENRING
                    MsgBox \"Token Ring adapter \"
                Case MIB_IF_TYPE_FDDI
                    MsgBox \"FDDI adapter \"
                Case MIB_IF_TYPE_PPP
                    MsgBox \"PPP adapter\"
                Case MIB_IF_TYPE_LOOPBACK
                    MsgBox \"Loopback adapter \"
                Case MIB_IF_TYPE_SLIP
                    MsgBox \"Slip adapter \"
                Case Else
                    MsgBox \"Other adapter \"
        End Select
    MsgBox \" AdapterName: \" & Buffer2.AdapterName
    MsgBox \"AdapterDescription: \" & Buffer2.Description

    For i = 0 To Buffer2.AddressLength - 1
          PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))
            If i < Buffer2.AddressLength - 1 Then
            PhysicalAddress = PhysicalAddress & \"-\"
            End If

    Next
    MsgBox \"Physical Address: \" & PhysicalAddress
    If Buffer2.DhcpEnabled Then
            MsgBox \"DHCP Enabled \"
    Else
            MsgBox \"DHCP disabled\"
    End If

    pAddrStr = Buffer2.IpAddressList.Next
    Do While pAddrStr <> 0
          CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer)
          MsgBox \"IP Address: \" & Buffer.IpAddress
          MsgBox \"Subnet Mask: \" & Buffer.IpMask
          pAddrStr = Buffer.Next
          If pAddrStr <> 0 Then
            CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, Len(Buffer2.IpAddressList)
          End If
  Loop
    MsgBox \"Default Gateway: \" & Buffer2.GatewayList.IpAddress
    pAddrStr = Buffer2.GatewayList.Next
    Do While pAddrStr <> 0
            CopyMemory Buffer, Buffer2.GatewayList, Len(Buffer)
            MsgBox \"IP Address: \" & Buffer.IpAddress
            pAddrStr = Buffer.Next
            If pAddrStr <> 0 Then
            CopyMemory Buffer2.GatewayList, ByVal pAddrStr, Len(Buffer2.GatewayList)
            End If
    Loop

    MsgBox \"DHCP Server: \" & Buffer2.DhcpServer.IpAddress
    MsgBox \"Primary WINS Server: \" & Buffer2.PrimaryWinsServer.IpAddress
    MsgBox \"Secondary WINS Server: \" & Buffer2.SecondaryWinsServer.IpAddress

    \' Display time
    NewTime = CDate(Adapt.LeaseObtained)
    MsgBox \"Lease Obtained: \" & CStr(NewTime)

    NewTime = CDate(Adapt.LeaseExpires)
    MsgBox \"Lease Expires :  \" & CStr(NewTime)
    pAdapt = Buffer2.Next
    If pAdapt <> 0 Then
        CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)
    End If
  Loop
End Sub

Bliv nu ikke sur over at der kommer 20 msgbox\'er Okay... håber du kan bruge dette....

øh?
jeg skulle ha fat i ip\'en ...!
den skriver på intet tidspunkt ip\'en.. (din EGEN ip)
anyways, så har jeg selv fundet en løsning..

i en PHP-fil skriver man følgende:

<?
function getip() {
$IP = $GLOBALS[\'REMOTE_ADDR\'];
$FIP = $GLOBALS[\'HTTP_X_FORWARDED_FOR\'];
if (($FIP != \"\") && ($FIP != \"unknown\")) $IP = $FIP;
$IP = explode(\",\", $IP);
$IP = $IP[0];
return $IP;
}
echo getip();
?>

og så uploader man den til en server der understøtter php..
man kalder den fx. ip.php ...
Så laver man et module i VB og skriver følgende:

Public Declare Function GetTempPath Lib \"kernel32.dll\" Alias \"GetTempPathA\" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetTempFileName Lib \"kernel32.dll\" Alias \"GetTempFileNameA\" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function URLDownloadToFile Lib \"urlmon\" Alias \"URLDownloadToFileA\" _
        (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
        ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function GetIp(toFile)
Dim GotIP
URLDownloadToFile 0, \"http://www.url.til.hp.dk/ip.php\", toFile, 0, 0
Open toFile For Input As #1
Line Input #1, GotIP
Close #1
GetIp = GotIP
End Function


så i en form (en button) skriver man dette:


Private Sub Command1_Click()
Dim tempfile As String  \' receives name of temporary file
Dim lastfour As Long  \' receives hex value of the randomly assigned ????

tempfile = Space(255)  \' initialize buffer to receive the filename
lastfour = GetTempFileName(GetTemp, \"api\", 0, tempfile)  \' get a unique temporary file name
\' (Note that the file is also created for you in this case.)
tempfile = Left(tempfile, InStr(tempfile, vbNullChar) - 1)  \' extract data from the variable
MsgBox \"Your IP is detected to be: \" & GetIp(tempfile), vbYesNo, \"Detection of IP\"
End Sub





... :O)
så din virker desværre ikke :(

winsock1.localip