مشکل در بدست اوردن سریال بایوس با اسمبلی اینلاین

[بهروز عباسی]

درود به همه برنامه نویس های گل
خسته نباشید

من تویه برنامم به سریال بایوس نیاز دارم (نمیخوام از WMI استفاده کنم)چندتا کد پیدا کردم اما برنامه خطا میده.
ازDelphi XE استفاده میکنم و Win XP ممنون میشم کمک کنید.

این کد اسمبلی درون خطی:
function GetBiosInfo() : AnsiString;
var buffer: array [0..199] of Char;
begin
asm
push ds
push eax
push ebx
push edx
pushf
mov edx, 0
mov ebx, 0fec71h
@1:
mov ah, [ebx]
mov offset(buffer) + edx, ah
inc edx
inc ebx
cmp ah, 0
jne @1
popf
pop edx
pop ebx
pop eax
pop ds
end;
Result := buffer;
end;

اینم یه کد ساده دیگه:
BiosSerialNo := String(Pchar(Ptr($FEC71)));

[بهروز عباسی]

ممکنه که خطای که میده به خاطر سیستم عامل باشه(اجازه دسترسی به داده های موردنظرم رو نده)؟

[فتح الله زاده]

دوست عزيز اگه واسه قفل ميخواي من از سريال هاري استفاده ميكنم ، اگه به دردت ميخوره برات بزارم

[بهروز عباسی]

دوست عزيز اگه واسه قفل ميخواي من از سريال هاري استفاده ميكنم ، اگه به دردت ميخوره برات بزارم
نه دوست عزیز برای قفل از mac address وسریال cpu وهارد استفاده میکنم کافیه
مشخصات بایوس رو برای کار دیگه ای لازم دارم
ممنون از کمکت

[بهروز عباسی]

مشکل تا حدودی حل شد
کامپوننت زیر مقادیری رو برمیگردونه اما اصلا مفهوم نیست لطفا دوستان یه نگاهی بندازن
اگه تونستن مشکلو حل کنن.

unit AWBiosInfo;

{$ALIGN ON}
{$MINENUMSIZE 4}

interface

uses
Windows, Classes, SysUtils;

type
PRomBiosDump = ^TRomBiosDump;
TRomBiosDump = array [$000F0000..$000FFFFF] of Byte;

type
TReadRomBiosMethod = (
rrbmAutomatic, { Autodetect OS type and use proper method }
rrbmGeneric, { Use 16-bit COM program to dump the BIOS }
rrbmMemory, { Read from memory (Win9x) }
rrbmPhysical { Read from physical memory object (WinNT) }
);

type
TAWBiosInfo = class (TComponent)
private
FDate,
FBios,
FVersion,
FSerialNumber,
FCopyright: string;
FReadRomBiosDumpSuccessful: Boolean;
procedure SetInfo(Value: string);
protected
FRomBiosDump: TRomBiosDump;
procedure RaiseSetReadonlyProperty;
procedure InitComponent; virtual;
public
constructor Create(AOwner: TComponent); override;
{constructor Create(AOwner: TComponent; ReadTimeout: Cardinal);override;}
property ReadRomBiosDumpSuccessful: Boolean read FReadRomBiosDumpSuccessful;
published
property Date: string read FDate write SetInfo stored False;
property Bios: string read FBios write SetInfo stored False;
property Version: string read FVersion write SetInfo stored False;
property SerialNumber: string read FSerialNumber write SetInfo stored False;
property Copyright: string read FCopyright write SetInfo stored False;
end;

TAWBiosInfoEx = class (TAWBiosInfo)
private
FDateInt64,
FBiosInt64,
FVersionInt64,
FSerialNumberInt64,
FCopyrightInt64: Int64;

FDateDWORD,
FBiosDWORD,
FVersionDWORD,
FSerialNumberDWORD,
FCopyrightDWORD: Cardinal;

FDateWord,
FBiosWord,
FVersionWord,
FSerialNumberWord,
FCopyrightWord: Word;

FDateByte,
FBiosByte,
FVersionByte,
FSerialNumberByte,
FCopyrightByte: Byte;

