• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Lấy về số seri CPU, ổ cứng MainBoard trong Access

• Trang chủ

  • Thủ Thuật Access
  • Access Nâng Cao
  • Thư viện thủ thuật
  • Lấy về số seri CPU, ổ cứng MainBoard trong Access
• Lấy về số seri CPU, ổ cứng MainBoard trong Access

• Lấy về số seri CPU, ổ cứng MainBoard trong Access

  Noname > 23-08-10, 01:25 PM

  Đôi khi có 1 số nhu cầu lấy thông tin phần cứng trong chương trình (chẳng hạn để cấp bản quyền). Dưới đây là Đoạn Code cho phép bạn lấy thông tin CPU máy tính:
  Download Demo
  
  Chú ý: Một số Main của các máy tính đặc biệt (VAIO, Apple...) không cho lấy thông số, nên hàm lấy main chỉ mang tính tham khảo .
  

  Mã:

  ' Lay thong tin CPU
Function GetCPUID()
     'ta.o ?o^'i ty'o+.ng di.ch vu. WMI
     Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
     'ti`m các CPU ?ang cha.y cu?a máy
     Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
     'la(.p hie^?n thi. ID cu?a tu+`ng CPU
     For Each objItem In colItems
     GetCPUID = objItem.ProcessorId
     Next
    
     End Function

  ' Lay Thong tin o Cung
  

  Mã:

  Function GetHDDserial()
    Dim fso As Object, Drv As Object
            'Create a FileSystemObject object
              Set fso = CreateObject("Scripting.FileSystemObject")
              'Assign the current drive letter if not specified
              Set Drv = fso.GetDrive(Environ("SystemDrive"))
              With Drv
                  If .IsReady Then
                      DriveSerial = Abs(.SerialNumber)
                  Else    '"Drive Not Ready!"
                      DriveSerial = -1
                  End If
              End With
              'Clean up
              Set Drv = Nothing
              Set fso = Nothing
              GetHDDserial = DriveSerial
     End Function

  ' Lay Thong tin Mainboard
  

  Mã:

  Function GetBoardSerial()

Set WMI = GetObject("winmgmts:\\.\root\cimv2")

Set objs = WMI.ExecQuery("Select * from Win32_BaseBoard")
For Each obj In objs
GetBoardSerial = obj.SerialNumber
Next

End Function

  =================================================================
  

  1.Lấy thông tin CPU (Click to View)

  Mã:

  Sub GetCPUID()
     'ta.o ðo^'i týo+.ng di.ch vu. WMI
     Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
     'ti`m các CPU ðang cha.y cu?a máy
     Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
     'la(.p hie^?n thi. ID cu?a tu+`ng CPU
     For Each objItem In colItems
     MsgBox "Processor Id: " & objItem.ProcessorId
     Next
     End Sub

  
  
  Lưu ý rằng trên các máy PC bình thường, chỉ có 1 CPU nên vòng lặp hiển thị thông tin sẽ chỉ chạy 1 lần và hiển thị ID của CPU duy nhất của máy.
  
  
  nguồn PC word

  2. Lấy thông tin ổ cứng: (Click to View)

  ' Đã update phần sửa lỗi của Cafe Via He
  

  Mã:

  Sub readserienumber()
    Dim fso As Object, Drv As Object
            'Create a FileSystemObject object
              Set fso = CreateObject("Scripting.FileSystemObject")
              'Assign the current drive letter if not specified
              Set Drv = fso.GetDrive(Environ("SystemDrive"))
              With Drv
                  If .IsReady Then
                      DriveSerial = Abs(.SerialNumber)
                  Else    '"Drive Not Ready!"
                      DriveSerial = -1
                  End If
              End With
              'Clean up
              Set Drv = Nothing
              Set fso = Nothing
              Msgbox "Serial là: " & DriveSerial
     End Sub

  3. Lấy Serial Main Board (Click to View)

  
  

  Mã:

  Sub readseriemainboard()
Dim objs As Object
Dim obj As Object
Dim WMI As Object
Dim sAns As String
Set WMI = GetObject("WinMgmts:")
Set objs = WMI.InstancesOf("Win32_BaseBoard")
For Each obj In objs
sAns = sAns & obj.SerialNumber
If sAns < objs.Count Then sAns = sAns & ","
Next
Msgbox "Serial main: " & sAns
End Sub

  Phần sửa lỗi lấy thông tin mainboard của Cafe Via He (Click to View)

  (11-11-10, 11:11 AM)Cafe Via He Đã viết: @ Bạn Quân: Thử lại đoạn code này, Cafe thêm mắm muối chút nè
  
  

  Mã:

  Sub readseriemainboard()
Dim objs As Object
Dim obj As Object
Dim WMI As Object
Dim sAns As String
Set WMI = GetObject("WinMgmts:")
Set objs = WMI.InstancesOf("Win32_BaseBoard")
For Each obj In objs

    sAns = sAns & "Serial Number: " & obj.SerialNumber & vbCrLf
    sAns = sAns & "Model: " & obj.product & vbCrLf

    If sAns < objs.Count Then sAns = sAns & ","

