delphi4arab منتديات دلفي للعرب
مكون HDDINFO لمعرفة الرقم التسلسلي للقرص الصلب - نسخة قابلة للطباعة

+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : سؤال و جواب حول دلفي (https://delphi4arab.net/forum/forumdisplay.php?fid=15)
+--- الموضوع : مكون HDDINFO لمعرفة الرقم التسلسلي للقرص الصلب (/showthread.php?tid=9781)



مكون HDDINFO لمعرفة الرقم التسلسلي للقرص الصلب - rachid1984 - 05-10-2018

الرجاء المساعدة من الإخوة في كيفية الحصول على الرقم التسلسلي للقرص الصلب باستعمال المكون HDDINFO وكيفية التعامل معه


RE: مكون HDDINFO لمعرفة الرقم التسلسلي للقرص الصلب - bouh25 - 06-10-2018

(05-10-2018, 07:01 PM)rachid1984 كتب : الرجاء المساعدة من الإخوة في كيفية الحصول على الرقم التسلسلي للقرص الصلب باستعمال المكون HDDINFO وكيفية التعامل معه

ممكن هذا المثال يفيدك


RE: مكون HDDINFO لمعرفة الرقم التسلسلي للقرص الصلب - S.FATEH - 06-10-2018

السلام عليكم تفضل
PHP كود :
uses
  Winapi
.Windows, System.SysUtils;

function 
GetDiskSerialNumber: string;
type
  TSrbIoControl 
= packed record
    HeaderLength
: ULONG;
 
   Signature: Array [0 .. 7] of AnsiChar;
 
   Timeout: ULONG;
 
   ControlCode: ULONG;
 
   ReturnCode: ULONG;
 
   Length: ULONG;
 
 end;

 
 SRB_IO_CONTROL = TSrbIoControl;
 
 PSrbIoControl = ^TSrbIoControl;

 
 TIDERegs = packed record
    bFeaturesReg
: Byte; // Used for specifying SMART "commands".
 
   bSectorCountReg: Byte; // IDE sector count register
 
   bSectorNumberReg: Byte; // IDE sector number register
 
   bCylLowReg: Byte; // IDE low order cylinder value
 
   bCylHighReg: Byte; // IDE high order cylinder value
 
   bDriveHeadReg: Byte; // IDE drive/head register
 
   bCommandReg: Byte; // Actual IDE command.
 
   bReserved: Byte; // reserved for future use. Must be zero.
 
 end;

 
 IDEREGS = TIDERegs;
 
 PIDERegs = ^TIDERegs;

 
 TSendCmdInParams = packed record
    cBufferSize
: DWORD; // Buffer size in bytes
 
   irDriveRegs: TIDERegs; // Structure with drive register values.
 
   bDriveNumber: Byte; // Physical drive number to send command to (0,1,2,3).
 
   bReserved: Array [0 .. 2] of Byte; // Reserved for future expansion.
 
   dwReserved: Array [0 .. 3] of DWORD; // For future use.
 
   bBuffer: Array [0 .. 0] of Byte; // Input buffer.
 
 end;

 
 SENDCMDINPARAMS = TSendCmdInParams;
 
 PSendCmdInParams = ^TSendCmdInParams;

 
 TIdSector = packed record
    wGenConfig
: Word;
 
   wNumCyls: Word;
 
   wReserved: Word;
 
   wNumHeads: Word;
 
   wBytesPerTrack: Word;
 
   wBytesPerSector: Word;
 
   wSectorsPerTrack: Word;
 
   wVendorUnique: Array [0 .. 2] of Word;
 
   sSerialNumber: Array [0 .. 19] of AnsiChar;
 
   wBufferType: Word;
 
   wBufferSize: Word;
 
   wECCSize: Word;
 
   sFirmwareRev: Array [0 .. 7] of AnsiChar;
 
   sModelNumber: Array [0 .. 39] of AnsiChar;
 
   wMoreVendorUnique: Word;
 
   wDoubleWordIO: Word;
 
   wCapabilities: Word;
 
   wReserved1: Word;
 
   wPIOTiming: Word;
 
   wDMATiming: Word;
 
   wBS: Word;
 
   wNumCurrentCyls: Word;
 
   wNumCurrentHeads: Word;
 
   wNumCurrentSectorsPerTrack: Word;
 
   ulCurrentSectorCapacity: ULONG;
 
   wMultSectorStuff: Word;
 
   ulTotalAddressableSectors: ULONG;
 
   wSingleWordDMA: Word;
 
   wMultiWordDMA: Word;
 
   bReserved: Array [0 .. 127] of Byte;
 
 end;

 
 PIdSector = ^TIdSector;
const
 
 IDE_ID_FUNCTION = $EC;
 
 IDENTIFY_BUFFER_SIZE = 512;
 
 DFP_RECEIVE_DRIVE_DATA = $0007C088;
 
 IOCTL_SCSI_MINIPORT = $0004D008;
 
 IOCTL_SCSI_MINIPORT_IDENTIFY = $001B0501;
 
 DataSize = sizeof(TSendCmdInParams) - 1 + IDENTIFY_BUFFER_SIZE;
 
 BufferSize = sizeof(SRB_IO_CONTROL) + DataSize;
 
 W9xBufferSize = IDENTIFY_BUFFER_SIZE + 16;
var
 
 hDevice: THandle;
 
 cbBytesReturned: DWORD;
 
 pInData: PSendCmdInParams;
 
 pOutData: Pointer; // PSendCmdInParams;
 
 Buffer: Array [0 .. BufferSize - 1] of Byte;
 
 srbControl: TSrbIoControl absolute Buffer;
 
 procedure ChangeByteOrder(var Data; Size: Integer);
 
 var
    ptr
: PAnsiChar;
 
   i: Integer;
 
   c: AnsiChar;
 
 begin
    ptr 
:= @Data;
 
   for i := 0 to (Size shr 1) - 1 do
 
   begin
      c 
:= ptr^;
 
     ptr^ := (ptr + 1)^;
 
     (ptr + 1)^ := c;
 
     Inc(ptr, 2);
 
   end;
 
 end;

begin
  Result 
:= '';
 
 FillChar(Buffer, BufferSize, #0);
 
 hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
 
   FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
 
 if hDevice = INVALID_HANDLE_VALUE then
    Exit
;
 
 try
    pInData 
:= PSendCmdInParams(@Buffer);
 
   pOutData := PAnsiChar(@pInData^.bBuffer);
 
   with pInData^ do
 
   begin
      cBufferSize 
:= IDENTIFY_BUFFER_SIZE;
 
     bDriveNumber := 0;
 
     with irDriveRegs do
 
     begin
        bFeaturesReg 
:= 0;
 
       bSectorCountReg := 1;
 
       bSectorNumberReg := 1;
 
       bCylLowReg := 0;
 
       bCylHighReg := 0;
 
       bDriveHeadReg := $A0;
 
       bCommandReg := IDE_ID_FUNCTION;
 
     end;
 
   end;
 
   if not DeviceIoControl(hDevice, DFP_RECEIVE_DRIVE_DATA, pInData,
 
     sizeof(TSendCmdInParams) - 1, pOutData, W9xBufferSize,
 
     cbBytesReturned, nil) then
      Exit
;
 
 finally
    CloseHandle
(hDevice);
 
 end;
 
 with PIdSector(PAnsiChar(pOutData) + 16)^ do
 
 begin
    ChangeByteOrder
(sSerialNumber, sizeof(sSerialNumber));
 
   SetString(Result, sSerialNumber, sizeof(sSerialNumber));
 
 end;
end; 



RE: مكون HDDINFO لمعرفة الرقم التسلسلي للقرص الصلب - bassem_43 - 09-05-2024

(06-10-2018, 12:16 PM)S.FATEH كتب : السلام عليكم تفضل
PHP كود :
uses
  Winapi
.Windows, System.SysUtils;

function 
GetDiskSerialNumber: string;
type
  TSrbIoControl 
= packed record
    HeaderLength
: ULONG;
 
   Signature: Array [0 .. 7] of AnsiChar;
 
   Timeout: ULONG;
 
   ControlCode: ULONG;
 
   ReturnCode: ULONG;
 
   Length: ULONG;
 
 end;

 
 SRB_IO_CONTROL = TSrbIoControl;
 
 PSrbIoControl = ^TSrbIoControl;

 
 TIDERegs = packed record
    bFeaturesReg
: Byte; // Used for specifying SMART "commands".
 
   bSectorCountReg: Byte; // IDE sector count register
 
   bSectorNumberReg: Byte; // IDE sector number register
 
   bCylLowReg: Byte; // IDE low order cylinder value
 
   bCylHighReg: Byte; // IDE high order cylinder value
 
   bDriveHeadReg: Byte; // IDE drive/head register
 
   bCommandReg: Byte; // Actual IDE command.
 
   bReserved: Byte; // reserved for future use. Must be zero.
 
 end;

 
 IDEREGS = TIDERegs;
 
 PIDERegs = ^TIDERegs;

 
 TSendCmdInParams = packed record
    cBufferSize
: DWORD; // Buffer size in bytes
 
   irDriveRegs: TIDERegs; // Structure with drive register values.
 
   bDriveNumber: Byte; // Physical drive number to send command to (0,1,2,3).
 
   bReserved: Array [0 .. 2] of Byte; // Reserved for future expansion.
 
   dwReserved: Array [0 .. 3] of DWORD; // For future use.
 
   bBuffer: Array [0 .. 0] of Byte; // Input buffer.
 
 end;

 
 SENDCMDINPARAMS = TSendCmdInParams;
 
 PSendCmdInParams = ^TSendCmdInParams;

 
 TIdSector = packed record
    wGenConfig
: Word;
 
   wNumCyls: Word;
 
   wReserved: Word;
 
   wNumHeads: Word;
 
   wBytesPerTrack: Word;
 
   wBytesPerSector: Word;
 
   wSectorsPerTrack: Word;
 
   wVendorUnique: Array [0 .. 2] of Word;
 
   sSerialNumber: Array [0 .. 19] of AnsiChar;
 
   wBufferType: Word;
 
   wBufferSize: Word;
 
   wECCSize: Word;
 
   sFirmwareRev: Array [0 .. 7] of AnsiChar;
 
   sModelNumber: Array [0 .. 39] of AnsiChar;
 
   wMoreVendorUnique: Word;
 
   wDoubleWordIO: Word;
 
   wCapabilities: Word;
 
   wReserved1: Word;
 
   wPIOTiming: Word;
 
   wDMATiming: Word;
 
   wBS: Word;
 
   wNumCurrentCyls: Word;
 
   wNumCurrentHeads: Word;
 
   wNumCurrentSectorsPerTrack: Word;
 
   ulCurrentSectorCapacity: ULONG;
 
   wMultSectorStuff: Word;
 
   ulTotalAddressableSectors: ULONG;
 
   wSingleWordDMA: Word;
 
   wMultiWordDMA: Word;
 
   bReserved: Array [0 .. 127] of Byte;
 
 end;

 
 PIdSector = ^TIdSector;
const
 
 IDE_ID_FUNCTION = $EC;
 
 IDENTIFY_BUFFER_SIZE = 512;
 
 DFP_RECEIVE_DRIVE_DATA = $0007C088;
 
 IOCTL_SCSI_MINIPORT = $0004D008;
 
 IOCTL_SCSI_MINIPORT_IDENTIFY = $001B0501;
 
 DataSize = sizeof(TSendCmdInParams) - 1 + IDENTIFY_BUFFER_SIZE;
 
 BufferSize = sizeof(SRB_IO_CONTROL) + DataSize;
 
 W9xBufferSize = IDENTIFY_BUFFER_SIZE + 16;
var
 
 hDevice: THandle;
 
 cbBytesReturned: DWORD;
 
 pInData: PSendCmdInParams;
 
 pOutData: Pointer; // PSendCmdInParams;
 
 Buffer: Array [0 .. BufferSize - 1] of Byte;
 
 srbControl: TSrbIoControl absolute Buffer;
 
 procedure ChangeByteOrder(var Data; Size: Integer);
 
 var
    ptr
: PAnsiChar;
 
   i: Integer;
 
   c: AnsiChar;
 
 begin
    ptr 
:= @Data;
 
   for i := 0 to (Size shr 1) - 1 do
 
   begin
      c 
:= ptr^;
 
     ptr^ := (ptr + 1)^;
 
     (ptr + 1)^ := c;
 
     Inc(ptr, 2);
 
   end;
 
 end;

begin
  Result 
:= '';
 
 FillChar(Buffer, BufferSize, #0);
 
 hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
 
   FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
 
 if hDevice = INVALID_HANDLE_VALUE then
    Exit
;
 
 try
    pInData 
:= PSendCmdInParams(@Buffer);
 
   pOutData := PAnsiChar(@pInData^.bBuffer);
 
   with pInData^ do
 
   begin
      cBufferSize 
:= IDENTIFY_BUFFER_SIZE;
 
     bDriveNumber := 0;
 
     with irDriveRegs do
 
     begin
        bFeaturesReg 
:= 0;
 
       bSectorCountReg := 1;
 
       bSectorNumberReg := 1;
 
       bCylLowReg := 0;
 
       bCylHighReg := 0;
 
       bDriveHeadReg := $A0;
 
       bCommandReg := IDE_ID_FUNCTION;
 
     end;
 
   end;
 
   if not DeviceIoControl(hDevice, DFP_RECEIVE_DRIVE_DATA, pInData,
 
     sizeof(TSendCmdInParams) - 1, pOutData, W9xBufferSize,
 
     cbBytesReturned, nil) then
      Exit
;
 
 finally
    CloseHandle
(hDevice);
 
 end;
 
 with PIdSector(PAnsiChar(pOutData) + 16)^ do
 
 begin
    ChangeByteOrder
(sSerialNumber, sizeof(sSerialNumber));
 
   SetString(Result, sSerialNumber, sizeof(sSerialNumber));
 
 end;
end; 

السلام عليكم
يشتغل مع وينداوز 7 فقط و لايشتغل مع وينداوز 10
هل من تعديل لكي يشتغل مع النسخ الاعلى و شكرا


RE: مكون HDDINFO لمعرفة الرقم التسلسلي للقرص الصلب - ALG2009 - 11-05-2024

وعليكم السلام

جرب هذا


uses
Windows;

function GetHardDiskSerialNumber: string;
const
IOCTL_STORAGE_QUERY_PROPERTY = $2D1400;
StorageDeviceProperty = 0;
IsWindows10OrGreater = $A0;
MAX_PATH = 260;
type
STORAGE_PROPERTY_QUERY = record
PropertyId: DWORD;
QueryType: DWORD;
AdditionalParameters: array [0..3] of Byte;
end;
STORAGE_DESCRIPTOR_HEADER = record
Version: DWORD;
Size: DWORD;
end;
STORAGE_DEVICE_DESCRIPTOR = record
Version: DWORD;
Size: DWORD;
DeviceType: Byte;
DeviceTypeModifier: Byte;
RemovableMedia: Boolean;
CommandQueueing: Boolean;
VendorIdOffset: DWORD;
ProductIdOffset: DWORD;
ProductRevisionOffset: DWORD;
SerialNumberOffset: DWORD;
BusType: DWORD;
RawPropertiesLength: DWORD;
RawDeviceProperties: array [0..0] of Byte;
end;
var
hDevice: THandle;
bytesReturned: DWORD;
propQuery: STORAGE_PROPERTY_QUERY;
descHeader: STORAGE_DESCRIPTOR_HEADER;
descBuffer: array [0..MAX_PATH] of Byte;
deviceDescriptor: STORAGE_DEVICE_DESCRIPTOR absolute descBuffer;
serialNumber: PAnsiChar;
begin
Result := '';

hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if hDevice = INVALID_HANDLE_VALUE then
Exit;

propQuery.PropertyId := StorageDeviceProperty;
propQuery.QueryType := PropertyStandardQuery;

if not DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, @propQuery,
SizeOf(STORAGE_PROPERTY_QUERY), @descBuffer, SizeOf(descBuffer),
bytesReturned, nil) then
begin
CloseHandle(hDevice);
Exit;
end;

descHeader := STORAGE_DESCRIPTOR_HEADER(descBuffer);
serialNumber := PAnsiChar(@descBuffer[deviceDescriptor.SerialNumberOffset]);
Result := string(serialNumber);

CloseHandle(hDevice);
end;


RE: مكون HDDINFO لمعرفة الرقم التسلسلي للقرص الصلب - bassem_43 - 12-05-2024

(11-05-2024, 08:58 PM)ALG2009 كتب : وعليكم السلام

جرب هذا


uses
Windows;

function GetHardDiskSerialNumber: string;
const
IOCTL_STORAGE_QUERY_PROPERTY = $2D1400;
StorageDeviceProperty = 0;
IsWindows10OrGreater = $A0;
MAX_PATH = 260;
type
STORAGE_PROPERTY_QUERY = record
PropertyId: DWORD;
QueryType: DWORD;
AdditionalParameters: array [0..3] of Byte;
end;
STORAGE_DESCRIPTOR_HEADER = record
Version: DWORD;
Size: DWORD;
end;
STORAGE_DEVICE_DESCRIPTOR = record
Version: DWORD;
Size: DWORD;
DeviceType: Byte;
DeviceTypeModifier: Byte;
RemovableMedia: Boolean;
CommandQueueing: Boolean;
VendorIdOffset: DWORD;
ProductIdOffset: DWORD;
ProductRevisionOffset: DWORD;
SerialNumberOffset: DWORD;
BusType: DWORD;
RawPropertiesLength: DWORD;
RawDeviceProperties: array [0..0] of Byte;
end;
var
hDevice: THandle;
bytesReturned: DWORD;
propQuery: STORAGE_PROPERTY_QUERY;
descHeader: STORAGE_DESCRIPTOR_HEADER;
descBuffer: array [0..MAX_PATH] of Byte;
deviceDescriptor: STORAGE_DEVICE_DESCRIPTOR absolute descBuffer;
serialNumber: PAnsiChar;
begin
Result := '';

hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if hDevice = INVALID_HANDLE_VALUE then
Exit;

propQuery.PropertyId := StorageDeviceProperty;
propQuery.QueryType := PropertyStandardQuery;

if not DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, @propQuery,
SizeOf(STORAGE_PROPERTY_QUERY), @descBuffer, SizeOf(descBuffer),
bytesReturned, nil) then
begin
CloseHandle(hDevice);
Exit;
end;

descHeader := STORAGE_DESCRIPTOR_HEADER(descBuffer);
serialNumber := PAnsiChar(@descBuffer[deviceDescriptor.SerialNumberOffset]);
Result := string(serialNumber);

CloseHandle(hDevice);
end;
بارك الله فيك
لقد وجدت هاته الوحدة و تفي بالغرض
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,WbemScripting_TLB,ActiveX;

type
TForm4 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form4: TForm4;

implementation

{$R *.dfm}

function GetWMIstring (wmiHost, wmiClass, wmiProperty : string)Confusedtring;
var // These are all needed for the WMI querying process
Locator: ISWbemLocator;
Services: ISWbemServices;
SObject: ISWbemObject;
ObjSet: ISWbemObjectSet;
SProp: ISWbemProperty;
Enum: IEnumVariant;
Value: Cardinal;
TempObj: OleVariant;
SN: string;
begin
try
Locator := CoSWbemLocator.Create; // Create the Location object
// Connect to the WMI service, with the root\cimv2 namespace
Services := Locator.ConnectServer(wmiHost, 'root\cimv2', '', '', '','', 0, nil);
ObjSet := Services.ExecQuery('SELECT * FROM '+wmiClass, 'WQL',
wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
Enum := (ObjSet._NewEnum) as IEnumVariant;
while (Enum.Next(1, TempObj, Value) = S_OK) do
begin
SObject := IUnknown(tempObj) as ISWBemObject;
SProp := SObject.Properties_.Item(wmiProperty, 0);
if VarIsNull(SProp.Get_Value) then
result := ''
else
begin
SN := SProp.Get_Value;
result := SN;
end;
end;
except // Trap any exceptions (Not having WMI installed will cause one!)
on exception do
result := '';
end;
end;

procedure TForm4.Button1Click(Sender: TObject);
var
xConfusedtring;
YConfusedtring;

begin


X:=GetWMIstring('','Win32_BIOS','SerialNumber');
Y:=GetWMIstring('','Win32_DiskDrive"','SerialNumber') ;

ShowMessage(x+';'+y);
end;

end.


RE: مكون HDDINFO لمعرفة الرقم التسلسلي للقرص الصلب - Delphi4Us - 08-07-2024

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

والمشكلة ربما في ملفات النظام او في القرص نفسه لا احد يعلم ولكن يبدو ان هناك من يستطيع تجاوز هذه المشاكل
مثل CrystalDiskInfo
ولهذا لابد من وجود طريقة افضل واضمن