DELPHI7.0获取硬盘、CPU、网卡序列号 - XpFox's Blog

001	//引用及TYPE变量申明

002

003

uses

004	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

005	Dialogs, StdCtrls,nb30; {重要引用}

006

007

type

008	PASTAT = ^TASTAT;

009	TASTAT = record

010	adapter : TAdapterStatus;

011	name_buf : TNameBuffer;

012

end;

013

014	TForm1 = class(TForm)

015	Button1: TButton;

016	Edit1: TEdit;

017	Label1: TLabel;

018	Label2: TLabel;

019	Label3: TLabel;

020	Edit2: TEdit;

021	Edit3: TEdit;

022	Button2: TButton;

023	Edit4: TEdit;

024	Label4: TLabel;

025	procedure Button1Click(Sender: TObject);

026	procedure Button2Click(Sender: TObject);

027

private

028	{ Private declarations }

029

public

030	{ Public declarations }

031

end;

032

033

var

034	Form1: TForm1;

035

036	implementation

037

038	{$R *.dfm}

039

type

040	TCPUID = array[1..4] of Longint;

041

042

//取硬盘系列号:

043	function GetIdeSerialNumber: pchar; //获取硬盘的出厂系列号；

044	const IDENTIFY_BUFFER_SIZE = 512;

045

type

046	TIDERegs = packed record

047	bFeaturesReg: BYTE;

048	bSectorCountReg: BYTE;

049	bSectorNumberReg: BYTE;

050	bCylLowReg: BYTE;

051	bCylHighReg: BYTE;

052	bDriveHeadReg: BYTE;

053	bCommandReg: BYTE;

054	bReserved: BYTE;

055

end;

056

057	TSendCmdInParams = packed record

058	cBufferSize: DWORD;

059	irDriveRegs: TIDERegs;

060	bDriveNumber: BYTE;

061	bReserved: array[0..2] of Byte;

062	dwReserved: array[0..3] of DWORD;

063	bBuffer: array[0..0] of Byte;

064

end;

065

066	TIdSector = packed record

067	wGenConfig: Word;

068	wNumCyls: Word;

069	wReserved: Word;

070	wNumHeads: Word;

071	wBytesPerTrack: Word;

072	wBytesPerSector: Word;

073	wSectorsPerTrack: Word;

074	wVendorUnique: array[0..2] of Word;

075	sSerialNumber: array[0..19] of CHAR;

076	wBufferType: Word;

077	wBufferSize: Word;

078	wECCSize: Word;

079	sFirmwareRev: array[0..7] of Char;

080	sModelNumber: array[0..39] of Char;

081	wMoreVendorUnique: Word;

082	wDoubleWordIO: Word;

083	wCapabilities: Word;

084	wReserved1: Word;

085	wPIOTiming: Word;

086	wDMATiming: Word;

087	wBS: Word;

088	wNumCurrentCyls: Word;

089	wNumCurrentHeads: Word;

090	wNumCurrentSectorsPerTrack: Word;

091	ulCurrentSectorCapacity: DWORD;

092	wMultSectorStuff: Word;

093	ulTotalAddressableSectors: DWORD;

094	wSingleWordDMA: Word;

095	wMultiWordDMA: Word;

096	bReserved: array[0..127] of BYTE;

097

end;

098

099	PIdSector = ^TIdSector;

100	TDriverStatus = packed record

101	bDriverError: Byte;

102	bIDEStatus: Byte;

103	bReserved: array[0..1] of Byte;

104	dwReserved: array[0..1] of DWORD;

105

end;

106

107	TSendCmdOutParams = packed record

108	cBufferSize: DWORD;

109	DriverStatus: TDriverStatus;

110	bBuffer: array[0..0] of BYTE;

111

end;

112

var

113	hDevice: Thandle;

114	cbBytesReturned: DWORD;

115	SCIP: TSendCmdInParams;

116	aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1)-1] of Byte;

117	IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;

118

119	procedure ChangeByteOrder(var Data; Size: Integer);//函数中的过程

