Lập trình VBA và API trong Excel để lấy tên máy tính và tên đăng nhập Windows

[Nguyễn Duy Tuân]

Trong lập trình VBA trong Excel, để lấy tên máy tính, tên đăng nhập Windows không có hàm nào cung cấp mà chúng ta phải sử dụng các hàm Windows API để lấy thông tin. Kỹ thuật lập trình Windows API rất hay và thú vị vì cho phép can thiệt sâu và hệ thống, tuy nhiên hiện nay ít người biết đến nó. Bài hướng dẫn này của tôi ngắn gọn, giúp các bạn lấy thông tin tên máy tính và tên đăng nhập, chỉ cần copy đoạn code dưới đây vào module trong VBAProject của mình.

MÃ NGUỒN TẠI ĐÂY:

'==========================================
Function ComputerName() As String
   Dim Buf As String * 255, n&
   If GetComputerName(Buf, 255) Then
      ComputerName = Left(Buf, InStr(Buf, Chr(0)) - 1)
   Else
      ComputerName = "Error! gui loi ve cho toi duytuan@bluesofts.net de tim nguyen nhan."
   End If
End Function
Function UserName() As String
   Dim Buf As String * 255, n&
   If GetUserName(Buf, 255) Then
      UserName = Left(Buf, InStr(Buf, Chr(0)) - 1)
   Else
      UserName = "Error! gui loi ve cho toi duytuan@bluesofts.net de tim nguyen nhan."
   End If
End Function
'==========================================

 

[YêuCN]

Anh

Lấy thông tin phần cứng như CPU, HĐ Serial,... các hàm API hay


Lấy Serial chuẩn không ngon ăn đâu nhé. Người ngoài còn tạo riêng DLL chỉ để cung cấp hàm nhận Serial chuẩn để ăn $ đó. Các cách làm chuẩn của Windows bằng API hay WMI đều gặp vấn đề khi máy Ghost đĩa (serial giống nhau một loạt), Windows 64-bit thì sai serial, phụ thuộc user đăng nhập Windows có phải Administrator hay không....

Mã nguồn để làm việc này bằng API lấy ngày trên trang Microsoft đây nhưng cũng không chuẩn:
https://social.msdn.microsoft.com/F...-serial-number-using-vb-60?forum=vbpowerpacks

Anh có thể khai thông code để làm việc này không bằng vba ?

 

[Nguyễn Duy Tuân]

Anh

Anh có thể khai thông code để làm việc này không bằng vba ?

Mình có share link người ta làm, hoặc trên mạng cubgx có vài source khác. Mình cũng chỉ biết đến vậy. Không biết ý bạn muốn khai thông gì khác?

 

[befaint]

code để làm việc này không

Trường hợp lấy thông tin phần cứng khi người dùng chạy trên máy ảo mới đáng kể ấy bạn.

 

[YêuCN]

@Nguyễn Duy Tuân
@befaint
Mình thấy có mấy trường hợp không lấy được mã máy hoặc mã máy bị trùng làm sao khắc phục ?

 

[cuongeva]

Mình thấy có cái này không biết xài được không:

Public Function getComputerIdForMac() As String
Dim sCmd As String
Dim lExitCode As Long
sCmd = "ioreg -l | grep IOPlatformSerialNumber | cut -d '""' -f4"
getComputerIdForMac = execShell(sCmd, lExitCode)
End Function

Public Function getComputerIdForWin() As Long
Dim fso As Object, Drv As Object, DriveSerial As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set Drv = fso.GetDrive(Environ("SystemDrive"))
With Drv
If .IsReady Then
DriveSerial = Abs(.SerialNumber)
Else
DriveSerial = -1
End If
End With
Set Drv = Nothing
Set fso = Nothing

getComputerIdForWin = DriveSerial
End Function

 

[cuongeva]

Trường hợp lấy thông tin phần cứng khi người dùng chạy trên máy ảo mới đáng kể ấy bạn.

@befaint:
Bạn thử nghiên cứu sử dụng TurboActivate xem sao? Cái này rất hiệu quả!

 

[cuongeva]

@befaint:
Bạn thử nghiên cứu sử dụng TurboActivate xem sao? Cái này rất hiệu quả!

Mình thấy cấu trúc để lấy thông tin gửi qua Email để tạo CDKey nó như thế này:

Private Sub btnActiveRequest_Click()
On Error GoTo TubrboAtiateProcError
Dim sFile As String
sFile = "Dangkybanquyen.xml"
ta.ActivativeRequestToFile (sFile)
MsgBox "Đã lưu file Dangkybanquyen.xml : " & GetTurboActiateDirectory, vbInformation
On Error Resume Next
ThisWorkbook.FollowHyperlink Address:=GetTurboActiate, NewWindow:=True
On Error GoTo 0
ProcExit:

Exit Sub
TurboActiateProcError:
MsgBox "Không tạo được file <Dangkybanquyen.xml> : " & Lỗi, vbExclamation
Resume ProcExit

End Sub