盒子论坛 v2.1

function GetCpuId:longint;assembler;register;
var
  temp:longint;
begin
  asm
    PUSH    EBX
    PUSH    EDI
    MOV     EDI,EAX
    MOV     EAX,1
    DW      $A20F
    MOV     TEMP,EDX
    POP     EDI
    POP     EBX
  end;
  result:=temp;
end;
----------------------------------------------

作者：

bios (阿贡)	★☆☆☆☆	-
	盒子中级会员

2004/2/4 18:01:51

2楼：

unit Unit1;
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Registry, StdCtrls, Buttons;

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Label3: TLabel;
Edit3: TEdit;
GetKeySpeedButton: TSpeedButton;
CheckBox1: TCheckBox;
Label4: TLabel;
procedure GetKeySpeedButtonClick(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Family, Model, Stepping: Byte;

implementation

{$R *.dfm}

//获得CPU信息的过程，用汇编代码写的
procedure GetCpuID;
asm
PUSH EAX
MOV EAX, 1
DW $A20F //汇编指令CPUID的机器代码
MOV Stepping, AL
AND Stepping, 0FH //取得CPU STEPPING数送入到变量Stepping中
AND AL, 0F0H
SHR AL, 4
MOV Model, AL //取得CPU MODEL数送入到变量Model中
SHR AX, 8
AND AL, 0FH
MOV Family, AL //取得CPU FAMILYG数送入到变量Family中
POP EAX
end;

//RSA的加密和解密函数，等价于(m^e) mod n（即m的e次幂对n求余）
function Encrypt_Decrypt(m: Int64; e: Int64=$2C86F9; n: Int64=$69AAA0E3): Int64;
var
a, b, c: Int64;
begin
a:=m;
b:=e;
c:=1;
while b<>0 do
if (b mod 2)=0
then begin
b:=b div 2;
a:=(a * a) mod n;
end
else begin
b:=b - 1;
c:=(a * c) mod n;
end;
Result:=c;
end;

procedure TForm1.GetKeySpeedButtonClick(Sender: TObject);
var
ID, UserName, CpuVer: String;
s: Array [1..4] of Cardinal;
temp, Num1, Num2: Cardinal;
Code1, Code2: Int64;
i, ascii: Byte;
Reg: TRegistry;
begin
if (Edit1.Text=') and (CheckBox1.Checked=False)
then Application.MessageBox('请输入注册申请码！', '警告', MB_OK);
if (Edit1.Text=') and (CheckBox1.Checked=True)
then Application.MessageBox('请输入注册者姓名！', '警告', MB_OK);
if (CheckBox1.Checked=true) and (Edit1.Text<>')
then begin
UserName:=Edit1.Text; //从Edit1.Text中取得用户名
GetCpuID; //调用过程GetCpuID
CpuVer:='Level '+IntToStr(Family)+' Rev. '+IntToStr(Model)+'.'+IntToStr(Stepping);
temp:=1;
i:=1;
while UserName[i]<>#0 do begin
ascii:=ord(UserName[i]); //函数ord()的作用为取得字符的ASCII码
temp:=(temp*ascii+$D0878) mod $F4240;
inc(i);
end;
i:=1;
while CpuVer[i]<>#0 do begin
ascii:=ord(CpuVer[i]);
temp:=(temp*ascii+$2597D) mod $F4240;
inc(i);
end;
ID:=IntToStr(temp);
end;
if (CheckBox1.Checked=false) and (Edit1.Text<>')
then ID:=Edit1.Text;
ID:=ID+'1234567';
SetLength(ID, 8); //把字符串ID长度变为8个，并把后面的字符截掉

//下面四行语句是把字符串'You are big pig.'的内存数据送到变量s中
s[1]:=$20756f59;
s[2]:=$20657261;
s[3]:=$20676962;
s[4]:=$2e676970;
Num1:=0;
for i:=4 downto 2 do
Num1:=(Num1+ord(ID[i])) shl 8;
Num1:=Num1+ord(ID[1]);
Num2:=0;
for i:=8 downto 6 do
Num2:=(Num2+ord(ID[i])) shl 8;
Num2:=Num2+ord(ID[5]);
temp:=0;
for i:=1 to 32 do begin
temp:=temp+$9E3779B9;
Num1:=Num1+(Num2 shl 4)+(s[1] xor Num2)+((Num2 shr 5) xor temp)+s[2];
Num2:=Num2+(Num1 shl 4)+(s[3] xor Num1)+((Num1 shr 5) xor temp)+s[4];
end;

Code1:=(Num1 mod $40000000) + 2;
Code2:=($93E0014 shl 2)+ Num1 div $40000000 + 2;
Code1:=Encrypt_Decrypt(Code1);
code2:=Encrypt_Decrypt(Code2);
if (CheckBox1.Checked=False) and (Edit1.Text<>')
then begin
Edit2.Text:=IntToHex(Code1, 8);
Edit3.Text:=IntToHex(Code2, 8);
end;
if (CheckBox1.Checked=True) and (Edit1.Text<>')
then begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
if Reg.OpenKey('Software\Wom', True)
then begin
Reg.DeleteValue('Masters');
Reg.WriteString('Register', UserName);
Reg.WriteString('Register_1', IntToHex(Code1, 8));
Reg.WriteString('Register_2', IntToHex(Code2, 8));
end;
Reg.Free;
Application.MessageBox('自动注册完成！', '信息', MB_OK);
end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked=true
then begin
GetKeySpeedButton.Caption:='自动注册';
Label1.Caption:='注册者姓名';
Edit1.MaxLength:=0;
Label2.Visible:=false;
Label3.Visible:=false;
Edit2.Visible:=false;
Edit3.Visible:=false;
end
else begin
GetKeySpeedButton.Caption:='取得注册码';
Label1.Caption:='注册申请码';
Edit1.MaxLength:=8;
Label2.Visible:=true;
Label3.Visible:=true;
Edit2.Visible:=true;
Edit3.Visible:=true;
end;
end;

end.

----------------------------------------------

作者：

bios (阿贡)	★☆☆☆☆	-
	盒子中级会员

2004/2/4 18:05:01

3楼：

拷一段获取网卡号的程序给你参考
function LanCardID: string;
//获取网卡物理地址
var guid: TGUID;
    i: integer;
begin
   result := ';
   CoCreateGUID(guid);
   for i := Low(guid.D4)+2 to High(guid.D4) do
   begin
      result := result + IntToHex(guid.D4[i],2);
   end;
end;

----------------------------------------------

作者：

bios (阿贡)	★☆☆☆☆	-
	盒子中级会员

2004/2/4 18:07:41

4楼：

如何得到硬盘物理序号
mysofts.51.net 2001-8-20 软件自做

unit hdid;

interface

uses
Windows, Controls,SysUtils,Forms;
//, Graphics, Dialogs, Classes, Messages,StdCtrls;
type
TSrbIoControl = packed record
HeaderLength : ULONG;
Signature : Array[0..7] of Char;
Timeout : ULONG;
ControlCode : ULONG;
ReturnCode : ULONG;
Length : ULONG;
end;
SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;

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. Must be zero.
end;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs;

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;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;

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 : ULONG;
wMultSectorStuff : Word;
ulTotalAddressableSectors : ULONG;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of Byte;
end;
PIdSector = ^TIdSector;

const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE = 512;
DFP_RECEIVE_DRIVE_DATA = $0007c088;
IOCTL_SCSI_MINIPORT = $0004d008;
IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;
DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;
type
Thdidform = class(TForm)
private
{ Private declarations }
public

{ Public declarations }
end;

var
hdidform: Thdidform;
function GetIdeDiskSerialNumber : String;

implementation

{$R *.DFM}
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;

function GetIdeDiskSerialNumber : String;

var
hDevice : THandle;
cbBytesReturned : DWORD;
pInData : PSendCmdInParams;
pOutData : Pointer; // PSendCmdOutParams
Buffer : Array[0..BufferSize-1] of Byte;
srbControl : TSrbIoControl absolute Buffer;
begin
Result := ';
FillChar(Buffer,BufferSize,#0);
if Win32Platform=VER_PLATFORM_WIN32_NT then
begin // Windows NT, Windows 2000
// Get SCSI port handle
hDevice := CreateFile( '\\.\Scsi0:',
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
System.Move('SCSIDISK',srbControl.Signature,8);
srbControl.Timeout := 2;
srbControl.Length := DataSize;
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
pInData := PSendCmdInParams(PChar(@Buffer)
+SizeOf(SRB_IO_CONTROL));
pOutData := pInData;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT,
@Buffer, BufferSize, @Buffer, BufferSize,
cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
end
else
begin // Windows 95 OSR2, Windows 98
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil,
CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
pInData := PSendCmdInParams(@Buffer);
pOutData := @pInData^.bBuffer;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,
pInData, SizeOf(TSendCmdInParams)-1, pOutData,
W9xBufferSize, cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
end;
with PIdSector(PChar(pOutData)+16)^ do
begin
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
end;
end;

END.

//win98要 c:\windows\system\的smartvsd.vxd
//copy to c:\windows\system\iosubsys
//reboot your computer and ok
//2000 and nt do not need
得到硬盘物理序号:

uses hdid;

hdsn:=trim(GetIdeDiskSerialNumber);

----------------------------------------------

作者：

bios (阿贡)	★☆☆☆☆	-
	盒子中级会员

2004/2/4 18:13:47

5楼：

网卡的MAC

//加入nb30.pas单元

var
  LanaNum: Byte;
  MACAddress: PMACAddress;
  RetCode: Byte;
begin
  LanaNum := StrToInt(ComboBox1.Text);
  New(MACAddress);
  try
    RetCode := GetMACAddress(LanaNum, MACAddress);
    if RetCode = NRC_GOODRET then
    begin
      Edit1.Text := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%.2x', MACAddress[0], MACAddress[1], MACAddress[2], MACAddress[3], MACAddress[4], MACAddress[5]]);
    end else
    begin
      Beep;
      Edit1.Text := 'Error';
      ShowMessage('GetMACAddress Error! RetCode = $' + IntToHex(RetCode, 2));
    end;
  finally
    Dispose(MACAddress);
  end;
----------------------------------------------

作者：

bios (阿贡)	★☆☆☆☆	-
	盒子中级会员

2004/2/4 18:16:15

6楼：

function TPCInfo.GetMainboardSerialNumber: string;
begin
if GetOS = ‘9x‘ then
Result := string(Pchar(Ptr($FEC71)))
else
Result := ‘‘;
end;

仅win9x可用.
----------------------------------------------

作者：

bios (阿贡)	★☆☆☆☆	-
	盒子中级会员

2004/2/4 18:20:53

7楼：

在计算机的BIOS芯片里有一个序列号，即BIOS序列号，据说是每一台计算机都不同的。有些软件就用这个序列号作为一个唯一的标识来使用。而在Windows优化大师中更是可以看到这个序列号，那么，他们是怎么读取的呢？
    不同品牌的计算机有不同的BIOS芯片，这给BIOS序列号的读取造成了一些麻烦。但这个序列号都是存储在物理内存的0x000f0000-0x000fffff这个区域里，具体的地址根据BIOS生产厂家有所不同。
    常见的BIOS生产厂家有AMI，Award，Phoenix；其中Phoenix一般用在IBM的笔记本电脑中。那么怎么鉴别BIOS的生产厂家呢？其实我也不知道有什么简单的标志，只是采取了搜索法，搜索上述内存区域，一旦发现"AMI"这个字符串就认为是AMI的BIOS，依此类推。
    根据试验发现，AMI的序列号地址在0x000ff478，Award的序列号地址在0x000fec71，而Phoenix的序列号不太明确，可能是0x000f6577、0x000f7196、0x000f7550中的一个，而且Windows优化大师也没有给出这种BIOS的序列号。而试验的几种BIOS生产日期都是在0x000ffff5处。
    关于如何读取物理内存的问题，在Win9X和WinNT是完全不同的。

    Windows 9X 的方法非常简单。
...
char *pSN=(char *)0x000fec71;
printf("%s\n",pSN);
...

//以下函数用以获得计算机BIOS系统信息。
function GetBios(value: integer): String;
// 1...Bios Type
// 2.. Bios Copyright
// 3.. Bios Date
// 4.. Bios Extended Info
// 5.. Bustype
// 6.. MachineType
begin
result:='(unavailable)';
case value of
1: result:=String(Pchar(Ptr($FE061)));
2: result:=String(Pchar(Ptr($FE091)));
3: result:=String(Pchar(Ptr($FFFF5)));
4: result:=String(Pchar(Ptr($FEC71)));
end;
end;
----------------------------------------------

作者：

bios (阿贡)	★☆☆☆☆	-
	盒子中级会员

2004/2/4 18:23:21

8楼：

一个例子：
(*******************************************************************************
*                                                                              *
* BIOS Help - read ROM BIOS on Windows 95/98/SE/ME/NT/2K/XP                    *
*                                                                              *
* Copyright (C) 2001, Nico Bendlin (nico@bendlin.de)                           *
*                                                                              *
* Compiler: Delphi 4.03/5.01/6.00                                              *
* Version: 1.03, 2001-09-02                                                    *
*                                                                              *
*******************************************************************************)

{ postum scriptum: sorry for the bad english, i wrote it in a hurry }

unit BiosHelp;

{$ALIGN ON}
{$MINENUMSIZE 4}

interface

uses
  Windows;

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) }
  );

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

{###############################################################################
#                                                                              #
#                             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
              FillChar(Buffer, SizeOf(TRomBiosDump), 0);
              Move(View^, Buffer, SizeOf(TRomBiosDump));
              Result := True;
            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;
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;

----------------------------------------------

作者：

river (HZG)	★☆☆☆☆	-
	盒子活跃会员

2004/2/4 20:29:44

9楼：

哇，太过瘾了！
好
----------------------------------------------
尽吾志而无悔
www.2ccc.com

作者：

zpeihe (stanley)	★☆☆☆☆	-
	盒子活跃会员

2004/2/5 19:40:15

10楼：

谢谢bios, 但是我那个GetIdeDiskSerialNumber 函数我下载测试过,在Win200 SERVER 和WINXP下得到的是空百,其他系统都没有问题. 能告诉我原因吗 ?
----------------------------------------------
I just loving Delphi

作者：

bios (阿贡)	★☆☆☆☆	-
	盒子中级会员

2004/2/5 19:45:08

11楼：

：）偶自己都没试过，呵呵，这是大家都复制来都粘贴的
----------------------------------------------

作者：

flyers (flyers)	★☆☆☆☆	-
	普通会员

2004/2/5 19:53:42

12楼：

哇，太无敌了，一个也看不懂……
----------------------------------------------
大家好，我是Flyers。

是Delphi.Net版主，小弟会尽力解决大家的问题！谢谢支持！

作者：

qingwen07 (qingwen)	★☆☆☆☆	-
	盒子活跃会员

2004/2/6 15:46:21

13楼：

zpeihe老兄啊,为什么我在任何系统中得到的结果都是空白啊!!!我要晕了
----------------------------------------------
-

作者：

jasonmao (jason)	★☆☆☆☆	-
	普通会员

2004/2/6 15:56:46

14楼：

强.
----------------------------------------------
我真的很菜啊。

作者：

zpeihe (stanley)	★☆☆☆☆	-
	盒子活跃会员

2004/2/8 18:16:38

15楼：

qingwen,你好，我测试过在WIN200个人版/WIN98/下是没有问题的，只是针对GetIdeDiskSerialNumber 这个函数。
----------------------------------------------
I just loving Delphi

作者：

ssyyxx (Startar)	★☆☆☆☆	-
	盒子活跃会员

2004/5/2 18:00:53

16楼：

!!!
----------------------------------------------
-

作者：

ssyyxx (Startar)	★☆☆☆☆	-
	盒子活跃会员

2004/5/2 18:01:43

17楼：

真强呀
----------------------------------------------
-

作者：

lyl910 (颠三倒四)	★☆☆☆☆	-
	盒子活跃会员

2004/5/3 0:09:34

18楼：

太长谁能把得到cpu id 部分的代码简化一下
----------------------------------------------
向大家学习。

作者：

antwin (联邦探长007)	★☆☆☆☆	-
	普通会员

2004/8/26 10:54:42

19楼：

我认为用控件是最好的啦
----------------------------------------------
联邦探长007

作者：

nswtnt (nswq)	★☆☆☆☆	-
	普通会员

2004/8/30 10:41:16

20楼：

晕倒~ 好象有些地方不能实现捏
----------------------------------------------
-

作者：

snjcyl (木二)	★☆☆☆☆	-
	盒子活跃会员

2004/9/21 22:34:43

21楼：

9X下和2K下的硬盘ID读取是不是不一样呀？为什么在2K下可以在9X下不行哦。
----------------------------------------------
-

作者：

ljhok (有点心动)	★☆☆☆☆	-
	盒子活跃会员

2004/11/13 16:50:05

22楼：

可是有些电脑取出来的号码是空的，通过加密换后出来的全是FFFFFFFFFF
----------------------------------------------
-

作者：

dz520dz (小狠)	★☆☆☆☆	-
	普通会员

2004/11/24 15:41:01

23楼：

nb!!!!!就是看不懂啊...操,我真他妈笨啊...
----------------------------------------------
-

作者：

dragon_cb (卫人人)	★☆☆☆☆	-
	普通会员

2005/1/6 16:16:59

24楼：

昏迷中！
----------------------------------------------
-

作者：

youxia (新游侠)	★☆☆☆☆	-
	盒子活跃会员

2005/1/19 11:16:11

25楼：

怎样取得SATA硬盘的序列号？用取IDE硬盘的方法得不到结果
----------------------------------------------
  __  _  ___
/  )/ )(_      _ __/
/(_/(__ /__)(/)(-/ /
            /

作者：

haifeng1978 (海风)	★☆☆☆☆	-
	普通会员

2005/3/16 10:16:00

26楼：

佩服!
----------------------------------------------
-虚心向各位delphi前辈学习！

作者：

cxgyr (伊然)	★☆☆☆☆	-
	普通会员

2005/3/17 16:43:01

27楼：

你们能不能也把源文件给发表一下!!
----------------------------------------------
只有想不到的,没有做不到的

作者：

ysy2005 (木小刀)	★☆☆☆☆	-
	普通会员

2005/3/22 9:47:59

28楼：

bios,我顶你！！！
----------------------------------------------
-

作者：

hxt (hxt)	★☆☆☆☆	-
	普通会员

2005/5/6 17:41:13

29楼：

牛x
----------------------------------------------
-

作者：

ldmmig (ldm)	★☆☆☆☆	-
	盒子活跃会员

2005/6/1 13:11:20

30楼：

软件一定要加密吗？
你们那个见过没被解密的软件。
----------------------------------------------
-

作者：

weiwei123 (weiwei)	★☆☆☆☆	-
	普通会员

2006/11/23 17:20:35

31楼：

反正我写的软件是不会要注册的...呵呵..
----------------------------------------------
我是个俗人

作者：

wycf021 (wycf021)	▲▲▲▲▲	-
	普通会员

2011/3/24 18:49:06

33楼：

蓝蜂科技8年来一直致力于企业网站建设企业网站制作企业网站设计企业网站优化企业网站推广网站建设公司搜索引擎优化论坛营销竞价推广博客营销问答营销媒体发布事件营销邮件营销企业网站建设网页设计建站流程等网络建设与推广的公司.

　　– Vi gör rundvandring i fabriken och tittar på säkerhet,resor Japan arbetsmiljö och arbetsförhållanden i stort.resor PeruVileverantörer. resor KinaKan vi hjälpa dem att leder detta också till en lägre produktionskostnad.resor Vietnam från design, inköp, logistik och produktion. Alla avdelningar kan bidra på något sätt. En framtagen hållbarhetsstrategi integreras nu i hela företaget och den ska in som en arbetet utåt.Övertid är ett problem som vi ofta stöter på.Kina resor också. Japan ResorDet är inte såFlyg Beijing Plaggen är exempel ur en ny kollektion,Peru Resor som Flyg Shanghaiär ett svillkor,Flyg Hongkong me
----------------------------------------------
-

作者：

wmh778899 (2332)	▲▲▲▲▲	-
	普通会员

2011/3/26 21:23:49

34楼：

全讯网新2
皇冠网址
www.zqmeo.com
----------------------------------------------
全讯网新2

作者：

seowhy123456 (seowhy123456)	▲▲▲▲▲	-
	禁用账号

2011/4/26 21:14:44

36楼：

……
被禁用帐号，帖子内容自动屏蔽！
……
----------------------------------------------
发布广告,禁用帐号!

作者：

seowhy123456 (seowhy123456)	▲▲▲▲▲	-
	禁用账号

2011/5/4 23:55:43

37楼：

……
被禁用帐号，帖子内容自动屏蔽！
……
----------------------------------------------
发布广告,禁用帐号!

作者：

baidu006 (chong)	▲▲▲▲▲	-
	普通会员

2011/6/23 17:15:40

38楼：

有这样一个故事，干旱的村子缺水，村里决定雇布鲁诺和柏波罗把附近河里的水运到深圳龙岗搬家公司村广场的蓄水池里，每天按运送的水量付钱，布鲁诺每天起早贪黑地工作，挣了不少收入；而柏波罗则用一部分时间运水，而用另一部分时间和周末休息日来建造深圳南山搬家公司他的管道。与柏波罗相比，布鲁诺挣的钱要多很多，很快富裕起来了。但几年以后，柏波罗的管道修成了，从此无论是吃饭还是睡觉，或是出去游玩，水都在源源不断地流进村里，而财富也不分昼夜地流进柏波罗的口袋。而深圳福田搬家公司布鲁诺却失了业，因为村子再也不需要他背着水桶运水了。这本六七万字的小书告诉人们，不要忘了修建你的财富管道，管道是你的生命线。书里还有一句很有味道的话，“今天，成为一名百万富翁深圳罗湖搬家公司不是一种机会，而是一种选择”。有一条管道的确是个美好的梦想，当你休息、休闲、休假的时候，管道不休息，源源不断地把财富送来，挡都挡不住。世界上深圳龙华搬家公司有些人的确是幸运，生下来就有这种管道，比如屁股底下坐着石油的人，只需要找根管子，一头接在地下，一头接在钱包上，就剩下数钱了，稍稍把阀门拧小点，每桶75块，还是美元；还有的人生下来就有权有势，只需要找几根管子把深圳宝安搬家公司几个图章连在一块儿就行了。而绝大多数人则要修建自己的管道。文人里面，据我所知鲁迅、巴金和李敖是修了管道的，鲁迅生前身后版税可观，巴老则从未拿过工资，《家》、《春》、《秋》等几部巨著的版税能让老人家衣食无忧，所以老人说了很多深圳罗湖搬家公司自己想说的话；李敖早就不靠着工资活着了，所以把“李敖有话说”玩儿得汪洋恣肆，淋漓尽致。建造管道的确是有力的，如果学会了炒股赚钱，一天一个涨停板，从下午三点闭市到第二天上午九点开盘，您歇着，股市可没歇着，还为您赚钱呢。甭多，就深圳福田搬家公司一万元起家，一天一个板，一年就赚中国22年的GDP，所以套牢了那么多人。对一个普通人来说，修建管道有很多困难，但心里有这个事儿，就很有意义，一个深圳南山搬家公司有准备的头脑肯定也会碰到更多的机会。与管道相比，我对勺子更感兴趣，勺子就是工作的收入。世界上的资源就那么多，锅就那么大，大家都在从锅里往外舀，只是深圳搬家公司有人用大勺，有人用小勺，有人用挖耳勺。要想多舀一点，就得把勺子做大。所以，要念书，要读学位，要考证，要跳槽，要争取升职，要读《怎样让老板离不开你》、《拒绝借口》、《怎样与女上司相处》，诸如深圳龙岗搬家公司此类老板和中层主管希望你读的书。读MBA、PHD、CFA、CPA，洗脑充电，恨不得把自个儿的DNA都改变了，就是为了把勺子做大。曾把上海“第一的哥”的那套绝活儿给一位天津的哥讲，这深圳宝安搬家公司老兄也说了不少经验，早上七点到九点在小区等活儿，九点到下午五六点蹲写字楼，六七八点蹲饭店，夜晚蹲宾馆、歌厅、洗浴，写字楼要看多少层、有没有什么大公司，宾馆要看晚上亮多少灯，哪儿的活儿“肥瘦”心中有数，道路哪儿通哪儿堵深圳空调拆装了然于胸，还有个不赚钱的？说起有些在一个地方“死蹲”的主儿，这老兄嗤之以鼻，“有活儿就拉，没活儿就玩牌”，那叫干活儿么？干活儿得琢磨，得动脑子！当时就感觉茅塞顿开，受益匪浅———是呀，干活儿得“动脑子”。倒退深圳空调移机二三十年，工人里很有些手巧的，自己动手，丰衣足食，偶尔从单位“顺”点什么，从盖小厨房、攒自行车、打家具，有的还能鼓捣点电器，攒收音机，还有自个儿攒电视的。不少人退休后还能找到个地方补差，有的还挺抢手。现在车钳刨铣磨的熟练工都供不应求，会修数控机床的更是奇缺。据统计，现在中国制造业发展的瓶颈不是资源、资金，却是缺少熟练的技术工人。当然，从单位“顺”东西不好，但深圳空调回收曾有一家日本公司从不禁止工人、技术员从企业拿元器件回家做试验，结果是凝聚了最出色的员工，因为他们找不到第二家企业能够享受这个待遇，企业相信你的诚实，鼓励你的创造力。“干深圳旧货回收一行，爱一行，干一行，钻一行”，这句老话到了资本时代，看来还是挺适用。按照经济学理论，收入取决于你工作的可替代性，可替代性越低，收入越高，反之就是收入越低。而可替代性就取决于你干活儿是不是动脑子。
----------------------------------------------
深圳龙岗搬家公司深圳南山搬家公司
深圳福田搬家公司深圳罗湖搬家公司

作者：

seowhy123456 (seowhy123456)	▲▲▲▲▲	-
	禁用账号

2011/7/7 23:43:02

39楼：

……
被禁用帐号，帖子内容自动屏蔽！
……
----------------------------------------------
发布广告,禁用帐号!

作者：

seowhy123456 (seowhy123456)	▲▲▲▲▲	-
	禁用账号

2011/7/7 23:48:21

40楼：

……
被禁用帐号，帖子内容自动屏蔽！
……
----------------------------------------------
发布广告,禁用帐号!

作者：

wsyhytxdi (wsyhytxdi)	★☆☆☆☆	-
	普通会员

2011/10/12 22:10:04

41楼：

学习，顶``
----------------------------------------------
-

作者：

chowyu (chowyu)	★☆☆☆☆	-
	普通会员

2012/10/24 21:35:09

42楼：

学习了，非常好的资料啊
----------------------------------------------
-

作者：

kylix2008 (kylix2008)	★☆☆☆☆	-
	普通会员

2015/5/16 17:02:11

43楼：

有没有适合XE 7 的取得CPU或其他硬件的序列号的代码？要能在Windows 7及以上的系统中运行。
----------------------------------------------
-

作者：

yxsoft (yxsoft)	★☆☆☆☆	-
	盒子活跃会员

2015/5/16 18:35:40

44楼：

没有管理员权限都取不上来吧
----------------------------------------------
Great!

信息

登陆以后才能回复