سوال: بدست آوردن شماره سریال فیزیکی هارد دیسکی که برنامه بر روی آن قرار دارد!!!

سلام
فرض کنید من سیستمی دارم که به آن چند هارد دیسک متصل شده است. سوال اینجا است که من می خواهم شماره سریال فیزیکی آن هارد دیسکی را بدست آورم که برنامه من بر روی آن قرار دارد. :گیج:
من قبلاً تابعی را پیدا کرده بودم که برای بدست آوردن شماره سریال فیزیکی هارد دیسک به کار می رفت ولی به جای شماره سریال هارد دیسک چرت و پرت بر می گرداند. (کد تابع در همین سایت بود) :عصبانی:

در ضمن من از دلفی 2010 استفاده می کنم. :لبخند:

لطفاً راهنمایی کنید. :قلب:

یه چیزی تو این مایه هاست

procedure TForm1.Button2Click(Sender: TObject);

var

  NotUsed: DWORD;

  VolumeFlags: DWORD;

  VolumeInfo: array[0..MAX_PATH] of Char;

  VolumeSerialNumber: DWORD;

  PartitionType: array[0..32] of Char;

  ResultStr :PChar;

  CurDrive, Buffer : PChar;

begin

 Buffer := PChar(ParamStr(0));

 GetMem(CurDrive, strlen(Buffer));

 strcopy(CurDrive, Buffer);

 CurDrive[3] := chr(0);

  GetVolumeInformation(CurDrive,

                       nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,

                       VolumeFlags, PartitionType, 32);

  GetMem(ResultStr, 256);

  strcopy(ResultStr, 'Serial of Volume ');

  strcat(ResultStr, CurDrive);

  strcat(ResultStr, ' is ');

  strcat(ResultStr, PChar(IntToStr(VolumeSerialNumber)));

  ShowMessage(ResultStr);

  FreeMem(ResultStr);

 FreeMem(CurDrive);

end;

این تابع برای بدست آوردن سریال فیزیکی نیست ، فقط سریال همون پارتیشن رو برمیگردونه که با هر بار فرمت عوض میشه.

نقل قول:

---

این تابع برای بدست آوردن سریال فیزیکی نیست ، فقط سریال همون پارتیشن رو برمیگردونه که با هر بار فرمت عوض میشه

---

dll به اسم 'HardwareIDExtractor.DLL' برای این کار هست جستجو کنید به نظرم demo هم داشته باشه.

بله این رو میدونم ، منظورم کدهایی بود که شما برای بدست آوردن سریال نوشته بودید.

از MiTeC_System_Information_v10.7.0_Full.Source استفاده کنید ، راحت ، کامل و دقیق

سلام
با استفاده از کامپوننت زیر که قابل نصب روی تمام نسخه های دلفی هست می تونید سریال سخت افزاری هارد رو روی تمامی نسخه های ویندوز (xp , Vista32 , Vista64 , Seven32 , Seven64) به دست بیارید.
http://artsoft.nm.ru/download/hddinfo.zip

با این کد سریال هارد رو می تونید بدست بیارید. در محیط Virtual هم سریال رو خالی برمی گردونه

 



function Sa_GetIdeSerialNumber : String;

const IDENTIFY_BUFFER_SIZE = 512;

type

  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;

  TSendCmdInParams = packed record

    // Buffer size in bytes

    cBufferSize  : DWORD;

    // Structure with drive register values.

    irDriveRegs  : TIDERegs;

    // Physical drive number to send command to (0,1,2,3).

    bDriveNumber : BYTE;

    bReserved    : Array[0..2] of Byte;

    dwReserved   : Array[0..3] of DWORD;

    bBuffer      : Array[0..0] of Byte;  // Input buffer.

  end;

  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 CHAR;

    wBufferType                : Word;

    wBufferSize                : Word;

    wECCSize                   : Word;

    sFirmwareRev               : Array[0..7] of Char;

    sModelNumber               : Array[0..39] of Char;

    wMoreVendorUnique          : Word;

    wDoubleWordIO              : Word;

    wCapabilities              : Word;

    wReserved1                 : Word;

    wPIOTiming                 : Word;

    wDMATiming                 : Word;

    wBS                        : Word;

    wNumCurrentCyls            : Word;

    wNumCurrentHeads           : Word;

    wNumCurrentSectorsPerTrack : Word;

    ulCurrentSectorCapacity    : DWORD;

    wMultSectorStuff           : Word;

    ulTotalAddressableSectors  : DWORD;

    wSingleWordDMA             : Word;

    wMultiWordDMA              : Word;

    bReserved                  : Array[0..127] of BYTE;

  end;

  PIdSector = ^TIdSector;

  TDriverStatus = packed record

    // Error code from driver, or 0 if no error.

    bDriverError : Byte;

    // Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR.

    bIDEStatus   : Byte;

    bReserved    : Array[0..1] of Byte;

    dwReserved   : Array[0..1] of DWORD;

  end;

  TSendCmdOutParams = packed record

    // Size of bBuffer in bytes

    cBufferSize  : DWORD;

    // Driver status structure.

    DriverStatus : TDriverStatus;

    // Buffer of arbitrary length in which to store the data read from the drive.

    bBuffer      : Array[0..0] of BYTE;

  end;

