IP-Adresse aufzeichnen

Hi,

habe ich im Netz gefunden maybe kannst Du es für Deine Funktion benötigen *zw*.

_________________________________________________________________________________________
Dieser etwas umfangreichere Tip dient dazu IP-Adressen von Rechnernamen (z.B.: Domänen) zu ermitteln. Es kann dabei über eine bestehende Online Verbindung auf den DNS des Providers zugefriffen werden. Dadurch ist die Umrechnung zwischen IP-Nummer und Rechnername bzw. umgekehrt möglich. Zudem ist daß ganze auch noch Offline auf ein Netzwerk anwendbar.
Weiterhin nutzt dieser Tip die Möglichkeiten der automatischen Einwahl, als auch die Abfrage des DFÜ-Status.
_________________________________________________________________________________________

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 WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&

Const MIN_SOCKETS_REQD = 1
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

'### Der folgende Abschnitt dient nur dazu, um festzustellen
' ob eine Online-Verbindung besteht bzw. um diese herzu-
' stellen und wieder abzubrechen.
' Sie können diesen Block bei Verzicht dieser Funktionen
' getrost löschen

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$

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
Label3.Caption = "Offline"
Else
RASStatus.dwSize = 160
Result = RasGetConnectStatus(RAS(0).hRasCon, RASStatus)
If RASStatus.RasConnState = &H2000 Then
DFÜStatus = True
Label3.Caption = "Online"
Else
DFÜStatus = False
Label3.Caption = "Einwahl oder Trennen der Verbindung"
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 GetDFÜ() As String
Dim s&, ln&, i%
Dim r(255) As RASENTRYNAME95

r(0).dwSize = 264
s = 256 * r(0).dwSize
Call RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
DFÜName = StrConv(r(i).szEntryName(), vbUnicode)
DFÜName = Left$(DFÜName, InStr(DFÜName, vbNullChar) - 1)
Shell "rundll32.exe rnaui.dll,RnaDial " & DFÜName
Shell "rundll32.exe rnaui.dll,RnaDial " & DFÜName
End Function

Private Sub HangUp(ByVal Verbindung$)
Dim s&, l&, ln&, aa$, rec&
ReDim r(255) As RASType

r(0).dwSize = 412
s = 256 * r(0).dwSize
l = RasEnumConnections(r(0), s, ln)
For l = 0 To ln - 1
aa = StrConv(r(l).szEntryName(), vbUnicode)
aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
If aa = Verbindung Then rec = RasHangUp(r(l).hRasCon)
Next
End Sub

Private Sub Form_Load()
Timer1.Interval = 200
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
DFÜStatus
End Sub

Private Sub Command5_Click()
Call GetDFÜ
End Sub
Private Sub Command7_Click()
If DFÜName <> "" Then Call HangUp(DFÜName)
End Sub
'### Ende des DFÜ-Pfrüfungs Abschnitts

Private Sub Command1_Click()
'### Eigene Adresse ermitteln
InitSockets
Text5.Text = MyHostName$()
CleanSockets
End Sub

Private Sub Command2_Click()
'### Eigene IP-Adressen abfragen
' Diese Routine kann unteranderem dazu benutzt werden,
' dynamische durch einen Provider zugewiesene IP-Adressen
' auszulesen.
' Da hier alle eigenen IP ausgelesen werden müssen die statio-
' nären [Localhost (127.0.0.1), Netzwerk (192.168.xxx.xxx)]
' eleminiert werden. Entfernen Sie dann aber auch folgende
' Steuerelemente aus dem Form:
' Timer1
' Label3
' Command5
' Command7

Dim X%
Dim IP$, DNS$, HOST$
If Not Online Then Exit Sub
MousePointer = vbHourglass
InitSockets
HOST = MyHostName$()
List1.Clear

Do
IP = HostByName$(HOST, X)
If Len(IP) = 0 Then Exit Do

DNS = HostByAddress(IP$)
List1.AddItem "DNS: " & DNS & " " & "IP: " & IP
X = X + 1
Loop

CleanSockets
MousePointer = vbDefault
End Sub

Private Sub Command3_Click()
Dim aa$
'### DNS-Abfrage nach Domäne (gibt IP zurück)
If Not Online Then Exit Sub
MousePointer = vbHourglass
InitSockets
aa = HostByAddress(Text1.Text)
If aa = "" Then MsgBox ("Nicht gefunden")
Text4.Text = aa
CleanSockets
MousePointer = vbDefault
End Sub

Private Sub Command4_Click()
Dim aa$
'### DNS-Abfrage nach IP (gibt Domäne zurück)
If Not Online Then Exit Sub
MousePointer = vbHourglass
InitSockets
aa = HostByName$(Text2.Text)
If aa = "" Then MsgBox ("Nicht gefunden")
Text3.Text = aa
CleanSockets
MousePointer = vbDefault
End Sub

Private Sub Command6_Click()
Unload Me
End Sub

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 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 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 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

LoBy = SocketData.wversion And &HFF&
HiBy = SocketData.wversion \ &H100 And &HFF&

If LoBy < WS_VERSION_MAJOR Or LoBy = WS_VERSION_MAJOR And _
HiBy < WS_VERSION_MINOR Then
MsgBox ("Die Windows-Sockets Version " & Trim$(Str$(LoBy)) & _
"." & Trim$(Str$(HiBy)) & " wird nicht von der '" & _
"winsock.dll' unterstützt !")
End
End If

If SocketData.iMaxSockets < MIN_SOCKETS_REQD Then
MsgBox ("Diese Anwendung verlangt mindestens " & _
Trim$(Str$(MIN_SOCKETS_REQD)) & " Sockets !")
End
End If
End Sub

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
Dubbai

Also das andere würde ich als overkill beschreiben, und nicht nutzbar vom web aus.
Ich nehme an das du mit den IP loggin nicht den notes client meinst, wei lmit den Notes client ist über den ID den eindeutigen zuordnung zum user möglich.

Vom web aus kannst du dieses über den CGI variabele Remote_Addr machen.