كود لاظهار رقم الهارد الثابت

[User user]

محتاج كود لاظهار رقم الهارد الحقيقى الثابت الذى لا يتغير مع تغير الويندوز او الفورمات 
REAL Hard Drive Serial Number

[ناقل]

تفضل ......

في ٢٢‏/١٢‏/٢٠٢١ at 15:10, ابو جودي said:

طيب نصيحة سيبك من رقم الماذر بورد

لانه احيانا الاكواد ما تحصل اى نتائج ومنها اللوحة تبعى 

 

ان كنت تريد رقم فريد اتفضل

- التجربة قبل وبعد فصل الشبكة ظهر نفس الرقم

- التجربة بعد أعادة تشغيل .. قبل وبعد فصل الشبكة ظهر نفس الرقم

- التجربة بعد الفرمات .. قبل وبعد فصل الشبكة ظهر نفس الرقم

- النظام قبل الفرمات ويندوز 10 - 64Bit   أوفس 2021 64Bit

- النظام بعد الفرمات ويندوز 7 - 32Bit   أوفس 2016 32Bit

والرقم الناتج من تلك الطريقة ثابت لا يتغير مطلقا

 

Get UUID.mdb 204 kB · 14 downloads

 

[User user]

17 دقائق مضت, ناقل said:

تفضل ......

 

شكرا لتعبك محتاج سيريال الهارد 

[Eng.Qassim]

 

[ابو جودي]

اتفضل

Function GetPhysicalSerial() As Variant

    Dim obj As Object
    Dim wmi As Object
    Dim SNList() As String, i As Long, count As Long
    
    Set wmi = GetObject("WinMgmts:")
    
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        If obj.SerialNumber <> "" Then count = count + 1
    Next
    
    'ReDim SNList(1 To Count, 1 To 1)
    ReDim SNList(1 To count)
    
    i = 1
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        'SNList(i, 1) = obj.SerialNumber
        SNList(i) = Trim(obj.SerialNumber & "")
        Debug.Print Trim(obj.SerialNumber & "")
        i = i + 1
        If i > count Then Exit For
    Next
    
    GetPhysicalSerial = SNList(1)
End Function

 

لم يتم الاختبار بعد الفورمات 

ولا ادرى هل تغيير رقم الهاردديسك يؤثر على النتيجة ام لا

[User user]

16 ساعات مضت, ابو جودي said:

اتفضل

Function GetPhysicalSerial() As Variant

    Dim obj As Object
    Dim wmi As Object
    Dim SNList() As String, i As Long, count As Long
    
    Set wmi = GetObject("WinMgmts:")
    
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        If obj.SerialNumber <> "" Then count = count + 1
    Next
    
    'ReDim SNList(1 To Count, 1 To 1)
    ReDim SNList(1 To count)
    
    i = 1
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        'SNList(i, 1) = obj.SerialNumber
        SNList(i) = Trim(obj.SerialNumber & "")
        Debug.Print Trim(obj.SerialNumber & "")
        i = i + 1
        If i > count Then Exit For
    Next
    
    GetPhysicalSerial = SNList(1)
End Function

 

لم يتم الاختبار بعد الفورمات 

ولا ادرى هل تغيير رقم الهاردديسك يؤثر على النتيجة ام لا

غير ثابت بيتغير مع تغير الويندوز 

[ابو جودي]

1 ساعه مضت, User user said:

غير ثابت بيتغير مع تغير الويندوز 

الله اعلم 

انا حصلت الكود من البحث وقيل انه هاد الرقم الثابت للهارد ديسك اللى لا بيتغير لا بأى طريقة من طرق المتبعة ولا بالفورمات 

ومن اجل ذلك لاننى لم اقم بعمل فورمات والتجربة للكود ذكرت ذلك 

اقتباس

لم يتم الاختبار بعد الفورمات 
ولا ادرى هل تغيير رقم الهاردديسك يؤثر على النتيجة ام لا

 

القول الفصل هو التجربة العملية بتغيير رقم الهارد ديسك

وتجربة الكود 