var hDevice : THandle;

    cbBytesReturned : DWORD;

    ptr : PChar;

    SCIP : TSendCmdInParams;

    aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;

    IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;

  procedure ChangeByteOrder( var Data; Size : Integer );

  var ptr : PChar;

      i : Integer;

      c : Char;

  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 := ''; // return empty string on error

  if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000

    begin

      // warning! change name for other drives: ex.: second drive '\\.\PhysicalDrive1\'

      hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,

        FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );

    end

  else // Version Windows 95 OSR2, Windows 98

    hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );

  if hDevice=INVALID_HANDLE_VALUE then Exit;

  try

    FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);

    FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);

    cbBytesReturned := 0;

    // Set up data structures for IDENTIFY command.

    with SCIP do

    begin

      cBufferSize  := IDENTIFY_BUFFER_SIZE;

//      bDriveNumber := 0;

      with irDriveRegs do

      begin

        bSectorCountReg  := 1;

        bSectorNumberReg := 1;

//      if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0

//      else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);

        bDriveHeadReg    := $A0;

        bCommandReg      := $EC;

      end;

    end;

    if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,

      @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;

  finally

    CloseHandle(hDevice);

  end;

  with PIdSector(@IdOutCmd.bBuffer)^ do

  begin

    ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );

    (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;

    Result := PChar(@sSerialNumber);

  end;

end;

نقل قول:

---

با این کد سریال هارد رو می تونید بدست بیارید. در محیط Virtual هم سریال رو خالی برمی گردونه

---

منظور از محیط مجازی چیه؟
برای منکه کلا خروجیش خالیه!

نقل قول:

---

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

منظور از محیط مجازی چیه؟
برای منکه کلا خروجیش خالیه!

---

یعنی اینکه مثلا اگر برنامه شما در محیطی مثل VirtualPC اجرا بشه مقداری بر نمیگردونه.

سلام
جناب majid_ramak :بوس: کدی که قرار داده اید درست است ولی مشکل اینجا است که این کد در محیط های یونیکد( دلفی 2009 به بعد یک رشته خالی را بر می گرداند). البته مشکل خاصی نبود فقط کافی بود که نوع مقدار برگشتی را به PAnsiChar تغییر بدیم و همچنین در آخرین خط تابع باید به جای PChar از PAnsiChar استفاده کنیم.
همینجا لازمه از همه دوستانی که به خاطر رفع این مشکل کمک کردند تشکر کنم. :قلب:

کد اصلاح شده که به درستی کار می کند:

function Sa_GetIdeSerialNumber : PAnsiChar;

const IDENTIFY_BUFFER_SIZE = 512;

type

  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;

  TSendCmdInParams = packed record

    // Buffer size in bytes

    cBufferSize  : DWORD;

    // Structure with drive register values.

    irDriveRegs  : TIDERegs;

    // Physical drive number to send command to (0,1,2,3).

    bDriveNumber : BYTE;

    bReserved    : Array[0..2] of Byte;

    dwReserved   : Array[0..3] of DWORD;

    bBuffer      : Array[0..0] of Byte;  // Input buffer.

  end;

  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 CHAR;

    wBufferType                : Word;

    wBufferSize                : Word;

    wECCSize                   : Word;

    sFirmwareRev               : Array[0..7] of Char;

    sModelNumber               : Array[0..39] of Char;

    wMoreVendorUnique          : Word;

    wDoubleWordIO              : Word;

    wCapabilities              : Word;

    wReserved1                 : Word;

    wPIOTiming                 : Word;

    wDMATiming                 : Word;

    wBS                        : Word;

    wNumCurrentCyls            : Word;

    wNumCurrentHeads           : Word;

    wNumCurrentSectorsPerTrack : Word;

    ulCurrentSectorCapacity    : DWORD;

    wMultSectorStuff           : Word;

    ulTotalAddressableSectors  : DWORD;

    wSingleWordDMA             : Word;

    wMultiWordDMA              : Word;

    bReserved                  : Array[0..127] of BYTE;

  end;

  PIdSector = ^TIdSector;

  TDriverStatus = packed record

    // Error code from driver, or 0 if no error.

    bDriverError : Byte;

    // Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR.

    bIDEStatus   : Byte;

    bReserved    : Array[0..1] of Byte;

    dwReserved   : Array[0..1] of DWORD;

  end;

  TSendCmdOutParams = packed record

    // Size of bBuffer in bytes

    cBufferSize  : DWORD;

    // Driver status structure.

    DriverStatus : TDriverStatus;

    // Buffer of arbitrary length in which to store the data read from the drive.

    bBuffer      : Array[0..0] of BYTE;

  end;

var hDevice : THandle;

    cbBytesReturned : DWORD;

    ptr : PChar;

    SCIP : TSendCmdInParams;

    aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;

    IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;

  procedure ChangeByteOrder( var Data; Size : Integer );

  var ptr : PChar;

      i : Integer;

      c : Char;

  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 := ''; // return empty string on error

  if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000

    begin

      // warning! change name for other drives: ex.: second drive '\\.\PhysicalDrive1\'

      hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,

        FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );

    end

  else // Version Windows 95 OSR2, Windows 98

    hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );

  if hDevice=INVALID_HANDLE_VALUE then Exit;

  try

    FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);

    FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);

    cbBytesReturned := 0;

    // Set up data structures for IDENTIFY command.

    with SCIP do

    begin

      cBufferSize  := IDENTIFY_BUFFER_SIZE;

//      bDriveNumber := 0;

      with irDriveRegs do

      begin

        bSectorCountReg  := 1;

        bSectorNumberReg := 1;

//      if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0

