få ip

Med ASP:  Request.ServerVariables(\"REMOTE_HOST\")

Ved ikke om du kan bruge det?

Option Explicit

Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Const ERROR_SUCCESS As Long = 0
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 MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1

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

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 Declare Function WSAGetLastError Lib \"WSOCK32.DLL\" () As Long

Public Declare Function WSAStartup Lib \"WSOCK32.DLL\" _
(ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long

Public Declare Function WSACleanup Lib \"WSOCK32.DLL\" () As Long

Public Declare Function gethostname Lib \"WSOCK32.DLL\" _
(ByVal szHost As String, ByVal dwHostLen As Long) As Long

Public Declare Function gethostbyname Lib \"WSOCK32.DLL\" _
(ByVal szHost As String) As Long

Public Declare Sub CopyMemory 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

CopyMemory HOST, lpHost, Len(HOST)
CopyMemory dwIPAddr, HOST.hAddrList, 4

ReDim tmpIPAddr(1 To HOST.hLen)

CopyMemory 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

Private Sub cmdGetIP_Click()
Msgbox GetIPAddress
End Sub

Private Sub cmdGetHost_Click()
Msgbox GetIPHostName
End Sub


- det skulle virke - dog skal det kompiles til p-code. (men jeg har ikke selv haft tid til at tjekke det endnu.

eh - jeg er nød til VB men kan man ikke bare skrive

Private Sub getip_Click()
msgbox LocalIP
End Sub

? =)

\\\\ -> RAZ

jelzin hvad mener du med at kompile det til p-code ?

Hm ... En anden måde at gøre det på ville være at indsætte en Winsock Control .. og så skrive

Private Sub Command1_Click()
MsgBox Winsock1.LocalIP
MsgBox Winsock1.LocalHostName
End Sub

Men det vil få hele programmet til at fylde mere en jelzins eksempel - men personligt er mit \"vist\" mest overskueligt? ;)

\\\\ - RAZ

sj>> under project options >> compile...

tak for pts. :)