120

var

121	ptr: Pchar;

122	i: Integer;

123

c: Char;

124

begin

125	ptr := @Data;

126	for I := 0 to (Size shr 1) - 1 do begin

127	c := ptr^;

128	ptr^ := (ptr + 1)^;

129	(ptr + 1)^ := c;

130	Inc(ptr, 2);

131

end;

132

end;

133

134	begin          //函数主体

135	Result := '';

136	if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then

137	begin // Windows NT, Windows 2000

138	hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,

139	FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);

140

end

141	else // Version Windows 95 OSR2, Windows 98

142	hDevice := CreateFile('\\.\SMARTVSD', 0, 0, nil, Create_NEW, 0, 0);

143	if hDevice = INVALID_HANDLE_VALUE then Exit;

144

try

145	FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);

146	FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);

147	cbBytesReturned := 0;

148	with SCIP do

149

begin

150	cBufferSize := IDENTIFY_BUFFER_SIZE;

151	with irDriveRegs do

152

begin

153	bSectorCountReg := 1;

154	bSectorNumberReg := 1;

155	bDriveHeadReg := $A0;

156	bCommandReg := $EC;

157

end;

158

end;

159	if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) then Exit;

160

finally

161	CloseHandle(hDevice);

162

end;

163	with PIdSector(@IdOutCmd.bBuffer)^ do

164

begin

165	ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));

166	(Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^:= #0;

167	Result := Pchar(@sSerialNumber);

168

end;

169

end;

170	//=================================================================

171

172

//CPU系列号:

173	FUNCTION GetCPUID : TCPUID; assembler; register;

174

asm

175	PUSH    EBX         {Save affected register}

176	PUSH    EDI

177	MOV     EDI,EAX     {@Resukt}

178	MOV     EAX,1

179	DW      $A20F       {CPUID Command}

180	STOSD      {CPUID[1]}

181	MOV     EAX,EBX

182	STOSD               {CPUID[2]}

183	MOV     EAX,ECX

184	STOSD               {CPUID[3]}

185	MOV     EAX,EDX

186	STOSD               {CPUID[4]}

187	POP     EDI      {Restore registers}

188	POP     EBX

189

END;

190

191	function GetCPUIDStr:String;

192

var

193	CPUID:TCPUID;

194

begin

195	CPUID:=GetCPUID;

196	Result:=IntToHex(CPUID[1],8)+IntToHex(CPUID[2],8)+IntToHex(CPUID[3],8)+IntToHex(CPUID[4],8);

197

end;

198

199	///==================================================================================

200

201	///取MAC(非集成网卡):

202

203	function NBGetAdapterAddress(a: Integer): string;

204

var

205	NCB: TNCB; // Netbios control block //NetBios控制块

206	ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取网卡状态

207	LANAENUM: TLANAENUM; // Netbios lana

208	intIdx: Integer; // Temporary work value//临时变量

209	cRC: Char; // Netbios return code//NetBios返回值

210	strTemp: string; // Temporary string//临时变量

211

begin

212	// Initialize

213	Result := '';

214

try

215	// Zero control blocl

216	ZeroMemory(@NCB, SizeOf(NCB));

217	// Issue enum command

218	NCB.ncb_command := Chr(NCBENUM);

219	cRC := NetBios(@NCB);

220	// Reissue enum command

221	NCB.ncb_buffer := @LANAENUM;

222	NCB.ncb_length := SizeOf(LANAENUM);

223	cRC := NetBios(@NCB);

224	if ord(cRC) <> 0 then

225

exit;

226	// Reset adapter

227	ZeroMemory(@NCB, SizeOf(NCB));

228	NCB.ncb_command := Chr(NCBRESET);

229	NCB.ncb_lana_num := LANAENUM.lana[a];

230	cRC := NetBios(@NCB);

231	if ord(cRC) <> 0 then

232

exit;

233	// Get adapter address

234	ZeroMemory(@NCB, SizeOf(NCB));

235	NCB.ncb_command := Chr(NCBASTAT);

236	NCB.ncb_lana_num := LANAENUM.lana[a];

237	StrPCopy(NCB.ncb_callname, '*');

238	NCB.ncb_buffer := @ADAPTER;

239	NCB.ncb_length := SizeOf(ADAPTER);

240	cRC := NetBios(@NCB);

241	// Convert it to string

242	strTemp := '';

243	for intIdx := 0 to 5 do

244	strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);

