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

[User user]

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

[ناقل]

تفضل ......

  في 22‏/12‏/2021 at 12:10, ابو جودي said:

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

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

 

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

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

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

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

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

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

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

 

Get UUID.mdb 204 kB · 14 downloads

Expand  

 

[User user]

  في 26‏/12‏/2021 at 19:47, ناقل said:

تفضل ......

 

Expand  

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

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

  في 26‏/12‏/2021 at 20:17, ابو جودي 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

 

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

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

Expand  

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

[ابو جودي]

  في 27‏/12‏/2021 at 12:37, User user said:

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

Expand  

الله اعلم 

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

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

  اقتباس

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

Expand  

 

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

وتجربة الكود 

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

 

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

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

[User user]

  في 27‏/12‏/2021 at 12:42, ابو جودي said:

الله اعلم 

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

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

 

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

وتجربة الكود 

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

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

Expand  

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

 

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

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.rarFetching info...

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

[User user]

  في 28‏/12‏/2021 at 08:27, سامي الحداد said:

@ Echo off

wmic diskdrive get serialnumber

pause

Expand  

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

  في 28‏/12‏/2021 at 08:27, سامي الحداد 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

Expand  

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

[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.accdbFetching info...

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

[User user]

  في 28‏/12‏/2021 at 14:33, 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

Expand  

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