Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Adding a computer IP address to a MS access field 2

Status
Not open for further replies.

dgp2

Technical User
Nov 5, 2002
14
0
0
US
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
 
Not sure about the IP Address but you can grab the username using:
=Environ("Username")
 
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.
 
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
 
Thanks a lot humbleprogrammer. It works great!! I really appreciate it.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top