245	Result := strTemp;

246

finally

247

end;

248

end;

249	//==========================================================================

250	//取MAC地址(集成网卡和非集成网卡):

251

252	function Getmac:string;

253

var

254	ncb : TNCB;

255

s:string;

256	adapt : TASTAT;

257	lanaEnum : TLanaEnum;

258	i, j, m : integer;

259	strPart, strMac : string;

260

begin

261	FillChar(ncb, SizeOf(TNCB), 0);

262	ncb.ncb_command := Char(NCBEnum);

263	ncb.ncb_buffer := PChar(@lanaEnum);

264	ncb.ncb_length := SizeOf(TLanaEnum);

265	s:=Netbios(@ncb);

266	for i := 0 to integer(lanaEnum.length)-1 do

267

begin

268	FillChar(ncb, SizeOf(TNCB), 0);

269	ncb.ncb_command := Char(NCBReset);

270	ncb.ncb_lana_num := lanaEnum.lana[i];

271	Netbios(@ncb);

272	Netbios(@ncb);

273	FillChar(ncb, SizeOf(TNCB), 0);

274	ncb.ncb_command := Chr(NCBAstat);

275	ncb.ncb_lana_num := lanaEnum.lana[i];

276	ncb.ncb_callname := '*               ';

277	ncb.ncb_buffer := PChar(@adapt);

278	ncb.ncb_length := SizeOf(TASTAT);

279

m:=0;

280	if (Win32Platform = VER_PLATFORM_WIN32_NT) then

281

m:=1;

282	if m=1 then

283

begin

284	if Netbios(@ncb) = Chr(0) then

285	strMac := '';

286	for j := 0 to 5 do

287

begin

288	strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);

289	strMac := strMac + strPart + '-';

290

end;

291	SetLength(strMac, Length(strMac)-1);

292

end;

293	if m=0 then

294	if Netbios(@ncb) <> Chr(0) then

295

begin

296	strMac := '';

297	for j := 0 to 5 do

298

begin

299	strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);

300	strMac := strMac + strPart + '-';

301

end;

302	SetLength(strMac, Length(strMac)-1);

303

end;

304

end;

305	result:=strmac;

306

end;

307

308	function PartitionString(StrV,PrtSymbol: string): TStringList;

309

var

310	iTemp: integer;

311

begin

312	result := TStringList.Create;

313	iTemp := pos(PrtSymbol,StrV);

314	while iTemp>0 do begin

315	if iTemp>1 then result.Append(copy(StrV,1,iTemp-1));

316	delete(StrV,1,iTemp+length(PrtSymbol)-1);

317	iTemp := pos(PrtSymbol,StrV);

318

end;

319	if Strv<>'' then result.Append(StrV);

320

end;

321

322	function MacStr():String;

323

var

324	Str:TStrings;

325	i:Integer;

326	MacStr:String;

327

begin

328	MacStr:='';

329	Str:=TStringList.Create;

330	Str:=PartitionString(Getmac,'-');

331	for i:=0 to Str.Count-1 do

332	MacStr:=MacStr+Str[i];

333	Result:=MacStr;

334

end;

335

336	//==============================================

337

338

339

//调用示例

340	procedure TForm1.Button1Click(Sender: TObject);

341

begin

342	Edit3.Text:=strpas(GetIdeSerialNumber);//取硬盘号

343	Edit2.text:=GetCPUIDStr;//CPU系列号

344	edit4.Text:=NBGetAdapterAddress(12);//非集成网卡

345	Edit1.text:=MacStr;//集成和非集成网卡

346

347

end;

Loading...