Get IP Address (1 Viewer)

CJBIRKIN

Drink!
Local time
Today, 06:03
Joined
May 10, 2002
Messages
256
Hi all,

Tried a search but can't use IP as it's to short so here goes.

Is there a way of getting the IP address/some other unique identifier of a computer through VBA?

Cheers

Chris
 

Mile-O

Back once again...
Local time
Today, 06:03
Joined
Dec 10, 2002
Messages
11,316
For the Local IP you'll need the WinSock ActiveX control, I believe.

For a unique identifier, have you thought about the computer's name? My Computer Class is in the Sample Databases forum with the code.
 

CJBIRKIN

Drink!
Local time
Today, 06:03
Joined
May 10, 2002
Messages
256
Mile-O-Phile said:
For the Local IP you'll need the WinSock ActiveX control, I believe.

For a unique identifier, have you thought about the computer's name? My Computer Class is in the Sample Databases forum with the code.


Thanks Mile, I'll try the winsock ax first.

Cheers

Chris
 

pono1

Registered User.
Local time
Yesterday, 23:03
Joined
Jun 23, 2002
Messages
1,186
Chris and Mile,

One possible catch -- depending on Chris's needs -- is that an IP address is not necessarily a unique identifier for a computer over time. Also, neither is a computer name a unique identifier for a PC over time, though it's probably less likely to change than an IP address.

Some place on MSDN or in the MS KnowledgeBase (sorry, no link handy) is code to get a serial number from a hard drive. Just a thought...

Regards,
Tim
 

CJBIRKIN

Drink!
Local time
Today, 06:03
Joined
May 10, 2002
Messages
256
pono1 said:
Chris and Mile,

One possible catch -- depending on Chris's needs -- is that an IP address is not necessarily a unique identifier for a computer over time. Also, neither is a computer name a unique identifier for a PC over time, though it's probably less likely to change than an IP address.

Some place on MSDN or in the MS KnowledgeBase (sorry, no link handy) is code to get a serial number from a hard drive. Just a thought...

Regards,
Tim


Hi Tim,

That sounds like a good idea.

Here is the code that will do it. http://www.applecore99.com/api/api007.asp

Code:
Option Compare Database
Option Explicit
 
Private Declare Function apiGetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _
    (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Private Const MAX_PATH = 260

Function fVolume1(strDriveLetter As String) As String
'   Function to return the volume label for a drive
'   Accepts:
'       strDriveLetter - a valid drive letter for the PC, in the format "C:\"
'   Returns:
'       The volume label if it exists, or else "No label"
    Dim strVolume As String
    strVolume = Dir(strDriveLetter, vbVolume)
    If strVolume = "" Then strVolume = "No label"
    fVolume1 = strVolume
End Function
 
Function fVolume2(strDriveLetter As String) As String
'   Function to return the volume label for a drive
'   Accepts:
'       strDriveLetter - a valid drive letter for the PC, in the format "C:\"
'   Returns:
'       The volume label if it exists, or else "No label"
    Dim lngReturn As Long, lngDummy1 As Long, lngDummy2 As Long, lngDummy3 As Long
    Dim strVolume As String, strDummy As String
    strVolume = Space(MAX_PATH)
    strDummy = Space(MAX_PATH)
    lngReturn = apiGetVolumeInformation(strDriveLetter, strVolume, Len(strVolume), lngDummy1, lngDummy2, lngDummy3, strDummy, Len(strDummy))
    strVolume = Left(strVolume, InStr(strVolume, vbNullChar) - 1)
    If strVolume = "" Then strVolume = "No label"
    fVolume2 = strVolume
End Function
 
Function fSerialNumber(strDriveLetter As String) As String
'   Function to return the serial number for a hard drive
'   Accepts:
'       strDriveLetter - a valid drive letter for the PC, in the format "C:\"
'   Returns:
'       The serial number for the drive, formatted as "xxxx-xxxx"
    Dim lngReturn As Long, lngDummy1 As Long, lngDummy2 As Long, lngSerial As Long
    Dim strDummy1 As String, strDummy2 As String, strSerial As String
    strDummy1 = Space(MAX_PATH)
    strDummy2 = Space(MAX_PATH)
    lngReturn = apiGetVolumeInformation(strDriveLetter, strDummy1, Len(strDummy1), lngSerial, lngDummy1, lngDummy2, strDummy2, Len(strDummy2))
    strSerial = Trim(Hex(lngSerial))
    strSerial = String(8 - Len(strSerial), "0") & strSerial
    strSerial = Left(strSerial, 4) & "-" & Right(strSerial, 4)
    fSerialNumber = strSerial
End Function


Chris
 

Users who are viewing this thread

Top Bottom