PDA

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



Hai Lúa Miền Tây
30-06-09, 12:57 PM
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.

Hai Lúa Miền Tây
30-06-09, 01:42 PM
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

ndu96081631
30-06-09, 07:14 PM
Tạm thời tôi chưa nghĩ ra cách lấy IP Address, còn Computer name và UserName thì tôi nghĩ sẽ như vầy:


Sub GetComInfo()
Dim p1 As String, p2 As String
On Error Resume Next
p1 = "HKLM\SYSTEM\ControlSet001\Control\ComputerName\Com puterName\ComputerName"
p2 = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName"
With CreateObject("WScript.Shell")
MsgBox .RegRead(p1)
MsgBox .RegRead(p2)
End With
End SubMấy thông số này lưu giử trong Registry thì cứ vào đó mà đọc cho khỏe... đâu cứ thứ gì cũng API...
Có ngắn gọn không?
Tham khảo thêm cách đọc và ghi thông tin trong Registry tại bài này:
http://www.giaiphapexcel.com/forum/showthread.php?p=155764

smbsolutions
30-06-09, 07:48 PM
Tạm thời tôi chưa nghĩ ra cách lấy IP Address, còn Computer name và UserName thì tôi nghĩ sẽ như vầy:

- Ứng dụng viết APIs mới là bài bản.

- IP Address: Google: Get IPAddress + Visual Basic + SourceCode
hoặc vào http://www.psc.com, chọn Visual Basic, Search: IPAddress

- Tương tự: GetComputerName, GetUserName cũng có rất nhiều code (nhiều vô cùng)

Note: Code VBA cũng như code VB6

ndu96081631
30-06-09, 07:52 PM
- Ứng dụng viết APIs mới là bài bản.

- IP Address: Google: Get IPAddress + Visual Basic + SourceCode
hoặc vào http://www.psc.com, chọn Visual Basic, Search: IPAddress

Note: Code VBA cũng như code VB6
Vâng! Tôi cũng rất thích API, và đang học nó... Nhưng cũng tùy việc mà xài...
API cũng được, cách thông thường cũng được... miễn.. gọn (chắc ai cũng thích cái vụ "gọn" này rồi)
Tôi cũng đã tìm được code GetIPAddress trên Google rồi, có điều nó chẳng ngon lành gì... Để suy nghĩ cách nào đó cực gọn sẽ đưa lên diển đàn
Cảm ơn bạn đã mách nước

ndu96081631
30-06-09, 09:14 PM
Ái chà... cái này chắc khá gọn gàng cho việc Get IP Address đây:


Sub Test()
Dim Item
On Error Resume Next
With GetObject("winmgmts:\\.\root\cimv2")
For Each Item In .ExecQuery("Select * from Win32_NetworkAdapterConfiguration", , 48)
Range("A65536").End(xlUp).Offset(1) = Item.IPAddress(0)
Next
End With
End Sub-----------------
Nghe đồn rằng trong VB6 còn có 1 câu lệnh tuyệt chiêu hơn nữa, họ lấy IP bằng cách:
- Đầu tiên vào menu Tools\References và add Microsoft Winsock Control 6.0 vào (MSWINSCK.ocx)
- Tiếp theo chỉ dùng 1 câu lệnh ngắn gọn thế này

MsgBox Winsock1.LocalIP
Tuy nhiên thử nghiệm trên VBA thì chẳng ăn thua gì ---> Không biết sai chổ nào

Hai Lúa Miền Tây
01-07-09, 07:33 AM
Thật tuyệt vời, mọi vấn đề đã được giải quyết. quá gọn !!!
Em có 1 câu hỏi nữa là, máy em set IP động, vừa sử dụng cáp vừa sử dụng wireless nên khi chạy code nó cho ra 2 địa chỉ cùng 1 lúc.
Có cách nào chỉ lấy 1 trong 2 mà không phải tắt bớt 1 trong 2 network không?
Em xin cám ơn trước