وبعمل فورمات  ثم تجربة الكود كذلك للتاكد من انها نفس النتيحة 

 

ولكن انا اميل الا ان هذا الرقم هو الرقم الثابت والذى لا يتغير مطلقا لان الروتين يقوم بتحضير موديل وسيريال الهارد ديسك  

تم تعديل ديسمبر 27, 2021 بواسطه ابو جودي

[User user]

1 ساعه مضت, ابو جودي said:

الله اعلم 

انا حصلت الكود من البحث وقيل انه هاد الرقم الثابت للهارد ديسك اللى لا بيتغير لا بأى طريقة من طرق المتبعة ولا بالفورمات 

ومن اجل ذلك لاننى لم اقم بعمل فورمات والتجربة للكود ذكرت ذلك 

 

القول الفصل خو التجربة العملية بتغيير رقم الهارد ديسك

وتجربة الكود 

وبعمل فورمات  ثم تجربة الكود كذلك

ولكن انا اميل الا ان هذا الرقم هو الرقم الثابت والذى لا يتغير مطلقا لان الروتين يقوم بتحضير موديل وسيريال الهارد ديسك  

حضرتك جربت الكود ؟

 

[سامي الحداد]

Sub GetPhysicalSerial()
 
Dim obj As Object
Dim WMI As Object
 
Set WMI = GetObject("WinMgmts:")
 
For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")
Debug.Print "SN: " & obj.SerialNumber
Next
 
End Sub

تفضل اخي 

هذا الكود لمعرفة رقم الهارد الثابت ولن يتغير ابدا.

@ Echo off

wmic diskdrive get serialnumber

pause

 

MyHdd.rar

تم تعديل ديسمبر 28, 2021 بواسطه سامي الحداد
إضافة كود VBA

[User user]

4 ساعات مضت, سامي الحداد said:

@ Echo off

wmic diskdrive get serialnumber

pause

كيفية تحويل الكود ل vba

4 ساعات مضت, سامي الحداد said:

Sub GetPhysicalSerial()
 
Dim obj As Object
Dim WMI As Object
 
Set WMI = GetObject("WinMgmts:")
 
For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")
Debug.Print "SN: " & obj.SerialNumber
Next
 
End Sub

مع تغير الويندوز بيتغير 

[Ahmed_J]

السلام عليكم

انا استخدم هذه الوحدة النمطية

اتمنى ان تكون المطلوب

Public Function GetHDID()
On Error Resume Next

   Dim wmi As Object
   Dim wmiCollection As Object
   Dim wmiMember As Object
   
   Set wmi = GetObject("winmgmts:\\")
   Set wmiCollection = wmi.InstancesOf("Win32_PhysicalMedia")
   
   For Each wmiMember In wmiCollection
   
   GetHDID = wmiMember.SerialNumber

     'MsgBox Trim(wmiMember.SerialNumber)
      
   Exit For
   Next
   Set wmiMember = Nothing
   Set wmiCollection = Nothing
   Set wmi = Nothing
End Function

 

 

test.accdb

تم تعديل ديسمبر 28, 2021 بواسطه Ahmed_J

[User user]

2 ساعات مضت, Ahmed_J said:

السلام عليكم

انا استخدم هذه الوحدة النمطية

اتمنى ان تكون المطلوب

Public Function GetHDID()
On Error Resume Next

   Dim wmi As Object
   Dim wmiCollection As Object
   Dim wmiMember As Object
   
   Set wmi = GetObject("winmgmts:\\")
   Set wmiCollection = wmi.InstancesOf("Win32_PhysicalMedia")
   
   For Each wmiMember In wmiCollection
   
   GetHDID = wmiMember.SerialNumber

     'MsgBox Trim(wmiMember.SerialNumber)
      
   Exit For
   Next
   Set wmiMember = Nothing
   Set wmiCollection = Nothing
   Set wmi = Nothing
End Function

 

 

test.accdb 536 kB · 2 downloads

اشكرك على تعبك 
للاسف السيريال بتاع الهارد بيتغير بعد تغير النسخه