计算机机用户名在哪里,获取本机的IP 计算机名 登录操作系统用户名-萧云

整理收收藏的代码：

Option Compare Database

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

'调用方法--'

'Private Sub Command0_Click()

'MsgBox ap_GetComputerName

'MsgBox ap_GetUserName

'MsgBox GetComputerIP

'End Sub