ndu96081631
01-07-09, 04:58 PM
Thật tuyệt vời, mọi vấn đề đã được giải quyết. quá gọn !!!
Em có 1 câu hỏi nữa là, máy em set IP động, vừa sử dụng cáp vừa sử dụng wireless nên khi chạy code nó cho ra 2 địa chỉ cùng 1 lúc.
Có cách nào chỉ lấy 1 trong 2 mà không phải tắt bớt 1 trong 2 network không?
Em xin cám ơn trước
Cái vụ IP này nói chung khá rắc rối (không dể như UserName và ComputerName) ---> Vì vậy bạn tạm thời chơi kiểu củ chuối như sau:
- Ra được kết quả thì thoát vòng lập luôn (nếu bạn muốn lấy giá trị đầu tiên)
- Lấy kết quả cuối "đè" lên kết quả đầu (nếu bạn muốn lấy kết quả cuối)
Đại khái là thế ---> Bạn cứ thử xem
(Tôi cũng không chắc ăn lắm)

smbsolutions
01-07-09, 06:37 PM
Vâng! Tôi cũng rất thích API, và đang học nó... Nhưng cũng tùy việc mà xài...
API cũng được, cách thông thường cũng được... miễn.. gọn (chắc ai cũng thích cái vụ "gọn" này rồi)
Tôi cũng đã tìm được code GetIPAddress trên Google rồi, có điều nó chẳng ngon lành gì... Để suy nghĩ cách nào đó cực gọn sẽ đưa lên diển đàn
Cảm ơn bạn đã mách nước

Mình nói thật, code gọn chưa chắc đã là code tốt đâu.

Ví dụ:

1 cái hàm A chẳng hạn, nó phải dùng tới cả 1 ứng dụng hoặc 1 thư viện nào đó to đùng và tức là cái application của mình khi chạy lại phải kéo theo cả cái thư viện đó.

APIs là cách viết chuẩn nhất, chuyên nghiệp nhất trong làng VB(A) vì chúng ta sử dụng các thư việc chuẩn (normal DLL) chứ ko phải active DLLs sẵn có của hệ điều hành (nó chỉ kém cách viết ASM trên VB thôi). Các cách khác là dựa trên cái gì đó có sẵn (và to đùng) mà bạn đang kéo thêm vào ứng dụng của bạn. Một lần nữa, với kinh nghiệm nhiều năm làm VB (not A) thì tôi ko nghĩ cách bạn viết trên là tốt đâu. Sure!