//      else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);

        bDriveHeadReg    := $A0;

        bCommandReg      := $EC;

      end;

    end;

    if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,

      @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;

  finally

    CloseHandle(hDevice);

  end;

  with PIdSector(@IdOutCmd.bBuffer)^ do

  begin

    ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );

    (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;

    Result := PAnsiChar(@sSerialNumber);

  end;

end;

خیلی عالی بود hddinfodemo.exe اما من فایل پروژه این فایل را میخوام میشه برام زیپ شده اون را بفرستی من از دلفی 7 استفاده میکنم و میخوام یک کلید دیگه روی اون اضافه کنم
meh_ghol@yahoo.com

لطفاً دست نگه دارید!!! :متفکر:
متوجه شدم کدی که در بالا قرار دادم درست کار نمیکنه (با نرم افزار Everest Ultimate Edition تست کردم.)
به نظر من بهتره طبق گفته ی دوست عزیزم در پست شماره 7 این تاپیک از کامپوننت hddinfo استفاده شود.(طبق تستهای انجام شده این کامپوننت درست عمل می کند و از این بابت مشکلی ندارد.) :خجالت:

لینک دانلود کامپوننت: http://artsoft.nm.ru/download/hddinfo.zip

نقل قول:

---

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

سلام
با استفاده از کامپوننت زیر که قابل نصب روی تمام نسخه های دلفی هست می تونید سریال سخت افزاری هارد رو روی تمامی نسخه های ویندوز (xp , Vista32 , Vista64 , Seven32 , Seven64) به دست بیارید.
http://artsoft.nm.ru/download/hddinfo.zip

---

با تشکر
مثل اینکه سایت روسیه و من هم نتونستم کامپوننت را پیدا کنم . در صورت امکان راهنمایی بفرمائید. متشکرم

سلام...:قلب:
این هم خود کامپوننت به همراه مثال:

یا حق... :چشمک:

نقل قول:

---

نوشته شده توسط شاهین عشایری

سلام...:قلب:
این هم خود کامپوننت به همراه مثال:

یا حق... :چشمک:

---

با تشکر از شما دوست گرامی. من می خوام یه طوری از سورس اون استفاده کنم و یه تابع بسازم که خروجیش سریال هارد باشه و نمی خوام کامپوننت حتما نصب باشه چون کار من یه طوریه که ممکنه رو چند تاسیستم کد بنویسم و رو همشون امکان نصب نیست. کنار این کامپوننت که گذاشتین یه فایل hddInfo.pas هست که خیلی پیچیدس و من چون از کامپوننت نویسی چیزی سر در نمیارم نتونستم یه تابع درست حسابی از توش در بیارم که که با Delphi 2010 هم سازگار باشه.
ممنون کمکی بکنید

خودم یه تغییراتی دادم و سریال رو بدست آوردم فقط از شما می خوام ببینین تو ویندوز شما و سطح دسترسی های مختلف ایرادی داره یا نه. من توی XP SP3 32bit و Win7 64bit تست کردم درست بود. ممنون زودتر جواب بدین. از این فایلا یکیش با فایل Exe و اون myHDDSerial1 بدون فایل Exe هستش.
ضمیمه 64660

این دوستان که دانلود میکنن لطفا بگن جواب داد یا نه! در ضمن بگین هاردتون IDE یا SATA هست. نوع ویندوزتون و... ممنون

نقل قول:

---

نوشته شده توسط 0armin0

خودم یه تغییراتی دادم و سریال رو بدست آوردم فقط از شما می خوام ببینین تو ویندوز شما و سطح دسترسی های مختلف ایرادی داره یا نه. من توی XP SP3 32bit و Win7 64bit تست کردم درست بود. ممنون زودتر جواب بدین. از این فایلا یکیش با فایل Exe و اون myHDDSerial1 بدون فایل Exe هستش.
ضمیمه 64660

---

با سلام

من روی ویندوز سون تست کردم و ارور هندل داد.هادمم اونی که ویندوز روش نصبه IDE ست و یه هاردمم SATA

نقل قول:

---

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

با سلام

من روی ویندوز سون تست کردم و ارور هندل داد.هادمم اونی که ویندوز روش نصبه IDE ست و یه هاردمم SATA

---

احتمالا IDE شما اولین هارد شماست و Master . لطف پارامتر 1 یعنی هارد دومتون رو براش ارسال کنید یعنی

ShowMessage(GetDevInfoNT(1)); 
   

توی کامپوننت این چندتا پروسیجر هست ولی من فقط از اولیش استفاده کردم.

procedure GetDevInfoNT(devno : byte);

procedure GetDevInfoNTScsi(devno : integer);

procedure GetDevInfoNTScsibyName(devname : string);

procedure GetDevInfoNTZeroRights(devno : integer; name : string);

procedure GetDevInfoWin9x(devno : byte);

باید همشون در نظر گرفته بشه. یکم کمک کنید. خودمم سعیم رو میکنم

از اینجا باید تصمیم گرفته بشه کدوم ویندوز و چه نوع هاردیه:

   

procedure THDDInfo.GetInfo;

var devno : byte;

begin

    devno := ord(fdrive);

    fillchar(IdeInfo, sizeof (IdeInfo), 0);

     case fmethod of

     gimAuto:

     begin

          if fisNT then

       try

        GetDevInfoNT(devno);

       except

        try

         GetDevInfoNTScsi(devno)

        except

         GetDevInfoNTZeroRights(devno,'');

        end;

       end

      else

      try

       GetDevInfoWin9x(devno)

      except

       GetInfoASPI(devno);

      end;

     end;

     gimNT:

        GetDevInfoNT(devno);

     gimScsi:

        GetDevInfoNTScsi(devno);

     gim9x:

      GetDevInfoWin9x(devno);

     gimByName:

      try

       GetDevInfoNTScsibyName(fName);

      except

        GetDevInfoNTZeroRights(0,fName);

      end;

     gimASPI:

      GetInfoASPI(devno);

     gimZeroRights:

      GetDevInfoNTZeroRights(devno,'');

     gimWMI:

      GetDevInfoWMI(devno);

   end;

به جای این همه دردسر کشیدن میتونید خودتون با WMI پیاده سازیش کنید ، یک درخواست WQL به Win32_DiskDrive بفرستید و SerialNumber رو درخواست کنید ، این کلاس به صورت خودکار حاوی مشخصات دیسکی هست که سیستم عامل از روی اون بارگذاری شده .

نقل قول:

---

نوشته شده توسط مجتبی تاجیک

به جای این همه دردسر کشیدن میتونید خودتون با WMI پیاده سازیش کنید ، یک درخواست WQL به Win32_DiskDrive بفرستید و SerialNumber رو درخواست کنید ، این کلاس به صورت خودکار حاوی مشخصات دیسکی هست که سیستم عامل از روی اون بارگذاری شده .

---

سلام.ممنون ولی اینهایی که گفتین یعنی چه؟!! یکم راحت تر بگین. کدی ، لینکی ، برنامه ای چیزی بی زحمت بذارید . این wmi چیه? درخواست WQL چیه ؟ Win32_DiskDrive چیه؟

سلام. نمیدونم با اینکه بلدین چرا جواب نمیدین. انگار فقط به سوال بعضی کاربرها جواب داده می شه.
من این کد رو پیدا کردم از اینجا
http://stackoverflow.com/questions/4...-wmi-in-delphi
اینم مال msdn
http://msdn.microsoft.com/en-us/library/aa394132

ولی اصلا نمی فهمم درسته یا نه و چطوری استفاده شده . برای هارد جواب میده یا نه ؟ وقتی کامپایل میشه I/O Error 105 از کلاس EInOutError میده . در ضمن اگه جواب بده برای همه هاردهای IDE و SATA و همه ویندوزها جواب میده؟ لطفا راهنمایی کنید

program GetWMI_Info;



{$APPTYPE CONSOLE}



uses

  SysUtils,

  StrUtils,

  ActiveX,

  ComObj,

  Variants;



function VarArrayToStr(const vArray: variant): string;



    function _VarToStr(const V: variant): string;

    var

    Vt: integer;

    begin

    Vt := VarType(V);

        case Vt of

          varSmallint,

          varInteger  : Result := IntToStr(integer(V));

          varSingle,

          varDouble,

          varCurrency : Result := FloatToStr(Double(V));

          varDate     : Result := VarToStr(V);

          varOleStr   : Result := WideString(V);

          varBoolean  : Result := VarToStr(V);

          varVariant  : Result := VarToStr(Variant(V));

          varByte     : Result := char(byte(V));

          varString   : Result := String(V);

          varArray    : Result := VarArrayToStr(Variant(V));

        end;

    end;



var

i : integer;

begin

    Result := '[';

     if (VarType(vArray) and VarArray)=0 then

       Result := _VarToStr(vArray)

    else

    for i := VarArrayLowBound(vArray, 1) to VarArrayHighBound(vArray, 1) do

     if i=VarArrayLowBound(vArray, 1)  then

      Result := Result+_VarToStr(vArray[i])

     else

      Result := Result+'|'+_VarToStr(vArray[i]);



    Result:=Result+']';

end;



function VarStrNull(const V:OleVariant):string; //avoid problems with null strings

begin

  Result:='';

  if not VarIsNull(V) then

  begin

    if VarIsArray(V) then

       Result:=VarArrayToStr(V)

    else

    Result:=VarToStr(V);

  end;

end;





function GetWMIObject(const objectName: String): IDispatch; //create the Wmi instance

var

  chEaten: Integer;

  BindCtx: IBindCtx;

  Moniker: IMoniker;

begin

  OleCheck(CreateBindCtx(0, bindCtx));

  OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));

  OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));

