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

[BORHAN TEC]

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

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

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

[tdkhakpur]

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

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;

[Nima NT]

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

[tdkhakpur]

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

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

[Nima NT]

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

[mehrpars]

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

[saeed6162]

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

[majid_ramak]

با این کد سریال هارد رو می تونید بدست بیارید. در محیط 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;

[1485159]

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

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

[majid_ramak]

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

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

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

[mehdi123456_mehdi123456]

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

[BORHAN TEC]

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

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

[khoshblagh]

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

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

[BORHAN TEC]

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

یا حق...

[0armin0]

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

یا حق...

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

[0armin0]

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

[0armin0]

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

[hp1361]

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

با سلام

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

[0armin0]

با سلام

من روی ویندوز سون تست کردم و ارور هندل داد.هادمم اونی که ویندوز روش نصبه 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;

[Felony]

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

[0armin0]

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

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

[0armin0]

سلام. نمیدونم با اینکه بلدین چرا جواب نمیدین. انگار فقط به سوال بعضی کاربرها جواب داده می شه.
من این کد رو پیدا کردم از اینجا
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.

[Felony]

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

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


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

[0armin0]

نه شما نه کاربر دیگه پسر خاله من نیستید که به سوال 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;

[Felony]

منظورم شما نبودید.خیلی کاربرهای دیگه هستن که همه ستاره هاشونم کامله... ممنون ولی من که اجرا کردم خروجی این بود"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 بسیار ساده براتون نوشتم ، کدهای بالا رو هم که دارید ، خودتون میتونید از ترکیبشون به کد مورد نظر برسید .

[0armin0]

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

[0armin0]

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

[عقاب سیاه]

سلام

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

[pezhvakco]

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

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

[0armin0]

ممنون که همتون! که دانلود میکنین نتیجه رو میگین! بله احتمالا کاملا درست کار میکنه فقط در کامپوننت اصلی و برنامه ای که من نوشتم هم وقتی 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;

[0armin0]

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

[sattaryekta]

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

[Nima NT]

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

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

[firststep]

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

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

[عقاب سیاه]

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

[عقاب سیاه]

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

[welcomer]

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

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

[Emdad2001]

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

[0armin0]

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