procedure SetInt64(Value: Int64);
procedure SetDWORD(Value: Cardinal);
procedure SetWord(Value: Word);
procedure SetByte(Value: Byte);
protected
procedure InitComponent; override;
public
//
published
property DateInt64: Int64 read FDateInt64 write SetInt64 stored False;
property DateDWORD: Cardinal read FDateDWORD write SetDWORD stored False;
property DateWord: Word read FDateWord write SetWord stored False;
property DateByte: Byte read FDateByte write SetByte stored False;
property BiosInt64: Int64 read FBiosInt64 write SetInt64 stored False;
property BiosDWORD: Cardinal read FBiosDWORD write SetDWORD stored False;
property BiosWord: Word read FBiosWord write SetWord stored False;
property BiosByte: Byte read FBiosByte write SetByte stored False;
property VersionInt64: Int64 read FVersionInt64 write SetInt64 stored False;
property VersionDWORD: Cardinal read FVersionDWORD write SetDWORD stored False;
property VersionWord: Word read FVersionWord write SetWord stored False;
property VersionByte: Byte read FVersionByte write SetByte stored False;
property SerialNumberInt64: Int64 read FSerialNumberInt64 write SetInt64
stored False;
property SerialNumberDWORD: Cardinal read FSerialNumberDWORD write SetDWORD
stored False;
property SerialNumberWord: Word read FSerialNumberWord write SetWord
stored False;
property SerialNumberByte: Byte read FSerialNumberByte write SetByte
stored False;
property CopyrightInt64: Int64 read FCopyrightInt64 write SetInt64 stored False;
property CopyrightDWORD: Cardinal read FCopyrightDWORD write SetDWORD
stored False;
property CopyrightWord: Word read FCopyrightWord write SetWord stored False;
property CopyrightByte: Byte read FCopyrightByte write SetByte stored False;
end;

procedure Register;

function ReadRomBios(var Dump: TRomBiosDump; Method: TReadRomBiosMethod;
Timeout: DWORD = INFINITE): Boolean;

function GetRomBiosBuffer(const Dump: TRomBiosDump; Address: Pointer;
var Buffer; BufferSize: Cardinal): Cardinal;
function GetRomBiosString(const Dump: TRomBiosDump; Address: Pointer): string;
function GetRomBiosLongLong(const Dump: TRomBiosDump; Address: Pointer):
LONGLONG;
function GetRomBiosDWord(const Dump: TRomBiosDump; Address: Pointer): DWORD;
function GetRomBiosWord(const Dump: TRomBiosDump; Address: Pointer): Word;
function GetRomBiosByte(const Dump: TRomBiosDump; Address: Pointer): Byte;

implementation


procedure Register;
begin
RegisterComponents('AWEN Components', [TAWBiosInfo, TAWBiosInfoEx]);
end;

{################################################# #############################
#
# #
# GENERIC METHOD #
# #
# Create an temporary folder, save an 16bit COM program (RomDump.com) into it,
#
# execute program redirected to an file (Rom.dmp, RomDump.com simply dumps the
#
# memory range F000:0000-F000:FFFF to STDOUT), read dump file into the buffer,
#
# and finally cleanup all temporary files and directories. #
# #
# (the function RomDumpCode is x86 specific, which i wrote to generate 16-bit #
# code with the help of the 23-bit Delphi compiler, never try to execute the #
# pseudo-code in your program! it will not work in 32-bit protected mode) #
# #
################################################## #############################
}

{ *INTERNAL* - Pseudo 16-bit code }

type
PRomDumpCodeInfo = ^TRomDumpCodeInfo;
TRomDumpCodeInfo = (rdciStart, rdciEnd, rdciSize);

function _RomDumpCode(Info: TRomDumpCodeInfo): Pointer;
var
CodeStart: Pointer;
CodeEnd: Pointer;
begin
asm
JMP @@End

