• 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

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

  dinhvank19 > 05-11-10, 12:15 PM

  (04-10-10, 07:42 PM)DoquangLam Đã viết: 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 !

  
  xem bài http://thuthuataccess.co.cc/forum/thread-285.html

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

  dinhvank19 > 05-11-10, 12:31 PM

  (23-08-10, 01:25 PM)Noname Đã viết: Đô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:
  

  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 CPU ổ cứng:
  
  

  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()
              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
  
  

  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

  
  Hình như đoạn code lấy serial đĩa cứng chạy không được trên mọi hệ điều hành!
  các bạn xem đoạn code dài dòng này ra sao?
  
  Option Explicit
  
  'àõnh nghôa caác hùçng cêìn duâng cho haâm CreateFile
  Private Const FILE_SHARE_READ = &H1
  Private Const FILE_SHARE_WRITE = &H2
  Private Const GENERIC_READ = &H80000000
  Private Const GENERIC_WRITE = &H40000000
  Private Const OPEN_EXISTING = 3
  Private Const CREATE_NEW = 1
  'àõnh nghôa caác hùçng, caác kiïíu cêìn duâng cho haâm DeviceIOControl
  'caác thöng tin naây àûúåc lêëy tûâ böå DDK
  Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088
  Private Enum HDINFO
  HD_MODEL_NUMBER
  HD_SERIAL_NUMBER
  HD_FIRMWARE_REVISION
  End Enum
  
  Private Type IDEREGS
  bFeaturesReg As Byte
  bSectorCountReg As Byte
  bSectorNumberReg As Byte
  bCylLowReg As Byte
  bCylHighReg As Byte
  bDriveHeadReg As Byte
  bCommandReg As Byte
  bReserved As Byte
  End Type
  
  Private Type SENDCMDINPARAMS
  cBufferSize As Long
  irDriveRegs As IDEREGS
  bDriveNumber As Byte
  bReserved(1 To 3) As Byte
  dwReserved(1 To 4) As Long
  End Type
  
  Private Type DRIVERSTATUS
  bDriveError As Byte
  bIDEStatus As Byte
  bReserved(1 To 2) As Byte
  dwReserved(1 To 2) As Long
  End Type
  
  Private Type SENDCMDOUTPARAMS
  cBufferSize As Long
  DStatus As DRIVERSTATUS ' ovvero DriverStatus
  bBuffer(1 To 512) As Byte
  End Type
  
  'Àõnh nghôa caác haâm API cêìn duâng
  Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
  Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
  
  'Àõnh nghôa haâm GetHDInfo àïí àoåc thöng tin vêåt lyá disk
  Private Function GetHDInfo(Drive As Integer, hdi As HDINFO) As String
  Dim bin As SENDCMDINPARAMS
  Dim bout As SENDCMDOUTPARAMS
  Dim hdh As Long
  Dim br As Long
  Dim ix As Long
  Dim hddfr As Long
  Dim hddln As Long
  Dim s As String
  Select Case hdi ' Selezione tipo caratteristica richiesta
  Case HD_MODEL_NUMBER
  hddfr = 55 ' Posizione nel buffer del ModelNumber
  hddln = 40 ' Lunghezza nel buffer del ModelNumber
  Case HD_SERIAL_NUMBER
  hddfr = 21 ' Posizione nel buffer del SerialNumber
  hddln = 20 ' Lunghezza nel buffer del SerialNumber
  Case HD_FIRMWARE_REVISION
  hddfr = 47 ' Posizione nel buffer del FirmwareRevision
  hddln = 8 ' Lunghezza nel buffer del FirmwareRevision
  Case Else
  Err.Raise 10001, "Illegal HD Data type" ' Altre informazioni non disponibili (Evoluzione futura)
  End Select
  'taåo file nhêån daång öí cûáng cêìn àoåc thöng tin
  hdh = CreateFile("\\.\PhysicalDrive" & Drive, GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
  'kiïím tra viïåc taåo file
  If hdh = 0 Then
  Err.Raise 10003, , "Error on CreateFile"
  End If
  
  'thiïët lêåp caác thöng söë input
  With bin
  .bDriveNumber = Drive
  .cBufferSize = 512
  With .irDriveRegs
  If (Drive And 1) Then
  .bDriveHeadReg = &HB0
  Else
  .bDriveHeadReg = &HA0
  End If
  .bCommandReg = &HEC
  .bSectorCountReg = 1
  .bSectorNumberReg = 1
  End With
  End With
  'goåi haâm DeviceIoControl àïí àoåc thöng tin
  DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, bin, Len(bin), bout, Len(bout), br, 0
  'copy thöng tin cêìn truy xuêët
  s = ""
  For ix = hddfr To hddfr + hddln - 1 Step 2
  If bout.bBuffer(ix + 1) = 0 Then Exit For
  s = s & Chr(bout.bBuffer(ix + 1))
  If bout.bBuffer(ix) = 0 Then Exit For
  s = s & Chr(bout.bBuffer(ix))
  Next ix
  GetHDInfo = Trim(s)
  'Àoáng handle disk
  CloseHandle hdh
  End Function
  /----------------------------------------------------------------------------
  Public Function Lay_Serial() As String
  On Error GoTo M01_MODAU_Err
  If Not IsNull(GetHDInfo(0, HD_SERIAL_NUMBER)) Then
  Lay_Serial = GetHDInfo(0, HD_SERIAL_NUMBER)
  'MsgBox GetHDInfo(0, HD_SERIAL_NUMBER)
  Else
  MsgBox "Khong doc duoc serial number!! ", vbCritical
  DoCmd.Quit
  End If
  
  M01_MODAU_Exit:
  Exit Function
  
  M01_MODAU_Err:
  MsgBox Error$
  Resume M01_MODAU_Exit
  End Function
  //sưu tầm

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

  haquocquan > 10-11-10, 08:04 PM

  Tôi chạy sao không được nhỉ.
  
  - Lấy CPU: OK.
  - Lấy Main: chỉ có mỗi dấu , thôi.
  - Lấy HD báo lỗi Set Drv = fso.GetDrive(). error 450
  Noname xem giúp nhé.

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

  Cafe Via He > 10-11-10, 09:55 PM

  (10-11-10, 08:04 PM)haquocquan Đã viết: Tôi chạy sao không được nhỉ.
  
  - Lấy CPU: OK.
  - Lấy Main: chỉ có mỗi dấu , thôi.
  - Lấy HD báo lỗi Set Drv = fso.GetDrive(). error 450
  Noname xem giúp nhé.

  
  Bạn Quân. Mình có fix lỗi error 450 rồi.
  Sửa lại đoạn code thế này
  
  

  Mã:

  Set Drv = fso.GetDrive(Environ("SystemDrive"))

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

  haquocquan > 10-11-10, 10:03 PM

  Cám ơn CFVH. Mình đã lấy được CPU và HD rồi. Nhưng còn MAIN vẫn chưa được.

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

  Cafe Via He > 11-11-10, 11:11 AM

  @ Bạn Quân: Thử lại đoạn code này, Cafe thêm mắm muối chút nè. Lấy Model và Bios của Main luô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

  
  

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

  Noname > 11-11-10, 11:21 AM

  Hé hé, tks cafe, đã cập nhật tất cả lên trang đầu cho mọi người dễ theo dõi!

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

  Cafe Via He > 11-11-10, 11:25 AM

  --------->>>> 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

  Noname > 18-11-10, 10:44 AM

  Đã Chuyển từ sub thành function lấy về thông tin CPU, main, HDD. Có demo, xem ở trang 1.
  Chú ý: Một số main không cho lấy thông tin serial (các đời máy VAIO, Apple) nên hàm Lấy thông tin Main chỉ mang tính tham khảo!

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

  vanrongvn > 08-01-11, 12:49 PM

  Cảm ơn Noname về access demo
  Từ nay mình có thể tạo bản quyền file.mdb giống như những phần mềm Thuế của Fash
• Bài trước Bài tiếp