DELPHI7.0獲取硬盤、CPU、網(wǎng)卡序列號 - XpFox's Blog

江南浪子1 2010-06-01

展開全文

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);//函數(shù)中的過程

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 //函數(shù)主體

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(非集成網(wǎng)卡):

202

203 function NBGetAdapterAddress(a: Integer): string;

204 var

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

206 ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取網(wǎng)卡狀態(tài)

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地址(集成網(wǎng)卡和非集成網(wǎng)卡):

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 //調(diào)用示例

340 procedure TForm1.Button1Click(Sender: TObject);

341 begin

342 Edit3.Text:=strpas(GetIdeSerialNumber);//取硬盤號

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

344 edit4.Text:=NBGetAdapterAddress(12);//非集成網(wǎng)卡

345 Edit1.text:=MacStr;//集成和非集成網(wǎng)卡

346

347 end;

本站是提供個人知識管理的網(wǎng)絡(luò)存儲空間，所有內(nèi)容均由用戶發(fā)布，不代表本站觀點。請注意甄別內(nèi)容中的聯(lián)系方式、誘導購買等信息，謹防詐騙。如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請點擊一鍵舉報。

轉(zhuǎn)藏 分享

QQ空間 QQ好友新浪微博微信

獻花（0） +1

來自：江南浪子1 > 《我的圖書館》

舉報/認領(lǐng)

0條評論

發(fā)表

請遵守用戶評論公約

類似文章 更多

江南浪子1

關(guān)注對話

TA的最新館藏

[轉(zhuǎn)] FastReport開發(fā)手冊
[轉(zhuǎn)] 中醫(yī):生姜治百病吃姜可防治10大疾病
[轉(zhuǎn)] Delphi中獲取打印機設(shè)備名和端口名
[轉(zhuǎn)] Delphi 三種氣泡提示效果
[轉(zhuǎn)] 如何給ActiveX數(shù)字簽名(Step by Step, Delphi)
[轉(zhuǎn)] SPEECH SDK中編程文檔 - 駱駝空間站 - 博客園

喜歡該文的人也喜歡更多

熱門閱讀換一換

一区二区三区日韩精品-日韩经典一区二区三区-五月激情综合丁香婷婷-欧美精品中文字幕专区

DELPHI7.0獲取硬盤、CPU、網(wǎng)卡序列號 - XpFox's Blog

DELPHI7.0獲取硬盤、CPU、網(wǎng)卡序列號 - XpFox's Blog