end;







function GetUsbDriveSerial(const Drive:AnsiChar):string;

var

  objWMIService  : OLEVariant;

  colDiskDrives  : OLEVariant;

  colLogicalDisks: OLEVariant;

  colPartitions  : OLEVariant;

  objDiskDrive   : OLEVariant;

  objPartition   : OLEVariant;

  objLogicalDisk : OLEVariant;

  oEnumDiskDrive : IEnumvariant;

  oEnumPartition : IEnumvariant;

  oEnumLogical   : IEnumvariant;

  iValue         : LongWord;

  DeviceID       : string;

begin;

  Result:='';

  objWMIService := GetWMIObject('winmgmts:\\localhost\root\CIMV2'); //Connect to the WMI

  //colDiskDrives := objWMIService.ExecQuery('SELECT DeviceID,SerialNumber FROM Win32_DiskDrive WHERE InterfaceType="USB"','WQL',0); 

  colDiskDrives := objWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive WHERE InterfaceType="USB"','WQL',0);

  oEnumDiskDrive:= IUnknown(colDiskDrives._NewEnum) as IEnumVariant;

  while oEnumDiskDrive.Next(1, objDiskDrive, iValue) = 0 do

  begin

     DeviceID        := StringReplace(VarStrNull(objDiskDrive.DeviceID),'\  ','\\',[rfReplaceAll]); //Escape the `\` chars in the DeviceID value because the '\' is a reserved character in WMI.

     colPartitions   := objWMIService.ExecQuery(Format('ASSOCIATORS OF {Win32_DiskDrive.DeviceID="%s"} WHERE AssocClass = Win32_DiskDriveToDiskPartition',[DeviceID]));//link the Win32_DiskDrive class with the Win32_DiskDriveToDiskPartition class 

     oEnumPartition  := IUnknown(colPartitions._NewEnum) as IEnumVariant;

      while oEnumPartition.Next(1, objPartition, iValue) = 0 do

       begin

            colLogicalDisks := objWMIService.ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID="'+VarStrNull(objPar  tition.DeviceID)+'"} WHERE AssocClass = Win32_LogicalDiskToPartition'); //link the Win32_DiskPartition class with theWin32_LogicalDiskToPartition class.

            oEnumLogical  := IUnknown(colLogicalDisks._NewEnum) as IEnumVariant;

              while oEnumLogical.Next(1, objLogicalDisk, iValue) = 0 do

              if VarStrNull(objLogicalDisk.DeviceID)=(Drive+':')  then //compare the device id

              begin

                  Result:=VarStrNull(objDiskDrive.SerialNumber);

                  Exit;

              end;

       end;

  end;

