Assalomu alaykum, yordam.uz saytimizga xush kelibsiz.
Bu saytda o`zingizni qiziqtirgan savollarga javob olishingiz va o`z sohangiz bo`yicha savollarga javob berishingiz mumkin. Bizning Oilamizga a'zo bo`lganingiz uchun chuqur Minnatdorchilik bildiramiz !!!

hdd id serial nomerini delphida olish

+3 ovoz
212 marta ko‘rilgan
so‘radi 04 iyul, 17 saylaw94 (83 bal)
Delphi da hdd id serial nomerini edit ga chiqarsa bo'ladimi? iloji bo'lsa batafsilroq. Javob uchun oldindan rahmat.
izoh qoldirdi 04 iyul, 17 Saidolim (3,566 bal)
o`zingiz biror usulni ishlatib ko`rmadingizmi? agar ishlatgan usulingizni ko`rsatsangiz, to`g`rilashga yordam berar edik. Chunki hamma HDD larni ham serial raqamini olib bo`lmaydi.

2 Javoblar

+4 ovoz
javob berdi 05 iyul, 17 oakrom (389 bal)
tanlangan 12 iyul, 17 vejon
 
Eng yaxshi javob

100% ishlidigan kod, XE lani xammasida ishlidi, Delphi 7 da xam ishlashi kerak.

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;

izoh qoldirdi 08 iyul, 17 DelphiGuru (823 bal)
Pachti hammasida ishlayabdi. Faqat Administrator nomidan dasturni ishga tushirish kerak. Raxmat!
–1 ovoz
javob berdi 05 iyul, 17 ☆☆tik⊙⊙tak☆☆ (353 bal)

Salom! Delphi ni qaysi versiyasida ishlavotganizi bilmaganim uchun o`zim bir vaqtla ishlagan Delphi 7 uchun siz bergan savolga javob qoldiraman. Lekin o`zim ishlatib ko`rganim yo`q chunki 4 yildan beri delphida ishlashi tuhtatgaman.

1) https://stackoverflow.com/questions/13215713/get-real-hdd-serial-number-with-delphi

yoki

2) https://stackoverflow.com/questions/5202270/in-delphi7-how-can-i-retrieve-hard-disk-unique-serial-number

Shu ssilkalarda aynan siz so`ragan narsa ko`rsatilgan

izoh qoldirdi 05 iyul, 17 Saidolim (3,566 bal)
Iloji bo`lsa, havola (ssilka)lar bilan javob bermang. Sababi havoladagi siteda bu havola ishlami qolsa, javobning qiymati yo`qoladi. Iloji bo`lsa, u yerdan olib, bizga moslab, ochiq matn shaklida yozib berganingiz maqul bo`lardi.

Assalomu alaykum, yordam.uz saytimizga xush kelibsiz.

Bu saytda o`zingizni qiziqtirgan savollarga javob olishingiz va o`z sohangiz bo`yicha savollarga javob berishingiz mumkin.

Bizning Oilamizga a'zo bo`lganingiz uchun chuqur Minnatdorchilik bildiramiz !!!

Telegram kanal YordamUzRss

...