PDA

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



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

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

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

tdkhakpur
چهارشنبه 19 خرداد 1389, 18:20 عصر
یه چیزی تو این مایه هاست


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
چهارشنبه 19 خرداد 1389, 18:28 عصر
این تابع برای بدست آوردن سریال فیزیکی نیست ، فقط سریال همون پارتیشن رو برمیگردونه که با هر بار فرمت عوض میشه.

tdkhakpur
چهارشنبه 19 خرداد 1389, 18:49 عصر
این تابع برای بدست آوردن سریال فیزیکی نیست ، فقط سریال همون پارتیشن رو برمیگردونه که با هر بار فرمت عوض میشه
dll به اسم 'HardwareIDExtractor.DLL' برای این کار هست جستجو کنید به نظرم demo هم داشته باشه.

Nima NT
چهارشنبه 19 خرداد 1389, 21:32 عصر
بله این رو میدونم ، منظورم کدهایی بود که شما برای بدست آوردن سریال نوشته بودید.

mehrpars
شنبه 22 خرداد 1389, 23:35 عصر
از MiTeC_System_Information_v10.7.0_Full.Source استفاده کنید ، راحت ، کامل و دقیق

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

majid_ramak
یک شنبه 23 خرداد 1389, 10:14 صبح
با این کد سریال هارد رو می تونید بدست بیارید. در محیط 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
یک شنبه 23 خرداد 1389, 15:19 عصر
با این کد سریال هارد رو می تونید بدست بیارید. در محیط Virtual هم سریال رو خالی برمی گردونهمنظور از محیط مجازی چیه؟
برای منکه کلا خروجیش خالیه!

majid_ramak
دوشنبه 24 خرداد 1389, 09:21 صبح
منظور از محیط مجازی چیه؟
برای منکه کلا خروجیش خالیه!

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

BORHAN TEC
پنج شنبه 27 خرداد 1389, 13:47 عصر
سلام
جناب 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
دوشنبه 31 خرداد 1389, 20:59 عصر
خیلی عالی بود hddinfodemo.exe اما من فایل پروژه این فایل را میخوام میشه برام زیپ شده اون را بفرستی من از دلفی 7 استفاده میکنم و میخوام یک کلید دیگه روی اون اضافه کنم
meh_ghol@yahoo.com

BORHAN TEC
سه شنبه 01 تیر 1389, 11:54 صبح
لطفاً دست نگه دارید!!! :متفکر:
متوجه شدم کدی که در بالا قرار دادم درست کار نمیکنه (با نرم افزار Everest Ultimate Edition تست کردم.)
به نظر من بهتره طبق گفته ی دوست عزیزم در پست شماره 7 این تاپیک از کامپوننت hddinfo استفاده شود.(طبق تستهای انجام شده این کامپوننت درست عمل می کند و از این بابت مشکلی ندارد.) :خجالت:

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

khoshblagh
پنج شنبه 20 آبان 1389, 08:59 صبح
سلام
با استفاده از کامپوننت زیر که قابل نصب روی تمام نسخه های دلفی هست می تونید سریال سخت افزاری هارد رو روی تمامی نسخه های ویندوز (xp , Vista32 , Vista64 , Seven32 , Seven64) به دست بیارید.
http://artsoft.nm.ru/download/hddinfo.zip
با تشکر
مثل اینکه سایت روسیه و من هم نتونستم کامپوننت را پیدا کنم . در صورت امکان راهنمایی بفرمائید. متشکرم

BORHAN TEC
جمعه 21 آبان 1389, 21:47 عصر
سلام...:قلب:
این هم خود کامپوننت به همراه مثال:

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

0armin0
پنج شنبه 16 دی 1389, 22:47 عصر
سلام...:قلب:
این هم خود کامپوننت به همراه مثال:

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

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

0armin0
جمعه 17 دی 1389, 01:56 صبح
خودم یه تغییراتی دادم و سریال رو بدست آوردم فقط از شما می خوام ببینین تو ویندوز شما و سطح دسترسی های مختلف ایرادی داره یا نه. من توی XP SP3 32bit و Win7 64bit تست کردم درست بود. ممنون زودتر جواب بدین. از این فایلا یکیش با فایل Exe و اون myHDDSerial1 بدون فایل Exe هستش.
64660

0armin0
جمعه 17 دی 1389, 13:09 عصر
این دوستان که دانلود میکنن لطفا بگن جواب داد یا نه! در ضمن بگین هاردتون IDE یا SATA هست. نوع ویندوزتون و... ممنون

