دریافت اطلاعات سیستم (مانند شماره سریال دیسک، ...) با استفاده از Windows Management Instrumentation

برای آشنایی با WMI به این نشانی بروید.

ابتدا رفرنس wmi scripting رو به برنامه اضافه میکنیم:
ضمیمه 153381
این کار الزامی نیست ولی چون early binding به کدنویسی بهتر و تمیزتری منجر میشه انجام میدیم.

برای هر یک از سخت افزارهای سیستم، باید از کلاس مربوط به اون استفاده کنیم.
لیست کلاس های سخت افزار سیستم

در این آموزش چون قصد داریم مشخصات دیسک ها رو بدست بیاریم، باید از کلاس Win32_DiskDrive استفاده کنیم.

لیست کامل property های یک diskdrive :

Availability

BytesPerSector

Capabilities

CapabilityDescriptions

Caption

CompressionMethod

ConfigManagerErrorCode

ConfigManagerUserConfig

CreationClassName

DefaultBlockSize

Description

DeviceID

ErrorCleared

ErrorDescription

ErrorMethodology

FirmwareRevision

Index

InstallDate

InterfaceType

LastErrorCode

Manufacturer

MaxBlockSize

MaxMediaSize

MediaLoaded

MediaType

MinBlockSize

Model

Name

NeedsCleaning

NumberOfMediaSupported

Partitions

PNPDeviceID

PowerManagementCapabilities

PowerManagementSupported

SCSIBus

SCSILogicalUnit

SCSIPort

SCSITargetId

SectorsPerTrack

SerialNumber

Signature

Size

Status

StatusInfo

SystemCreationClassName

SystemName

TotalCylinders

TotalHeads

TotalSectors

TotalTracks

TracksPerCylinder

اول یک جدول میسازیم که propertyهای مورد نظر ما رو در بر داشته باشه،
فیلدهای نمونه میتونه شبیه زیر باشه:
ضمیمه 153382

Option Compare Database

Option Explicit



Sub DisksInfo()

DoCmd.RunSQL ("DELETE * FROM DiskDrives")





Dim rs As Recordset

Set rs = CurrentDb.OpenRecordset("DiskDrives")

Dim fld As Field





Dim Loc As New SWbemLocator

Dim Svc As SWbemServices

Set Svc = Loc.ConnectServer(".", "root\cimv2")





Dim Drives As SWbemObjectSet

Set Drives = Svc.ExecQuery("SELECT * FROM Win32_DiskDrive")

Dim Drive As SWbemObject





For Each Drive In Drives

    rs.AddNew

        For Each fld In rs.Fields

            rs(fld.Name) = Trim(Drive.Properties_(fld.Name))

        Next

    rs.Update

Next





rs.Close

Set rs = Nothing

Set Loc = Nothing

Set Svc = Nothing

End Sub

نمونه نتایج:
ضمیمه 153383

برنامه نمونه:

نقل قول:

---

نوشته شده توسط mazoolagh

برنامه نمونه:

---

عالی بود ؛ فقط یک سوال داشتم
آیا در آفیس 64 بیتی هم جواب می دهد؟ یا فقط 32 بیتی یا اصلأ ربطی ندارد؟
با تشکر از شما

نقل قول:

---

نوشته شده توسط SB1398

آیا در آفیس 64 بیتی هم جواب می دهد؟ یا فقط 32 بیتی یا اصلأ ربطی ندارد؟

---

کدهای استفاده شده به ورژن آفیس بستگی نداره،
و برنامه نمونه هم با آفیس 2019 x64 ساخته شده.
با خیال راحت استفاده کنین.

کدهایی که از توابع api استفاده میکنن به 32/64 بیت بودن آفیس حساسن و برای اونهاست که باید تمهیدات لازم رو ببینید.