{ *BEGIN* 16-bit code }
{ -- never use it in your program! -- }
{ COM which writes ROM-BIOS to StdOut }
@@Start:
{ Dump F000:0000-F000:FFFE }
XOR eDX, eDX // DS = 0xF000 ; Data segment
MOV DH, 0F0h
MOV DS, eDX
XOR eDX, eDX // DX = 0x0000 ; Data offset
XOR eCX, eCX // CX = 0xFFFF ; Data length
DEC eCX
XOR eBX, eBX // BX = 0x0001 ; STDOUT (file handle)
INC eBX
MOV AH, 40h // DosCall(0x40) ; INT21, DOS_WRITE_TO_HANDLE
INT 21h
JC @@Exit // On error exit ; AL = Error code
{ Dump F000:FFFF }
XOR eDX, eDX // DS = 0xF000 ; Data segment
MOV DH, 0F0h
MOV DS, eDX
XOR eDX, eDX // DX = 0xFFFF ; Data offset
DEC eDX
XOR eCX, eCX // CX = 0x0001 ; Data length
INC eCX
MOV eBX, eCX // BX = 0x0001 ; STDOUT (file handle)
MOV AH, 40h // DosCall(0x40) ; INT21, DOS_WRITE_TO_HANDLE
INT 21h
JC @@Exit // On error exit ; AL = Error code
MOV AL, 0 // no error ; AL = 0
@@Exit:
MOV AH, 4Ch // DosCall(0x4C) ; INT21, DOS_TERMINATE_EXE
INT 21h
@@End:
{ *END* 16-bit code }

MOV CodeStart, OFFSET @@Start
MOV CodeEnd, OFFSET @@End
end;
case Info of
rdciStart:
Result := CodeStart;
rdciEnd:
Result := CodeEnd;
rdciSize:
Result := Pointer(Cardinal(CodeEnd) - Cardinal(CodeStart));
else
Result := nil;
end;
end;

{ *INTERNAL* - Save 16-bit code to file }

function _RomDumpCodeToFile(const Filename: string): Boolean;
var
ComFile: THandle;
Size: Cardinal;
begin
Result := False;
ComFile := CreateFile(PChar(Filename), GENERIC_WRITE, FILE_SHARE_READ, nil,
CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if ComFile <> INVALID_HANDLE_VALUE then
try
Result := WriteFile(ComFile, _RomDumpCode(rdciStart)^,
Cardinal(_RomDumpCode(rdciSize)), Size, nil) and
(Size = Cardinal(_RomDumpCode(rdciSize)));
if not Result then
DeleteFile(PChar(Filename));
finally
CloseHandle(ComFile);
end;
end;

{ *INTERNAL* - Execute 16-bit code redirected to file }

function _RomDumpCodeExecute(const Com, Dmp: string; Timeout: DWORD): Boolean;
var
ComSpec: string;
si: TStartupInfo;
pi: TProcessInformation;
begin
Result := False;
SetLength(ComSpec, MAX_PATH);
SetLength(ComSpec,
GetEnvironmentVariable('ComSpec', PChar(@ComSpec[1]), MAX_PATH));
if Length(ComSpec) > 0 then
begin
FillChar(si, SizeOf(TStartupInfo), 0);
si.cb := SizeOf(TStartupInfo);
si.dwFlags := STARTF_USESHOWWINDOW;
si.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(ComSpec + ' /C ' + Com + ' > ' + Dmp),
nil, nil, False, CREATE_NEW_CONSOLE or CREATE_NEW_PROCESS_GROUP, nil,
nil, si, pi) then
try
Result := WaitForSingleObject(pi.hProcess, Timeout) <> WAIT_TIMEOUT;
finally
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
end;
end;

function DirectoryExists(const Dir: string): Boolean;
var
Attr: DWORD;
begin
Attr := GetFileAttributes(PChar(Dir));
Result := (Attr <> $FFFFFFFF) and
(Attr and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY);
end;

{ Get BIOS dump the generic way }

