Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
284to288
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
284to288
284to288
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Rechner IP

Rechner IP
26.07.2003 19:07:43
Matthias
Hallo Zusammen,
habe ein kleines Problem und hoffe ich bekomme hier geholfen.
Ich möche gerne mit hilfe von Excel die IP meines Rechners auslesen. Ist das überhaupt möglich?
Schonmal besten Dank für die Hilfe!
Gruß
Matthias

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Rechner IP
26.07.2003 19:17:28
Hans W Hofmann
:-) Klar,
die wieß ich auswendig 127.0.0.1
Falls Dir die Lösung nicht gefällt würde ich mal das Archiv befragen...
Gruß HW

muß man das verstehn??
26.07.2003 19:28:00
andreas
....
ich auf jeden Fall nicht !
*fg*

danke ...
26.07.2003 19:55:15
andreas
AW: Rechner IP
26.07.2003 20:17:41
Matthias C.
Hallo Andreas,
Diesen Code habe ich von der Hans W. Herber-CD kopiert.
Den nachstehenden Code in ein Standardmodul eingeben, einer Schaltfläche zuweisen und starten.
StandardModule: Modul1
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () _
As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
wVersionRequired&, lpWSAData As WinSocketDataType) _
As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () _
As Long
Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal _
HostName$, ByVal HostLen%) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
(ByVal HostName$) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" _
(ByVal addr$, ByVal laenge%, ByVal typ%) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As _
Any, ByVal hpvSource&, ByVal cbCopy&)
Const WS_VERSION_REQD = &H101
Const SOCKET_ERROR = -1
Const WSADescription_Len = 256
Const WSASYS_Status_Len = 128
Private Type HostDeType
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
Private Type WinSocketDataType
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 RasEnumConnections Lib "RasApi32.DLL" _
Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As _
Long, lpcConnections As Long) As Long
Private Declare Function RasGetConnectStatus Lib "RasApi32.DLL" _
Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, _
lpStatus As Any) As Long
Private Declare Function RasEnumEntries Lib "RasApi32.DLL" _
Alias "RasEnumEntriesA" (ByVal reserved$, ByVal _
lpszPhonebook$, lprasentryname As Any, lpcb As Long, _
lpcEntries As Long) As Long
Private Declare Function RasHangUp Lib "RasApi32.DLL" _
Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Const RAS_MaxEntryName = 256
Const RAS_MaxDeviceType = 16
Const RAS_MaxDeviceName = 32
Private Type RASType
dwSize As Long
hRasCon As Long
szEntryName(RAS_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
Private Type RASStatusType
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS_MaxEntryName) As Byte
End Type
Dim DFÜName$
Sub AufrufDNS()
Dim sIP As String
sIP = InputBox("IP-Adresse:", , "212.227.119.87")
If sIP = "" Then Exit Sub
Call WWWAddress(sIP)
End Sub

Sub AufrufIP()
Dim sDNS As String
sDNS = InputBox("DNS-Adresse:", , "www.herber.de")
Call WWWAddress(sDNS)
End Sub

Sub WWWAddress(strAddress As String)
Dim X%
Dim IP$, DNS$, HOST$
If Not Online Then Exit Sub
Call InitSockets
If IsNumeric(Left(strAddress, 1)) Then
DNS = HostByAddress(strAddress)
IP = strAddress
Else
IP = HostByName(strAddress)
DNS = strAddress
End If
ActiveCell.Value = "DNS: " & DNS & " " & "IP: " & IP
Call CleanSockets
End Sub


Private Sub InitSockets()
Dim Result%
Dim LoBy%, HiBy%
Dim SocketData As WinSocketDataType
Result = WSAStartup(WS_VERSION_REQD, SocketData)
If Result <> 0 Then
MsgBox ("'winsock.dll' antwortet nicht !")
End
End If
End Sub


Private Function HostByName(Name$, Optional X% = 0) As String
Dim MemIp() As Byte
Dim Y%
Dim HostDeAddress&, HostIp&
Dim IPAddress$
Dim HOST As HostDeType
HostDeAddress = gethostbyname(Name)
If HostDeAddress = 0 Then
HostByName = ""
Exit Function
End If
Call RtlMoveMemory(HOST, HostDeAddress, LenB(HOST))
For Y = 0 To X
Call RtlMoveMemory(HostIp, HOST.hAddrList + 4 * Y, 4)
If HostIp = 0 Then
HostByName = ""
Exit Function
End If
Next Y
ReDim MemIp(1 To HOST.hLength)
Call RtlMoveMemory(MemIp(1), HostIp, HOST.hLength)
IPAddress = ""
For Y = 1 To HOST.hLength
IPAddress = IPAddress & MemIp(Y) & "."
Next Y
IPAddress = Left$(IPAddress, Len(IPAddress) - 1)
HostByName = IPAddress
End Function


Private Function DFÜStatus() As Boolean
Dim RAS(255) As RASType, RASStatus As RASStatusType
Dim lg&, lpcon&, Result&
RAS(0).dwSize = 412
lg = 256 * RAS(0).dwSize
Result = RasEnumConnections(RAS(0), lg, lpcon)
If lpcon = 0 Then
DFÜStatus = False
Else
RASStatus.dwSize = 160
Result = RasGetConnectStatus(RAS(0).hRasCon, RASStatus)
If RASStatus.RasConnState = &H2000 Then
DFÜStatus = True
Else
DFÜStatus = False
End If
End If
End Function


Private Function Online() As Boolean
Dim Test As Boolean
Test = DFÜStatus
If Test = False Then MsgBox _
("Keine Online Verbindung vorhanden ! Bitte einwählen !")
Online = Test
End Function



Private Function HostByAddress(ByVal Addresse$) As String
Dim X%
Dim HostDeAddress&
Dim aa$, BB As String * 5
Dim HOST As HostDeType
aa = Chr$(Val(NextChar(Addresse, ".")))
aa = aa + Chr$(Val(NextChar(Addresse, ".")))
aa = aa + Chr$(Val(NextChar(Addresse, ".")))
aa = aa + Chr$(Val(Addresse))
HostDeAddress = gethostbyaddr(aa, Len(aa), 2)
If HostDeAddress = 0 Then
HostByAddress = ""
Exit Function
End If
Call RtlMoveMemory(HOST, HostDeAddress, LenB(HOST))
aa = ""
X = 0
Do
Call RtlMoveMemory(ByVal BB, HOST.hName + X, 1)
If Left$(BB, 1) = Chr$(0) Then Exit Do
aa = aa + Left$(BB, 1)
X = X + 1
Loop
HostByAddress = aa
End Function


Private Function MyHostName() As String
Dim HostName As String * 256
If gethostname(HostName, 256) = SOCKET_ERROR Then
MsgBox "Windows Sockets error " & Str(WSAGetLastError())
Exit Function
Else
MyHostName = NextChar(Trim$(HostName), Chr$(0))
End If
End Function


Private Sub CleanSockets()
Dim Result&
Result = WSACleanup()
If Result <> 0 Then
MsgBox ("Socket Error " & Trim$(Str$(Result)) & _
" in Prozedur 'CleanSockets' aufgetreten !")
End
End If
End Sub


Private Function NextChar(Text$, Char$) As String
Dim POS%
POS = InStr(1, Text, Char)
If POS = 0 Then
NextChar = Text
Text = ""
Else
NextChar = Left$(Text, POS - 1)
Text = Mid$(Text, POS + Len(Char))
End If
End Function


MfG Matthias

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige