在Access中获取本机IP地址、电脑名及开机登录用户名-林岚
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


在Access中获取本机IP地址、电脑名及开机登录用户名

发表时间:2018/1/29 23:34:06 评论(1) 浏览(9704)  评论 | 加入收藏 | 复制
   
摘 要:在Access中获取本机IP地址、电脑名及开机登录用户名
正 文:

 

Private Const WS_VERSION_REQD = &H101

Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&

Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&

Private Const MIN_SOCKETS_REQD = 1

Private Const SOCKET_ERROR = -1

Private Const WSADescription_Len = 256

Private Const WSASYS_Status_Len = 128

 

Private Type HOSTENT

hName As Long

hAliases As Long

hAddrType As Integer

hLength As Integer

hAddrList As Long

End Type

 

Private Type WSADATA

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

 

Declare Function wu_GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Declare Function wu_GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long

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

Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long

Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

 

Function ap_GetComputerName() As Variant

Dim strComputerName As String

Dim lngLength As Long

Dim lngResult As Long

 

strComputerName = String(255, 0)

lngLength = 255

 

lngResult = wu_GetComputerName(strComputerName, lngLength)

ap_GetComputerName = Left(strComputerName, InStr(1, strComputerName, Chr(0)) - 1)

 

End Function

 

Function ap_GetUserName() As Variant

Dim strUserName As String

Dim lngLength As Long

Dim lngResult As Long

 

strUserName = String(255, 0)

lngLength = 255

 

lngResult = wu_GetUserName(strUserName, lngLength)

ap_GetUserName = Left(strUserName, InStr(1, strUserName, Chr(0)) - 1)

 

End Function

Function GetComputerIP() As String

Dim hostent_addr As Long

Dim host As HOSTENT

Dim hostip_addr As Long

Dim temp_ip_address() As Byte

Dim I As Integer

Dim vntTemp As Variant

 

SocketsInitialize

 

hostent_addr = gethostbyname(vntTemp)

 

If hostent_addr = 0 Then

MsgBox "Can't resolve name."

Exit Function

End If

 

RtlMoveMemory host, hostent_addr, LenB(host)

RtlMoveMemory hostip_addr, host.hAddrList, 4

 

ReDim temp_ip_address(1 To host.hLength)

RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength

 

For I = 1 To host.hLength

GetComputerIP = GetComputerIP & temp_ip_address(I) & "."

Next

GetComputerIP = Mid$(GetComputerIP, 1, Len(GetComputerIP) - 1)

 

SocketsCleanup

End Function

 

Function hibyte(ByVal wParam As Integer)

hibyte = wParam \ &H100 And &HFF&

End Function

 

Function lobyte(ByVal wParam As Integer)

lobyte = wParam And &HFF&

End Function

 

Sub SocketsInitialize()

 

Dim WSAD As WSADATA

Dim iReturn As Integer

Dim sLowByte As String, sHighByte As String, sMsg As String

 

iReturn = WSAStartup(WS_VERSION_REQD, WSAD)

 

If iReturn <> 0 Then

MsgBox "Winsock.dll is not responding."

End

End If

 

If lobyte(WSAD.wversion) < WS_VERSION_MAJOR or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then

sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))

sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))

sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte

sMsg = sMsg & " is not supported by winsock.dll "

MsgBox sMsg

End

End If

 

If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then

sMsg = "This application requires a minimum of "

sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."

MsgBox sMsg

End

End If

 

End Sub

 

Sub SocketsCleanup()

Dim lReturn As Long

 

lReturn = WSACleanup()

 

If lReturn <> 0 Then

MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "

End

End If

 

End Sub


Access软件网交流QQ群(群号:198465573)
 
 相关文章
获取本机的IP 计算机名 登录操作系统用户名  【不详  2010/7/20】
【access源码】一个用于获取网卡MAC地址或IP地址的通用函数...  【红尘如烟  2010/8/8】
【access源码】一个获取本机外网IP的函数\获取本机公网IP的...  【红尘如烟  2012/4/7】
【Access示例】判断IP地址是否合法  【缪炜  2016/5/20】
根据表名和SQL Server服务IP地址,在ACCESS中创建S...  【smileyoufu  2017/11/29】
使用蒲公英VPN远程访问动态IP服务器  【刘文涛  2018/1/3】
常见问答
技术分类
相关资源
文章搜索
关于作者

林岚

文章分类

文章存档

友情链接