根据ip地址拿到计算机用户名,在Access中获取本机IP地址、电脑名及开机登录用户名...

时　间:2018-01-29 23:34:06

作　者:摘　要:在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交流群(群号:39785885)

Access源码网店