Adding a computer IP address to a MS access field 2

[dgp2]

Does anyone know the Visual Basic code for capturing a computer IP address and put it in an Access2000 table? I currently have a form in Access where a user can enter an order, I would like to capture the ip address of the computer of where the order was processed. Any help would be greatly appreciated.

dgp2

 

[humbleprogrammer]

Not sure about the IP Address but you can grab the username using:
=Environ("Username&quot

 

[dgp2]

Thanks for the idea but it isn't quite what I'm looking for. I would like to track what computer it comes from regardless of the user name.

 

[Databaseguy]

Look into GetHostByName API, of the Windows Sockets dll, Wsock32.dll

 

[humbleprogrammer]

Thanks to Databaseguy's guidance, I found some code that I was able to make work. Follow below:

1. Add a text box to your form and name it Text1.
2. Copy the below code into the form. Go to the top tool bar, select View - Code and paste this code.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2003 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Const ERROR_SUCCESS As Long = 0

Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type

Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type

Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type

Private Type IP_ADAPTER_INFO
dwNext As Long
ComboIndex As Long 'reserved
sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
dwAddressLength As Long
sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
dwIndex As Long
uType As Long
uDhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
bHaveWins As Long
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End Type

Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
(pTcpTable As Any, _
pdwSize As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(dst As Any, _
src As Any, _
ByVal bcount As Long)

Private Function LocalIPAddress() As String

'api vars
Dim cbRequired As Long
Dim buff() As Byte
Dim Adapter As IP_ADAPTER_INFO
Dim AdapterStr As IP_ADDR_STRING

'working vars
Dim ptr1 As Long
Dim sIPAddr As String
Dim found As Boolean

Call GetAdaptersInfo(ByVal 0&, cbRequired)

If cbRequired > 0 Then

ReDim buff(0 To cbRequired - 1) As Byte

If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then

'get a pointer to the data stored in buff()
ptr1 = VarPtr(buff(0))

Do While (ptr1 <> 0) 'And (found = False)

'copy the data from the pointer to the
'first adapter into the IP_ADAPTER_INFO type
CopyMemory Adapter, ByVal ptr1, LenB(Adapter)

With Adapter

'the DHCP IP address is in the
'IpAddress.IpAddr member

sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))

If Len(sIPAddr) > 0 Then
found = True
Exit Do
End If

ptr1 = .dwNext

End With 'With Adapter

'ptr1 is 0 when (no more adapters)
Loop 'Do While (ptr1 <> 0)

End If 'If GetAdaptersInfo
End If 'If cbRequired > 0

'return any string found
LocalIPAddress = sIPAddr


End Function


Private Function TrimNull(item As String)

Dim pos As Integer

'double check that there is a chr$(0) in the string
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If

End Function

Private Sub Form_Open(Cancel As Integer)

Text1.SetFocus
Text1.Text = LocalIPAddress()

End Sub

 

[dgp2]

Thanks a lot humbleprogrammer. It works great!! I really appreciate it.