كود معرفة سريال هارد الكمبيوتر

[AhmedEmam]

السلام عليكم السادة الاعضاء الكرام

ممكن كود عند فتح نموذج يظهر لى رقم السيريال بتاع الهارد فى تكست بوكس

لكم الشكر والتقدير 

[Foksh]

8 دقائق مضت, AhmedEmam said:

السلام عليكم

وعليكم السلام ورحمة الله وبركاته ..

لدي دالة تجلب جميع أرقام الهارد ديسك ( القرص الصلب ) حتى لو كان لديك أكثر من هارد موصول على نفس الكمبيوتر ..

Public Function GetAllHardDiskSerials() As String
    On Error GoTo ErrorHandler
    
    Dim objWMIService As Object
    Dim colDisks As Object
    Dim objDisk As Object
    Dim result As String
    Dim i As Integer
    
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colDisks = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive")
    
    i = 1
    For Each objDisk In colDisks
        If Not IsNull(objDisk.SerialNumber) Then
            Dim serial As String
            serial = Trim(objDisk.SerialNumber)
            If serial <> "" Then
                result = result & "Disk " & i & ": " & serial & vbCrLf
                i = i + 1
            End If
        End If
    Next
    
    If result = "" Then
        GetAllHardDiskSerials = "No serial numbers found"
    Else
        GetAllHardDiskSerials = result
    End If
    
CleanUp:
        Set objDisk = Nothing
        Set colDisks = Nothing
        Set objWMIService = Nothing
        Exit Function
        
ErrorHandler:
        GetAllHardDiskSerials = "Error"
        Resume CleanUp
End Function

 

أو هذه الدالة البسيطة أيضاً التي تجلب رقم الهارد الذي تم تثبيت نظام التشغيل ويندوز عليه :-

Public Function GetHardDiskSerial2() As String
    On Error GoTo ErrorHandler
    
    Dim objWMIService As Object
    Dim colDisks As Object
    Dim objDisk As Object
    Dim strSerial As String
    
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colDisks = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive")
    
    For Each objDisk In colDisks
        If Not IsNull(objDisk.SerialNumber) Then
            strSerial = Trim(objDisk.SerialNumber)
            If strSerial <> "" Then
                GetHardDiskSerial2 = strSerial
                Exit For
            End If
        End If
    Next
    
    If GetHardDiskSerial2 = "" Then
        GetHardDiskSerial2 = "Not Found"
    End If
    
CleanUp:
        Set objDisk = Nothing
        Set colDisks = Nothing
        Set objWMIService = Nothing
        Exit Function
        
ErrorHandler:
        Resume CleanUp
End Function

 

والإستدعاء فقط في أي مربع نص = اسم الدالة فقط ، كما في الملف المرفق للتوضيح .

HD Serial.zip