function ReadRomBios16(var Buffer: TRomBiosDump; Timeout: DWORD): Boolean;
const
TempSub = '~RomDmp';
ComName = 'RomDump.com';
DmpName = 'Rom.dmp';
var
TempPath: string;
TempDir: string;
TempIdx: Integer;
TempIdxStr: string;
ComFile: string;
DmpFile: string;
DmpHandle: THandle;
Written: DWORD;
begin
Result := False;
SetLength(TempPath, MAX_PATH);
SetLength(TempPath, GetTempPath(MAX_PATH, PChar(@TempPath[1])));
if Length(TempPath) > 0 then
begin
if (TempPath[Length(TempPath)] <> '\') then
TempPath := TempPath + '\';
TempIdx := 0;
repeat
Inc(TempIdx);
Str(TempIdx, TempIdxStr);
TempDir := TempPath + TempSub + TempIdxStr;
until not DirectoryExists(TempDir);
if CreateDirectory(PChar(TempDir), nil) then
try
TempDir := TempDir + '\';
ComFile := TempDir + ComName;
DmpFile := TempDir + DmpName;
if _RomDumpCodeToFile(ComFile) then
try
if _RomDumpCodeExecute(ComFile, DmpFile, Timeout) then
begin
DmpHandle := CreateFile(PChar(DmpFile), GENERIC_READ,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if DmpHandle <> INVALID_HANDLE_VALUE then
try
FillChar(Buffer, SizeOf(TRomBiosDump), 0);
Result := ReadFile(DmpHandle, Buffer, SizeOf(TRomBiosDump),
Written, nil) and (Written = SizeOf(TRomBiosDump));
finally
CloseHandle(DmpHandle);
end;
end;
finally
DeleteFile(PChar(DmpFile));
DeleteFile(PChar(ComFile));
end;
finally
RemoveDirectory(PChar(TempDir));
end;
end;
end;

{################################################# #############################
#
# #
# DIRECT METHOD (Win9x) #
# #
# Due to the fact that Windows 95/98/ME maps the BIOS into every Win32 process
#
# for read access it is very simple to fill the buffer from memory. #
# #
################################################## #############################
}

function ReadRomBios9x(var Buffer: TRomBiosDump): Boolean;
begin
Result := False;
try
FillChar(Buffer, SizeOf(TRomBiosDump), 0);
Move(Pointer(Low(TRomBiosDump))^, Buffer, SizeOf(TRomBiosDump));
Result := True;
except
// ignore exceptions
end
end;

{################################################# #############################
#
# #
# PHYSICAL MEMORY METHOD (WinNT) #
# #
# On Windows NT the ROM BIOS is only available through the named kernel object
#
# '\Device\PhysicalMemory'. Because it is impossible to open kernel objects in
#
# user mode with standard Win32 API functions we make use of NT's nativeAPI in
#
# NtDll.dll ("NT-Layer") namely ZwOpenSection. #
# #
# (note: mostly there are two versions of every function ZwXxx and NtXxx. The #
# only difference in kernel mode is that the NtXxx version works in conside- #
# ration to security while ZwXxx not. But in user mode both work like NtXxx.)
#
# #
# At first the section is opened with ZwOpenSection. Normally we would proceed
#
# ZwMapViewOfSection, ZwUnmapViewOfSection, and NtClose. But the functions are
#
# more complex and there is no needing for it. With the handle (because we are
#
# in the "very simple" user mode =) we now use MapViewOfFile, UnmapViewOfFile,
#
# and CloseHandle to map an memory window (the ROM BIOS) into our process. #
# #
# Due to the fact that ZwOpenSection returns NT error-codes in case of failure
#
# we have to translate it to an Win32 error-code (RtlNtStatusToDosError). #
# All NT specific functions are dynamically loaded -- because the applications
#
# should start on Win9x systems =) #
# #
################################################## #############################
}

{ For more information see Windows 2000/XP DDK }
{ It works on Windows NT 4.0 too, use NtDll.dll }

type
NTSTATUS = Integer;

const
STATUS_SUCCESS = NTSTATUS(0);
STATUS_INVALID_HANDLE = NTSTATUS($C0000008);
STATUS_ACCESS_DENIED = NTSTATUS($C0000022);

type
PUnicodeString = ^TUnicodeString;
TUnicodeString = packed record
Length: Word;
MaximumLength: Word;
Buffer: PWideChar;
end;

const
OBJ_INHERIT = $00000002;
OBJ_PERMANENT = $00000010;
OBJ_EXCLUSIVE = $00000020;
OBJ_CASE_INSENSITIVE = $00000040;
OBJ_OPENIF = $00000080;
OBJ_OPENLINK = $00000100;
OBJ_KERNEL_HANDLE = $00000200;
OBJ_VALID_ATTRIBUTES = $000003F2;

type
PObjectAttributes = ^TObjectAttributes;
TObjectAttributes = record
Length: ULONG;
RootDirectory: THandle;
ObjectName: PUnicodeString;
Attributes: ULONG;
SecurityDescriptor: PSecurityDescriptor;
SecurityQualityOfService: PSecurityQualityOfService;
end;

const
ObjectPhysicalMemoryDeviceName = '\Device\PhysicalMemory';
ObjectPhysicalMemoryName: TUnicodeString = (
Length: Length(ObjectPhysicalMemoryDeviceName) * 2;
MaximumLength: Length(ObjectPhysicalMemoryDeviceName) * 2 + 2;
Buffer: ObjectPhysicalMemoryDeviceName;
);
ObjectPhysicalMemoryAccessMask: ACCESS_MASK = SECTION_MAP_READ;
ObjectPhysicalMemoryAttributes: TObjectAttributes =(
Length: SizeOf(TObjectAttributes);
RootDirectory: 0;
ObjectName: @ObjectPhysicalMemoryName;
Attributes: OBJ_CASE_INSENSITIVE;
SecurityDescriptor: nil;
SecurityQualityOfService: nil;
);

type
TFNZwOpenSection = function(out SectionHandle: THandle;
DesiredAccess: ACCESS_MASK; ObjectAttributes: PObjectAttributes): NTSTATUS;
stdcall;
TFNRtlNtStatusToDosError = function(Status: NTSTATUS): DWORD; stdcall;

const
ntdll = 'ntdll.dll';

var
ZwOpenSection: TFNZwOpenSection;
RtlNtStatusToDosError: TFNRtlNtStatusToDosError;

function ReadRomBiosNt(var Buffer: TRomBiosDump; Timeout: DWORD): Boolean;
var
NtLayer: HMODULE;
Status: NTSTATUS;
Section: THandle;
View: Pointer;
begin
Result := False;
NtLayer := GetModuleHandle(ntdll);
if NtLayer = 0 then
SetLastError(ERROR_CALL_NOT_IMPLEMENTED)
else
begin
if not Assigned(ZwOpenSection) then
ZwOpenSection := GetProcAddress(NtLayer, 'ZwOpenSection');
if not Assigned(RtlNtStatusToDosError) then
RtlNtStatusToDosError := GetProcAddress(NtLayer, 'RtlNtStatusToDosError');
if not (Assigned(ZwOpenSection) and Assigned(RtlNtStatusToDosError)) then
SetLastError(ERROR_CALL_NOT_IMPLEMENTED)
else
begin
Status := ZwOpenSection(Section, ObjectPhysicalMemoryAccessMask,
@ObjectPhysicalMemoryAttributes);
case Status of
STATUS_SUCCESS:
try
View := MapViewOfFile(Section, ObjectPhysicalMemoryAccessMask, 0,
Low(TRomBiosDump), SizeOf(TRomBiosDump));
if Assigned(View) then
try
try
FillChar(Buffer, SizeOf(TRomBiosDump), 0);
Move(View^, Buffer, SizeOf(TRomBiosDump));
Result := True;
except
// ignore exceptions
end;
finally
UnmapViewOfFile(View);
end;
finally
CloseHandle(Section);
end;
STATUS_ACCESS_DENIED:
Result := ReadRomBios16(Buffer, Timeout);
else
SetLastError(RtlNtStatusToDosError(Status))
end;
end;
end;
end;

{################################################# #############################
#
# #
# ReadRomBios #
# #
################################################## #############################
}

function ReadRomBios(var Dump: TRomBiosDump; Method: TReadRomBiosMethod;
Timeout: DWORD = INFINITE): Boolean;
begin
Result := False;
case Method of
rrbmAutomatic:
if (Integer(GetVersion) < 0) then
try
Result := ReadRomBios9x(Dump);
except
Result := ReadRomBios16(Dump, Timeout);
end
else
Result := ReadRomBiosNt(Dump, Timeout);
rrbmGeneric:
Result := ReadRomBios16(Dump, Timeout);
rrbmMemory:
Result := ReadRomBios9x(Dump);
rrbmPhysical:
Result := ReadRomBiosNt(Dump, Timeout);
else
SetLastError(ERROR_INVALID_PARAMETER);
end;
end;

{################################################# #############################
#
# #
# Utilities to simplify the access to data as generic standard types #
# #
################################################## #############################
}

function GetRomBiosBuffer(const Dump: TRomBiosDump; Address: Pointer;
var Buffer; BufferSize: Cardinal): Cardinal;
//Dump¾ÍÊÇ ReadRomBios ¶Á³öÀ´µÄÊý×飬
//Address¾ÍÊÇÆðʼµÄ¶ÁÈ¡µÄµØÖ·£� �BufferSize¾ÍÊÇÄãÒª¶ÁÈ ¡µÄ´óС¡£
begin
Result := 0;
if (Cardinal(Address) >= Low(TRomBiosDump)) and
(Cardinal(Address) <= High(TRomBiosDump)) then
begin
Result := BufferSize;
if (Cardinal(Address) + BufferSize > High(TRomBiosDump)) then
Result := High(TRomBiosDump) - Cardinal(Address) + 1;
Move(Dump[Cardinal(Address)], Buffer, Result);
end;
end;

function GetRomBiosString(const Dump: TRomBiosDump; Address: Pointer): string;
begin
Result := '';
if (Cardinal(Address) >= Low(TRomBiosDump)) and
(Cardinal(Address) <= High(TRomBiosDump)) then
Result := string(PChar(@Dump[Cardinal(Address)]));
end;

function GetRomBiosLongLong(const Dump: TRomBiosDump; Address: Pointer):
LONGLONG;
type
PLongLong = ^LONGLONG;
begin
Result := 0;
if (Cardinal(Address) >= Low(TRomBiosDump)) and
(Cardinal(Address) <= High(TRomBiosDump) - SizeOf(LONGLONG) + 1) then
Result := PLongLong(@Dump[Cardinal(Address)])^;
end;

function GetRomBiosDWord(const Dump: TRomBiosDump; Address: Pointer): DWORD;
begin
Result := 0;
if (Cardinal(Address) >= Low(TRomBiosDump)) and
(Cardinal(Address) <= High(TRomBiosDump) - SizeOf(DWORD) + 1) then
Result := PDWORD(@Dump[Cardinal(Address)])^;
end;

function GetRomBiosWord(const Dump: TRomBiosDump; Address: Pointer): Word;
begin
Result := 0;
if (Cardinal(Address) >= Low(TRomBiosDump)) and
(Cardinal(Address) <= High(TRomBiosDump) - SizeOf(Word) + 1) then
Result := PWord(@Dump[Cardinal(Address)])^;
end;

function GetRomBiosByte(const Dump: TRomBiosDump; Address: Pointer): Byte;
begin
Result := 0;
if (Cardinal(Address) >= Low(TRomBiosDump)) and
(Cardinal(Address) <= High(TRomBiosDump) - SizeOf(Byte) + 1) then
Result := PByte(@Dump[Cardinal(Address)])^;
end;

{ TAWBiosInfo }

const
// Æ«ÒÆÁ¿ Address Öµ£¬ÔÚ GetRomBiosXXXX º¯ÊýÖеĵڶþ¸ö²ÎÊýÖµ³£Á¿
bcDate = $ffff5;
bcBiosName = $ffa68;
bcVersion = $fe061;
bcSerialNumber = $FEC71;
bcCopyright = $fe091;

constructor TAWBiosInfo.Create(AOwner: TComponent);
var
I: Integer;
begin
if AOwner <> nil then
for I := 0 to AOwner.ComponentCount - 1 do
if AOwner.Components[I] is TAWBiosInfo then
raise Exception.Create('Can not place the second AWBiosInfo component here.');
inherited Create(AOwner);
InitComponent;
end;

{constructor TAWBiosInfo.Create(AOwner: TComponent; ReadTimeout: Cardinal);
begin
inherited Create(AOwner);
InitComponent;
end;}

procedure TAWBiosInfo.InitComponent;
begin
FReadRomBiosDumpSuccessful := ReadRomBios(FRomBiosDump, rrbmAutomatic);
if FReadRomBiosDumpSuccessful then
begin
FDate := Trim(GetRomBiosString(FRomBiosDump, Ptr(bcDate))); // bios date
FBios := Trim(GetRomBiosString(FRomBiosDump, Ptr(bcBiosName))); // bios name
FVersion := Trim(GetRomBiosString(FRomBiosDump, Ptr(bcVersion))); // bios version
FSerialNumber := Trim(GetRomBiosString(FRomBiosDump, Ptr(bcSerialNumber))); // bios serial number
FCopyright := Trim(GetRomBiosString(FRomBiosDump, Ptr(bcCopyright))); // bios copyringht
end
else begin
FDate := '';
FBios := '';
FVersion := '';
FSerialNumber := '';
FCopyright := '';
end;
end;

procedure TAWBiosInfo.SetInfo(Value: string);
begin
RaiseSetReadonlyProperty;
end;

procedure TAWBiosInfo.RaiseSetReadonlyProperty;
begin
// if not (csLoading in ComponentState) then
if (csDesigning in ComponentState) or (DebugHook = 1) then
raise Exception.Create('You can not set readonly property.');
end;

{ TAWBiosInfoEx }

procedure TAWBiosInfoEx.InitComponent;
begin
inherited InitComponent;
if ReadRomBiosDumpSuccessful then
begin
FDateInt64 := Int64(GetRomBiosLONGLONG(FRomBiosDump, Ptr(bcDate))); // bios date
FDateDWORD := Cardinal(GetRomBiosDWORD(FRomBiosDump, Ptr(bcDate)));
FDateWord := GetRomBiosWord(FRomBiosDump, Ptr(bcDate));
FDateByte := GetRomBiosByte(FRomBiosDump, Ptr(bcDate));

FBiosInt64 := Int64(GetRomBiosLONGLONG(FRomBiosDump, Ptr(bcBiosName))); // bios name
FBiosDWORD := Cardinal(GetRomBiosDWORD(FRomBiosDump, Ptr(bcBiosName)));
FBiosWord := GetRomBiosWord(FRomBiosDump, Ptr(bcBiosName));
FBiosByte := GetRomBiosByte(FRomBiosDump, Ptr(bcBiosName));

FVersionInt64 := Int64(GetRomBiosLONGLONG(FRomBiosDump, Ptr(bcVersion))); // bios version
FVersionDWORD := Cardinal(GetRomBiosDWORD(FRomBiosDump, Ptr(bcVersion)));
FVersionWord := GetRomBiosWord(FRomBiosDump, Ptr(bcVersion));
FVersionByte := GetRomBiosByte(FRomBiosDump, Ptr(bcVersion));

FSerialNumberInt64 := Int64(GetRomBiosLONGLONG(FRomBiosDump, Ptr(bcSerialNumber))); // bios serial number
FSerialNumberDWORD := Cardinal(GetRomBiosDWORD(FRomBiosDump, Ptr(bcSerialNumber)));
FSerialNumberWord := GetRomBiosWord(FRomBiosDump, Ptr(bcSerialNumber));;
FSerialNumberByte := GetRomBiosByte(FRomBiosDump, Ptr(bcSerialNumber));

FCopyrightInt64 := Int64(GetRomBiosLONGLONG(FRomBiosDump, Ptr(bcCopyright))); // bios copyringht
FCopyrightDWORD := Cardinal(GetRomBiosDWORD(FRomBiosDump, Ptr(bcCopyright)));
FCopyrightWord := GetRomBiosWord(FRomBiosDump, Ptr(bcCopyright));
FCopyrightByte := GetRomBiosByte(FRomBiosDump, Ptr(bcCopyright));
end
else begin
FDateInt64 := 0;
FDateDWORD := 0;
FDateWord := 0;
FDateByte := 0;

FBiosInt64 := 0;
FBiosDWORD := 0;
FBiosWord := 0;
FBiosByte := 0;

FVersionInt64 := 0;
FVersionDWORD := 0;
FVersionWord := 0;
FVersionByte := 0;

FSerialNumberInt64 := 0;
FSerialNumberDWORD := 0;
FSerialNumberWord := 0;
FSerialNumberByte := 0;

FCopyrightInt64 := 0;
FCopyrightDWORD := 0;
FCopyrightWord := 0;
FCopyrightByte := 0;
end;
end;

procedure TAWBiosInfoEx.SetInt64(Value: Int64);
begin
RaiseSetReadonlyProperty;
end;

procedure TAWBiosInfoEx.SetDWORD(Value: Cardinal);
begin
RaiseSetReadonlyProperty;
end;

procedure TAWBiosInfoEx.SetWord(Value: Word);
begin
RaiseSetReadonlyProperty;
end;

procedure TAWBiosInfoEx.SetByte(Value: Byte);
begin
RaiseSetReadonlyProperty;
end;

end.

[بهروز عباسی]

دوستان با WMI هم سعی کردم این کارو بکنم اما هیچی برنمیگردونه
مشکل از کده یا سیستم؟

اینم کد WMI

implementation
uses
{SysUtils, Variants, }ActiveX, ComObj;
{$R *.dfm}
function GetWMIstring(wmiHost, root, wmiClass, wmiProperty: string): string;
var
objWMIService: OLEVariant;
colItems: OLEVariant;
colItem: OLEVariant;
oEnum: IEnumvariant;
iValue: LongWord;

function GetWMIObject(const objectName: String): IDispatch;
var
chEaten: Integer;
BindCtx: IBindCtx; // for access to a bind context
Moniker: IMoniker; // Enables you to use a moniker object
begin
OleCheck(CreateBindCtx(0, BindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten,
Moniker)); // Converts a string into a moniker that identifies the object named by the string
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
// Binds to the specified object
end;

begin
objWMIService := GetWMIObject(Format('winmgmts:\\%s\%s', [wmiHost, root]));
colItems := objWMIService.ExecQuery(Format('SELECT * FROM %s', [wmiClass]),
'WQL', 0);
oEnum := IUnknown(colItems._NewEnum) as IEnumvariant;
while oEnum.Next(1, colItem, iValue) = 0 do
begin
Result := colItem.Properties_.Item(wmiProperty, 0); // you can improve this code ;) , storing the results in an TString.
end;
end;
procedure TForm1.Button1Click(Sender: TObject);

var
str1: string;
begin
str1 := GetWMIstring('.', 'root\CIMV2', 'Win32_BIOS', 'SerialNumber');
ShowMessage(str1);
end;

[بهروز عباسی]

دراین تاپیـــــک (http://barnamenevis.org/showthread.php?36011-%D8%B3%D8%B1%DB%8C%D8%A7%D9%84-%D8%A8%D8%A7%DB%8C%D9%88%D8%B3&highlight=%D8%A8%D8%A7%DB%8C%D9%88%D8%B3)
یکی از دوستان تابع زیررو نوشته:
function GetBiosInfoAsText: string;
var
P, Q: PAnsiChar;
begin
Q := nil;
P := PansiChar(Ptr($FE000));
repeat
if Q <> nil then begin
if not (P^ in [#10, #13, #32..#126, #169, #184]) then begin
if (P^ = #0) and (P - Q >= 8) then begin
Result := Result + TrimRight(string(Q)) + #13#10;
end;
Q := nil;
end;
end else
if P^ in [#33..#126, #169, #184] then
Q := P;
Inc(P);
until P > PChar(Ptr($FFFFF));
Result := TrimRight(Result);
end;

و مثل من به خطا برخورد کردن و جناب کشاورز در جواب چنین گفته:

اون کد فقط بدرد ویندوزهای 9x می خورد، در ویندوزهای NT, 2000, XP و بالاتر، این کد عمل نخواهد کرد، چون دسترسی مستقیم به حافظه وجود نداره. حالا اگه راهش اون کد باشه کسی میتونه اون کد رو به یه برنامه کرنل مد تبدیل کنه؟
لطفا اگه کسی میتونه کمک کنه.

[Felony]

این کد رو سیستم من جواب بدون مشکل اجرا شد :

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;
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;
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 Serial: String;
var
objWMIService : OLEVariant;
colItems : OLEVariant;
colItem : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
begin;
objWMIService:= GetWMIObject('winmgmts:\\localhost\root\CIMV2');
colItems := objWMIService.ExecQuery('SELECT * FROM Win32_Bios','WQL',0);
oEnum := IUnknown(colItems._NewEnum) as IEnumVariant;
while oEnum.Next(1, colItem, iValue) = 0 do
begin
Result:= VarStrNull(colItem.SerialNumber);
end;
end;

[بهروز عباسی]

این کد رو سیستم من جواب بدون مشکل اجرا شد :
خیلی ممنون ، مشکل به خاطر سیستم بود مادر بردهای گیگابایت این مقدار رو ندارند(خالیه)
روی 8 تا سیستم تست کردم با بقیه مادر بردها مشکلی نداره.