51代码网┆ORACLE┆MYSQL┆SQL SERVER┆其它数据库┆java/jsp┆asp/asp.net┆C/C++/VC++┆APP应用┆其它语言┆服务器应用
您现在的位置： 51代码网 >> 其它 >> 文章正文

Delphi获取CPU序列号\网卡MAC地址\IP\硬盘序列号

更新时间：2012-3-4：  来源:51代码网

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,nb30; {重要引用}
type
  PASTAT = ^TASTAT;
  TASTAT = record
  adapter : TAdapterStatus;
  name_buf : TNameBuffer;
end;
  TForm1 = class(TForm)
  Button1: TButton;
  Edit1: TEdit;
  Label1: TLabel;
  Label2: TLabel;
  Label3: TLabel;
  Edit2: TEdit;
  Edit3: TEdit;
  Button2: TButton;
  Edit4: TEdit;
  Label4: TLabel;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
  private
  { Private declarations }
  public
  { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
type
  TCPUID = array[1..4] of Longint;
//取硬盘系列号:
function GetIdeSerialNumber: pchar; //获取硬盘的出厂系列号；
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 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
  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: 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 := '';
  if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then
  begin // Windows NT, Windows 2000
  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;
  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;
  Result := Pchar(@sSerialNumber);
  end;
end;
//=================================================================
//CPU系列号:
FUNCTION GetCPUID : TCPUID; assembler; register;
asm
  PUSH EBX {Save affected register}
  PUSH EDI
  MOV EDI,EAX {@Resukt}
  MOV EAX,1
  DW $A20F {CPUID Command}
  STOSD {CPUID[1]}
  MOV EAX,EBX
  STOSD {CPUID[2]}
  MOV EAX,ECX
  STOSD {CPUID[3]}
  MOV EAX,EDX
  STOSD {CPUID[4]}
  POP EDI {Restore registers}
  POP EBX
END;
function GetCPUIDStr:String;
var
  CPUID:TCPUID;
begin
  CPUID:=GetCPUID;
  Result:=IntToHex(CPUID[1],8)+IntToHex(CPUID[2],8)+IntToHex(CPUID[3],8)+IntToHex(CPUID[4],8);
end;
///==================================================================================
///取MAC(非集成网卡):
function NBGetAdapterAddress(a: Integer): string;
var
  NCB: TNCB; // Netbios control block //NetBios控制块
  ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取网卡状态
  LANAENUM: TLANAENUM; // Netbios lana
  intIdx: Integer; // Temporary work value//临时变量
  cRC: Char; // Netbios return code//NetBios返回值
  strTemp: string; // Temporary string//临时变量
begin
  // Initialize
  Result := '';
  try
  // Zero control blocl
  ZeroMemory(@NCB, SizeOf(NCB));
  // Issue enum command
  NCB.ncb_command := Chr(NCBENUM);
  cRC := NetBios(@NCB);
  // Reissue enum command
  NCB.ncb_buffer := @LANAENUM;
  NCB.ncb_length := SizeOf(LANAENUM);
  cRC := NetBios(@NCB);
  if Ord(cRC) <> 0 then
  exit;
  // Reset adapter
  ZeroMemory(@NCB, SizeOf(NCB));
  NCB.ncb_command := Chr(NCBRESET);
  NCB.ncb_lana_num := LANAENUM.lana[a];
  cRC := NetBios(@NCB);
  if Ord(cRC) <> 0 then
  exit;
  // Get adapter address
  ZeroMemory(@NCB, SizeOf(NCB));
  NCB.ncb_command := Chr(NCBASTAT);
  NCB.ncb_lana_num := LANAENUM.lana[a];
  StrPCopy(NCB.ncb_callname, '*');
  NCB.ncb_buffer := @ADAPTER;
  NCB.ncb_length := SizeOf(ADAPTER);
  cRC := NetBios(@NCB);
  // Convert it to string
  strTemp := '';
  for intIdx := 0 to 5 do
  strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);
  Result := strTemp;
  finally
  end;