end;



begin

 try

    CoInitialize(nil);

    try

      Writeln(GetUsbDriveSerial('F'));

      Readln;

    finally

      CoUninitialize;

    end;

 except

    on E:Exception do

    begin

        Writeln(E.Classname, ':', E.Message);

        Readln;

    end;

  end;

end.

نقل قول:

---

سلام. نمیدونم با اینکه بلدین چرا جواب نمیدین. انگار فقط به سوال بعضی کاربرها جواب داده می شه.

---

نه شما نه کاربر دیگه پسر خاله من نیستید که به سوال x جواب داده بشه و به سوال y نه !


نمونه ضمیمه رو ببینید .

نقل قول:

---

نوشته شده توسط مجتبی تاجیک

نه شما نه کاربر دیگه پسر خاله من نیستید که به سوال x جواب داده بشه و به سوال y نه !


نمونه ضمیمه رو ببینید .

---

منظورم شما نبودید.خیلی کاربرهای دیگه هستن که همه ستاره هاشونم کامله... ممنون ولی من که اجرا کردم خروجی این بود"SerialNumber" و هیچی دیگه نداشت. فکر میکنم استفاده از WMI فقط یکی از راه های بدست آوردنشه و ممکنه رو بعضی سیستم ها با سطح دسترسی های مختلف ، نوع هارد ، نوع ویندوز متفاوت باشه دلیل حرفم هم استفاده این کامپوننت که دوستمون گذاشت و رو همه سیستم ها جواب میده هست. این کامپوننت هم از WMI استفاده میکنه (خط یکی به آخر GetDevInfoWMI)هم چنتا روش دیگه هرکدوم نشد میره سراغ اونیکی

procedure THDDInfo.GetInfo;

var devno : byte;

begin

    devno := ord(fdrive);

    fillchar(IdeInfo, sizeof (IdeInfo), 0);

     case fmethod of

     gimAuto:

     begin

          if fisNT then

       try

        GetDevInfoNT(devno);

       except

        try

         GetDevInfoNTScsi(devno)

        except

         GetDevInfoNTZeroRights(devno,'');

        end;

       end

      else

      try

       GetDevInfoWin9x(devno)

      except

       GetInfoASPI(devno);

      end;

     end;

     gimNT:

        GetDevInfoNT(devno);

     gimScsi:

        GetDevInfoNTScsi(devno);

     gim9x:

      GetDevInfoWin9x(devno);

     gimByName:

      try

       GetDevInfoNTScsibyName(fName);

      except

        GetDevInfoNTZeroRights(0,fName);

      end;

     gimASPI:

      GetInfoASPI(devno);

     gimZeroRights:

      GetDevInfoNTZeroRights(devno,'');

     gimWMI:

      GetDevInfoWMI(devno);

   end;

نقل قول:

---

نوشته شده توسط 0armin0

منظورم شما نبودید.خیلی کاربرهای دیگه هستن که همه ستاره هاشونم کامله... ممنون ولی من که اجرا کردم خروجی این بود"SerialNumber" و هیچی دیگه نداشت. فکر میکنم استفاده از WMI فقط یکی از راه های بدست آوردنشه و ممکنه رو بعضی سیستم ها با سطح دسترسی های مختلف ، نوع هارد ، نوع ویندوز متفاوت باشه دلیل حرفم هم استفاده این کامپوننت که دوستمون گذاشت و رو همه سیستم ها جواب میده هست. این کامپوننت هم از WMI استفاده میکنه (خط یکی به آخر GetDevInfoWMI)هم چنتا روش دیگه هرکدوم نشد میره سراغ اونیکی

procedure THDDInfo.GetInfo;

var devno : byte;

begin

    devno := ord(fdrive);

    fillchar(IdeInfo, sizeof (IdeInfo), 0);

     case fmethod of

     gimAuto:

     begin

          if fisNT then

       try

        GetDevInfoNT(devno);

       except

        try

         GetDevInfoNTScsi(devno)

        except

         GetDevInfoNTZeroRights(devno,'');

        end;

       end

      else

      try

       GetDevInfoWin9x(devno)

      except

       GetInfoASPI(devno);

      end;

     end;

     gimNT:

        GetDevInfoNT(devno);

     gimScsi:

        GetDevInfoNTScsi(devno);

     gim9x:

      GetDevInfoWin9x(devno);

     gimByName:

      try

       GetDevInfoNTScsibyName(fName);

      except

        GetDevInfoNTZeroRights(0,fName);

      end;

     gimASPI:

      GetInfoASPI(devno);

     gimZeroRights:

      GetDevInfoNTZeroRights(devno,'');

     gimWMI:

      GetDevInfoWMI(devno);

   end;

---

قرار نیست همه چیز آماده در اختیار شما قرار بگیره ، یک نمونه WMI بسیار ساده براتون نوشتم ، کدهای بالا رو هم که دارید ، خودتون میتونید از ترکیبشون به کد مورد نظر برسید .

