معرفة الرقم التسلسلي للقرص

[ashraf]

من الاستخدامات منع تشغيل القاعدة في جهاز آخر إذا أختلف رقم القرص عن الرقم المسجل بالقاعدة .

في الوحدة النمطية العامة اكتب :

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

وفي حدث عند نقر زر أمر اكتب :

Dim disk As String

Dim serialnum As Long, serial As String


disk = "c:\" 'غير الى القرص الذي تريد

RetVal = GetVolumeInformation(disk, NomVolume, Len(NomVolume), _

serialnum, dum, dum, ResStr, Len(ResStr))


'استخراج الرقم التسلسلي

serial = Right(String(8, "0") + Hex$(serialnum), 8)

serial = Left(serial, 4) + "-" + Right$(serial, 4)

MsgBox serial

**************

مع تحيات موقع أبو حمود