end;
//==========================================================================
//取MAC地址(集成网卡和非集成网卡):
function Getmac:string;
var
  ncb : TNCB;
  s:string;
  adapt : TASTAT;
  lanaEnum : TLanaEnum;
  i, j, m : integer;
  strPart, strMac : string;
begin
FillChar(ncb, SizeOf(TNCB), 0);
  ncb.ncb_command := Char(NCBEnum);
  ncb.ncb_buffer := PChar(@lanaEnum);
  ncb.ncb_length := SizeOf(TLanaEnum);
  s:=Netbios(@ncb);
  for i := 0 to integer(lanaEnum.length)-1 do
  begin
  FillChar(ncb, SizeOf(TNCB), 0);
  ncb.ncb_command := Char(NCBReset);
  ncb.ncb_lana_num := lanaEnum.lana[i];
  Netbios(@ncb);
  Netbios(@ncb);
  FillChar(ncb, SizeOf(TNCB), 0);
  ncb.ncb_command := Chr(NCBAstat);
  ncb.ncb_lana_num := lanaEnum.lana[i];
  ncb.ncb_callname := '* ';
  ncb.ncb_buffer := PChar(@adapt);
  ncb.ncb_length := SizeOf(TASTAT);
  m:=0;
  if (Win32Platform = VER_PLATFORM_WIN32_NT) then
  m:=1;
  if m=1 then
  begin
  if Netbios(@ncb) = Chr(0) then
  strMac := '';
  for j := 0 to 5 do
  begin
  strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
  strMac := strMac + strPart + '-';
  end;
  SetLength(strMac, Length(strMac)-1);
  end;
  if m=0 then
  if Netbios(@ncb) <> Chr(0) then
  begin
  strMac := '';
  for j := 0 to 5 do
  begin
  strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
  strMac := strMac + strPart + '-';
  end;
  SetLength(strMac, Length(strMac)-1);
  end;
  end;
result:=strmac;
end;
function PartitionString(StrV,PrtSymbol: string): TStringList;
var
  iTemp: integer;
begin
  result := TStringList.Create;
  iTemp := pos(PrtSymbol,StrV);
  while iTemp>0 do begin
  if iTemp>1 then result.Append(copy(StrV,1,iTemp-1));
  delete(StrV,1,iTemp+length(PrtSymbol)-1);
  iTemp := pos(PrtSymbol,StrV);
  end;
  if Strv<>'' then result.Append(StrV);
end;
function MacStr():String;
var
  Str:TStrings;
  i:Integer;
  MacStr:String;
begin
  MacStr:='';
  Str:=TStringList.Create;
  Str:=PartitionString(Getmac,'-');
  for i:=0 to Str.Count-1 do
  MacStr:=MacStr+Str[i];
  Result:=MacStr;
end;
//==============================================

//调用示例
procedure TForm1.Button1Click(Sender: TObject);
begin
 Edit3.Text:=strpas(GetIdeSerialNumber);//取硬盘号
  Edit2.text:=GetCPUIDStr;//CPU系列号
  edit4.Text:=NBGetAdapterAddress(12);//非集成网卡
  Edit1.text:=MacStr;//集成和非集成网卡
end;

在win7 下以管理员身份运行

1、关于序列号乱码问题，注释掉(Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^:= #0;试试
2、网卡MAC获取：1楼给的代码，是可以的，不过TNBC只支持AnsiChar，所以在上面的相关函数中，有关类型声明及强制转化，全部使用AnsiChar即可

  • 上一篇文章：
  • 下一篇文章： 没有了
    • 赞助商链接
    最新文章
    推荐文章
  • 此栏目下没有推荐文章
    • 相关文章
    正弦曲线求取高峰的算法
    DBGRID着色的顺序问题
    GetPixel在windows7下面很慢是怎么回事
    delphi怎么用同一个热键来隐藏或显现呢
    {
    设为首页 | 加入收藏 | 友情链接 | 网站地图 | 联系站长 |