بله خوب معلومه . روش کار میکنم. اینم فایل pas که باید روش کار بشه میذارم اگه کسی تونست از روی این کدها یه تابع نهایی برای بدست آوردن سریال هارد برای Delphi 2010 که نیاز به کامپوننت هم نباشه بنویسه لطفا همینجا بذاره.:بوس:

خودم بالاخره تقریبا کاملش کردم ! لطفا فایل exe یا کامپایل با Delphi 2010 تست کنید ببینید جواب میده یا نه. اگه نداد مشخصات سیستم تون رو مثل ویندوز ، نوع هارد و سطح دسترسی کاربرتون رو بگید . فقط خواهش می کنم التماس میکنم هرکی دانلود کرد و امتحان کرد نتیجه رو بگه.
اگه کوچکترین تغییری در کدش دادید یا اصلاحش کردید یا اشکالی دیدید حتما توی این پست قرار بدید یا به من ایمیل بزنید . من چند وقته روش کار میکنم الآن هم اگه به ساعت این پست نگاه کنید می بینید تا دیروقت روش زحمت کشیدم.:گریه: الآن همتون خوابین! اگه به دردتون خورد دکمه تشکر یادتون نره! بلکه تشویق:تشویق: بشم کاملش کنم :لبخند: آخه هیچکی ازم تشکر نکرده خوب.البته باید همتون کمک کنید و نتیجه رو هم بگید.
از این کد فعلا در پروژه هاتون استفاده نکنید تا کامل و بی نقص بشه

سلام

من تست کردم و جوابی کاملا مشابه داشت با کامپوننتی که تو همین تاپیک معرفی شد!
موفق باشدی

نقل قول:

---

نوشته شده توسط 0armin0

لطفا فایل exe یا کامپایل با Delphi 2010 تست کنید ببینید جواب میده یا نه.[/I][/B]

---

درست کار کرد .
من با برنامه دیگر هم امتحان کردم درست بود ...

ممنون که همتون! که دانلود میکنین نتیجه رو میگین! بله احتمالا کاملا درست کار میکنه فقط در کامپوننت اصلی و برنامه ای که من نوشتم هم وقتی user یا کاربر ویندوز Limit باشه یا Guest باشه نمیتونه سریال رو پیدا کنه یعنی تابع GetDevInfoNTZeroRights درست عمل نمیکنه.اونم تقصیر من نیست به صاحب کامپوننت بگین!
حالا شما دوستان عزیز اگه فکر میکنین این مساله باید حل بشه یه راهنمایی بکنید.
اینم تابعش

function GetDevInfoNTZeroRights(devno : integer; name : string):string;

var

   h:Cardinal;

   i,j:integer;

   query : STORAGE_PROPERTY_QUERY;

   dwBytesReturned : dword;

   buffer : array [0..9999] of ansichar;

   sdd : STORAGE_DEVICE_DESCRIPTOR absolute buffer;

   dgex : DISK_GEOMETRY_EX absolute buffer;

   xbuf : array [1..127] of ansichar;

   xname : string;