hp1361
جمعه 17 دی 1389, 15:22 عصر
خودم یه تغییراتی دادم و سریال رو بدست آوردم فقط از شما می خوام ببینین تو ویندوز شما و سطح دسترسی های مختلف ایرادی داره یا نه. من توی XP SP3 32bit و Win7 64bit تست کردم درست بود. ممنون زودتر جواب بدین. از این فایلا یکیش با فایل Exe و اون myHDDSerial1 بدون فایل Exe هستش.
64660

با سلام

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

0armin0
جمعه 17 دی 1389, 16:51 عصر
با سلام

من روی ویندوز سون تست کردم و ارور هندل داد.هادمم اونی که ویندوز روش نصبه 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
شنبه 18 دی 1389, 08:30 صبح
به جای این همه دردسر کشیدن میتونید خودتون با WMI پیاده سازیش کنید ، یک درخواست WQL به Win32_DiskDrive بفرستید و SerialNumber رو درخواست کنید ، این کلاس به صورت خودکار حاوی مشخصات دیسکی هست که سیستم عامل از روی اون بارگذاری شده .

0armin0
شنبه 18 دی 1389, 22:41 عصر
به جای این همه دردسر کشیدن میتونید خودتون با WMI پیاده سازیش کنید ، یک درخواست WQL به Win32_DiskDrive بفرستید و SerialNumber رو درخواست کنید ، این کلاس به صورت خودکار حاوی مشخصات دیسکی هست که سیستم عامل از روی اون بارگذاری شده .

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

0armin0
چهارشنبه 22 دی 1389, 01:07 صبح
سلام. نمیدونم با اینکه بلدین چرا جواب نمیدین. انگار فقط به سوال بعضی کاربرها جواب داده می شه.
من این کد رو پیدا کردم از اینجا
http://stackoverflow.com/questions/4292395/get-usb-serial-number-without-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(objPartition.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
چهارشنبه 22 دی 1389, 06:39 صبح
سلام. نمیدونم با اینکه بلدین چرا جواب نمیدین. انگار فقط به سوال بعضی کاربرها جواب داده می شه.
نه شما نه کاربر دیگه پسر خاله من نیستید که به سوال x جواب داده بشه و به سوال y نه !


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

0armin0
جمعه 24 دی 1389, 21:52 عصر
نه شما نه کاربر دیگه پسر خاله من نیستید که به سوال 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
جمعه 24 دی 1389, 23:46 عصر
منظورم شما نبودید.خیلی کاربرهای دیگه هستن که همه ستاره هاشونم کامله... ممنون ولی من که اجرا کردم خروجی این بود"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
جمعه 24 دی 1389, 23:58 عصر
بله خوب معلومه . روش کار میکنم. اینم فایل pas که باید روش کار بشه میذارم اگه کسی تونست از روی این کدها یه تابع نهایی برای بدست آوردن سریال هارد برای Delphi 2010 که نیاز به کامپوننت هم نباشه بنویسه لطفا همینجا بذاره.:بوس:

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

عقاب سیاه
شنبه 25 دی 1389, 15:32 عصر
سلام

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

pezhvakco
یک شنبه 26 دی 1389, 20:00 عصر
لطفا فایل exe یا کامپایل با Delphi 2010 تست کنید ببینید جواب میده یا نه.[/I][/B]

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

0armin0
دوشنبه 27 دی 1389, 10:10 صبح
ممنون که همتون! که دانلود میکنین نتیجه رو میگین! بله احتمالا کاملا درست کار میکنه فقط در کامپوننت اصلی و برنامه ای که من نوشتم هم وقتی 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
سه شنبه 28 دی 1389, 23:21 عصر
سلام. لطفا یه نفر توی ویندوز 7 یا ویستایی که UAC یا User Account Control اون فعال باشه کار میکنه یا نه. متاسفانه خودم ندارم. اگه شد یا نشد ، نوع SATA یا IDE بودن هاردتون رو بگید و مارکش. ممنون. منتظرتون هستم. لطفا همکاری کنین

sattaryekta
چهارشنبه 29 دی 1389, 13:51 عصر
کاربرد آن چیست؟
منظورم این است که شماره سریال یک هارد دیسک چه کاربردی ممکن است داشته باشد؟

