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

[mazoolagh]

برای آشنایی با WMI به این نشانی (https://docs.microsoft.com/en-us/windows/win32/wmisdk/wmi-start-page) بروید.

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

[mazoolagh]

برای هر یک از سخت افزارهای سیستم، باید از کلاس مربوط به اون استفاده کنیم.
لیست کلاس های سخت افزار سیستم (https://docs.microsoft.com/en-us/windows/win32/cimwin32prov/computer-system-hardware-classes)

در این آموزش چون قصد داریم مشخصات دیسک ها رو بدست بیاریم، باید از کلاس Win32_DiskDrive (https://docs.microsoft.com/en-us/windows/win32/cimwin32prov/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

[mazoolagh]

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

[mazoolagh]

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

[mazoolagh]

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

[mazoolagh]

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

[SB1398]

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

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

[mazoolagh]

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


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

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