begin

 scsiflag := true;

 if name = '' then xname := '\\.\PhysicalDrive'+inttostr(devno)

 else xname := '\\.\'+name;



 h := CreateFile (pchar(xname), 0,

                  FILE_SHARE_READ or FILE_SHARE_WRITE, nil,

                  OPEN_EXISTING, 0, 0);

 if h = INVALID_HANDLE_VALUE then raise Exception.Create('Can''t create device handle!');

 try

  dwBytesReturned := 0;



  fillchar(InfoArray,sizeof(InfoArray),#0);

    fillchar(query,SizeOf(query),#0);

    fillchar(buffer,SizeOf(buffer),#0);

  query.PropertyId := StorageDeviceProperty;

  query.QueryType := PropertyStandardQuery;



    if DeviceIoControl(h, IOCTL_STORAGE_QUERY_PROPERTY , @query, SizeOf(query), @buffer, sizeof(buffer), dwBytesReturned, nil )

  then

  begin

   IdeInfo.Config := sdd.DeviceType;



   j := 1;

   for i := sdd.ProductIdOffset to sdd.ProductIdOffset+39 do

   begin

    if buffer[i] = #0 then break;

    if buffer[i] >= ' ' then

    begin

     Ideinfo.Model[j] := buffer[i];

     inc(j);

    end;

   end;



   j := 1;

   for i := sdd.ProductRevisionOffset to sdd.ProductRevisionOffset + 7 do

   begin

    if buffer[i] = #0 then break;

    Ideinfo.Revision[j] := Buffer[i];

    inc(j);

   end;



   j := 1;

      fillchar(xbuf,SizeOf(xbuf),#0);

   for i := sdd.SerialNumberOffset to sdd.SerialNumberOffset + 127 do

   begin

    if Buffer[i] = #0 then break;

    xbuf[j] := Buffer[i];

    inc(j);

   end;

   converth(@xbuf[1],@Ideinfo.Serial[1],20);

  end

  else

  begin

   raise Exception.Create('GetDevInfoZeroRights filed!');

  end;





  if name <> '' then

  begin

   devno := 255;

   if lowercase(copy(name,1,length(name)-1)) = 'physicaldrive' then

     devno := ord(name[length(name)])-ord('0');

  end;



  if (devno >= 0) and (devno <= 3) then

  begin



    fillchar(buffer,SizeOf(buffer),#0);



   if not DeviceIoControl(h,IOCTL_DISK_GET_DRIVE_GEOMETRY_EX  ,nil,0,@buffer,

                   sizeof(buffer),dwBytesReturned,nil)

   then

     if IdeInfo.Model[1] = #0 then raise Exception.Create('GetDevInfoZeroRights filed!')

     else

     begin

      exit

     end

   else

   begin

     scsiflag := false;

     if dgex.Geometry.MediaType = FixedMedia then

       IdeInfo.Config := $0040

      else

     if dgex.Geometry.MediaType = RemovableMedia then

       IdeInfo.Config := $0080;



     IdeInfo.CylsTotal := dgex.Geometry.Cylinders;

     IdeInfo.LBASectors := dgex.DiskSize div dgex.Geometry.BytesPerSector;

     IdeInfo.BPS := dgex.Geometry.BytesPerSector;

     IdeInfo.SPT := dgex.Geometry.SectorsPerTrack;

     IdeInfo.HeadTotal := dgex.Geometry.TracksPerCylinder;

     IdeInfo.BPT := dgex.Geometry.BytesPerSector * dgex.Geometry.SectorsPerTrack;

   end;

  end;

  hddserial:=Trim(IdeInfo.Serial);

  Result:=hddserial;

 finally

 CloseHandle(h);

 end;

end;

سلام. لطفا یه نفر توی ویندوز 7 یا ویستایی که UAC یا User Account Control اون فعال باشه کار میکنه یا نه. متاسفانه خودم ندارم. اگه شد یا نشد ، نوع SATA یا IDE بودن هاردتون رو بگید و مارکش. ممنون. منتظرتون هستم. لطفا همکاری کنین

کاربرد آن چیست؟
منظورم این است که شماره سریال یک هارد دیسک چه کاربردی ممکن است داشته باشد؟

نقل قول:

---

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

کاربرد آن چیست؟
منظورم این است که شماره سریال یک هارد دیسک چه کاربردی ممکن است داشته باشد؟

---

به عنوان نمونه نوشتن قفل های نرم افزاری.

خوب ببینین یکی از بهترین و مهمترین استفادهاش تی ساخت قلف های نرم افزاری و علاو بر این استفادهی داره که مثلا شما دوست داری فقط برنامت روی یک هارد کار کنه ویا روی یک هارد خاص یک جوره دیگه اجرابشه

____
خوب تمام اینها + اگه شما اطلاعات سیستم ی که برنامت داره روش اجرا می شه داشته باشی استفادهای جالبی می شه ازش کرد

درود
من توی ویندوز7 که User Account Control فعال بود تست کردم!
درست بود.

ببخشید فراموش کردم!
هاردم sata است و مار کش هم دقیق یادم نیست یه چیزی تو مایه های Moxtor

نقل قول:

---

نوشته شده توسط 0armin0

خودم بالاخره تقریبا کاملش کردم ! لطفا فایل exe یا کامپایل با Delphi 2010 تست کنید ببینید جواب میده یا نه. اگه نداد مشخصات سیستم تون رو مثل ویندوز ، نوع هارد و سطح دسترسی کاربرتون رو بگید . فقط خواهش می کنم التماس میکنم هرکی دانلود کرد و امتحان کرد نتیجه رو بگه.
اگه کوچکترین تغییری در کدش دادید یا اصلاحش کردید یا اشکالی دیدید حتما توی این پست قرار بدید یا به من ایمیل بزنید . من چند وقته روش کار میکنم الآن هم اگه به ساعت این پست نگاه کنید می بینید تا دیروقت روش زحمت کشیدم.:گریه: الآن همتون خوابین! اگه به دردتون خورد دکمه تشکر یادتون نره! بلکه تشویق:تشویق: بشم کاملش کنم :لبخند: آخه هیچکی ازم تشکر نکرده خوب.البته باید همتون کمک کنید و نتیجه رو هم بگید.
از این کد فعلا در پروژه هاتون استفاده نکنید تا کامل و بی نقص بشه

---

با تشکر از شما دوست گرامی من بر روی win 7 و با هارد hitachi در لپ تاپ تست کردم و کاملا درست عمل کرد . موفق باشی

سلام من کد myHDDSerial رو روی ویندوز 7 64 بیت با هارد WD Sata اجرا کردم UAC هم فعال بود مشکلی نداشت ولی روی user group کار نمی کنه

سلام . ممنون منظورتون از user group رو نفهمیدم

سلام منم روي ويندوز xp sp3 تست كردم درست بود هاردم هم sata هست

با توجه به اینکه مدتها از تصحیح کدم میگذره و اشکالی گزارش نشده تا 99درصد اطمینان بهش دارم البته تا ویندوز 7 . کسی ویندوز 8 داره تست بگیره ممنون میشم

با سلام من تو ویندوز XP 32bit تسط کردم درست بود

با سلام خدمت دو3تان
بویژه دوست عزیز 0armin0

چندتا سوال داشتم :متفکر:

آیا این سریال منحصر به فرده؟؟

با نصب مجدد ویندوز یا فرمت کردن هارد تغییر نمیکنه؟؟

آیا امکانش هست این برنامه رو به کامپوننت تبدیل کنیم؟؟

با تشکر

نقل قول:

---

آیا این سریال منحصر به فرده؟؟

---

بله

نقل قول:

---

با نصب مجدد ویندوز یا فرمت کردن هارد تغییر نمیکنه؟؟

---

خیر، مگر اینکه کاربر برنامه رو در یک ویندوز مجازی اجرا کرده باشه!

نقل قول:

---

آیا امکانش هست این برنامه رو به کامپوننت تبدیل کنیم؟؟

---

به جای این دردسرها از کامپوننت hddinfo استفاده کنید.

نقل قول:

---

به جای این دردسرها از کامپوننت hddinfo استفاده کنید.

---

این کامپوننت رایگانه؟؟؟

غیر فعال نمیشه؟

من فقط میخوام Serial Number هارد رو بدست بیارم چطوری میتونم از این کامپوننت استفاده کنم؟

بازم ممنون از راهنماییتون:لبخندساده:

دوستان ؟:لبخندساده:

من بصورت زیر از این کامپوننت استفاده کردم

hdd.Method:=TGetInfoMethod(gimAuto);

HDD.DeviceName:='PhysicalDrive0';

HDD.Drive:=dPrimaryMaster;

edit1.text:=HDD.Serial;

و سریال هارد خودم رو بدست آوردم

میخواستم بدونم آیا این روش درسته؟ روی تمام هارد ها جواب میده؟

با تشکر:قلب:

نقل قول:

---

میخواستم بدونم آیا این روش درسته؟ روی تمام هارد ها جواب میده؟

---

من در یک نرم افزار از همین روش استفاده کرده ام. نرم افزار مربوطه روی چند هزار کامپیوتر اجرا شده و بعد از دو سال هنوز مشکلی در این خصوص گزارش نشده.

نقل قول:

---

نوشته شده توسط BORHAN TEC

سلام
جناب majid_ramak :بوس: کدی که قرار داده اید درست است ولی مشکل اینجا است که این کد در محیط های یونیکد( دلفی 2009 به بعد یک رشته خالی را بر می گرداند). البته مشکل خاصی نبود فقط کافی بود که نوع مقدار برگشتی را به PAnsiChar تغییر بدیم و همچنین در آخرین خط تابع باید به جای PChar از PAnsiChar استفاده کنیم.
همینجا لازمه از همه دوستانی که به خاطر رفع این مشکل کمک کردند تشکر کنم. :قلب:

کد اصلاح شده که به درستی کار می کند:

function Sa_GetIdeSerialNumber : PAnsiChar;

const IDENTIFY_BUFFER_SIZE = 512;

type

  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;

  TSendCmdInParams = packed record

    // Buffer size in bytes

    cBufferSize  : DWORD;

    // Structure with drive register values.

    irDriveRegs  : TIDERegs;

    // Physical drive number to send command to (0,1,2,3).

    bDriveNumber : BYTE;

    bReserved    : Array[0..2] of Byte;

    dwReserved   : Array[0..3] of DWORD;

    bBuffer      : Array[0..0] of Byte;  // Input buffer.

  end;

  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 CHAR;

    wBufferType                : Word;

    wBufferSize                : Word;

    wECCSize                   : Word;

    sFirmwareRev               : Array[0..7] of Char;

    sModelNumber               : Array[0..39] of Char;

    wMoreVendorUnique          : Word;

    wDoubleWordIO              : Word;

    wCapabilities              : Word;

    wReserved1                 : Word;

    wPIOTiming                 : Word;

    wDMATiming                 : Word;

    wBS                        : Word;

    wNumCurrentCyls            : Word;

    wNumCurrentHeads           : Word;

    wNumCurrentSectorsPerTrack : Word;

    ulCurrentSectorCapacity    : DWORD;

    wMultSectorStuff           : Word;

    ulTotalAddressableSectors  : DWORD;

    wSingleWordDMA             : Word;

    wMultiWordDMA              : Word;

    bReserved                  : Array[0..127] of BYTE;

  end;

  PIdSector = ^TIdSector;

  TDriverStatus = packed record

    // Error code from driver, or 0 if no error.

    bDriverError : Byte;

    // Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR.

    bIDEStatus   : Byte;

    bReserved    : Array[0..1] of Byte;

    dwReserved   : Array[0..1] of DWORD;

  end;

  TSendCmdOutParams = packed record

    // Size of bBuffer in bytes

    cBufferSize  : DWORD;

    // Driver status structure.

    DriverStatus : TDriverStatus;

    // Buffer of arbitrary length in which to store the data read from the drive.

    bBuffer      : Array[0..0] of BYTE;

  end;

var hDevice : THandle;

    cbBytesReturned : DWORD;

    ptr : PChar;

    SCIP : TSendCmdInParams;

    aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;

    IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;

  procedure ChangeByteOrder( var Data; Size : Integer );

  var ptr : PChar;

      i : Integer;

      c : Char;

  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 := ''; // return empty string on error

  if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000

    begin

      // warning! change name for other drives: ex.: second drive '\\.\PhysicalDrive1\'

      hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,

        FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );

    end

  else // Version Windows 95 OSR2, Windows 98

    hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );

  if hDevice=INVALID_HANDLE_VALUE then Exit;

  try

    FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);

    FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);

    cbBytesReturned := 0;

    // Set up data structures for IDENTIFY command.

    with SCIP do

    begin

      cBufferSize  := IDENTIFY_BUFFER_SIZE;

//      bDriveNumber := 0;

      with irDriveRegs do

      begin

        bSectorCountReg  := 1;

        bSectorNumberReg := 1;

//      if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0

//      else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);

        bDriveHeadReg    := $A0;

        bCommandReg      := $EC;

      end;

    end;

    if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,

      @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;

  finally

    CloseHandle(hDevice);

  end;

  with PIdSector(@IdOutCmd.bBuffer)^ do

  begin

    ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );

    (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;

    Result := PAnsiChar(@sSerialNumber);

  end;

end;

---

کد با را در ویندوز هفت و دلفی XE4 شماره سریال هارد را به شکل غلط نمایش میدهد.
فرضا شماره سریال WD-WCC4J3142470 را به شکل غلط اینطور نمایش میدهد: W4CCW4137J0742-
به نظر شما علت چیست و چگونه برنامه اصلاح میشود؟ متشکرم

سلام.ویندوزم win10 x64 هستش.فایل exe ارور میده اما بادسترسی admin اجرا کنی کار میده.