Cách lấy địa chỉ IP, tên máy tính và username

Chia sẻ bởi:hands

★★★★★

‹ Chia sẻ Code Import/Export Data từ Excel... Gửi thông báo khi đến sinh nhật ›

Quảng cáo

Cách lấy địa chỉ IP

Chào các anh chị GPE,
Xin các anh chị chỉ em cách lấy địa chỉ IP tự như sau:
IP|
?
Em xin cám ơn trước.
Nhân tiện đây em xin chia sẻ với mọi người cách lấy tên máy và user name như sau:

Option Explicit
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function ReturnComputerName() As String
   Dim rString As String * 255, sLen As Long, tString As String
   tString = ""
   On Error Resume Next
   sLen = GetComputerName(rString, 255)
   sLen = InStr(1, rString, Chr(0))
   If sLen > 0 Then
       tString = Left(rString, sLen - 1)
   Else
       tString = rString
   End If
   On Error GoTo 0
   ReturnComputerName = UCase(Trim(tString))
End Function
Function ReturnUserName() As String

Dim rString As String * 255, sLen As Long, tString As String
   tString = ""
   On Error Resume Next
   sLen = GetUserName(rString, 255)
   sLen = InStr(1, rString, Chr(0))
   If sLen > 0 Then
       tString = Left(rString, sLen - 1)
   Else
       tString = rString
   End If
   On Error GoTo 0
   ReturnUserName = UCase(Trim(tString))
End Function
Sub Testem()
Dim iComNm As String
Dim iUsrNm As String
Dim rDate As Date
rDate = Now()
iComNm = ReturnComputerName
iUsrNm = ReturnUserName
   MsgBox "You are logged in as the following..." & vbNewLine & _
   "Computer : " & iComNm & vbNewLine & _
   "Username : " & iUsrNm & vbNewLine & _
   "IP Address : ???" & vbNewLine & _
   "Date : " & rDate
Sheets("UserLog").Range("A65536").End(xlUp).Offset(1).Value = iComNm
Sheets("UserLog").Range("C65536").End(xlUp).Offset(1).Value = iUsrNm
Sheets("UserLog").Range("D65536").End(xlUp).Offset(1).Value = rDate
End Sub