1. unit Unit1;
2. interface
3. uses
4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
5. Dialogs, StdCtrls;
6. type
7. TForm1 = class(TForm)
8. Button1: TButton;
9. Button2: TButton;
10. procedure Button1Click(Sender: TObject);
11. procedure Button2Click(Sender: TObject);
12. private
13. { Private declarations }
14. public
15. { Public declarations }
16. end;
17. TFileItem = class(TCollectionItem)
18. public
19. FileName: WideString;
20. FileSize: Int64;
21. IsDirectory: Boolean;
22. end;
23. var
24. Form1: TForm1;
25. implementation
26. {$R *.dfm}
27. //------ 取CPU序列号 uses WinSock
28. function GetCPUID: string;
29. procedure SetCPU(Handle: THandle; CPUNO: Integer);
30. var
31. ProcessAffinity: Cardinal;
32. _SystemAffinity: Cardinal;
33. begin
34. GetProcessAffinityMask(handle, ProcessAffinity, _SystemAffinity);
35. ProcessAffinity := CPUNO;
36. SetProcessAffinityMask(handle, ProcessAffinity);
37. end;
38. const
39. CPUINFO = '%.8x-%.8x-%.8x-%.8x';
40. var
41. iEax: Integer;
42. iEbx: Integer;
43. iEcx: Integer;
44. iEdx: Integer;
45. begin
46. SetCPU(GetCurrentProcess, 1);
47. asm
48. push ebx
49. push ecx
50. push edx
51. mov   eax, 1
52. DW $A20F//cpuid
53. mov   iEax, eax
54. mov   iEbx, ebx
55. mov   iEcx, ecx
56. mov   iEdx, edx
57. pop edx
58. pop ecx
59. pop ebx
60. end;
61. Result := Format(CPUINFO, [iEax, iEbx, iEcx, iEdx]);
62. end;
63. //获取网卡
64. function MacAddress: string;
65. var
66. Lib: Cardinal;
67. Func : function(GUID: PGUID): Longint; stdcall;
68. GUID1, GUID2: TGUID;
69. begin
70. Result := '';
71. Lib := LoadLibrary('rpcrt4.dll');
72. if Lib <> 0 then
73. begin
74. if Win32Platform <>VER_PLATFORM_WIN32_NT then
75. @Func := GetProcAddress(Lib, 'UuidCreate')
76. else @Func := GetProcAddress(Lib, 'UuidCreateSequential');
77. if Assigned(Func) then
78. begin
79. if (Func(@GUID1) = 0) and
80. (Func(@GUID2) = 0) and
81. (GUID1.D4[2] = GUID2.D4[2]) and
82. (GUID1.D4[3] = GUID2.D4[3]) and
83. (GUID1.D4[4] = GUID2.D4[4]) and
84. (GUID1.D4[5] = GUID2.D4[5]) and
85. (GUID1.D4[6] = GUID2.D4[6]) and
86. (GUID1.D4[7] = GUID2.D4[7]) then
87. begin
88. Result :=
89. IntToHex(GUID1.D4[2], 2) + '-' +
90. IntToHex(GUID1.D4[3], 2) + '-' +
91. IntToHex(GUID1.D4[4], 2) + '-' +
92. IntToHex(GUID1.D4[5], 2) + '-' +
93. IntToHex(GUID1.D4[6], 2) + '-' +
94. IntToHex(GUID1.D4[7], 2);
95. end;
96. end;
97. FreeLibrary(Lib);
98. end;
99. end;
100. //取硬盘系列号:
101. function GetIdeSerialNumber: Pansichar; //获取硬盘的出厂系列号；
102. const IDENTIFY_BUFFER_SIZE = 512;
103. type
104. TIDERegs = packed record
105. bFeaturesReg: BYTE;
106. bSectorCountReg: BYTE;
107. bSectorNumberReg: BYTE;
108. bCylLowReg: BYTE;
109. bCylHighReg: BYTE;
110. bDriveHeadReg: BYTE;
111. bCommandReg: BYTE;
112. bReserved: BYTE;
113. end;
114. TSendCmdInParams = packed record
115. cBufferSize: DWORD;
116. irDriveRegs: TIDERegs;
117. bDriveNumber: BYTE;
118. bReserved: array[0..2] of Byte;
119. dwReserved: array[0..3] of DWORD;
120. bBuffer: array[0..0] of Byte;
121. end;
122. TIdSector = packed record
123. wGenConfig: Word;
124. wNumCyls: Word;
125. wReserved: Word;
126. wNumHeads: Word;
127. wBytesPerTrack: Word;
128. wBytesPerSector: Word;
129. wSectorsPerTrack: Word;
130. wVendorUnique: array[0..2] of Word;
131. sSerialNumber: array[0..19] of CHAR;
132. wBufferType: Word;
133. wBufferSize: Word;
134. wECCSize: Word;
135. sFirmwareRev: array[0..7] of Char;
136. sModelNumber: array[0..39] of Char;
137. wMoreVendorUnique: Word;
138. wDoubleWordIO: Word;
139. wCapabilities: Word;
140. wReserved1: Word;
141. wPIOTiming: Word;
142. wDMATiming: Word;
143. wBS: Word;
144. wNumCurrentCyls: Word;
145. wNumCurrentHeads: Word;
146. wNumCurrentSectorsPerTrack: Word;
147. ulCurrentSectorCapacity: DWORD;
148. wMultSectorStuff: Word;
149. ulTotalAddressableSectors: DWORD;
150. wSingleWordDMA: Word;
151. wMultiWordDMA: Word;
152. bReserved: array[0..127] of BYTE;
153. end;
154. PIdSector = ^TIdSector;
155. TDriverStatus = packed record
156. bDriverError: Byte;
157. bIDEStatus: Byte;
158. bReserved: array[0..1] of Byte;
159. dwReserved: array[0..1] of DWORD;
160. end;
161. TSendCmdOutParams = packed record
162. cBufferSize: DWORD;
163. DriverStatus: TDriverStatus;
164. bBuffer: array[0..0] of BYTE;
165. end;
166. var
167. hDevice: Thandle;
168. cbBytesReturned: DWORD;
169. SCIP: TSendCmdInParams;
170. aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
171. IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;
172. procedure ChangeByteOrder(var Data; Size: Integer);//函数中的过程
173. var
174. ptr: Pchar;
175. i: Integer;
176. c: Char;
177. begin
178. ptr := @Data;
179. for I := 0 to (Size shr 1) - 1 do begin
180. c := ptr^;
181. ptr^ := (ptr + 1)^;
182. (ptr + 1)^ := c;
183. Inc(ptr, 2);
184. end;
185. end;
186. begin //函数主体
187. Result := '';
188. if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then
189. begin // Windows NT, Windows 2000
190. hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
191. FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
192. end
193. else // Version Windows 95 OSR2, Windows 98
194. hDevice := CreateFile('\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);
195. if hDevice = INVALID_HANDLE_VALUE then Exit;
196. try
197. FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);
198. FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
199. cbBytesReturned := 0;
200. with SCIP do
201. begin
202. cBufferSize := IDENTIFY_BUFFER_SIZE;
203. with irDriveRegs do
204. begin
205. bSectorCountReg := 1;
206. bSectorNumberReg := 1;
207. bDriveHeadReg := $A0;
208. bCommandReg := $EC;
209. end;
210. end;
211. if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) then Exit;
212. finally
213. CloseHandle(hDevice);
214. end;
215. with PIdSector(@IdOutCmd.bBuffer)^ do
216. begin
217. ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
218. (Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^:= #0;
219. Result := PAnsichar(@sSerialNumber);
220. end;
221. end;
222. //获取目录下的文件
223. procedure FindAllFiles(APath: WideString; AFiles: TCollection;
224. var AFileSize: Int64);
225. var
226. strSearchPath: WideString;
227. strSafePath: WideString;
228. FindData: WIN32_FIND_DATAW;
229. hFind: THandle;
230. objItem: TFileItem;
231. begin
232. strSafePath := Trim(APath);
233. if strSafePath[Length(strSafePath)] <> '\' then strSafePath := strSafePath + '\';
234. strSearchPath := strSafePath + '*.*';
235. hFind := FindFirstFileW(PWideChar(strSearchPath), FindData);
236. if (INVALID_HANDLE_VALUE = hFind) then Exit;
237. while True do
238. begin
239. if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
240. begin
241. if(FindData.cFileName[0] <> '.') then
242. begin
243. objItem := TFileItem(AFiles.Add());
244. objItem.FileName := strSafePath + FindData.cFileName;
245. objItem.FileSize := 0;
246. objItem.IsDirectory := True;
247. FindAllFiles(strSafePath + FindData.cFileName, AFiles, AFileSize);
248. end;
249. end
250. else
251. begin
252. objItem := TFileItem(AFiles.Add());
253. objItem.FileName := strSafePath + FindData.cFileName;
254. objItem.FileSize := FindData.nFileSizeLow or FindData.nFileSizeHigh shl SizeOf(FindData.nFileSizeHigh);
255. objItem.IsDirectory := False;
256. AFileSize := AFileSize + objItem.FileSize;
257. end;
258. if (not FindNextFileW(hFind, FindData)) then Break;
259. end;
260. Windows.FindClose(hFind);
261. end;
262. //强制删除目录
263. function ForceToRemoveDir(ADir: string): Boolean;
264. var
265. pDir: PChar;
266. SR: TSearchRec;
267. FR: Integer;
268. begin
269. Result := False;
270. pDir := PChar(ADir);
271. if not DirectoryExists(pDir) then Exit;
272. try
273. if Copy(pDir, Length(pDir), 1) <> '\' then
274. pDir := PChar(pDir + '\');
275. FR := FindFirst(pDir + '*.*', FaAnyfile, SR);
276. while FR = 0 do
277. begin
278. if ((SR.Attr and FaDirectory) = FaDirectory) and
279. (SR.Name <> '.') and (SR.Name <> '..') then
280. begin
281. if not ForceToRemoveDir(StrPas(pDir) + SR.Name) then Break;
282. end;
283. if ((SR.Attr and FaDirectory <> FaDirectory) and
284. (SR.Attr and FaVolumeID <> FaVolumeID)) then
285. begin
286. SysUtils.FileSetAttr(pDir + SR.Name,
287. SysUtils.FileGetAttr(pDir + SR.Name) and (not
288. SysUtils.faReadOnly)); //取消文件的只读属性
289. if not DeleteFile(PChar(pDir + SR.Name)) then
290. Break;
291. end;
292. FR := FindNext(SR);
293. end;
294. SysUtils.FindClose(SR);
295. RemoveDirectory(pDir);
296. Result := True;
297. except
298. end;
299. end;
300. //获取windows系统版本
301. function GetWindowsVersion: string;
302. var
303. AWin32Version: Extended;
304. os: string;
305. begin
306. os := 'Windows ';
307. AWin32Version := StrtoFloat(format('%d.%d' ,[Win32MajorVersion, Win32MinorVersion]));
308. if Win32Platform = VER_PLATFORM_WIN32s then
309. Result := os + '32'
310. else if Win32Platform=VER_PLATFORM_WIN32_WINDOWS then
311. begin
312. if AWin32Version=4.0 then
313. Result := os + '95'
314. else if AWin32Version=4.1 then
315. Result := os + '98'
316. else if AWin32Version=4.9 then
317. Result := os + 'Me'
318. else
319. Result := os + '9x'
320. end
321. else if Win32Platform = VER_PLATFORM_WIN32_NT then
322. begin
323. if AWin32Version=3.51 then
324. Result := os + 'NT 3.51'
325. else if AWin32Version=4.0 then
326. Result := os + 'NT 4.0'
327. else if AWin32Version=5.0 then
328. Result := os + '2000'
329. else if AWin32Version=5.1 then
330. Result := os + 'XP'
331. else if AWin32Version=5.2 then
332. Result := os + '2003'
333. else if AWin32Version=6.0 then
334. Result := os + 'Vista'
335. else if AWin32Version=6.1 then
336. Result := os + '7'
337. else
338. Result := os ;
339. end
340. else
341. Result := os + '??';
342. end;
343. procedure TForm1.Button1Click(Sender: TObject);
344. var
345. i:integer;
346. begin
347. showmessage(MacAddress());
348. showmessage(GetCPUID());
349. showmessage(GetIdeSerialNumber());
350. showmessage(GetWindowsVersion());
351. end;
352. procedure TForm1.Button2Click(Sender: TObject);
353. var
354. aFiles: TCollection;
355. aFileSize: Int64;
356. begin
357. //FindAllFiles('C:\\apache-tomcat-6.0.32',aFiles,aFileSize);
358. //showmessage(inttostr(aFileSize));
359. ForceToRemoveDir('C:\apache-tomcat-6.0.32');
360. showmessage('删除目录成功！');
361. end;
362. end.

http://blog.csdn.net/earbao/article/details/19629579