Đây là hàm tương đối chuẩn mà tôi đã dùng ở VNUNI SIC (http://www.vnuni.net/forum/index.php?topic=8.0) (để làm chức năng System Auditor: theo dõi dấu vết hệ thống)


Public Function IPAddress() As String
'************************************************* *****************************
'* *
'* Name: IPAddress *
'* *
'* Purpose: Get IPAddress *
'* *
'* Returns: IPAddress *
'* *
'************************************************* *****************************

On Error GoTo PROC_ERROR

Dim ret As Long, i As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
Dim strIP As String, strTemp As String

GetIpAddrTable ByVal 0&, ret, True

If ret <= 0 Then Exit Function

ReDim bBytes(0 To ret - 1) As Byte

'retrieve the data
GetIpAddrTable bBytes(0), ret, False

'Get the first 4 bytes to get the entry's.. ip installed
CopyMemory Listing.dEntrys, bBytes(0), 4

For i = 0 To Listing.dEntrys - 1
CopyMemory Listing.mIPInfo(i), bBytes(4 + (i * Len(Listing.mIPInfo(i)))), Len(Listing.mIPInfo(i))
strTemp = ConvertAddressToString(Listing.mIPInfo(i).dwAddr)
If strTemp <> "0.0.0.0" Then strIP = strIP & IIf(Len(strIP) = 0, "", ";") & strTemp
'//strIPSubNetMask = "IP Subnetmask : " & ConvertAddressToString(Listing.mIPInfo(i).dwMask)
'//strBroadCastIPAddress = "BroadCast IP address : " & ConvertAddressToString(Listing.mIPInfo(i).dwBCastA ddr)
Next

IPAddress = strIP


PROC_DONE:
Exit Function

PROC_ERROR:
Call Process_Error(MODULE_NAME, "IPAddress")
Resume PROC_DONE
End FunctionCác declaration của APIs thì bạn tự tìm trên Google nhé.

Món này thì mình ko bao giờ dùng:

GetObject("winmgmts:\\.\root\cimv2")

Cách này (dùng Winsock) thì I am sorry nhưng thực sự là cách của newbie chiêu chứ ko phải là tuyệt chiêu (vì chỉ lấy mỗi IPAddr thôi mà phải sài tới cả 1 OCX, mà cái OCX này nếu viết VB chuyên nghiệp thì cũng ko nên dùng mà nên dùng thư viện về INET). Từ đó để mọi người thấy là 1 ứng dụng chuyên nghiệp thì họ cần phải chú ý tới những vấn đề gì.


Nghe đồn rằng trong VB6 còn có 1 câu lệnh tuyệt chiêu hơn nữa, họ lấy IP bằng cách:
MsgBox Winsock1.LocalIP

Nói qua như vậy để các bạn thấy là, viết ngắn nhưng phải hiểu bản chất của sự vật hiện tượng, phải xem xem lõi của từng lệnh mà bạn viết lên nó đụng tới đâu. Ngay như cách viết connection vào CSDL dùng các String Connection nhưng các bạn phải hiểu mỗi loại nó khác nhau như thế nào, cái nào là direct connection, cái nào dùng qua driver, ODBC thì nó có kiến trúc thế nào, v.v... để từ đó chọn ra loại phù hợp nhất (chứ ko phải connect cái pực vào CSDL là sướng đâu)

ndu96081631
01-07-09, 07:21 PM
Mình nói thật, code gọn chưa chắc đã là code tốt đâu.

Ví dụ:

1 cái hàm A chẳng hạn, nó phải dùng tới cả 1 ứng dụng hoặc 1 thư viện nào đó to đùng và tức là cái application của mình khi chạy lại phải kéo theo cả cái thư viện đó.

APIs là cách viết chuẩn nhất, chuyên nghiệp nhất trong làng VB(A) vì chúng ta sử dụng các thư việc chuẩn (normal DLL) chứ ko phải active DLLs sẵn có của hệ điều hành (nó chỉ kém cách viết ASM trên VB thôi). Các cách khác là dựa trên cái gì đó có sẵn (và to đùng) mà bạn đang kéo thêm vào ứng dụng của bạn. Một lần nữa, với kinh nghiệm nhiều năm làm VB (not A) thì tôi ko nghĩ cách bạn viết trên là tốt đâu. Sure!

Vâng! Đương nhiên tôi tin vào kinh nghiệm của bạn rồi... Nhưng ác cái tôi chỉ mới tập tành VBA... VB thì mới "rờ rờ" sơ qua... API lại càng tịt... nên hàm mà bạn vừa đưa ra ở trên tôi không biết áp dụng vào Excel như thế nào nữa
Rất mong sự chỉ giáo của bạn ---> Đã giúp thì giúp cho trót chứ nhỉ!
Cảm ơn bạn trước!

smbsolutions
02-07-09, 08:37 AM
Các hàm như GetIpAddrTable, CopyMemory, và Type MIB_IPADDRTABLE có thể tìm qua Google được mà, bạn copy cái đoạn đó vào 1 module, thêm khai báo đầy đủ cho nó. Sau đó chỉ sử dụng cái hàm IPAddress trong code thôi. (Mình không làm Excel nên ko biết VBA có chạy ko, nhưng TuânVNUNI rất quen mấy cái vụ này sẽ help bạn)

Nguyễn Duy Tuân
02-07-09, 12:18 PM
Các hàm như GetIpAddrTable, CopyMemory, và Type MIB_IPADDRTABLE có thể tìm qua Google được mà, bạn copy cái đoạn đó vào 1 module, thêm khai báo đầy đủ cho nó. Sau đó chỉ sử dụng cái hàm IPAddress trong code thôi. (Mình không làm Excel nên ko biết VBA có chạy ko, nhưng TuânVNUNI rất quen mấy cái vụ này sẽ help bạn)

Đây là code đầy đủ tôi đã chỉnh lại cách nhận kết quả là theo mảng giá trị, có thể nhận một hoặc nhiều giá trị trên Worksheet hoặc trong VBA.



Option Explicit

Const MAX_IP = 5

Type IPINFO
dwAddr As Long ' Get IP address
dwIndex As Long
dwMask As Long ' subnet mask
dwBCastAddr As Long ' broadcast address
dwReasmSize As Long ' assembly size
unused1 As Integer
unused2 As Integer
End Type

Type MIB_IPADDRTABLE
dEntrys As Long 'number of entries in the table
mIPInfo(MAX_IP) As IPINFO 'array of IP address entries
End Type

Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
'Private Declare Function GetIpAddrTable Lib "IPHLPAPI.dll" (ByRef pIpAddrTable As MIB_IPADDRTABLE, ByRef pdwSize As Long, ByVal border As Long) As Long
Private Declare Function GetIpAddrTable Lib "IPHLPAPI.dll" (ByRef pIpAddrTable As Byte, ByRef pdwSize As Long, ByVal border As Long) As Long

Public Function IPAddress() As Variant
'************************************************* *****************************
'* *
'* Name: IPAddress *
'* *
'* Purpose: Get IPAddress *
'* *
'* Returns: IPAddress *
'* *
'************************************************* *****************************

On Error GoTo PROC_ERROR

Dim ret As Long, i As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
Dim strIP As String, strTemp As String
Dim TempArr() As String
Dim IPCount As Long

GetIpAddrTable ByVal 0&, ret, True

If ret <= 0 Then Exit Function

ReDim bBytes(0 To ret - 1) As Byte

'retrieve the data
GetIpAddrTable bBytes(0), ret, False

'Get the first 4 bytes to get the entry's.. ip installed
CopyMemory Listing.dEntrys, bBytes(0), 4

For i = 0 To Listing.dEntrys - 1
CopyMemory Listing.mIPInfo(i), bBytes(4 + (i * Len(Listing.mIPInfo(i)))), Len(Listing.mIPInfo(i))
strTemp = ConvertAddressToString(Listing.mIPInfo(i).dwAddr)
If strTemp <> "0.0.0.0" Then
IPCount = IPCount + 1
'strIP = strIP & IIf(Len(strIP) = 0, "", ";") & strTemp
ReDim Preserve TempArr(IPCount - 1) As String
TempArr(IPCount - 1) = strTemp

End If
'//strIPSubNetMask = "IP Subnetmask : " & ConvertAddressToString(Listing.mIPInfo(i).dwMask)
'//strBroadCastIPAddress = "BroadCast IP address : " & ConvertAddressToString(Listing.mIPInfo(i).dwBCastA ddr)
Next

'IPAddress = strIP
'Return to array of IP
'On the Excel Worksheet, select cells in the same row, enter formula =IPAddress() , to get the array values, press CTRL+SHIFT+ENTER (combination).
'If you want to get the first IP, enter formula =IPAddress() then pressing ENTER key only.
IPAddress = TempArr

PROC_DONE:
Exit Function

PROC_ERROR:
'Call Process_Error(MODULE_NAME, "IPAddress")
Resume PROC_DONE
End Function

Public Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long

CopyMemory myByte(0), longAddr, 4

For Cnt = 0 To 3
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) & "."
Next Cnt

ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function