Next
'Set objs = Nothing
Set objs = WMI.InstancesOf("Win32_BIOS")
  
For Each obj In objs
    sAns = sAns & "BIOS: " & obj.Manufacturer & vbCrLf
Next
MsgBox sAns
End Sub

  Cafe via He: sửa hàm GETCPU của Noname chút. (Click to View)

  (11-11-10, 11:25 AM)Cafe Via He Đã viết: --------->>>> Sửa lại đoạn code GETCPU của Noname chút. Lấy CPU name và Manufacturer
  

  Mã:

  Sub GetCPUID()
     'ta.o ðo^'i týo+.ng di.ch vu. WMI
     Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
     'ti`m các CPU ðang cha.y cu?a máy
     Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
     'la(.p hie^?n thi. ID cu?a tu+`ng CPU
     For Each objItem In colItems
     MsgBox "Processor Id: " & objItem.ProcessorId & vbCrLf & _
            "Proccess Name: " & objItem.Name & vbCrLf & _
            "Manufacturer: " & objItem.Manufacturer
     Next
End Sub

• RE: Lấy về số seri CPU, ổ cứng MainBoard trong Access

  DoquangLam > 01-10-10, 11:01 PM

  Cám ơn Noname để mình thực hành

• RE: Lấy về số seri CPU, ổ cứng MainBoard trong Access

  DoquangLam > 01-10-10, 11:17 PM

  Noname ơi mình nhờ bạn nối 2 đoạn Code để lấy thông tin của Main Board và ổ cứng dùm mình với (Lấy thông tin Main Board hoặc ổ cứng thì mình làm được rồi, lấy 2 thông tin cùng lúc thì mình chịu thua). Cám ơn nhiều.
  

• RE: Lấy về số seri CPU, ổ cứng MainBoard trong Access

  Noname > 01-10-10, 11:24 PM

  sac, thì mỗi cái bạn gán nó vào 1 biến. Hoặc thay vì dùng sub, bạn dùng function, rồi chỗ cuối cùng phát biểu msgbox, bạn gán tên function bằng kết quả trả về.

• RE: Lấy về số seri CPU, ổ cứng MainBoard trong Access

  DoquangLam > 02-10-10, 12:08 AM

  Noname ơi thông cảm cho mình nhé, cái vụ này thì mình dở lắm không biết gì cả, đặc biệt là Code.

• RE: Lấy về số seri CPU, ổ cứng MainBoard trong Access

  DoquangLam > 02-10-10, 11:25 AM

  Private Sub Form_Load()
  Dim fso As Object, Drv As Object
  'Create a FileSystemObject object
  Set fso = CreateObject("Scripting.FileSystemObject")
  'Assign the current drive letter if not specified
  Set Drv = fso.GetDrive() ' Nó báo lỗi ngay dòng này Noname ơi.
  With Drv
  If .IsReady Then
  DriveSerial = Abs(.SerialNumber)
  Else '"Drive Not Ready!"
  DriveSerial = -1
  End If
  End With
  'Clean up
  Set Drv = Nothing
  Set fso = Nothing
  MsgBox "Serial là: " & DriveSerial
  End Sub
  

• RE: Lấy về số seri CPU, ổ cứng MainBoard trong Access

  DoquangLam > 02-10-10, 09:17 PM

  Noname ơi, xem lại dùm mình với

• RE: Lấy về số seri CPU, ổ cứng MainBoard trong Access

  Cafe Via He > 04-10-10, 10:32 AM

  Bạn sửa dòng đó như thế này thử xem:
  
  Set Drv = fso.GetDrive(Environ("SystemDrive"))

• RE: Lấy về số seri CPU, ổ cứng MainBoard trong Access

  DoquangLam > 04-10-10, 07:28 PM

  Cám ơn bạn nhé !
  Tiện đây cho mình hỏi thêm tí nhé :
  - Mình có forms có tên là DangKy
  - Bây giờ mình muốn các bạn viết dùm mình Code qui định cho nó khi khởi động đến lần thứ 3 hay 5,6... (do mình quy định trong code) thì hiện lên dòng thông báo "Đã hết hạn sử dụng", bấm OK thì nó thoát fomrs.
  Cám ơn !

• Code qui định số lần cho phép khởi động fomrs !

  DoquangLam > 04-10-10, 07:42 PM

  Nhờ các bạn trợ giúp :
  
  - Mình có forms có tên là DangKy
  - Bây giờ mình muốn các bạn viết dùm mình Code qui định cho nó khi khởi động đến lần thứ 3 hay 5,6... (do mình quy định trong code) thì hiện lên dòng thông báo "Đã hết hạn sử dụng", bấm OK thì nó thoát fomrs.
  Cám ơn !
  
• Bài trước Bài tiếp