delphi4arab منتديات دلفي للعرب

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

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

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

السلام عليكم تفضل

(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
هل من تعديل لكي يشتغل مع النسخ الاعلى و شكرا

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

جرب هذا


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;

(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)tring;
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
xtring;
Ytring;

begin


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

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

end.

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

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