Đọc serial ổ đĩa

[chibi]

Tôi muốn các bạn chỉ giúp:
- Hàm đọc serialnumber của đĩa cứng (Không phải từng ổ - C:, D: trên đĩa).
- Ngắt chức năng cắt (cut) trong Excel.

 

[phongvanvu]

Đây là hàm đọc serial number của ổ cứng:
Private Sub Test()

'Show drive serial number for the current drive
MsgBox " Drive serial number for " & Left(Application.Path, 1) & ": " & GetDriveSerialNumber
End

End Sub

Public Function GetDriveSerialNumber(Optional ByVal DriveLetter As String) As Long

Dim fso As Object, Drv As Object

'Create a FileSystemObject object
Set fso = CreateObject("Scripting.FileSystemObject")

'Assign the current drive letter if not specified
If DriveLetter <> "" Then
Set Drv = fso.GetDrive(DriveLetter)
Else
Set Drv = fso.GetDrive(fso.GetDriveName(Application.Path))
End If

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

GetDriveSerialNumber = DriveSerial

End Function
Còn ngắt chức năng Cut trong Excel thì tôi không biết.

 

[chibi]

Dùng như bạn phongvanvu thì đọc được serialnumber cử từng ổ (C:, D:...). Nếu dùng ghost từ cùng 1 nguồn thì sẽ đọc số này giống nhau trên 2 đĩa cứng khác nhau.
Tôi muốn đọc "mã số" (tạm dịch) của đĩa cứng.

 

[phongvanvu]

Có phải cái này không vậy:
Sub FactoryVolumeSerieHD()
Dim ObjetoWMI As Object
Dim Disco As Object
Dim Discos As Object
Set ObjetoWMI = GetObject("WINMGMTS:")
Set Discos = ObjetoWMI.InstancesOf("Win32_PhysicalMedia")
For Each Disco In Discos
MsgBox "Serie : " & Disco.SerialNumber
Next
End Sub
Nếu phải thì thanks cho tôi một cái.

 

[tigertiger]

Có phải cái này không vậy:
Sub FactoryVolumeSerieHD()
Dim ObjetoWMI As Object
Dim Disco As Object
Dim Discos As Object
Set ObjetoWMI = GetObject("WINMGMTS:")
Set Discos = ObjetoWMI.InstancesOf("Win32_PhysicalMedia")
For Each Disco In Discos
MsgBox "Serie : " & Disco.SerialNumber
Next
End Sub
Nếu phải thì thanks cho tôi một cái.

hình như không hoạt động được - hay ở partion ẩn nó không hoạt động, thông tin giúp mình nhé

Dùng như bạn phongvanvu thì đọc được serialnumber cử từng ổ (C:, D:...). Nếu dùng ghost từ cùng 1 nguồn thì sẽ đọc số này giống nhau trên 2 đĩa cứng khác nhau.
Tôi muốn đọc "mã số" (tạm dịch) của đĩa cứng.

để tránh ghost mà vẫn đọc được (tôi đoán bạn bảo vệ khóa mã vba) bạn hãy kiểm tra luôn tất cả các serial của các ổ logic có trong máy.

đúng là bảo vệ mã vba khó quá - (vì có những tiện ích dò pw). cao thủ nào có cao kiến về bảo vệ mã vba trong excel, autoCAD cho ý kiến với?

hình như vba không cho dịch mã -thế mới khổ và khó, thành quả của ta mà thiên hạ cư ngang nhiên dùng (thà gửi lên diễn đàn a e ta cùng khai thác còn hơn) hu hu hu?

 

[Nguyễn Duy Tuân]

Nếu chỉ VBA bảo vệ nó thì thực sự là khó khăn. Bạn hãy dùng VB6, chuyển code của bạn sang và đặt trong một class, sau đó biên dịch thành file dll.

 

[chibi]

Chân thành cảm ơn phongvanvu. Có thể giải thích rõ hơn chút nữa được không? Thanks.

 

[levanduyet]

Nếu chỉ VBA bảo vệ nó thì thực sự là khó khăn. Bạn hãy dùng VB6, chuyển code của bạn sang và đặt trong một class, sau đó biên dịch thành file dll.

Hay bạn cũng có thể viết code bình thường nhưng dùng VSTO cho Office. Khi lập trình, nó sẽ tự động tạo file *.Dll mà bạn không cần phải chuyển code và biên dịch như trên.


Lê Văn Duyệt

 

[PMXD]

Đọc Serial ổ cứng bằng cách dùng hàm API của Window

Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long


Sub GetSerial()
Dim a As String, b As String, C As Long, e As Long, f As Long, g As String, H As Long, D As Long
b = Space(255)
a = "C:\"
C = 255
D = 255
e = 255
f = 255
H = 255
Call GetVolumeInformation(a, b, C, D, e, f, g, H)
End Sub

 

[tklshb]

Ô! Tôi cứ tưởng mỗi ổ cứng chỉ có 1 số Serial thôi chứ (cho dù bạn chia nó ra làm nhiều phân vùng khác nhau).
-----------------------------------------

 

[PhanTuHuong]

Của anh PMXD chỉ thực hiện cho từng ổ đĩa thôi, để lấy tên của máy tính thì sử dụng hàm sau:

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

------------------------------

Function Get_Computer_Name()

Dim buffer As String * 512, length As Long
length = Len(buffer)
If GetComputerName(buffer, length) Then
'Returns nonzero if successful, and modifies the length argument
Get_Computer_Name = Trim(Left$(buffer, length))
End If

End Function

 

[tklshb]

Hay bạn cũng có thể viết code bình thường nhưng dùng VSTO cho Office. Khi lập trình, nó sẽ tự động tạo file *.Dll mà bạn không cần phải chuyển code và biên dịch như trên.

Mong bạn giải thích thêm, tôi không rõ VSTO là gì ?

 

[PhanTuHuong]

đó chính là các từ đầu Visual Studio Tools for Office.