Nima NT
چهارشنبه 29 دی 1389, 13:58 عصر
کاربرد آن چیست؟
منظورم این است که شماره سریال یک هارد دیسک چه کاربردی ممکن است داشته باشد؟
به عنوان نمونه نوشتن قفل های نرم افزاری.

firststep
چهارشنبه 29 دی 1389, 14:02 عصر
خوب ببینین یکی از بهترین و مهمترین استفادهاش تی ساخت قلف های نرم افزاری و علاو بر این استفادهی داره که مثلا شما دوست داری فقط برنامت روی یک هارد کار کنه ویا روی یک هارد خاص یک جوره دیگه اجرابشه

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

عقاب سیاه
چهارشنبه 29 دی 1389, 15:10 عصر
درود
من توی ویندوز7 که User Account Control فعال بود تست کردم!
درست بود.

عقاب سیاه
جمعه 01 بهمن 1389, 10:27 صبح
ببخشید فراموش کردم!
هاردم sata است و مار کش هم دقیق یادم نیست یه چیزی تو مایه های Moxtor

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

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

Emdad2001
جمعه 26 آبان 1391, 00:02 صبح
سلام من کد myHDDSerial رو روی ویندوز 7 64 بیت با هارد WD Sata اجرا کردم UAC هم فعال بود مشکلی نداشت ولی روی user group کار نمی کنه

0armin0
شنبه 27 آبان 1391, 23:20 عصر
سلام . ممنون منظورتون از user group رو نفهمیدم

saeed_molaali
جمعه 30 فروردین 1392, 14:43 عصر
سلام منم روي ويندوز xp sp3 تست كردم درست بود هاردم هم sata هست

0armin0
سه شنبه 03 اردیبهشت 1392, 21:43 عصر
با توجه به اینکه مدتها از تصحیح کدم میگذره و اشکالی گزارش نشده تا 99درصد اطمینان بهش دارم البته تا ویندوز 7 . کسی ویندوز 8 داره تست بگیره ممنون میشم

gholami146
جمعه 06 اردیبهشت 1392, 16:24 عصر
با سلام من تو ویندوز XP 32bit تسط کردم درست بود

mortezahbh
پنج شنبه 05 تیر 1393, 11:09 صبح
با سلام خدمت دو3تان
بویژه دوست عزیز 0armin0 (http://barnamenevis.org/member.php?24661-0armin0)

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

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

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

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

با تشکر

BORHAN TEC
پنج شنبه 05 تیر 1393, 11:23 صبح
آیا این سریال منحصر به فرده؟؟
بله


با نصب مجدد ویندوز یا فرمت کردن هارد تغییر نمیکنه؟؟
خیر، مگر اینکه کاربر برنامه رو در یک ویندوز مجازی اجرا کرده باشه!


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

mortezahbh
جمعه 06 تیر 1393, 01:03 صبح
به جای این دردسرها از کامپوننت hddinfo استفاده کنید.


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

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

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

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

mortezahbh
یک شنبه 08 تیر 1393, 02:09 صبح
دوستان ؟:لبخندساده:

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



hdd.Method:=TGetInfoMethod(gimAuto);
HDD.DeviceName:='PhysicalDrive0';
HDD.Drive:=dPrimaryMaster;
edit1.text:=HDD.Serial;


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

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

با تشکر:قلب:

BORHAN TEC
یک شنبه 08 تیر 1393, 13:22 عصر
میخواستم بدونم آیا این روش درسته؟ روی تمام هارد ها جواب میده؟

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

khoshblagh
سه شنبه 22 مهر 1393, 14:38 عصر
سلام
جناب 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-
به نظر شما علت چیست و چگونه برنامه اصلاح میشود؟ متشکرم

ahoora2014
جمعه 29 آبان 1394, 21:27 عصر
سلام.ویندوزم win10 x64 هستش.فایل exe ارور میده اما بادسترسی admin اجرا کنی کار میده.

mortezahbh
چهارشنبه 21 بهمن 1394, 11:30 صبح
سلام
من از HDDInfo استفاده میکنم ولی الان که ویندوزم رو عوض کردم و نرم افزارم رو دوباره باز میکنم کتابخانه HDDInfo رو نمیشناسه

توی دلفی XE4 دارم کار میکنم
تعجب میکنم چون قبلا مشکلی نداشتم ولی الان نمیشناسه
لطفا راهنماییی کنید

mortezahbh
جمعه 07 اسفند 1394, 06:11 صبح
اگه سوالم واضح نیست بگید که بیشتر توضیح بدم