Hai Lúa Miền Tây
02-07-09, 01:30 PM
Xin các anh chị chỉ giúp cách lấy IP vào đoạn code sau giúp.


Sub Testem()
Dim iComNm As String
Dim iUsrNm As String
Dim iDate As Date
iDate = Now()
iComNm = ReturnComputerName
iUsrNm = ReturnUserName
MsgBox "You are logged in as the following..." & vbNewLine & _
"Computer : " & iComNm & vbNewLine & _
"Username : " & iUsrNm & vbNewLine & _
"---" & vbNewLine & _
"IP Address : ???.???.?.???" & vbNewLine & _
"---" & vbNewLine & _
"Date : " & iDate
Sheets("UserLog").Range("A65536").End(xlUp).Offset(1).Value = iComNm
Sheets("UserLog").Range("B65536").End(xlUp).Offset(1).Value = "???.???.?.???"
Sheets("UserLog").Range("C65536").End(xlUp).Offset(1).Value = iUsrNm
Sheets("UserLog").Range("D65536").End(xlUp).Offset(1).Value = iDate
End Sub

Em cám ơn trước

Nguyễn Duy Tuân
02-07-09, 01:43 PM
Mọi người đã giúp bạn cái khó nhất rồi, việc ủa bạn là ghép vào thôi. Hãy cố học và làm cho bằng được cái yêu hết sức cơ bản trên nhé.

Hai Lúa Miền Tây
02-07-09, 02:16 PM
Mọi người đã giúp bạn cái khó nhất rồi, việc ủa bạn là ghép vào thôi. Hãy cố học và làm cho bằng được cái yêu hết sức cơ bản trên nhé.
Em đã lấy được rồi, xin chia sẻ cùng các anh chị ở file đính kèm