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

[hadisalahi2]

سلام به همه عزیزان

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

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

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

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

از دوستانی که در این زمینه کار کردن و یک کد تر و تمیز دارن ، در اختیار بنده حقیر بزارن
پیشاپیش مچکرم
یا حق

[meysam_212]

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

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

var
PWindowsDir: array [0..255] of Char;
begin
GetWindowsDirectory(PWindowsDir,255);
ShowMessage(StrPas(PWindowsDir));

[Mask]

میتونید از سریال هارد استفاده کنید.
من از این تابع استفاده میکنم. زیاد مشکلی باهاش نداشتم.

function GetIdeSerialNumber(i:Integer) : String;const IDENTIFY_BUFFER_SIZE = 512;
type
TIDERegs = packed record
bFeaturesReg : BYTE;
bSectorCountReg : BYTE;
bSectorNumberReg : BYTE;
bCylLowReg : BYTE;
bCylHighReg : BYTE;
bDriveHeadReg : BYTE;
bCommandReg : BYTE;
bReserved : BYTE;
end;
TSendCmdInParams = packed record
cBufferSize : DWORD;
irDriveRegs : TIDERegs;
bDriveNumber : BYTE;
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte;
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 ansiCHAR;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev : Array[0..7] of ansiChar;
sModelNumber : Array[0..39] of ansiChar;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : DWORD;
wMultSectorStuff : Word;
ulTotalAddressableSectors : DWORD;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of BYTE;
end;
PIdSector = ^TIdSector;
TDriverStatus = packed record
bDriverError : Byte;
bIDEStatus : Byte;
bReserved : Array[0..1] of Byte;
dwReserved : Array[0..1] of DWORD;
end;
TSendCmdOutParams = packed record
cBufferSize : DWORD;
DriverStatus : TDriverStatus;
bBuffer : Array[0..0] of BYTE;
end;
var hDevice : THandle;
cbBytesReturned : DWORD;
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 : PansiChar;
i : Integer;
c : ansiChar;
begin
ptr := @Data;
for i := 0 to (Size shr 1)-1 do
begin
c := ptr^;
ptr^ := (ptr+1)^;
(ptr+1)^ := c;
Inc(ptr,2);
end;
end;
begin
Result := '';
if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then
begin
hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
end
else
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;
with SCIP do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
with irDriveRegs do
begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
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;
case i of
0: Result := PansiChar(@sModelNumber);
1: Result := PansiChar(@sSerialNumber);
2: Result := PansiChar(@sFirmwareRev);
end;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);begin
Edit1.Text:=trim( GetIdeSerialNumber(0));
Edit2.Text:=trim( GetIdeSerialNumber(1));
Edit3.Text:=trim( GetIdeSerialNumber(2));
end;

[meysam_212]

دستت درد نکنه، مطمئنی همیشه منحصر بفرده؟ فلش رو با هارد اشتباه نمیگیره؟ یعنی اگه فلش به سیستم باشه اشتباه نمی کنه؟

[hadisalahi2]

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

اینجا میزارم تا دوستان اگه خواستن فیضش رو ببرند
یا حق

[mehdi_moosavi]

دوستان محترم این توابع در ویندوز xp کار میکنه ولی در ویندوز 7 رشته خالی برمیگردونه
میشه لطفا راهنمایی بفرمایید
با تشکر

[Saeid59_m]

دوستان محترم این توابع در ویندوز xp کار میکنه ولی در ویندوز 7 رشته خالی برمیگردونه
میشه لطفا راهنمایی بفرمایید
با تشکر

به کاملا درسته توی ویندوز 7 به بعد باید برنامه در حالت Run as administrator اجرای بشه . یعنی باید برای برنامت manifest درست کنی

[hadisalahi2]

به کاملا درسته توی ویندوز 7 به بعد باید برنامه در حالت Run as administrator اجرای بشه . یعنی باید برای برنامت manifest درست کنی
بله من در ویندوز 10 هم تست کردم و مشکلی نداشته و تا الان مورد گزارش نکردن از اینکه رشته خالی برگردونه
اما باید منیفست رو ایجاد کنید