Produced by Araxis Merge on 3/1/2017 4:26:05 PM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | v31A_T105_CIF.zip\OR_30_434V104_SRC\XE8\ExceptionLogger\Source | JclSysInfo.pas | Tue Sep 6 17:12:16 2016 UTC |
2 | v31A_T105_CIF.zip\OR_30_434V104_SRC\XE8\ExceptionLogger\Source | JclSysInfo.pas | Wed Mar 1 21:37:41 2017 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 12164 |
Changed | 1 | 2 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | {********* ********** ********** ********** ********** ********** ********** ********** ********** *********} | |
2 | { } | |
3 | { Project JEDI Code Library (J CL) } | |
4 | { } | |
5 | { The cont ents of th is file ar e subject to the Moz illa Publi c License Version 1. 1 (the "Li cense"); } | |
6 | { you may not use th is file ex cept in co mpliance w ith the Li cense. You may obtai n a copy o f the } | |
7 | { License at http:// www.mozill a.org/MPL/ } | |
8 | { } | |
9 | { Software distribut ed under t he License is distri buted on a n "AS IS" basis, WIT HOUT WARRA NTY OF } | |
10 | { ANY KIND , either e xpress or implied. S ee the Lic ense for t he specifi c language governing rights } | |
11 | { and limi tations un der the Li cense. } | |
12 | { } | |
13 | { The Orig inal Code is JclSysI nfo.pas. } | |
14 | { } | |
15 | { The Init ial Develo per of the Original Code is Ma rcel van B rakel. } | |
16 | { Portions created b y Marcel v an Brakel are Copyri ght (C) Ma rcel van B rakel. All rights re served. } | |
17 | { } | |
18 | { Contribu tors: } | |
19 | { Alexan der Radche nko } | |
20 | { Andre Snepvanger s (asnepva ngers) } | |
21 | { Azret Botash } | |
22 | { Bryan Coutch } | |
23 | { Carl C lark } | |
24 | { Eric S . Fisher } | |
25 | { Floren t Ouchet ( outchy) } | |
26 | { Heiko Adams } | |
27 | { James Azarja } | |
28 | { Jean-F abien Conn ault (cyco crew) } | |
29 | { John C Molyneux } | |
30 | { Marcel van Brake l } | |
31 | { Matthi as Thoma ( mthoma) } | |
32 | { Mike L ischke } | |
33 | { Nick H odges } | |
34 | { Olivie r Sannier (obones) } | |
35 | { Peter Friese } | |
36 | { Peter Thornquist (peter3) } | |
37 | { Petr V ones (pvon es) } | |
38 | { Rik Ba rker } | |
39 | { Robert Marquardt (marquard t) } | |
40 | { Robert Rossmair (rrossmair ) } | |
41 | { Scott Price } | |
42 | { Tom Ha hn (tomhah n) } | |
43 | { Wim de Cleen } | |
44 | { } | |
45 | {********* ********** ********** ********** ********** ********** ********** ********** ********** *********} | |
46 | { } | |
47 | { This uni t contains routines and classe s to retri eve variou s pieces o f system i nformation . } | |
48 | { Examples are the l ocation of standard folders, s ettings of environme nt variabl es, proces sor } | |
49 | { details and the Wi ndows vers ion. } | |
50 | { } | |
51 | {********* ********** ********** ********** ********** ********** ********** ********** ********** *********} | |
52 | { } | |
53 | { Last mod ified: $Da te:: $ } | |
54 | { Revision : $Re v:: $ } | |
55 | { Author: $Au thor:: $ } | |
56 | { } | |
57 | {********* ********** ********** ********** ********** ********** ********** ********** ********** *********} | |
58 | ||
59 | // Windows NT 4 and earlier do not suppo rt GetSyst emPowerSta tus (while introduce d | |
60 | // in NT4 - it is a stub there - impleme nted in Wi ndows 2000 and later . | |
61 | ||
62 | ||
63 | unit JclSy sInfo; | |
64 | ||
65 | {$I jcl.in c} | |
66 | ||
67 | interface | |
68 | ||
69 | uses | |
70 | {$IFDEF UNITVERSIO NING} | |
71 | JclUnitV ersioning, | |
72 | {$ENDIF UNITVERSIO NING} | |
73 | {$IFDEF HAS_UNIT_L IBC} | |
74 | Libc, | |
75 | {$ENDIF HAS_UNIT_L IBC} | |
76 | {$IFDEF HAS_UNITSC OPE} | |
77 | {$IFDEF MSWINDOWS} | |
78 | Winapi.W indows, Wi nApi.Activ eX, Winapi .ShlObj, | |
79 | {$ENDIF MSWINDOWS} | |
80 | System.C lasses, | |
81 | {$ELSE ~ HAS_UNITSC OPE} | |
82 | {$IFDEF MSWINDOWS} | |
83 | Windows, ActiveX, ShlObj, | |
84 | {$ENDIF MSWINDOWS} | |
85 | Classes, | |
86 | {$ENDIF ~HAS_UNITS COPE} | |
87 | JclBase, JclResour ces; | |
88 | ||
89 | // Environ ment Varia bles | |
90 | {$IFDEF MS WINDOWS} | |
91 | type | |
92 | TEnviron mentOption = (eoLoca lMachine, eoCurrentU ser, eoAdd itional); | |
93 | TEnviron mentOption s = set of TEnvironm entOption; | |
94 | {$ENDIF MS WINDOWS} | |
95 | ||
96 | function D elEnvironm entVar(con st Name: s tring): Bo olean; | |
97 | function E xpandEnvir onmentVar( var Value: string): Boolean; | |
98 | function E xpandEnvir onmentVarC ustom(var Value: str ing; Vars: TStrings) : Boolean; | |
99 | function G etEnvironm entVar(con st Name: s tring; out Value: st ring): Boo lean; over load; | |
100 | function G etEnvironm entVar(con st Name: s tring; out Value: st ring; Expa nd: Boolea n): Boolea n; overloa d; | |
101 | function G etEnvironm entVars(co nst Vars: TStrings): Boolean; overload; | |
102 | function G etEnvironm entVars(co nst Vars: TStrings; Expand: Bo olean): Bo olean; ove rload; | |
103 | function S etEnvironm entVar(con st Name, V alue: stri ng): Boole an; | |
104 | {$IFDEF MS WINDOWS} | |
105 | function C reateEnvir onmentBloc k(const Op tions: TEn vironmentO ptions; co nst Additi onalVars: TStrings): PChar; | |
106 | procedure DestroyEnv ironmentBl ock(var En v: PChar); | |
107 | procedure SetGlobalE nvironment Variable(V ariableNam e, Variabl eContent: string); | |
108 | {$ENDIF MS WINDOWS} | |
109 | ||
110 | // Common Folder Loc ations | |
111 | {$IFDEF MS WINDOWS} | |
112 | function G etCommonFi lesFolder: string; | |
113 | {$ENDIF MS WINDOWS} | |
114 | function G etCurrentF older: str ing; | |
115 | {$IFDEF MS WINDOWS} | |
116 | function G etProgramF ilesFolder : string; | |
117 | function G etWindowsF older: str ing; | |
118 | function G etWindowsS ystemFolde r: string; | |
119 | function G etWindowsT empFolder: string; | |
120 | ||
121 | function G etDesktopF older: str ing; | |
122 | function G etPrograms Folder: st ring; | |
123 | {$ENDIF MS WINDOWS} | |
124 | function G etPersonal Folder: st ring; | |
125 | {$IFDEF MS WINDOWS} | |
126 | function G etFavorite sFolder: s tring; | |
127 | function G etStartupF older: str ing; | |
128 | function G etRecentFo lder: stri ng; | |
129 | function G etSendToFo lder: stri ng; | |
130 | function G etStartmen uFolder: s tring; | |
131 | function G etDesktopD irectoryFo lder: stri ng; | |
132 | function G etCommonDo cumentsFol der: strin g; | |
133 | function G etNethoodF older: str ing; | |
134 | function G etFontsFol der: strin g; | |
135 | function G etCommonSt artmenuFol der: strin g; | |
136 | function G etCommonSt artupFolde r: string; | |
137 | function G etPrinthoo dFolder: s tring; | |
138 | function G etProfileF older: str ing; | |
139 | function G etCommonPr ogramsFold er: string ; | |
140 | function G etCommonDe sktopdirec toryFolder : string; | |
141 | function G etCommonAp pdataFolde r: string; | |
142 | function G etAppdataF older: str ing; | |
143 | function G etLocalApp Data: stri ng; | |
144 | function G etCommonFa voritesFol der: strin g; | |
145 | function G etTemplate sFolder: s tring; | |
146 | function G etInternet CacheFolde r: string; | |
147 | function G etCookiesF older: str ing; | |
148 | function G etHistoryF older: str ing; | |
149 | ||
150 | // Advance d Power Ma nagement ( APM) | |
151 | type | |
152 | TAPMLine Status = ( alsOffline , alsOnlin e, alsUnkn own); | |
153 | TAPMBatt eryFlag = (abfHigh, abfLow, ab fCritical, abfChargi ng, abfNoB attery, ab fUnknown); | |
154 | TAPMBatt eryFlags = set of TA PMBatteryF lag; | |
155 | ||
156 | function G etAPMLineS tatus: TAP MLineStatu s; | |
157 | function G etAPMBatte ryFlag: TA PMBatteryF lag; | |
158 | function G etAPMBatte ryFlags: T APMBattery Flags; | |
159 | function G etAPMBatte ryLifePerc ent: Integ er; | |
160 | function G etAPMBatte ryLifeTime : DWORD; | |
161 | function G etAPMBatte ryFullLife Time: DWOR D; | |
162 | ||
163 | // Identif ication | |
164 | type | |
165 | TFileSys temFlag = | |
166 | ( | |
167 | fsCase Sensitive, // The f ile system supports case-sensi tive file names. | |
168 | fsCase PreservedN ames, // The f ile system preserves the case of file na mes when i t places a name on d isk. | |
169 | fsSupp ortsUnicod eOnDisk, // The f ile system supports Unicode in file name s as they appear on disk. | |
170 | fsPers istentACLs , // The f ile system preserves and enfor ces ACLs. For exampl e, NTFS pr eserves an d enforces ACLs, and FAT does not. | |
171 | fsSupp ortsFileCo mpression, // The f ile system supports file-based compressi on. | |
172 | fsSupp ortsVolume Quotas, // The f ile system supports disk quota s. | |
173 | fsSupp ortsSparse Files, // The f ile system supports sparse fil es. | |
174 | fsSupp ortsRepars ePoints, // The f ile system supports reparse po ints. | |
175 | fsSupp ortsRemote Storage, // ? | |
176 | fsVolu meIsCompre ssed, // The s pecified v olume is a compresse d volume; for exampl e, a Doubl eSpace vol ume. | |
177 | fsSupp ortsObject Ids, // The f ile system supports object ide ntifiers. | |
178 | fsSupp ortsEncryp tion, // The f ile system supports the Encryp ted File S ystem (EFS ). | |
179 | fsSupp ortsNamedS treams, // The f ile system supports named stre ams. | |
180 | fsVolu meIsReadOn ly // The s pecified v olume is r ead-only. | |
181 | // Windo ws 2000/NT and Windo ws Me/98/9 5: This v alue is no t supporte d. | |
182 | ); | |
183 | ||
184 | TFileSys temFlags = set of TF ileSystemF lag; | |
185 | ||
186 | function G etVolumeNa me(const D rive: stri ng): strin g; | |
187 | function G etVolumeSe rialNumber (const Dri ve: string ): string; | |
188 | function G etVolumeFi leSystem(c onst Drive : string): string; | |
189 | function G etVolumeFi leSystemFl ags(const Volume: st ring): TFi leSystemFl ags; | |
190 | {$ENDIF MS WINDOWS} | |
191 | function G etIPAddres s(const Ho stName: st ring): str ing; | |
192 | {$IFDEF MS WINDOWS} | |
193 | procedure GetIpAddre sses(Resul ts: TStrin gs; const HostName: AnsiString ); overloa d; | |
194 | {$ENDIF MS WINDOWS} | |
195 | procedure GetIpAddre sses(Resul ts: TStrin gs); overl oad; | |
196 | function G etLocalCom puterName: string; | |
197 | function G etLocalUse rName: str ing; | |
198 | {$IFDEF MS WINDOWS} | |
199 | function G etUserDoma inName(con st CurUser : string): string; | |
200 | function G etWorkGrou pName: Wid eString; | |
201 | {$ENDIF MS WINDOWS} | |
202 | function G etDomainNa me: string ; | |
203 | {$IFDEF MS WINDOWS} | |
204 | function G etRegister edCompany: string; | |
205 | function G etRegister edOwner: s tring; | |
206 | function G etBIOSName : string; | |
207 | function G etBIOSCopy right: str ing; | |
208 | function G etBIOSExte ndedInfo: string; | |
209 | function G etBIOSDate : TDateTim e; | |
210 | {$ENDIF MS WINDOWS} | |
211 | ||
212 | // Process es, Tasks and Module s | |
213 | type | |
214 | TJclTerm inateAppRe sult = (ta Error, taC lean, taKi ll); | |
215 | ||
216 | function R unningProc essesList( const List : TStrings ; FullPath : Boolean = True): B oolean; | |
217 | ||
218 | {$IFDEF MS WINDOWS} | |
219 | function L oadedModul esList(con st List: T Strings; P rocessID: DWORD; Han dlesOnly: Boolean = False): Bo olean; | |
220 | function G etTasksLis t(const Li st: TStrin gs): Boole an; | |
221 | ||
222 | function M oduleFromA ddr(const Addr: Poin ter): HMOD ULE; | |
223 | function I sSystemMod ule(const Module: HM ODULE): Bo olean; | |
224 | ||
225 | function I sMainAppWi ndow(Wnd: THandle): Boolean; | |
226 | function I sWindowRes ponding(Wn d: THandle ; Timeout: Integer): Boolean; | |
227 | ||
228 | function G etWindowIc on(Wnd: TH andle; Lar geIcon: Bo olean): HI CON; | |
229 | function G etWindowCa ption(Wnd: THandle): string; | |
230 | function T erminateTa sk(Wnd: TH andle; Tim eout: Inte ger): TJcl TerminateA ppResult; | |
231 | function T erminateAp p(ProcessI D: DWORD; Timeout: I nteger): T JclTermina teAppResul t; | |
232 | {$ENDIF MS WINDOWS} | |
233 | ||
234 | {$IFDEF MS WINDOWS} | |
235 | {.$IFNDEF FPC} | |
236 | function G etPidFromP rocessName (const Pro cessName: string): T Handle; | |
237 | function G etProcessN ameFromWnd (Wnd: THan dle): stri ng; | |
238 | function G etProcessN ameFromPid (PID: DWOR D): string ; | |
239 | function G etMainAppW ndFromPid( PID: DWORD ): THandle ; | |
240 | function G etWndFromP id(PID: DW ORD; const WindowCla ssName: st ring): HWN D; | |
241 | {.$ENDIF ~ FPC} | |
242 | ||
243 | function G etShellPro cessName: string; | |
244 | {.$IFNDEF FPC} | |
245 | function G etShellPro cessHandle : THandle; | |
246 | {.$ENDIF ~ FPC} | |
247 | ||
248 | // Version Informati on | |
249 | type | |
250 | TWindows Version = | |
251 | (wvUnkn own, wvWin 95, wvWin9 5OSR2, wvW in98, wvWi n98SE, wvW inME, | |
252 | wvWinN T31, wvWin NT35, wvWi nNT351, wv WinNT4, wv Win2000, w vWinXP, | |
253 | wvWin2 003, wvWin XP64, wvWi n2003R2, w vWinVista, wvWinServ er2008, | |
254 | wvWin7 , wvWinSer ver2008R2, wvWin8, w vWin8RT, w vWinServer 2012, | |
255 | wvWin8 1, wvWin81 RT, wvWinS erver2012R 2, wvWin10 , wvWinSer ver2016); | |
256 | TWindows Edition = | |
257 | (weUnkn own, weWin XPHome, we WinXPPro, weWinXPHom eN, weWinX PProN, weW inXPHomeK, | |
258 | weWinX PProK, weW inXPHomeKN , weWinXPP roKN, weWi nXPStarter , weWinXPM ediaCenter , | |
259 | weWinX PTablet, w eWinVistaS tarter, we WinVistaHo meBasic, w eWinVistaH omeBasicN, | |
260 | weWinV istaHomePr emium, weW inVistaBus iness, weW inVistaBus inessN, | |
261 | weWinV istaEnterp rise, weWi nVistaUlti mate, weWi n7Starter, weWin7Hom eBasic, | |
262 | weWin7 HomePremiu m, weWin7P rofessiona l, weWin7E nterprise, weWin7Ult imate, | |
263 | weWin8 , weWin8Pr o, weWin8E nterprise, weWin8RT, weWin81, weWin81Pro , | |
264 | weWin8 1Enterpris e, weWin81 RT, weWin1 0, weWin10 Home, weWi n10Pro, | |
265 | weWin1 0Enterpris e, weWin10 Education) ; | |
266 | TNtProdu ctType = | |
267 | (ptUnkn own, ptWor kStation, ptServer, ptAdvanced Server, | |
268 | ptPers onal, ptPr ofessional , ptDatace nterServer , ptEnterp rise, ptWe bEdition); | |
269 | TProcess orArchitec ture = | |
270 | (paUnkn own, // un known proc essor | |
271 | pax863 2, // x8 6 32 bit p rocessors (some P4, Celeron, A thlon and older) | |
272 | pax866 4, // x8 6 64 bit p rocessors (latest P4 , Celeron and Athlon 64) | |
273 | paIA64 ); // It anium proc essors | |
274 | ||
275 | var | |
276 | { in cas e of addit ions, don' t forget t o update i nitializat ion sectio n! } | |
277 | IsWin95: Boolean = False; | |
278 | IsWin95O SR2: Boole an = False ; | |
279 | IsWin98: Boolean = False; | |
280 | IsWin98S E: Boolean = False; | |
281 | IsWinME: Boolean = False; | |
282 | IsWinNT: Boolean = False; | |
283 | IsWinNT3 : Boolean = False; | |
284 | IsWinNT3 1: Boolean = False; | |
285 | IsWinNT3 5: Boolean = False; | |
286 | IsWinNT3 51: Boolea n = False; | |
287 | IsWinNT4 : Boolean = False; | |
288 | IsWin2K: Boolean = False; | |
289 | IsWinXP: Boolean = False; | |
290 | IsWin200 3: Boolean = False; | |
291 | IsWinXP6 4: Boolean = False; | |
292 | IsWin200 3R2: Boole an = False ; | |
293 | IsWinVis ta: Boolea n = False; | |
294 | IsWinSer ver2008: B oolean = F alse; | |
295 | IsWin7: Boolean = False; | |
296 | IsWinSer ver2008R2: Boolean = False; | |
297 | IsWin8: Boolean = False; | |
298 | IsWin8RT : Boolean = False; | |
299 | IsWinSer ver2012: B oolean = F alse; | |
300 | IsWin81: Boolean = False; | |
301 | IsWin81R T: Boolean = False; | |
302 | IsWinSer ver2012R2: Boolean = False; | |
303 | IsWin10: Boolean = False; | |
304 | IsWinSer ver2016: B oolean = F alse; | |
305 | ||
306 | const | |
307 | PROCESSO R_ARCHITEC TURE_INTEL = 0; | |
308 | {$EXTERN ALSYM PROC ESSOR_ARCH ITECTURE_I NTEL} | |
309 | PROCESSO R_ARCHITEC TURE_AMD64 = 9; | |
310 | {$EXTERN ALSYM PROC ESSOR_ARCH ITECTURE_A MD64} | |
311 | PROCESSO R_ARCHITEC TURE_IA32_ ON_WIN64 = 10; | |
312 | {$EXTERN ALSYM PROC ESSOR_ARCH ITECTURE_I A32_ON_WIN 64} | |
313 | PROCESSO R_ARCHITEC TURE_IA64 = 6; | |
314 | {$EXTERN ALSYM PROC ESSOR_ARCH ITECTURE_I A64} | |
315 | ||
316 | function G etWindowsV ersion: TW indowsVers ion; | |
317 | function G etWindowsE dition: TW indowsEdit ion; | |
318 | function N tProductTy pe: TNtPro ductType; | |
319 | function G etWindowsV ersionStri ng: string ; | |
320 | function G etWindowsE ditionStri ng: string ; | |
321 | function G etWindowsP roductStri ng: string ; | |
322 | function N tProductTy peString: string; | |
323 | function G etWindowsB uildNumber : Integer; | |
324 | function G etWindowsM ajorVersio nNumber: I nteger; | |
325 | function G etWindowsM inorVersio nNumber: I nteger; | |
326 | function G etWindowsV ersionNumb er: string ; | |
327 | function G etWindowsS ervicePack Version: I nteger; | |
328 | function G etWindowsS ervicePack VersionStr ing: strin g; | |
329 | function G etOpenGLVe rsion(cons t Win: THa ndle; out Version, V endor: Ans iString): Boolean; | |
330 | function G etNativeSy stemInfo(v ar SystemI nfo: TSyst emInfo): B oolean; | |
331 | function G etProcesso rArchitect ure: TProc essorArchi tecture; | |
332 | function I sWindows64 : Boolean; | |
333 | function J clCheckWin Version(Ma jor, Minor : Integer) : Boolean; | |
334 | {$ENDIF MS WINDOWS} | |
335 | ||
336 | function G etOSVersio nString: s tring; | |
337 | ||
338 | // Hardwar e | |
339 | {$IFDEF MS WINDOWS} | |
340 | function G etMacAddre sses(const Machine: string; co nst Addres ses: TStri ngs): Inte ger; | |
341 | {$ENDIF MS WINDOWS} | |
342 | function R eadTimeSta mpCounter: Int64; | |
343 | {$IFDEF WI N64} | |
344 | {$EXTERNAL SYM ReadTi meStampCou nter} | |
345 | {$ENDIF WI N64} | |
346 | ||
347 | type | |
348 | TTLBInfo rmation = (tiEntries , tiAssoci ativity); | |
349 | TCacheIn formation = (ciLineS ize {in By tes}, ciLi nesPerTag, ciAssocia tivity, ci Size); | |
350 | ||
351 | TIntelSp ecific = r ecord | |
352 | L2Cach e: Cardina l; | |
353 | CacheD escriptors : array [0 ..15] of B yte; | |
354 | BrandI D: Byte; | |
355 | FlushL ineSize: B yte; | |
356 | APICID : Byte; | |
357 | ExFeat ures: Card inal; | |
358 | Ex64Fe atures: Ca rdinal; | |
359 | Ex64Fe atures2: C ardinal; | |
360 | PowerM anagementF eatures: C ardinal; | |
361 | Physic alAddressB its: Byte; | |
362 | Virtua lAddressBi ts: Byte; | |
363 | end; | |
364 | ||
365 | TCyrixSp ecific = r ecord | |
366 | L1Cach eInfo: arr ay [0..3] of Byte; | |
367 | TLBInf o: array [ 0..3] of B yte; | |
368 | end; | |
369 | ||
370 | TAMDSpec ific = pac ked record | |
371 | ExFeat ures: Card inal; | |
372 | ExFeat ures2: Car dinal; | |
373 | Featur es2: Cardi nal; | |
374 | BrandI D: Byte; | |
375 | FlushL ineSize: B yte; | |
376 | APICID : Byte; | |
377 | ExBran dID: Word; | |
378 | // do not split L1 MByte T LB | |
379 | L1MByt eInstructi onTLB: arr ay [TTLBIn formation] of Byte; | |
380 | L1MByt eDataTLB: array [TTL BInformati on] of Byt e; | |
381 | // do not split L1 KByte T LB | |
382 | L1KByt eInstructi onTLB: arr ay [TTLBIn formation] of Byte; | |
383 | L1KByt eDataTLB: array [TTL BInformati on] of Byt e; | |
384 | L1Data Cache: arr ay [TCache Informatio n] of Byte ; | |
385 | L1Inst ructionCac he: array [TCacheInf ormation] of Byte; | |
386 | // do not split L2 MByte T LB | |
387 | L2MByt eInstructi onTLB: arr ay [TTLBIn formation] of Byte; // L2 T LB for 2-M Byte and 4 -MByte pag es | |
388 | L2MByt eDataTLB: array [TTL BInformati on] of Byt e; // L2 T LB for 2-M Byte and 4 -MByte pag es | |
389 | // do not split L2 KByte T LB | |
390 | L2KByt eDataTLB: array [TTL BInformati on] of Byt e; // L2 T LB for 4-K Byte pages | |
391 | L2KByt eInstructi onTLB: arr ay [TTLBIn formation] of Byte; // L2 T LB for 4-K Byte pages | |
392 | L2Cach e: Cardina l; | |
393 | L3Cach e: Cardina l; | |
394 | Advanc edPowerMan agement: C ardinal; | |
395 | Physic alAddressS ize: Byte; | |
396 | Virtua lAddressSi ze: Byte; | |
397 | end; | |
398 | ||
399 | TVIASpec ific = rec ord | |
400 | ExFeat ures: Card inal; | |
401 | DataTL B: array [ TTLBInform ation] of Byte; | |
402 | Instru ctionTLB: array [TTL BInformati on] of Byt e; | |
403 | L1Data Cache: arr ay [TCache Informatio n] of Byte ; | |
404 | L1Inst ructionCac he: array [TCacheInf ormation] of Byte; | |
405 | L2Data Cache: Car dinal; | |
406 | end; | |
407 | ||
408 | TTransme taSpecific = record | |
409 | ExFeat ures: Card inal; | |
410 | DataTL B: array [ TTLBInform ation] of Byte; | |
411 | CodeTL B: array [ TTLBInform ation] of Byte; | |
412 | L1Data Cache: arr ay [TCache Informatio n] of Byte ; | |
413 | L1Code Cache: arr ay [TCache Informatio n] of Byte ; | |
414 | L2Cach e: Cardina l; | |
415 | Revisi onABCD: Ca rdinal; | |
416 | Revisi onXXXX: Ca rdinal; | |
417 | Freque ncy: Cardi nal; | |
418 | CodeMo rphingABCD : Cardinal ; | |
419 | CodeMo rphingXXXX : Cardinal ; | |
420 | Transm etaFeature s: Cardina l; | |
421 | Transm etaInforma tions: arr ay [0..64] of Char; | |
422 | Curren tVoltage: Cardinal; | |
423 | Curren tFrequency : Cardinal ; | |
424 | Curren tPerforman ce: Cardin al; | |
425 | end; | |
426 | ||
427 | TCacheFa mily = ( | |
428 | cfInst ructionTLB , cfDataTL B, | |
429 | cfL1In structionC ache, cfL1 DataCache, | |
430 | cfL2Ca che, cfL2T LB, cfL3Ca che, cfTra ce, cfOthe r); | |
431 | ||
432 | TCacheIn fo = recor d | |
433 | D: Byt e; | |
434 | Family : TCacheFa mily; | |
435 | Size: Cardinal; | |
436 | WaysOf Assoc: Byt e; | |
437 | LineSi ze: Byte; // f or Normal Cache | |
438 | LinePe rSector: B yte; // f or L3 Norm al Cache | |
439 | Entrie s: Cardina l; // for TLB | |
440 | I: PRe sStringRec ; | |
441 | end; | |
442 | ||
443 | TFreqInf o = record | |
444 | RawFre q: Int64; | |
445 | NormFr eq: Int64; | |
446 | InCycl es: Int64; | |
447 | ExTick s: Int64; | |
448 | end; | |
449 | ||
450 | const | |
451 | CPU_TYPE _INTEL = 1; | |
452 | CPU_TYPE _CYRIX = 2; | |
453 | CPU_TYPE _AMD = 3; | |
454 | CPU_TYPE _TRANSMETA = 4; | |
455 | CPU_TYPE _VIA = 5; | |
456 | ||
457 | type | |
458 | TSSESupp ort = (sse , sse2, ss e3, ssse3, sse41, ss e42, sse4A , sse5, av x); | |
459 | TSSESupp orts = set of TSSESu pport; | |
460 | ||
461 | TCpuInfo = record | |
462 | HasIns truction: Boolean; | |
463 | AES: B oolean; | |
464 | MMX: B oolean; | |
465 | ExMMX: Boolean; | |
466 | _3DNow : Boolean; | |
467 | Ex3DNo w: Boolean ; | |
468 | SSE: T SSESupport s; | |
469 | IsFDIV OK: Boolea n; | |
470 | Is64Bi ts: Boolea n; | |
471 | DEPCap able: Bool ean; | |
472 | HasCac heInfo: Bo olean; | |
473 | HasExt endedInfo: Boolean; | |
474 | PType: Byte; | |
475 | Family : Byte; | |
476 | Extend edFamily: Byte; | |
477 | Model: Byte; | |
478 | Extend edModel: B yte; | |
479 | Steppi ng: Byte; | |
480 | Featur es: Cardin al; | |
481 | Freque ncyInfo: T FreqInfo; | |
482 | Vendor IDString: array [0.. 11] of Ans iChar; | |
483 | Manufa cturer: ar ray [0..9] of AnsiCh ar; | |
484 | CpuNam e: array [ 0..47] of AnsiChar; | |
485 | L1Data CacheSize: Cardinal; // in k Byte | |
486 | L1Data CacheLineS ize: Byte; // in B yte | |
487 | L1Data CacheAssoc iativity: Byte; | |
488 | L1Inst ructionCac heSize: Ca rdinal; // in k Byte | |
489 | L1Inst ructionCac heLineSize : Byte; // in B yte | |
490 | L1Inst ructionCac heAssociat ivity: Byt e; | |
491 | L2Cach eSize: Car dinal; // in k Byte | |
492 | L2Cach eLineSize: Byte; // in B yte | |
493 | L2Cach eAssociati vity: Byte ; | |
494 | L3Cach eSize: Car dinal; // in k Byte | |
495 | L3Cach eLineSize: Byte; // in B yte | |
496 | L3Cach eAssociati vity: Byte ; | |
497 | L3Line sPerSector : Byte; | |
498 | Logica lCore: Byt e; | |
499 | Physic alCore: By te; | |
500 | HyperT hreadingTe chnology: Boolean; | |
501 | Hardwa reHyperThr eadingTech nology: Bo olean; | |
502 | // tod o: TLB | |
503 | case C puType: By te of | |
504 | CPU_ TYPE_INTEL : (IntelSp ecific: TI ntelSpecif ic;); | |
505 | CPU_ TYPE_CYRIX : (CyrixSp ecific: TC yrixSpecif ic;); | |
506 | CPU_ TYPE_AMD: (AMDSpecif ic: TAMDSp ecific;); | |
507 | CPU_ TYPE_TRANS META: (Tra nsmetaSpec ific: TTra nsmetaSpec ific;); | |
508 | CPU_ TYPE_VIA: (ViaSpecif ic: TViaSp ecific;); | |
509 | end; | |
510 | ||
511 | const | |
512 | VendorID Intel: arr ay [0..11] of AnsiCh ar = 'Genu ineIntel'; | |
513 | VendorID Cyrix: arr ay [0..11] of AnsiCh ar = 'Cyri xInstead'; | |
514 | VendorID AMD: array [0..11] o f AnsiChar = 'Authen ticAMD'; | |
515 | VendorID Transmeta: array [0. .11] of An siChar = ' GenuineTMx 86'; | |
516 | VendorID VIA: array [0..11] o f AnsiChar = 'Centau rHauls'; | |
517 | ||
518 | // Constan ts to be u sed with F eature Fla g set of a CPU | |
519 | // eg. IF (Features and FPU_FL AG = FPU_F LAG) THEN CPU has Fl oating-Poi nt unit on | |
520 | // chip. H owever, In tel claims that in f uture mode ls, a zero in the fe ature | |
521 | // flags w ill mean t hat the ch ip has tha t feature, however, the follow ing flags | |
522 | // will wo rk for any productio n 80x86 ch ip or clon e. | |
523 | // eg. IF (Features and FPU_FL AG = 0) th en CPU has Floating- Point unit on chip. | |
524 | ||
525 | const | |
526 | { 32 bit s in a DWo rd Value } | |
527 | BIT_0 = $000 00001; | |
528 | BIT_1 = $000 00002; | |
529 | BIT_2 = $000 00004; | |
530 | BIT_3 = $000 00008; | |
531 | BIT_4 = $000 00010; | |
532 | BIT_5 = $000 00020; | |
533 | BIT_6 = $000 00040; | |
534 | BIT_7 = $000 00080; | |
535 | BIT_8 = $000 00100; | |
536 | BIT_9 = $000 00200; | |
537 | BIT_10 = $000 00400; | |
538 | BIT_11 = $000 00800; | |
539 | BIT_12 = $000 01000; | |
540 | BIT_13 = $000 02000; | |
541 | BIT_14 = $000 04000; | |
542 | BIT_15 = $000 08000; | |
543 | BIT_16 = $000 10000; | |
544 | BIT_17 = $000 20000; | |
545 | BIT_18 = $000 40000; | |
546 | BIT_19 = $000 80000; | |
547 | BIT_20 = $001 00000; | |
548 | BIT_21 = $002 00000; | |
549 | BIT_22 = $004 00000; | |
550 | BIT_23 = $008 00000; | |
551 | BIT_24 = $010 00000; | |
552 | BIT_25 = $020 00000; | |
553 | BIT_26 = $040 00000; | |
554 | BIT_27 = $080 00000; | |
555 | BIT_28 = $100 00000; | |
556 | BIT_29 = $200 00000; | |
557 | BIT_30 = $400 00000; | |
558 | BIT_31 = DWOR D($8000000 0); | |
559 | ||
560 | { Standa rd Feature Flags } | |
561 | FPU_FLAG = BIT_ 0; // Flo ating-Poin t unit on chip | |
562 | VME_FLAG = BIT_ 1; // Vir tual Mode Extention | |
563 | DE_FLAG = BIT_ 2; // Deb ugging Ext ention | |
564 | PSE_FLAG = BIT_ 3; // Pag e Size Ext ention | |
565 | TSC_FLAG = BIT_ 4; // Tim e Stamp Co unter | |
566 | MSR_FLAG = BIT_ 5; // Mod el Specifi c Register s | |
567 | PAE_FLAG = BIT_ 6; // Phy sical Addr ess Extent ion | |
568 | MCE_FLAG = BIT_ 7; // Mac hine Check Exception | |
569 | CX8_FLAG = BIT_ 8; // CMP XCHG8 Inst ruction | |
570 | APIC_FLA G = BIT_ 9; // Sof tware-acce ssible loc al APIC on Chip | |
571 | BIT_10_F LAG = BIT_ 10; // Res erved, do not count on value | |
572 | SEP_FLAG = BIT_ 11; // Fas t System C all | |
573 | MTRR_FLA G = BIT_ 12; // Mem ory Type R ange Regis ters | |
574 | PGE_FLAG = BIT_ 13; // Pag e Global E nable | |
575 | MCA_FLAG = BIT_ 14; // Mac hine Check Architect ure | |
576 | CMOV_FLA G = BIT_ 15; // Con ditional M ove Instru ction | |
577 | PAT_FLAG = BIT_ 16; // Pag e Attribut e Table | |
578 | PSE36_FL AG = BIT_ 17; // 36- bit Page S ize Extent ion | |
579 | PSN_FLAG = BIT_ 18; // Pro cessor ser ial number is presen t and enab led | |
580 | CLFLSH_F LAG = BIT_ 19; // CLF LUSH intru ction | |
581 | BIT_20_F LAG = BIT_ 20; // Res erved, do not count on value | |
582 | DS_FLAG = BIT_ 21; // Deb ug store | |
583 | ACPI_FLA G = BIT_ 22; // The rmal monit or and clo ck control | |
584 | MMX_FLAG = BIT_ 23; // MMX technolog y | |
585 | FXSR_FLA G = BIT_ 24; // Fas t Floating Point Sav e and Rest ore | |
586 | SSE_FLAG = BIT_ 25; // Str eaming SIM D Extensio ns | |
587 | SSE2_FLA G = BIT_ 26; // Str eaming SIM D Extensio ns 2 | |
588 | SS_FLAG = BIT_ 27; // Sel f snoop | |
589 | HTT_FLAG = BIT_ 28; // Hyp er-threadi ng technol ogy | |
590 | TM_FLAG = BIT_ 29; // The rmal monit or | |
591 | BIT_30_F LAG = BIT_ 30; // Res erved, do not count on value | |
592 | PBE_FLAG = BIT_ 31; // Pen ding Break Enable | |
593 | ||
594 | { Standa rd Intel F eature Fla gs } | |
595 | INTEL_FP U = BIT _0; // Fl oating-Poi nt unit on chip | |
596 | INTEL_VM E = BIT _1; // Vi rtual Mode Extention | |
597 | INTEL_DE = BIT _2; // De bugging Ex tention | |
598 | INTEL_PS E = BIT _3; // Pa ge Size Ex tention | |
599 | INTEL_TS C = BIT _4; // Ti me Stamp C ounter | |
600 | INTEL_MS R = BIT _5; // Mo del Specif ic Registe rs | |
601 | INTEL_PA E = BIT _6; // Ph ysical Add ress Exten tion | |
602 | INTEL_MC E = BIT _7; // Ma chine Chec k Exceptio n | |
603 | INTEL_CX 8 = BIT _8; // CM PXCHG8 Ins truction | |
604 | INTEL_AP IC = BIT _9; // So ftware-acc essible lo cal APIC o n Chip | |
605 | INTEL_BI T_10 = BIT _10; // Re served, do not count on value | |
606 | INTEL_SE P = BIT _11; // Fa st System Call | |
607 | INTEL_MT RR = BIT _12; // Me mory Type Range Regi sters | |
608 | INTEL_PG E = BIT _13; // Pa ge Global Enable | |
609 | INTEL_MC A = BIT _14; // Ma chine Chec k Architec ture | |
610 | INTEL_CM OV = BIT _15; // Co nditional Move Instr uction | |
611 | INTEL_PA T = BIT _16; // Pa ge Attribu te Table | |
612 | INTEL_PS E36 = BIT _17; // 36 -bit Page Size Exten tion | |
613 | INTEL_PS N = BIT _18; // Pr ocessor se rial numbe r is prese nt and ena bled | |
614 | INTEL_CL FLSH = BIT _19; // CL FLUSH intr uction | |
615 | INTEL_BI T_20 = BIT _20; // Re served, do not count on value | |
616 | INTEL_DS = BIT _21; // De bug store | |
617 | INTEL_AC PI = BIT _22; // Th ermal moni tor and cl ock contro l | |
618 | INTEL_MM X = BIT _23; // MM X technolo gy | |
619 | INTEL_FX SR = BIT _24; // Fa st Floatin g Point Sa ve and Res tore | |
620 | INTEL_SS E = BIT _25; // St reaming SI MD Extensi ons | |
621 | INTEL_SS E2 = BIT _26; // St reaming SI MD Extensi ons 2 | |
622 | INTEL_SS = BIT _27; // Se lf snoop | |
623 | INTEL_HT T = BIT _28; // Hy per-thread ing techno logy | |
624 | INTEL_TM = BIT _29; // Th ermal moni tor | |
625 | INTEL_IA 64 = BIT _30; // IA 32 emulati on mode on Itanium p rocessors (IA64) | |
626 | INTEL_PB E = BIT _31; // Pe nding Brea k Enable | |
627 | ||
628 | { Extend ed Intel F eature Fla gs } | |
629 | EINTEL_S SE3 = BIT_0; / / Streamin g SIMD Ext ensions 3 | |
630 | EINTEL_P CLMULQDQ = BIT_1; / / the proc essor supp orts the P CLMULQDQ i nstruction | |
631 | EINTEL_D TES64 = BIT_2; / / the proc essor supp orts DS ar ea using 6 4-bit layo ut | |
632 | EINTEL_M ONITOR = BIT_3; / / Monitor/ MWAIT | |
633 | EINTEL_D SCPL = BIT_4; / / CPL Qual ified debu g Store | |
634 | EINTEL_V MX = BIT_5; / / Virtual Machine Te chnology | |
635 | EINTEL_S MX = BIT_6; / / Safer Mo de Extensi ons | |
636 | EINTEL_E ST = BIT_7; / / Enhanced Intel Spe edstep tec hnology | |
637 | EINTEL_T M2 = BIT_8; / / Thermal monitor 2 | |
638 | EINTEL_S SSE3 = BIT_9; / / SSSE 3 e xtensions | |
639 | EINTEL_C NXTID = BIT_10; / / L1 Conte xt ID | |
640 | EINTEL_B IT_11 = BIT_11; / / Reserved , do not c ount on va lue | |
641 | EINTEL_F MA = BIT_12; / / Fused Mu ltiply Add | |
642 | EINTEL_C X16 = BIT_13; / / CMPXCHG1 6B instruc tion | |
643 | EINTEL_X TPR = BIT_14; / / Send Tas k Priority messages | |
644 | EINTEL_P DCM = BIT_15; / / Perf/Deb ug Capabil ity MSR | |
645 | EINTEL_B IT_16 = BIT_16; / / Reserved , do not c ount on va lue | |
646 | EINTEL_P CID = BIT_17; / / Process- context Id entifiers | |
647 | EINTEL_D CA = BIT_18; / / Direct C ache Acces s | |
648 | EINTEL_S SE4_1 = BIT_19; / / Streamin g SIMD Ext ensions 4. 1 | |
649 | EINTEL_S SE4_2 = BIT_20; / / Streamin g SIMD Ext ensions 4. 2 | |
650 | EINTEL_X 2APIC = BIT_21; / / x2APIC f eature | |
651 | EINTEL_M OVBE = BIT_22; / / MOVBE in struction | |
652 | EINTEL_P OPCNT = BIT_23; / / A value of 1 indic ates the p rocessor s upports th e POPCNT i nstruction . | |
653 | EINTEL_T SC_DL = BIT_24; / / TSC-Dead line | |
654 | EINTEL_A ES = BIT_25; / / the proc essor supp orts the A ES instruc tion exten sions | |
655 | EINTEL_X SAVE = BIT_26; / / XSAVE/XR STOR proce ssor exten ded states feature, XSETBV/XGE TBV instru ctions and XFEATURE_ ENABLED_MA SK (XCR0) register | |
656 | EINTEL_O SXSAVE = BIT_27; / / OS has e nabled fea tures pres ent in EIN TEL_XSAVE | |
657 | EINTEL_A VX = BIT_28; / / Advanced Vector Ex tensions | |
658 | EINTEL_B IT_29 = BIT_29; / / Reserved , do not c ount on va lue | |
659 | EINTEL_R DRAND = BIT_30; / / the proc essor supp orts the R DRAND inst ruction. | |
660 | EINTEL_B IT_31 = BIT_31; / / Always r eturn 0 | |
661 | ||
662 | { Extend ed Intel 6 4 Bits Fea ture Flags } | |
663 | EINTEL64 _BIT_0 = BIT_0; // Reserved, do not co unt on val ue | |
664 | EINTEL64 _BIT_1 = BIT_1; // Reserved, do not co unt on val ue | |
665 | EINTEL64 _BIT_2 = BIT_2; // Reserved, do not co unt on val ue | |
666 | EINTEL64 _BIT_3 = BIT_3; // Reserved, do not co unt on val ue | |
667 | EINTEL64 _BIT_4 = BIT_4; // Reserved, do not co unt on val ue | |
668 | EINTEL64 _BIT_5 = BIT_5; // Reserved, do not co unt on val ue | |
669 | EINTEL64 _BIT_6 = BIT_6; // Reserved, do not co unt on val ue | |
670 | EINTEL64 _BIT_7 = BIT_7; // Reserved, do not co unt on val ue | |
671 | EINTEL64 _BIT_8 = BIT_8; // Reserved, do not co unt on val ue | |
672 | EINTEL64 _BIT_9 = BIT_9; // Reserved, do not co unt on val ue | |
673 | EINTEL64 _BIT_10 = BIT_10; // Reserved, do not co unt on val ue | |
674 | EINTEL64 _SYS = BIT_11; // 64 Bit - SYSCALL SY SRET | |
675 | EINTEL64 _BIT_12 = BIT_12; // Reserved, do not co unt on val ue | |
676 | EINTEL64 _BIT_13 = BIT_13; // Reserved, do not co unt on val ue | |
677 | EINTEL64 _BIT_14 = BIT_14; // Reserved, do not co unt on val ue | |
678 | EINTEL64 _BIT_15 = BIT_15; // Reserved, do not co unt on val ue | |
679 | EINTEL64 _BIT_16 = BIT_16; // Reserved, do not co unt on val ue | |
680 | EINTEL64 _BIT_17 = BIT_17; // Reserved, do not co unt on val ue | |
681 | EINTEL64 _BIT_18 = BIT_18; // Reserved, do not co unt on val ue | |
682 | EINTEL64 _BIT_19 = BIT_19; // Reserved, do not co unt on val ue | |
683 | EINTEL64 _XD = BIT_20; // Execution Disable B it | |
684 | EINTEL64 _BIT_21 = BIT_21; // Reserved, do not co unt on val ue | |
685 | EINTEL64 _BIT_22 = BIT_22; // Reserved, do not co unt on val ue | |
686 | EINTEL64 _BIT_23 = BIT_23; // Reserved, do not co unt on val ue | |
687 | EINTEL64 _BIT_24 = BIT_24; // Reserved, do not co unt on val ue | |
688 | EINTEL64 _BIT_25 = BIT_25; // Reserved, do not co unt on val ue | |
689 | EINTEL64 _1GBYTE = BIT_26; // 1G-Byte p ages are a vailable | |
690 | EINTEL64 _RDTSCP = BIT_27; // RDTSCP an d IA32_TSC _AUX are a vailable | |
691 | EINTEL64 _BIT_28 = BIT_28; // Reserved, do not co unt on val ue | |
692 | EINTEL64 _EM64T = BIT_29; // Intel Ext ended Memo ry 64 Tech nology | |
693 | EINTEL64 _BIT_30 = BIT_30; // Reserved, do not co unt on val ue | |
694 | EINTEL64 _BIT_31 = BIT_31; // Reserved, do not co unt on val ue | |
695 | ||
696 | { Extend ed Intel 6 4 Bits Fea ture Flags continued } | |
697 | EINTEL64 _2_LAHF = BIT_0; // LAHF/SA HF availab le in 64 b it mode | |
698 | EINTEL64 _2_BIT_1 = BIT_1; // Reserve d, do not count on v alue | |
699 | EINTEL64 _2_BIT_2 = BIT_2; // Reserve d, do not count on v alue | |
700 | EINTEL64 _2_BIT_3 = BIT_3; // Reserve d, do not count on v alue | |
701 | EINTEL64 _2_BIT_4 = BIT_4; // Reserve d, do not count on v alue | |
702 | EINTEL64 _2_BIT_5 = BIT_5; // Reserve d, do not count on v alue | |
703 | EINTEL64 _2_BIT_6 = BIT_6; // Reserve d, do not count on v alue | |
704 | EINTEL64 _2_BIT_7 = BIT_7; // Reserve d, do not count on v alue | |
705 | EINTEL64 _2_BIT_8 = BIT_8; // Reserve d, do not count on v alue | |
706 | EINTEL64 _2_BIT_9 = BIT_9; // Reserve d, do not count on v alue | |
707 | EINTEL64 _2_BIT_10 = BIT_10; // Reserve d, do not count on v alue | |
708 | EINTEL64 _2_BIT_11 = BIT_11; // Reserve d, do not count on v alue | |
709 | EINTEL64 _2_BIT_12 = BIT_12; // Reserve d, do not count on v alue | |
710 | EINTEL64 _2_BIT_13 = BIT_13; // Reserve d, do not count on v alue | |
711 | EINTEL64 _2_BIT_14 = BIT_14; // Reserve d, do not count on v alue | |
712 | EINTEL64 _2_BIT_15 = BIT_15; // Reserve d, do not count on v alue | |
713 | EINTEL64 _2_BIT_16 = BIT_16; // Reserve d, do not count on v alue | |
714 | EINTEL64 _2_BIT_17 = BIT_17; // Reserve d, do not count on v alue | |
715 | EINTEL64 _2_BIT_18 = BIT_18; // Reserve d, do not count on v alue | |
716 | EINTEL64 _2_BIT_19 = BIT_19; // Reserve d, do not count on v alue | |
717 | EINTEL64 _2_BIT_20 = BIT_20; // Reserve d, do not count on v alue | |
718 | EINTEL64 _2_BIT_21 = BIT_21; // Reserve d, do not count on v alue | |
719 | EINTEL64 _2_BIT_22 = BIT_22; // Reserve d, do not count on v alue | |
720 | EINTEL64 _2_BIT_23 = BIT_23; // Reserve d, do not count on v alue | |
721 | EINTEL64 _2_BIT_24 = BIT_24; // Reserve d, do not count on v alue | |
722 | EINTEL64 _2_BIT_25 = BIT_25; // Reserve d, do not count on v alue | |
723 | EINTEL64 _2_BIT_26 = BIT_26; // Reserve d, do not count on v alue | |
724 | EINTEL64 _2_BIT_27 = BIT_27; // Reserve d, do not count on v alue | |
725 | EINTEL64 _2_BIT_28 = BIT_28; // Reserve d, do not count on v alue | |
726 | EINTEL64 _2_BIT_29 = BIT_29; // Reserve d, do not count on v alue | |
727 | EINTEL64 _2_BIT_30 = BIT_30; // Reserve d, do not count on v alue | |
728 | EINTEL64 _2_BIT_31 = BIT_31; // Reserve d, do not count on v alue | |
729 | ||
730 | { INTEL Power Mana gement Fla gs } | |
731 | PINTEL_T EMPSENSOR = BIT_0; // Digital temperatu re sensor | |
732 | PINTEL_T URBOBOOST = BIT_1; // Intel T urbo Boost Technolog y Availabl e | |
733 | PINTEL_A RAT = BIT_2; // APIC-Ti mer-always -running f eature | |
734 | PINTEL_B IT_3 = BIT_3; // Reverve d, do not count on v alue | |
735 | PINTEL_P LN = BIT_4; // Power L imit Notif ication co nstrols | |
736 | PINTEL_E CMD = BIT_5; // Clock M odulation duty cycle extension | |
737 | PINTEL_P TM = BIT_6; // Package Thermal M anagement | |
738 | PINTEL_B IT_7 = BIT_7; // Reserve d, do not count on v alue | |
739 | PINTEL_B IT_8 = BIT_8; // Reserve d, do not count on v alue | |
740 | PINTEL_B IT_9 = BIT_9; // Reserve d, do not count on v alue | |
741 | PINTEL_B IT_10 = BIT_10; // Reserve d, do not count on v alue | |
742 | PINTEL_B IT_11 = BIT_11; // Reserve d, do not count on v alue | |
743 | PINTEL_B IT_12 = BIT_12; // Reserve d, do not count on v alue | |
744 | PINTEL_B IT_13 = BIT_13; // Reserve d, do not count on v alue | |
745 | PINTEL_B IT_14 = BIT_14; // Reserve d, do not count on v alue | |
746 | PINTEL_B IT_15 = BIT_15; // Reserve d, do not count on v alue | |
747 | PINTEL_B IT_16 = BIT_16; // Reserve d, do not count on v alue | |
748 | PINTEL_B IT_17 = BIT_17; // Reserve d, do not count on v alue | |
749 | PINTEL_B IT_18 = BIT_18; // Reserve d, do not count on v alue | |
750 | PINTEL_B IT_19 = BIT_19; // Reserve d, do not count on v alue | |
751 | PINTEL_B IT_20 = BIT_20; // Reserve d, do not count on v alue | |
752 | PINTEL_B IT_21 = BIT_21; // Reserve d, do not count on v alue | |
753 | PINTEL_B IT_22 = BIT_22; // Reserve d, do not count on v alue | |
754 | PINTEL_B IT_23 = BIT_23; // Reserve d, do not count on v alue | |
755 | PINTEL_B IT_24 = BIT_24; // Reserve d, do not count on v alue | |
756 | PINTEL_B IT_25 = BIT_25; // Reserve d, do not count on v alue | |
757 | PINTEL_B IT_26 = BIT_26; // Reserve d, do not count on v alue | |
758 | PINTEL_B IT_27 = BIT_27; // Reserve d, do not count on v alue | |
759 | PINTEL_B IT_28 = BIT_28; // Reserve d, do not count on v alue | |
760 | PINTEL_B IT_29 = BIT_29; // Reserve d, do not count on v alue | |
761 | PINTEL_B IT_30 = BIT_30; // Reserve d, do not count on v alue | |
762 | PINTEL_B IT_31 = BIT_31; // Reserve d, do not count on v alue | |
763 | ||
764 | { AMD St andard Fea ture Flags } | |
765 | AMD_FPU = BIT_ 0; // Flo ating-Poin t unit on chip | |
766 | AMD_VME = BIT_ 1; // Vir tual Mode Extention | |
767 | AMD_DE = BIT_ 2; // Deb ugging Ext ention | |
768 | AMD_PSE = BIT_ 3; // Pag e Size Ext ention | |
769 | AMD_TSC = BIT_ 4; // Tim e Stamp Co unter | |
770 | AMD_MSR = BIT_ 5; // Mod el Specifi c Register s | |
771 | AMD_PAE = BIT_ 6; // Phy sical addr ess Extens ions | |
772 | AMD_MCE = BIT_ 7; // Mac hine Check Exception | |
773 | AMD_CX8 = BIT_ 8; // CMP XCHG8 Inst ruction | |
774 | AMD_APIC = BIT_ 9; // Sof tware-acce ssible loc al APIC on Chip | |
775 | AMD_BIT_ 10 = BIT_ 10; // Res erved, do not count on value | |
776 | AMD_SEP_ BIT = BIT_ 11; // SYS ENTER and SYSEXIT in structions | |
777 | AMD_MTRR = BIT_ 12; // Mem ory Type R ange Regis ters | |
778 | AMD_PGE = BIT_ 13; // Pag e Global E nable | |
779 | AMD_MCA = BIT_ 14; // Mac hine Check Architect ure | |
780 | AMD_CMOV = BIT_ 15; // Con ditional M ove Instru ction | |
781 | AMD_PAT = BIT_ 16; // Pag e Attribut e Table | |
782 | AMD_PSE3 6 = BIT_ 17; // Pag e Size Ext ensions | |
783 | AMD_BIT_ 18 = BIT_ 18; // Res erved, do not count on value | |
784 | AMD_CLFL SH = BIT_ 19; // CLF LUSH instr uction | |
785 | AMD_BIT_ 20 = BIT_ 20; // Res erved, do not count on value | |
786 | AMD_BIT_ 21 = BIT_ 21; // Res erved, do not count on value | |
787 | AMD_BIT_ 22 = BIT_ 22; // Res erved, do not count on value | |
788 | AMD_MMX = BIT_ 23; // MMX technolog y | |
789 | AMD_FXSR = BIT_ 24; // FXS AVE and FX STORE inst ructions | |
790 | AMD_SSE = BIT_ 25; // SSE Extension s | |
791 | AMD_SSE2 = BIT_ 26; // SSE 2 Extensio ns | |
792 | AMD_BIT_ 27 = BIT_ 27; // Res erved, do not count on value | |
793 | AMD_HTT = BIT_ 28; // Hyp er-Threadi ng Technol ogy | |
794 | AMD_BIT_ 29 = BIT_ 29; // Res erved, do not count on value | |
795 | AMD_BIT_ 30 = BIT_ 30; // Res erved, do not count on value | |
796 | AMD_BIT_ 31 = BIT_ 31; // Res erved, do not count on value | |
797 | ||
798 | { AMD St andard Fea ture Flags continued } | |
799 | AMD2_SSE 3 = BIT_0; // SSE3 exte nsions | |
800 | AMD2_PCL MULQDQ = BIT_1; // PCLMULQDQ instructi on support | |
801 | AMD2_BIT _2 = BIT_2; // Reserved, do not co unt on val ue | |
802 | AMD2_MON ITOR = BIT_3; // MONITOR/M WAIT instr uctions. S ee "MONITO R" and "MW AIT" in AP M3. | |
803 | AMD2_BIT _4 = BIT_4; // Reserved, do not co unt on val ue | |
804 | AMD2_BIT _5 = BIT_5; // Reserved, do not co unt on val ue | |
805 | AMD2_BIT _6 = BIT_6; // Reserved, do not co unt on val ue | |
806 | AMD2_BIT _7 = BIT_7; // Reserved, do not co unt on val ue | |
807 | AMD2_BIT _8 = BIT_8; // Reserved, do not co unt on val ue | |
808 | AMD2_SSS E3 = BIT_9; // supplemen tal SSE3 e xtensions | |
809 | AMD2_BIT _10 = BIT_10; // Reserved, do not co unt on val ue | |
810 | AMD2_BIT _11 = BIT_11; // Reserved, do not co unt on val ue | |
811 | AMD2_FMA = BIT_12; // FMA instr uction sup port | |
812 | AMD2_CMP XCHG16B = BIT_13; // CMPXCHG16 B availabl e | |
813 | AMD2_BIT _14 = BIT_14; // Reserved, do not co unt on val ue | |
814 | AMD2_BIT _15 = BIT_15; // Reserved, do not co unt on val ue | |
815 | AMD2_BIT _16 = BIT_16; // Reserved, do not co unt on val ue | |
816 | AMD2_BIT _17 = BIT_17; // Reserved, do not co unt on val ue | |
817 | AMD2_BIT _18 = BIT_18; // Reserved, do not co unt on val ue | |
818 | AMD2_SSE 41 = BIT_19; // SSE4.1 in struction support | |
819 | AMD2_SSE 42 = BIT_20; // SSE4.2 in struction support | |
820 | AMD2_BIT _21 = BIT_21; // Reserved, do not co unt on val ue | |
821 | AMD2_BIT _22 = BIT_22; // Reserved, do not co unt on val ue | |
822 | AMD2_POP CNT = BIT_23; // POPCNT in struction. See "POPC NT" in APM 3. | |
823 | AMD2_BIT _24 = BIT_24; // Reserved, do not co unt on val ue | |
824 | AMD2_AES = BIT_25; // AES instr uction sup port | |
825 | AMD2_XSA VE = BIT_26; // XSAVE (an d related) instructi ons are su pported by hardware | |
826 | AMD2_OSX SAVE = BIT_27; // XSAVE (an d related) instructi ons are en abled | |
827 | AMD2_AVX = BIT_28; // AVX instr uction sup port | |
828 | AMD2_F16 C = BIT_29; // half-prec ision conv ert instru ction supp ort | |
829 | AMD2_BIT _30 = BIT_30; // Reserved, do not co unt on val ue | |
830 | AMD2_RAZ = BIT_31; // Reserved for use by hyperviso r to indic ate guest status | |
831 | ||
832 | { AMD En hanced Fea ture Flags } | |
833 | EAMD_FPU = BIT _0; // Fl oating-Poi nt unit on chip | |
834 | EAMD_VME = BIT _1; // Vi rtual Mode Extention | |
835 | EAMD_DE = BIT _2; // De bugging Ex tention | |
836 | EAMD_PSE = BIT _3; // Pa ge Size Ex tention | |
837 | EAMD_TSC = BIT _4; // Ti me Stamp C ounter | |
838 | EAMD_MSR = BIT _5; // Mo del Specif ic Registe rs | |
839 | EAMD_PAE = BIT _6; // Ph ysical-add ress exten sions | |
840 | EAMD_MCE = BIT _7; // Ma chine Chec k Exceptio n | |
841 | EAMD_CX8 = BIT _8; // CM PXCHG8 Ins truction | |
842 | EAMD_API C = BIT _9; // Ad vanced Pro grammable Interrupt Controler | |
843 | EAMD_BIT _10 = BIT _10; // Re served, do not count on value | |
844 | EAMD_SEP = BIT _11; // Fa st System Call | |
845 | EAMD_MTR R = BIT _12; // Me mory-Type Range Regi sters | |
846 | EAMD_PGE = BIT _13; // Pa ge Global Enable | |
847 | EAMD_MCA = BIT _14; // Ma chine Chec k Architec ture | |
848 | EAMD_CMO V = BIT _15; // Co nditional Move Intru ctions | |
849 | EAMD_PAT = BIT _16; // Pa ge Attribu tes Table | |
850 | EAMD_PSE 2 = BIT _17; // Pa ge Size Ex tensions | |
851 | EAMD_BIT _18 = BIT _18; // Re served, do not count on value | |
852 | EAMD_BIT _19 = BIT _19; // Re served, do not count on value | |
853 | EAMD_NX = BIT _20; // No -Execute P age Protec tion | |
854 | EAMD_BIT _21 = BIT _21; // Re served, do not count on value | |
855 | EAMD_EXM MX = BIT _22; // AM D Extensio ns to MMX technology | |
856 | EAMD_MMX = BIT _23; // MM X technolo gy | |
857 | EAMD_FX = BIT _24; // FX SAVE and F XSTORE ins tructions | |
858 | EAMD_FFX = BIT _25; // Fa st FXSAVE and FXSTOR E instruct ions | |
859 | EAMD_1GB PAGE = BIT _26; // 1- GB large p age suppor t. | |
860 | EAMD_RDT SCP = BIT _27; // RD TSCP instr uction. | |
861 | EAMD_BIT _28 = BIT _28; // Re served, do not count on value | |
862 | EAMD_LON G = BIT _29; // Lo ng Mode (6 4-bit Core ) | |
863 | EAMD_EX3 DNOW = BIT _30; // AM D Extensio ns to 3DNo w! intruct ions | |
864 | EAMD_3DN OW = BIT _31; // AM D 3DNOW! T echnology | |
865 | ||
866 | { AMD Ex tended Fea ture Flags continued } | |
867 | EAMD2_LA HF = BIT_0; // LAHF/ SAHF avail able in 64 -bit mode | |
868 | EAMD2_CM PLEGACY = BIT_1; // core multi-proc essing leg acy mode | |
869 | EAMD2_SV M = BIT_2; // Secur e Virtual Machine | |
870 | EAMD2_EX TAPICSPACE = BIT_3; // This bit indica tes the pr esence of extended A PIC regist er space s tarting at offset 40 0h from th e “APIC Ba se Address Register, ” as speci fied in th e BKDG. | |
871 | EAMD2_AL TMOVCR8 = BIT_4; // LOCK MOV CR0 me ans MOV CR 8 | |
872 | EAMD2_AB M = BIT_5; // ABM: Advanced b it manipul ation. LZC NT instruc tion suppo rt. | |
873 | EAMD2_SS E4A = BIT_6; // EXTRQ , INSERTQ, MOVNTSS, and MOVNTS D instruct ion suppor t. | |
874 | EAMD2_MI SALIGNSSE = BIT_7; // Misal igned SSE mode. | |
875 | EAMD2_3D NOWPREFETC H = BIT_8; // PREFE TCH and PR EFETCHW in struction support. | |
876 | EAMD2_OS VW = BIT_9; // OS vi sible work around. | |
877 | EAMD2_IB S = BIT_10 ; // Instr uction bas ed samplin g | |
878 | EAMD2_XO P = BIT_11 ; // exten ded operat ion suppor t | |
879 | EAMD2_SK INIT = BIT_12 ; // SKINI T, STGI, a nd DEV sup port. | |
880 | EAMD2_WD T = BIT_13 ; // Watch dog timer support. | |
881 | EAMD2_BI T_14 = BIT_14 ; // Reser ved, do no t count on value | |
882 | EAMD2_LW P = BIT_15 ; // light weight pro filing sup port | |
883 | EAMD2_FM A4 = BIT_16 ; // 4-ope rand FMA i nstruction support. | |
884 | EAMD2_BI T_17 = BIT_17 ; // Reser ved, do no t count on value | |
885 | EAMD2_BI T_18 = BIT_18 ; // Reser ved, do no t count on value | |
886 | EAMD2_NO DEID = BIT_19 ; // Suppo rt for MSR C001_100C[ NodeId, No desPerProc essor] | |
887 | EAMD2_BI T_20 = BIT_20 ; // Reser ved, do no t count on value | |
888 | EAMD2_TB M = BIT_21 ; // trail ing bit ma nipulation instructi on support | |
889 | EAMD2_TO POLOGYEXT = BIT_22 ; // topol ogy extens ions suppo rt | |
890 | EAMD2_BI T_23 = BIT_23 ; // Reser ved, do no t count on value | |
891 | EAMD2_BI T_24 = BIT_24 ; // Reser ved, do no t count on value | |
892 | EAMD2_BI T_25 = BIT_25 ; // Reser ved, do no t count on value | |
893 | EAMD2_BI T_26 = BIT_26 ; // Reser ved, do no t count on value | |
894 | EAMD2_BI T_27 = BIT_27 ; // Reser ved, do no t count on value | |
895 | EAMD2_BI T_28 = BIT_28 ; // Reser ved, do no t count on value | |
896 | EAMD2_BI T_29 = BIT_29 ; // Reser ved, do no t count on value | |
897 | EAMD2_BI T_30 = BIT_30 ; // Reser ved, do no t count on value | |
898 | EAMD2_BI T_31 = BIT_31 ; // Reser ved, do no t count on value | |
899 | ||
900 | { AMD Po wer Manage ment Featu res Flags } | |
901 | PAMD_TEM PSENSOR = BIT_ 0; // Tem perature S ensor | |
902 | PAMD_FRE QUENCYID = BIT_ 1; // Fre quency ID Control | |
903 | PAMD_VOL TAGEID = BIT_ 2; // Vol tage ID Co ntrol | |
904 | PAMD_THE RMALTRIP = BIT_ 3; // The rmal Trip | |
905 | PAMD_THE RMALMONITO R = BIT_ 4; // The rmal Monit oring | |
906 | PAMD_BIT _5 = BIT_ 5; // Res erved, do not count on value | |
907 | PAMD_100 MHZSTEP = BIT_ 6; // 100 Mhz multi plier cont rol. | |
908 | PAMD_HWP STATE = BIT_ 7; // Har dware P-St ate contro l. | |
909 | PAMD_TSC _INVARIANT = BIT_ 8; // TSC rate is i nvariant | |
910 | PAMD_CPB = BIT_ 9; // cor e performa nce boost | |
911 | PAMD_EFF FREQRO = BIT_ 10; // rea d-only eff ective fre quency int erface | |
912 | PAMD_BIT _11 = BIT_ 11; // Res erved, do not count on value | |
913 | PAMD_BIT _12 = BIT_ 12; // Res erved, do not count on value | |
914 | PAMD_BIT _13 = BIT_ 13; // Res erved, do not count on value | |
915 | PAMD_BIT _14 = BIT_ 14; // Res erved, do not count on value | |
916 | PAMD_BIT _15 = BIT_ 15; // Res erved, do not count on value | |
917 | PAMD_BIT _16 = BIT_ 16; // Res erved, do not count on value | |
918 | PAMD_BIT _17 = BIT_ 17; // Res erved, do not count on value | |
919 | PAMD_BIT _18 = BIT_ 18; // Res erved, do not count on value | |
920 | PAMD_BIT _19 = BIT_ 19; // Res erved, do not count on value | |
921 | PAMD_BIT _20 = BIT_ 20; // Res erved, do not count on value | |
922 | PAMD_BIT _21 = BIT_ 21; // Res erved, do not count on value | |
923 | PAMD_BIT _22 = BIT_ 22; // Res erved, do not count on value | |
924 | PAMD_BIT _23 = BIT_ 23; // Res erved, do not count on value | |
925 | PAMD_BIT _24 = BIT_ 24; // Res erved, do not count on value | |
926 | PAMD_BIT _25 = BIT_ 25; // Res erved, do not count on value | |
927 | PAMD_BIT _26 = BIT_ 26; // Res erved, do not count on value | |
928 | PAMD_BIT _27 = BIT_ 27; // Res erved, do not count on value | |
929 | PAMD_BIT _28 = BIT_ 28; // Res erved, do not count on value | |
930 | PAMD_BIT _29 = BIT_ 29; // Res erved, do not count on value | |
931 | PAMD_BIT _30 = BIT_ 30; // Res erved, do not count on value | |
932 | PAMD_BIT _31 = BIT_ 31; // Res erved, do not count on value | |
933 | ||
934 | { AMD TL B and L1 A ssociativi ty constan ts } | |
935 | AMD_ASSO C_RESERVED = 0; | |
936 | AMD_ASSO C_DIRECT = 1; | |
937 | // 2 to 254 = dire ct value t o the asso ciativity | |
938 | AMD_ASSO C_FULLY = 255; | |
939 | ||
940 | { AMD L2 Cache Ass ociativity constants } | |
941 | AMD_L2_A SSOC_DISAB LED = 0; | |
942 | AMD_L2_A SSOC_DIREC T = 1; | |
943 | AMD_L2_A SSOC_2WAY = 2; | |
944 | AMD_L2_A SSOC_4WAY = 4; | |
945 | AMD_L2_A SSOC_8WAY = 6; | |
946 | AMD_L2_A SSOC_16WAY = 8; | |
947 | AMD_L2_A SSOC_32WAY = 10; | |
948 | AMD_L2_A SSOC_48WAY = 11; | |
949 | AMD_L2_A SSOC_64WAY = 12; | |
950 | AMD_L2_A SSOC_96WAY = 13; | |
951 | AMD_L2_A SSOC_128WA Y = 14; | |
952 | AMD_L2_A SSOC_FULLY = 15; | |
953 | ||
954 | // TODO AMD SVM an d LWP bits | |
955 | ||
956 | { VIA St andard Fea ture Flags } | |
957 | VIA_FPU = BIT_0; // FPU pre sent | |
958 | VIA_VME = BIT_1; // Virtual Mode Exte nsion | |
959 | VIA_DE = BIT_2; // Debuggi ng extensi ons | |
960 | VIA_PSE = BIT_3; // Page Si ze Extensi ons (4MB) | |
961 | VIA_TSC = BIT_4; // Time St amp Counte r | |
962 | VIA_MSR = BIT_5; // Model S pecific Re gisters | |
963 | VIA_PAE = BIT_6; // Physica l Address Extension | |
964 | VIA_MCE = BIT_7; // Machine Check Exc eption | |
965 | VIA_CX8 = BIT_8; // CMPXCHG 8B instruc tion | |
966 | VIA_APIC = BIT_9; // APIC su pported | |
967 | VIA_BIT_ 10 = BIT_10; // Reserve d, do not count on v alue | |
968 | VIA_SEP = BIT_11; // Fast Sy stem Call | |
969 | VIA_MTRR = BIT_12; // Memory Range Regi sters | |
970 | VIA_PTE = BIT_13; // PTE Glo bal Bit | |
971 | VIA_MCA = BIT_14; // Machine Check Arc hitecture | |
972 | VIA_CMOV E = BIT_15; // Conditi onal Move | |
973 | VIA_PAT = BIT_16; // Page At tribute Ta ble | |
974 | VIA_PSE2 = BIT_17; // 36-bit Page Size Extension | |
975 | VIA_SNUM = BIT_18; // Process or serial number | |
976 | VIA_BIT_ 19 = BIT_19; // Reserve d, do not count on v alue | |
977 | VIA_BIT_ 20 = BIT_20; // Reserve d, do not count on v alue | |
978 | VIA_BIT_ 21 = BIT_21; // Reserve d, do not count on v alue | |
979 | VIA_BIT_ 22 = BIT_22; // Reserve d, do not count on v alue | |
980 | VIA_MMX = BIT_23; // MMX | |
981 | VIA_FX = BIT_24; // FXSAVE and FXSTOR E instruct ions | |
982 | VIA_SSE = BIT_25; // Streami ng SIMD Ex tension | |
983 | VIA_BIT_ 26 = BIT_26; // Reserve d, do not count on v alue | |
984 | VIA_BIT_ 27 = BIT_27; // Reserve d, do not count on v alue | |
985 | VIA_BIT_ 28 = BIT_28; // Reserve d, do not count on v alue | |
986 | VIA_BIT_ 29 = BIT_29; // Reserve d, do not count on v alue | |
987 | VIA_BIT_ 30 = BIT_30; // Reserve d, do not count on v alue | |
988 | VIA_3DNO W = BIT_31; // 3DNow! Technology | |
989 | ||
990 | { VIA Ex tended Fea ture Flags } | |
991 | EVIA_AIS = BIT_ 0; // Alt ernate Ins truction S et | |
992 | EVIA_AIS E = BIT_ 1; // Alt ernate Ins truction S et Enabled | |
993 | EVIA_NO_ RNG = BIT_ 2; // NO Random Num ber Genera tor | |
994 | EVIA_RNG E = BIT_ 3; // Ran dom Number Generator Enabled | |
995 | EVIA_MSR = BIT_ 4; // Lon ghaul MSR 0x110A ava ilable | |
996 | EVIA_FEM MS = BIT_ 5; // FEM MS instruc tion Prese nt | |
997 | EVIA_NO_ ACE = BIT_ 6; // Adv anced Cryp tography E ngine NOT Present | |
998 | EVIA_ACE E = BIT_ 7; // ACE Enabled | |
999 | EVIA_BIT _8 = BIT_ 8; // Res erved, do not count on value | |
1000 | EVIA_BIT _9 = BIT_ 9; // Res erved, do not count on value | |
1001 | EVIA_BIT _10 = BIT_ 10; // Res erved, do not count on value | |
1002 | EVIA_BIT _11 = BIT_ 11; // Res erved, do not count on value | |
1003 | EVIA_BIT _12 = BIT_ 12; // Res erved, do not count on value | |
1004 | EVIA_BIT _13 = BIT_ 13; // Res erved, do not count on value | |
1005 | EVIA_BIT _14 = BIT_ 14; // Res erved, do not count on value | |
1006 | EVIA_BIT _15 = BIT_ 15; // Res erved, do not count on value | |
1007 | EVIA_BIT _16 = BIT_ 16; // Res erved, do not count on value | |
1008 | EVIA_BIT _17 = BIT_ 17; // Res erved, do not count on value | |
1009 | EVIA_BIT _18 = BIT_ 18; // Res erved, do not count on value | |
1010 | EVIA_BIT _19 = BIT_ 19; // Res erved, do not count on value | |
1011 | EVIA_BIT _20 = BIT_ 20; // Res erved, do not count on value | |
1012 | EVIA_BIT _21 = BIT_ 21; // Res erved, do not count on value | |
1013 | EVIA_BIT _22 = BIT_ 22; // Res erved, do not count on value | |
1014 | EVIA_BIT _23 = BIT_ 23; // Res erved, do not count on value | |
1015 | EVIA_BIT _24 = BIT_ 24; // Res erved, do not count on value | |
1016 | EVIA_BIT _25 = BIT_ 25; // Res erved, do not count on value | |
1017 | EVIA_BIT _26 = BIT_ 26; // Res erved, do not count on value | |
1018 | EVIA_BIT _27 = BIT_ 27; // Res erved, do not count on value | |
1019 | EVIA_BIT _28 = BIT_ 28; // Res erved, do not count on value | |
1020 | EVIA_BIT _29 = BIT_ 29; // Res erved, do not count on value | |
1021 | EVIA_BIT _30 = BIT_ 30; // Res erved, do not count on value | |
1022 | EVIA_BIT _31 = BIT_ 31; // Res erved, do not count on value | |
1023 | ||
1024 | { Cyrix Standard F eature Fla gs } | |
1025 | CYRIX_FP U = BIT _0; // Fl oating-Poi nt unit on chip | |
1026 | CYRIX_VM E = BIT _1; // Vi rtual Mode Extention | |
1027 | CYRIX_DE = BIT _2; // De bugging Ex tention | |
1028 | CYRIX_PS E = BIT _3; // Pa ge Size Ex tention | |
1029 | CYRIX_TS C = BIT _4; // Ti me Stamp C ounter | |
1030 | CYRIX_MS R = BIT _5; // Mo del Specif ic Registe rs | |
1031 | CYRIX_PA E = BIT _6; // Ph ysical Add ress Exten tion | |
1032 | CYRIX_MC E = BIT _7; // Ma chine Chec k Exceptio n | |
1033 | CYRIX_CX 8 = BIT _8; // CM PXCHG8 Ins truction | |
1034 | CYRIX_AP IC = BIT _9; // So ftware-acc essible lo cal APIC o n Chip | |
1035 | CYRIX_BI T_10 = BIT _10; // Re served, do not count on value | |
1036 | CYRIX_BI T_11 = BIT _11; // Re served, do not count on value | |
1037 | CYRIX_MT RR = BIT _12; // Me mory Type Range Regi sters | |
1038 | CYRIX_PG E = BIT _13; // Pa ge Global Enable | |
1039 | CYRIX_MC A = BIT _14; // Ma chine Chec k Architec ture | |
1040 | CYRIX_CM OV = BIT _15; // Co nditional Move Instr uction | |
1041 | CYRIX_BI T_16 = BIT _16; // Re served, do not count on value | |
1042 | CYRIX_BI T_17 = BIT _17; // Re served, do not count on value | |
1043 | CYRIX_BI T_18 = BIT _18; // Re served, do not count on value | |
1044 | CYRIX_BI T_19 = BIT _19; // Re served, do not count on value | |
1045 | CYRIX_BI T_20 = BIT _20; // Re served, do not count on value | |
1046 | CYRIX_BI T_21 = BIT _21; // Re served, do not count on value | |
1047 | CYRIX_BI T_22 = BIT _22; // Re served, do not count on value | |
1048 | CYRIX_MM X = BIT _23; // MM X technolo gy | |
1049 | CYRIX_BI T_24 = BIT _24; // Re served, do not count on value | |
1050 | CYRIX_BI T_25 = BIT _25; // Re served, do not count on value | |
1051 | CYRIX_BI T_26 = BIT _26; // Re served, do not count on value | |
1052 | CYRIX_BI T_27 = BIT _27; // Re served, do not count on value | |
1053 | CYRIX_BI T_28 = BIT _28; // Re served, do not count on value | |
1054 | CYRIX_BI T_29 = BIT _29; // Re served, do not count on value | |
1055 | CYRIX_BI T_30 = BIT _30; // Re served, do not count on value | |
1056 | CYRIX_BI T_31 = BIT _31; // Re served, do not count on value | |
1057 | ||
1058 | { Cyrix Enhanced F eature Fla gs } | |
1059 | ECYRIX_F PU = BI T_0; // F loating-Po int unit o n chip | |
1060 | ECYRIX_V ME = BI T_1; // V irtual Mod e Extentio n | |
1061 | ECYRIX_D E = BI T_2; // D ebugging E xtention | |
1062 | ECYRIX_P SE = BI T_3; // P age Size E xtention | |
1063 | ECYRIX_T SC = BI T_4; // T ime Stamp Counter | |
1064 | ECYRIX_M SR = BI T_5; // M odel Speci fic Regist ers | |
1065 | ECYRIX_P AE = BI T_6; // P hysical Ad dress Exte ntion | |
1066 | ECYRIX_M CE = BI T_7; // M achine Che ck Excepti on | |
1067 | ECYRIX_C X8 = BI T_8; // C MPXCHG8 In struction | |
1068 | ECYRIX_A PIC = BI T_9; // S oftware-ac cessible l ocal APIC on Chip | |
1069 | ECYRIX_S EP = BI T_10; // F ast System Call | |
1070 | ECYRIX_B IT_11 = BI T_11; // R eserved, d o not coun t on value | |
1071 | ECYRIX_M TRR = BI T_12; // M emory Type Range Reg isters | |
1072 | ECYRIX_P GE = BI T_13; // P age Global Enable | |
1073 | ECYRIX_M CA = BI T_14; // M achine Che ck Archite cture | |
1074 | ECYRIX_I CMOV = BI T_15; // I nteger Con ditional M ove Instru ction | |
1075 | ECYRIX_F CMOV = BI T_16; // F loating Po int Condit ional Move Instructi on | |
1076 | ECYRIX_B IT_17 = BI T_17; // R eserved, d o not coun t on value | |
1077 | ECYRIX_B IT_18 = BI T_18; // R eserved, d o not coun t on value | |
1078 | ECYRIX_B IT_19 = BI T_19; // R eserved, d o not coun t on value | |
1079 | ECYRIX_B IT_20 = BI T_20; // R eserved, d o not coun t on value | |
1080 | ECYRIX_B IT_21 = BI T_21; // R eserved, d o not coun t on value | |
1081 | ECYRIX_B IT_22 = BI T_22; // R eserved, d o not coun t on value | |
1082 | ECYRIX_M MX = BI T_23; // M MX technol ogy | |
1083 | ECYRIX_E MMX = BI T_24; // E xtended MM X Technolo gy | |
1084 | ECYRIX_B IT_25 = BI T_25; // R eserved, d o not coun t on value | |
1085 | ECYRIX_B IT_26 = BI T_26; // R eserved, d o not coun t on value | |
1086 | ECYRIX_B IT_27 = BI T_27; // R eserved, d o not coun t on value | |
1087 | ECYRIX_B IT_28 = BI T_28; // R eserved, d o not coun t on value | |
1088 | ECYRIX_B IT_29 = BI T_29; // R eserved, d o not coun t on value | |
1089 | ECYRIX_B IT_30 = BI T_30; // R eserved, d o not coun t on value | |
1090 | ECYRIX_B IT_31 = BI T_31; // R eserved, d o not coun t on value | |
1091 | ||
1092 | { Transm eta Featur es } | |
1093 | TRANSMET A_FPU = BIT_0; / / Floating -Point uni t on chip | |
1094 | TRANSMET A_VME = BIT_1; / / Virtual Mode Exten tion | |
1095 | TRANSMET A_DE = BIT_2; / / Debuggin g Extentio n | |
1096 | TRANSMET A_PSE = BIT_3; / / Page Siz e Extentio n | |
1097 | TRANSMET A_TSC = BIT_4; / / Time Sta mp Counter | |
1098 | TRANSMET A_MSR = BIT_5; / / Model Sp ecific Reg isters | |
1099 | TRANSMET A_BIT_6 = BIT_6; / / Reserved , do not c ount on va lue | |
1100 | TRANSMET A_BIT_7 = BIT_7; / / Reserved , do not c ount on va lue | |
1101 | TRANSMET A_CX8 = BIT_8; / / CMPXCHG8 Instructi on | |
1102 | TRANSMET A_BIT_9 = BIT_9; / / Reserved , do not c ount on va lue | |
1103 | TRANSMET A_BIT_10 = BIT_10; / / Reserved , do not c ount on va lue | |
1104 | TRANSMET A_SEP = BIT_11; / / Fast sys tem Call E xtensions | |
1105 | TRANSMET A_BIT_12 = BIT_12; / / Reserved , do not c ount on va lue | |
1106 | TRANSMET A_BIT_13 = BIT_13; / / Reserved , do not c ount on va lue | |
1107 | TRANSMET A_BIT_14 = BIT_14; / / Reserved , do not c ount on va lue | |
1108 | TRANSMET A_CMOV = BIT_15; / / Conditio nal Move I nstruction | |
1109 | TRANSMET A_BIT_16 = BIT_16; / / Reserved , do not c ount on va lue | |
1110 | TRANSMET A_BIT_17 = BIT_17; / / Reserved , do not c ount on va lue | |
1111 | TRANSMET A_PSN = BIT_18; / / Processo r Serial N umber | |
1112 | TRANSMET A_BIT_19 = BIT_19; / / Reserved , do not c ount on va lue | |
1113 | TRANSMET A_BIT_20 = BIT_20; / / Reserved , do not c ount on va lue | |
1114 | TRANSMET A_BIT_21 = BIT_21; / / Reserved , do not c ount on va lue | |
1115 | TRANSMET A_BIT_22 = BIT_22; / / Reserved , do not c ount on va lue | |
1116 | TRANSMET A_MMX = BIT_23; / / MMX tech nology | |
1117 | TRANSMET A_BIT_24 = BIT_24; / / Reserved , do not c ount on va lue | |
1118 | TRANSMET A_BIT_25 = BIT_25; / / Reserved , do not c ount on va lue | |
1119 | TRANSMET A_BIT_26 = BIT_26; / / Reserved , do not c ount on va lue | |
1120 | TRANSMET A_BIT_27 = BIT_27; / / Reserved , do not c ount on va lue | |
1121 | TRANSMET A_BIT_28 = BIT_28; / / Reserved , do not c ount on va lue | |
1122 | TRANSMET A_BIT_29 = BIT_29; / / Reserved , do not c ount on va lue | |
1123 | TRANSMET A_BIT_30 = BIT_30; / / Reserved , do not c ount on va lue | |
1124 | TRANSMET A_BIT_31 = BIT_31; / / Reserved , do not c ount on va lue | |
1125 | ||
1126 | { Extend ed Transme ta Feature s } | |
1127 | ETRANSME TA_FPU = BIT_0; // Floatin g-Point un it on chip | |
1128 | ETRANSME TA_VME = BIT_1; // Virtual Mode Exte ntion | |
1129 | ETRANSME TA_DE = BIT_2; // Debuggi ng Extenti on | |
1130 | ETRANSME TA_PSE = BIT_3; // Page Si ze Extenti on | |
1131 | ETRANSME TA_TSC = BIT_4; // Time St amp Counte r | |
1132 | ETRANSME TA_MSR = BIT_5; // Model S pecific Re gisters | |
1133 | ETRANSME TA_BIT_6 = BIT_6; // Reserve d, do not count on v alue | |
1134 | ETRANSME TA_BIT_7 = BIT_7; // Reserve d, do not count on v alue | |
1135 | ETRANSME TA_CX8 = BIT_8; // CMPXCHG 8 Instruct ion | |
1136 | ETRANSME TA_BIT_9 = BIT_9; // Reserve d, do not count on v alue | |
1137 | ETRANSME TA_BIT_10 = BIT_10; // Reserve d, do not count on v alue | |
1138 | ETRANSME TA_BIT_11 = BIT_11; // Reserve d, do not count on v alue | |
1139 | ETRANSME TA_BIT_12 = BIT_12; // Reserve d, do not count on v alue | |
1140 | ETRANSME TA_BIT_13 = BIT_13; // Reserve d, do not count on v alue | |
1141 | ETRANSME TA_BIT_14 = BIT_14; // Reserve d, do not count on v alue | |
1142 | ETRANSME TA_CMOV = BIT_15; // Conditi onal Move Instructio n | |
1143 | ETRANSME TA_FCMOV = BIT_16; // Float C onditional Move Inst ruction | |
1144 | ETRANSME TA_BIT_17 = BIT_17; // Reserve d, do not count on v alue | |
1145 | ETRANSME TA_BIT_18 = BIT_18; // Reserve d, do not count on v alue | |
1146 | ETRANSME TA_BIT_19 = BIT_19; // Reserve d, do not count on v alue | |
1147 | ETRANSME TA_BIT_20 = BIT_20; // Reserve d, do not count on v alue | |
1148 | ETRANSME TA_BIT_21 = BIT_21; // Reserve d, do not count on v alue | |
1149 | ETRANSME TA_BIT_22 = BIT_22; // Reserve d, do not count on v alue | |
1150 | ETRANSME TA_MMX = BIT_23; // MMX tec hnology | |
1151 | ETRANSME TA_BIT_24 = BIT_24; // Reserve d, do not count on v alue | |
1152 | ETRANSME TA_BIT_25 = BIT_25; // Reserve d, do not count on v alue | |
1153 | ETRANSME TA_BIT_26 = BIT_26; // Reserve d, do not count on v alue | |
1154 | ETRANSME TA_BIT_27 = BIT_27; // Reserve d, do not count on v alue | |
1155 | ETRANSME TA_BIT_28 = BIT_28; // Reserve d, do not count on v alue | |
1156 | ETRANSME TA_BIT_29 = BIT_29; // Reserve d, do not count on v alue | |
1157 | ETRANSME TA_BIT_30 = BIT_30; // Reserve d, do not count on v alue | |
1158 | ETRANSME TA_BIT_31 = BIT_31; // Reserve d, do not count on v alue | |
1159 | ||
1160 | { Transm eta Specif ic Feature s } | |
1161 | STRANSME TA_RECOVER Y = BIT_0; // Recov ery Mode | |
1162 | STRANSME TA_LONGRUN = BIT_1; // Long Run | |
1163 | STRANSME TA_BIT_2 = BIT_2; // Debug ging Exten tion | |
1164 | STRANSME TA_LRTI = BIT_3; // Long Run Table Interface | |
1165 | STRANSME TA_BIT_4 = BIT_4; // Reser ved, do no t count on value | |
1166 | STRANSME TA_BIT_5 = BIT_5; // Reser ved, do no t count on value | |
1167 | STRANSME TA_BIT_6 = BIT_6; // Reser ved, do no t count on value | |
1168 | STRANSME TA_PTTI1 = BIT_7; // Persi stent Tran slation Te chnology 1 .x | |
1169 | STRANSME TA_PTTI2 = BIT_8; // Persi stent Tran slation Te chnology 2 .0 | |
1170 | STRANSME TA_BIT_9 = BIT_9; // Reser ved, do no t count on value | |
1171 | STRANSME TA_BIT_10 = BIT_10 ; // Reser ved, do no t count on value | |
1172 | STRANSME TA_BIT_11 = BIT_11 ; // Reser ved, do no t count on value | |
1173 | STRANSME TA_BIT_12 = BIT_12 ; // Reser ved, do no t count on value | |
1174 | STRANSME TA_BIT_13 = BIT_13 ; // Reser ved, do no t count on value | |
1175 | STRANSME TA_BIT_14 = BIT_14 ; // Reser ved, do no t count on value | |
1176 | STRANSME TA_BIT_15 = BIT_15 ; // Reser ved, do no t count on value | |
1177 | STRANSME TA_BIT_16 = BIT_16 ; // Reser ved, do no t count on value | |
1178 | STRANSME TA_BIT_17 = BIT_17 ; // Reser ved, do no t count on value | |
1179 | STRANSME TA_BIT_18 = BIT_18 ; // Reser ved, do no t count on value | |
1180 | STRANSME TA_BIT_19 = BIT_19 ; // Reser ved, do no t count on value | |
1181 | STRANSME TA_BIT_20 = BIT_20 ; // Reser ved, do no t count on value | |
1182 | STRANSME TA_BIT_21 = BIT_21 ; // Reser ved, do no t count on value | |
1183 | STRANSME TA_BIT_22 = BIT_22 ; // Reser ved, do no t count on value | |
1184 | STRANSME TA_BIT_23 = BIT_23 ; // Reser ved, do no t count on value | |
1185 | STRANSME TA_BIT_24 = BIT_24 ; // Reser ved, do no t count on value | |
1186 | STRANSME TA_BIT_25 = BIT_25 ; // Reser ved, do no t count on value | |
1187 | STRANSME TA_BIT_26 = BIT_26 ; // Reser ved, do no t count on value | |
1188 | STRANSME TA_BIT_27 = BIT_27 ; // Reser ved, do no t count on value | |
1189 | STRANSME TA_BIT_28 = BIT_28 ; // Reser ved, do no t count on value | |
1190 | STRANSME TA_BIT_29 = BIT_29 ; // Reser ved, do no t count on value | |
1191 | STRANSME TA_BIT_30 = BIT_30 ; // Reser ved, do no t count on value | |
1192 | STRANSME TA_BIT_31 = BIT_31 ; // Reser ved, do no t count on value | |
1193 | ||
1194 | { Consta nts of bit s of the M XCSR regis ter - Inte l and AMD processors that supp ort SSE in structions } | |
1195 | MXCSR_IE = BIT_0; // Invalid O peration f lag | |
1196 | MXCSR_DE = BIT_1; // Denormal flag | |
1197 | MXCSR_ZE = BIT_2; // Divide by Zero flag | |
1198 | MXCSR_OE = BIT_3; // Overflow flag | |
1199 | MXCSR_UE = BIT_4; // Underflow flag | |
1200 | MXCSR_PE = BIT_5; // Precision flag | |
1201 | MXCSR_DA Z = BIT_6; // Denormal are Zero f lag | |
1202 | MXCSR_IM = BIT_7; // Invalid O peration m ask | |
1203 | MXCSR_DM = BIT_8; // Denormal mask | |
1204 | MXCSR_ZM = BIT_9; // Divide by Zero mask | |
1205 | MXCSR_OM = BIT_10 ; // Overflow mask | |
1206 | MXCSR_UM = BIT_11 ; // Underflow mask | |
1207 | MXCSR_PM = BIT_12 ; // Precision mask | |
1208 | MXCSR_RC 1 = BIT_13 ; // Rounding control, b it 1 | |
1209 | MXCSR_RC 2 = BIT_14 ; // Rounding control, b it 2 | |
1210 | MXCSR_RC = MXCSR_ RC1 or MXC SR_RC2; // Rounding control | |
1211 | MXCSR_FZ = BIT_15 ; // Flush to Zero | |
1212 | ||
1213 | const | |
1214 | IntelCac heDescript ion: array [0..102] of TCacheI nfo = ( | |
1215 | (D: $0 0; Family: cfOther; Size: 0 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 00), | |
1216 | (D: $0 1; Family: cfInstruc tionTLB; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 32; I : @RsIntel CacheDescr 01), | |
1217 | (D: $0 2; Family: cfInstruc tionTLB; Size: 4 096; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 2; I : @RsIntel CacheDescr 02), | |
1218 | (D: $0 3; Family: cfDataTLB ; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 64; I : @RsIntel CacheDescr 03), | |
1219 | (D: $0 4; Family: cfDataTLB ; Size: 4 096; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 8; I : @RsIntel CacheDescr 04), | |
1220 | (D: $0 5; Family: cfDataTLB ; Size: 4 096; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 32; I : @RsIntel CacheDescr 05), | |
1221 | (D: $0 6; Family: cfL1Instr uctionCach e; Size: 8 ; Ways OfAssoc: 4 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 06), | |
1222 | (D: $0 8; Family: cfL1Instr uctionCach e; Size: 1 6; Ways OfAssoc: 4 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 08), | |
1223 | (D: $0 9; Family: cfL1Instr uctionCach e; Size: 3 2; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 09), | |
1224 | (D: $0 A; Family: cfL1DataC ache; Size: 8 ; Ways OfAssoc: 2 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 0A), | |
1225 | (D: $0 B; Family: cfInstruc tionTLB; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 4; I : @RsIntel CacheDescr 0B), | |
1226 | (D: $0 C; Family: cfL1DataC ache; Size: 1 6; Ways OfAssoc: 4 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 0C), | |
1227 | (D: $0 D; Family: cfL1DataC ache; Size: 1 6; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 0D), | |
1228 | (D: $0 E; Family: cfL1DataC ache; Size: 2 4; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 0E), | |
1229 | (D: $2 1; Family: cfL2Cache ; Size: 2 56; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 21), | |
1230 | (D: $2 2; Family: cfL3Cache ; Size: 5 12; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 2; Entri es: 0; I : @RsIntel CacheDescr 22), | |
1231 | (D: $2 3; Family: cfL3Cache ; Size: 1 024; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 2; Entri es: 0; I : @RsIntel CacheDescr 23), | |
1232 | (D: $2 5; Family: cfL3Cache ; Size: 2 048; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 2; Entri es: 0; I : @RsIntel CacheDescr 25), | |
1233 | (D: $2 9; Family: cfL3Cache ; Size: 4 096; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 2; Entri es: 0; I : @RsIntel CacheDescr 29), | |
1234 | (D: $2 C; Family: cfL1DataC ache; Size: 3 2; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 2C), | |
1235 | (D: $3 0; Family: cfL1Instr uctionCach e; Size: 3 2; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 30), | |
1236 | (D: $3 9; Family: cfL2Cache ; Size: 1 28; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 39), | |
1237 | (D: $3 A; Family: cfL2Cache ; Size: 1 92; Ways OfAssoc: 6 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 3A), | |
1238 | (D: $3 B; Family: cfL2Cache ; Size: 1 28; Ways OfAssoc: 2 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 3B), | |
1239 | (D: $3 C; Family: cfL2Cache ; Size: 2 56; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 3C), | |
1240 | (D: $3 D; Family: cfL2Cache ; Size: 3 84; Ways OfAssoc: 6 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 3D), | |
1241 | (D: $3 E; Family: cfL2Cache ; Size: 5 12; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 3E), | |
1242 | (D: $4 0; Family: cfOther; Size: 0 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 40), | |
1243 | (D: $4 1; Family: cfL2Cache ; Size: 1 28; Ways OfAssoc: 4 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 41), | |
1244 | (D: $4 2; Family: cfL2Cache ; Size: 2 56; Ways OfAssoc: 4 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 42), | |
1245 | (D: $4 3; Family: cfL2Cache ; Size: 5 12; Ways OfAssoc: 4 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 43), | |
1246 | (D: $4 4; Family: cfL2Cache ; Size: 1 024; Ways OfAssoc: 4 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 44), | |
1247 | (D: $4 5; Family: cfL2Cache ; Size: 2 048; Ways OfAssoc: 4 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 45), | |
1248 | (D: $4 6; Family: cfL3Cache ; Size: 4 096; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 46), | |
1249 | (D: $4 7; Family: cfL3Cache ; Size: 8 192; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 47), | |
1250 | (D: $4 8; Family: cfL2Cache ; Size: 3 072; Ways OfAssoc: 1 2; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 48), | |
1251 | (D: $4 9; Family: cfL2Cache ; Size: 4 096; Ways OfAssoc: 1 6; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 49), | |
1252 | (D: $4 A; Family: cfL3Cache ; Size: 6 144; Ways OfAssoc: 1 2; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 4A), | |
1253 | (D: $4 B; Family: cfL3Cache ; Size: 8 192; Ways OfAssoc: 1 6; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 4B), | |
1254 | (D: $4 C; Family: cfL3Cache ; Size: 1 2288; Ways OfAssoc: 1 2; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 4C), | |
1255 | (D: $4 D; Family: cfL3Cache ; Size: 1 6384; Ways OfAssoc: 1 6; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 4D), | |
1256 | (D: $4 E; Family: cfL3Cache ; Size: 6 144; Ways OfAssoc: 2 4; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 4E), | |
1257 | (D: $4 F; Family: cfInstruc tionTLB; Size: 4 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 32; I : @RsIntel CacheDescr 4F), | |
1258 | (D: $5 0; Family: cfInstruc tionTLB; Size: 4 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 64; I : @RsIntel CacheDescr 50), | |
1259 | (D: $5 1; Family: cfInstruc tionTLB; Size: 4 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 128; I : @RsIntel CacheDescr 51), | |
1260 | (D: $5 2; Family: cfInstruc tionTLB; Size: 4 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 256; I : @RsIntel CacheDescr 52), | |
1261 | (D: $5 5; Family: cfInstruc tionTLB; Size: 2 048; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 7; I : @RsIntel CacheDescr 55), | |
1262 | (D: $5 6; Family: cfDataTLB ; Size: 4 096; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 16; I : @RsIntel CacheDescr 56), | |
1263 | (D: $5 7; Family: cfDataTLB ; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 16; I : @RsIntel CacheDescr 57), | |
1264 | (D: $5 9; Family: cfDataTLB ; Size: 4 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 16; I : @RsIntel CacheDescr 59), | |
1265 | (D: $5 A; Family: cfDataTLB ; Size: 4 096; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 32; I : @RsIntel CacheDescr 5A), | |
1266 | (D: $5 B; Family: cfDataTLB ; Size: 4 096; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 64; I : @RsIntel CacheDescr 5B), | |
1267 | (D: $5 C; Family: cfDataTLB ; Size: 4 096; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 128; I : @RsIntel CacheDescr 5C), | |
1268 | (D: $5 D; Family: cfDataTLB ; Size: 4 096; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 256; I : @RsIntel CacheDescr 5D), | |
1269 | (D: $6 0; Family: cfL1DataC ache; Size: 1 6; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 60), | |
1270 | (D: $6 6; Family: cfL1DataC ache; Size: 8 ; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 66), | |
1271 | (D: $6 7; Family: cfL1DataC ache; Size: 1 6; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 67), | |
1272 | (D: $6 8; Family: cfL1DataC ache; Size: 3 2; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 68), | |
1273 | (D: $7 0; Family: cfTrace; Size: 1 2; Ways OfAssoc: 8 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 70), | |
1274 | (D: $7 1; Family: cfTrace; Size: 1 6; Ways OfAssoc: 8 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 71), | |
1275 | (D: $7 2; Family: cfTrace; Size: 3 2; Ways OfAssoc: 8 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 72), | |
1276 | (D: $7 3; Family: cfTrace; Size: 6 4; Ways OfAssoc: 8 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 73), | |
1277 | (D: $7 6; Family: cfInstruc tionTLB; Size: 2 048; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 8; I : @RsIntel CacheDescr 76), | |
1278 | (D: $7 8; Family: cfL2Cache ; Size: 1 024; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 78), | |
1279 | (D: $7 9; Family: cfL2Cache ; Size: 1 28; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 2; Entri es: 0; I : @RsIntel CacheDescr 79), | |
1280 | (D: $7 A; Family: cfL2Cache ; Size: 2 56; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 2; Entri es: 0; I : @RsIntel CacheDescr 7A), | |
1281 | (D: $7 B; Family: cfL2Cache ; Size: 5 12; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 2; Entri es: 0; I : @RsIntel CacheDescr 7B), | |
1282 | (D: $7 C; Family: cfL2Cache ; Size: 1 024; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 2; Entri es: 0; I : @RsIntel CacheDescr 7C), | |
1283 | (D: $7 D; Family: cfL2Cache ; Size: 2 048; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 7D), | |
1284 | (D: $7 F; Family: cfL2Cache ; Size: 5 12; Ways OfAssoc: 2 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 7F), | |
1285 | (D: $8 0; Family: cfL2Cache ; Size: 5 12; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 80), | |
1286 | (D: $8 2; Family: cfL2Cache ; Size: 2 56; Ways OfAssoc: 8 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 82), | |
1287 | (D: $8 3; Family: cfL2Cache ; Size: 5 12; Ways OfAssoc: 8 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 83), | |
1288 | (D: $8 4; Family: cfL2Cache ; Size: 1 024; Ways OfAssoc: 8 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 84), | |
1289 | (D: $8 5; Family: cfL2Cache ; Size: 2 048; Ways OfAssoc: 8 ; LineSiz e: 32; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 85), | |
1290 | (D: $8 6; Family: cfL2Cache ; Size: 5 12; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 86), | |
1291 | (D: $8 7; Family: cfL2Cache ; Size: 1 024; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr 87), | |
1292 | (D: $B 0; Family: cfInstruc tionTLB; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 128; I : @RsIntel CacheDescr B0), | |
1293 | (D: $B 1; Family: cfInstruc tionTLB; Size: 2 048; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 8; I : @RsIntel CacheDescr B1), | |
1294 | (D: $B 2; Family: cfInstruc tionTLB; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 64; I : @RsIntel CacheDescr B2), | |
1295 | (D: $B 3; Family: cfDataTLB ; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 128; I : @RsIntel CacheDescr B3), | |
1296 | (D: $B 4; Family: cfDataTLB ; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 256; I : @RsIntel CacheDescr B4), | |
1297 | (D: $B A; Family: cfDataTLB ; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 64; I : @RsIntel CacheDescr BA), | |
1298 | (D: $C 0; Family: cfDataTLB ; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 8; I : @RsIntel CacheDescr C0), | |
1299 | (D: $C A; Family: cfL2TLB; Size: 4 ; Ways OfAssoc: 4 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 512; I : @RsIntel CacheDescr CA), | |
1300 | (D: $D 0; Family: cfL3Cache ; Size: 5 12; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr D0), | |
1301 | (D: $D 1; Family: cfL3Cache ; Size: 1 024; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr D1), | |
1302 | (D: $D 2; Family: cfL3Cache ; Size: 2 048; Ways OfAssoc: 4 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr D2), | |
1303 | (D: $D 6; Family: cfL3Cache ; Size: 1 024; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr D6), | |
1304 | (D: $D 7; Family: cfL3Cache ; Size: 2 048; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr D7), | |
1305 | (D: $D 8; Family: cfL3Cache ; Size: 4 096; Ways OfAssoc: 8 ; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr D8), | |
1306 | (D: $D C; Family: cfL3Cache ; Size: 1 536; Ways OfAssoc: 1 2; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr DC), | |
1307 | (D: $D D; Family: cfL3Cache ; Size: 3 072; Ways OfAssoc: 1 2; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr DD), | |
1308 | (D: $D E; Family: cfL3Cache ; Size: 6 144; Ways OfAssoc: 1 2; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr DE), | |
1309 | (D: $E 2; Family: cfL3Cache ; Size: 2 048; Ways OfAssoc: 1 6; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr E2), | |
1310 | (D: $E 3; Family: cfL3Cache ; Size: 4 096; Ways OfAssoc: 1 6; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr E3), | |
1311 | (D: $E 4; Family: cfL3Cache ; Size: 8 192; Ways OfAssoc: 1 6; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr E4), | |
1312 | (D: $E A; Family: cfL3Cache ; Size: 1 2288; Ways OfAssoc: 2 4; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr EA), | |
1313 | (D: $E B; Family: cfL3Cache ; Size: 1 8432; Ways OfAssoc: 2 4; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr EB), | |
1314 | (D: $E C; Family: cfL3Cache ; Size: 2 4576; Ways OfAssoc: 2 4; LineSiz e: 64; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr EC), | |
1315 | (D: $F 0; Family: cfOther; Size: 0 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr F0), | |
1316 | (D: $F 1; Family: cfOther; Size: 0 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr F1), | |
1317 | (D: $F F; Family: cfOther; Size: 0 ; Ways OfAssoc: 0 ; LineSiz e: 0; Lin ePerSector : 0; Entri es: 0; I : @RsIntel CacheDescr FF) | |
1318 | ); | |
1319 | ||
1320 | procedure GetCpuInfo (var CpuIn fo: TCpuIn fo); | |
1321 | ||
1322 | function G etIntelCac heDescript ion(const D: Byte): string; | |
1323 | function R oundFreque ncy(const Frequency: Integer): Integer; | |
1324 | {$IFDEF MS WINDOWS} | |
1325 | function G etCPUSpeed (var CpuSp eed: TFreq Info): Boo lean; | |
1326 | ||
1327 | type | |
1328 | TOSEnabl edFeature = (oefFPU, oefSSE, o efAVX); | |
1329 | TOSEnabl edFeatures = set of TOSEnabled Feature; | |
1330 | ||
1331 | function G etOSEnable dFeatures: TOSEnable dFeatures; | |
1332 | {$ENDIF MS WINDOWS} | |
1333 | function C PUID: TCpu Info; | |
1334 | function T estFDIVIns truction: Boolean; | |
1335 | ||
1336 | // Memory Informatio n | |
1337 | {$IFDEF MS WINDOWS} | |
1338 | function G etMaxAppAd dress: TJc lAddr; | |
1339 | function G etMinAppAd dress: TJc lAddr; | |
1340 | {$ENDIF MS WINDOWS} | |
1341 | function G etMemoryLo ad: Byte; | |
1342 | function G etSwapFile Size: Int6 4; | |
1343 | function G etSwapFile Usage: Byt e; | |
1344 | function G etTotalPhy sicalMemor y: Int64; | |
1345 | function G etFreePhys icalMemory : Int64; | |
1346 | {$IFDEF MS WINDOWS} | |
1347 | function G etTotalPag eFileMemor y: Int64; | |
1348 | function G etFreePage FileMemory : Int64; | |
1349 | function G etTotalVir tualMemory : Int64; | |
1350 | function G etFreeVirt ualMemory: Int64; | |
1351 | {$ENDIF MS WINDOWS} | |
1352 | ||
1353 | // Alloc g ranularity | |
1354 | procedure RoundToAll ocGranular ity64(var Value: Int 64; Up: Bo olean); | |
1355 | procedure RoundToAll ocGranular ityPtr(var Value: Po inter; Up: Boolean); | |
1356 | ||
1357 | {$IFDEF MS WINDOWS} | |
1358 | // Keyboar d Informat ion | |
1359 | function G etKeyState (const Vir tualKey: C ardinal): Boolean; | |
1360 | function G etNumLockK eyState: B oolean; | |
1361 | function G etScrollLo ckKeyState : Boolean; | |
1362 | function G etCapsLock KeyState: Boolean; | |
1363 | ||
1364 | // Windows 95/98/Me system res ources inf ormation | |
1365 | type | |
1366 | TFreeSys ResKind = (rtSystem, rtGdi, rt User); | |
1367 | TFreeSys temResourc es = recor d | |
1368 | System Res: Integ er; | |
1369 | GdiRes : Integer; | |
1370 | UserRe s: Integer ; | |
1371 | end; | |
1372 | ||
1373 | function I sSystemRes ourcesMete rPresent: Boolean; | |
1374 | ||
1375 | function G etFreeSyst emResource s(const Re sourceType : TFreeSys ResKind): Integer; o verload; | |
1376 | function G etFreeSyst emResource s: TFreeSy stemResour ces; overl oad; | |
1377 | function G etBPP: Car dinal; | |
1378 | ||
1379 | // Install ed program s informat ion | |
1380 | function P rogIDExist s(const Pr ogID: stri ng): Boole an; | |
1381 | function I sWordInsta lled: Bool ean; | |
1382 | function I sExcelInst alled: Boo lean; | |
1383 | function I sAccessIns talled: Bo olean; | |
1384 | function I sPowerPoin tInstalled : Boolean; | |
1385 | function I sFrontPage Installed: Boolean; | |
1386 | function I sOutlookIn stalled: B oolean; | |
1387 | function I sInternetE xplorerIns talled: Bo olean; | |
1388 | function I sMSProject Installed: Boolean; | |
1389 | function I sOpenOffic eInstalled : Boolean; | |
1390 | function I sLibreOffi ceInstalle d: Boolean ; | |
1391 | ||
1392 | {$ENDIF MS WINDOWS} | |
1393 | ||
1394 | // Public global var iables | |
1395 | var | |
1396 | Processo rCount: Ca rdinal = 0 ; | |
1397 | AllocGra nularity: Cardinal = 0; | |
1398 | PageSize : Cardinal = 0; | |
1399 | ||
1400 | {$IFDEF UN ITVERSIONI NG} | |
1401 | const | |
1402 | UnitVers ioning: TU nitVersion Info = ( | |
1403 | RCSfil e: '$URL$' ; | |
1404 | Revisi on: '$Revi sion$'; | |
1405 | Date: '$Date$'; | |
1406 | LogPat h: 'JCL\so urce\commo n'; | |
1407 | Extra: ''; | |
1408 | Data: nil | |
1409 | ); | |
1410 | {$ENDIF UN ITVERSIONI NG} | |
1411 | ||
1412 | implementa tion | |
1413 | ||
1414 | uses | |
1415 | {$IFDEF HAS_UNITSC OPE} | |
1416 | System.S ysUtils, S ystem.Math , | |
1417 | {$IFDEF MSWINDOWS} | |
1418 | Winapi.M essages, W inapi.Wins ock, Snmp, | |
1419 | {$IFDEF FPC} | |
1420 | JwaTlHel p32, JwaPs Api, | |
1421 | {$ELSE ~ FPC} | |
1422 | Winapi.T LHelp32, W inapi.PsAp i, | |
1423 | JclShell , | |
1424 | {$ENDIF ~FPC} | |
1425 | JclRegis try, JclWi n32, | |
1426 | {$ENDIF MSWINDOWS} | |
1427 | {$ELSE ~ HAS_UNITSC OPE} | |
1428 | SysUtils , | |
1429 | Math, | |
1430 | {$IFDEF MSWINDOWS} | |
1431 | Messages , Winsock, Snmp, | |
1432 | {$IFDEF FPC} | |
1433 | JwaTlHel p32, JwaPs Api, | |
1434 | {$ELSE ~ FPC} | |
1435 | TLHelp32 , PsApi, | |
1436 | JclShell , | |
1437 | {$ENDIF ~FPC} | |
1438 | JclRegis try, JclWi n32, | |
1439 | {$ENDIF MSWINDOWS} | |
1440 | {$ENDIF ~HAS_UNITS COPE} | |
1441 | Jcl8087, JclIniFil es, | |
1442 | JclSysUt ils, JclFi leUtils, J clAnsiStri ngs, JclSt rings; | |
1443 | ||
1444 | {$IFDEF FP C} | |
1445 | {$IFDEF MS WINDOWS} | |
1446 | ||
1447 | function P idlToPath( IdList: PI temIdList) : string; | |
1448 | begin | |
1449 | SetLengt h(Result, MAX_PATH); | |
1450 | if SHGet PathFromId List(IdLis t, PChar(R esult)) th en | |
1451 | StrRes etLength(R esult) | |
1452 | else | |
1453 | Result := ''; | |
1454 | end; | |
1455 | ||
1456 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- -------- | |
1457 | ||
1458 | function G etSpecialF olderLocat ion(const Folder: In teger): st ring; | |
1459 | var | |
1460 | FolderPi dl: PItemI dList; | |
1461 | begin | |
1462 | FolderPi dl := nil; | |
1463 | if Succe eded(SHGet SpecialFol derLocatio n(0, Folde r, FolderP idl)) then | |
1464 | begin | |
1465 | try | |
1466 | Resu lt := Pidl ToPath(Fol derPidl); | |
1467 | finall y | |
1468 | CoTa skMemFree( FolderPidl ); | |
1469 | end; | |
1470 | end | |
1471 | else | |
1472 | Result := ''; | |
1473 | end; | |
1474 | ||
1475 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- -------- | |
1476 | ||
1477 | {$ENDIF MS WINDOWS} | |
1478 | {$ENDIF FP C} | |
1479 | ||
1480 | //=== Envi ronment == ========== ========== ========== ========== ========== ======== | |
1481 | ||
1482 | function D elEnvironm entVar(con st Name: s tring): Bo olean; | |
1483 | begin | |
1484 | {$IFDEF UNIX} | |
1485 | UnSetEnv (PChar(Nam e)); | |
1486 | Result : = True; | |
1487 | {$ENDIF UNIX} | |
1488 | {$IFDEF MSWINDOWS} | |
1489 | Result : = SetEnvir onmentVari able(PChar (Name), ni l); | |
1490 | {$ENDIF MSWINDOWS} | |
1491 | end; | |
1492 | ||
1493 | function E xpandEnvir onmentVar( var Value: string): Boolean; | |
1494 | {$IFDEF UN IX} | |
1495 | begin | |
1496 | Result : = True; | |
1497 | end; | |
1498 | {$ENDIF UN IX} | |
1499 | {$IFDEF MS WINDOWS} | |
1500 | var | |
1501 | R: Integ er; | |
1502 | Expanded : string; | |
1503 | begin | |
1504 | SetLengt h(Expanded , 1); | |
1505 | R := Exp andEnviron mentString s(PChar(Va lue), PCha r(Expanded ), 0); | |
1506 | SetLengt h(Expanded , R); | |
1507 | Result : = ExpandEn vironmentS trings(PCh ar(Value), PChar(Exp anded), R) <> 0; | |
1508 | if Resul t then | |
1509 | begin | |
1510 | StrRes etLength(E xpanded); | |
1511 | Value := Expande d; | |
1512 | end; | |
1513 | end; | |
1514 | {$ENDIF MS WINDOWS} | |
1515 | ||
1516 | function E xpandEnvir onmentVarC ustom(var Value: str ing; Vars: TStrings) : Boolean; | |
1517 | ||
1518 | function FindClosi ngBrace(co nst R: str ing; var P osition: I nteger): B oolean; | |
1519 | var | |
1520 | Index, Len, Brac eCount: In teger; | |
1521 | Quotes : string; | |
1522 | begin | |
1523 | Len := Length(R) ; | |
1524 | BraceC ount := 0; | |
1525 | Quotes := ''; | |
1526 | while (Position <= Len) do | |
1527 | begin | |
1528 | // h andle quot es first | |
1529 | if ( R[Position ] = Native SingleQuot e) then | |
1530 | begi n | |
1531 | In dex := Jcl Strings.Ch arPos(Quot es, Native SingleQuot e); | |
1532 | if Index >= 0 then | |
1533 | SetLength( Quotes, In dex - 1) | |
1534 | el se | |
1535 | Quotes := Quotes + N ativeSingl eQuote; | |
1536 | end; | |
1537 | ||
1538 | if ( R[Position ] = Native DoubleQuot e) then | |
1539 | begi n | |
1540 | In dex := Jcl Strings.Ch arPos(Quot es, Native DoubleQuot e); | |
1541 | if Index >= 0 then | |
1542 | SetLength( Quotes, In dex - 1) | |
1543 | el se | |
1544 | Quotes := Quotes + N ativeDoubl eQuote; | |
1545 | end; | |
1546 | ||
1547 | if ( R[Position ] = '`') t hen | |
1548 | begi n | |
1549 | In dex := Jcl Strings.Ch arPos(Quot es, '`'); | |
1550 | if Index >= 0 then | |
1551 | SetLength( Quotes, In dex - 1) | |
1552 | el se | |
1553 | Quotes := Quotes + ' `'; | |
1554 | end; | |
1555 | ||
1556 | if Q uotes = '' then | |
1557 | begi n | |
1558 | if R[Positio n] = ')' t hen | |
1559 | be gin | |
1560 | Dec(BraceC ount); | |
1561 | if BraceCo unt = 0 th en | |
1562 | Break; | |
1563 | en d | |
1564 | el se | |
1565 | if R[Positio n] = '(' t hen | |
1566 | Inc(BraceC ount); | |
1567 | end; | |
1568 | Inc( Position); | |
1569 | end; | |
1570 | Result := Positi on <= Len; | |
1571 | ||
1572 | // Delp hi XE's Co deGear.Del phi.Target s has a bu g where th e closing paran is m issing | |
1573 | // "'$( DelphiWin3 2DebugDCUP ath'!=''". But it is still a v alid strin g and not worth | |
1574 | // an e xception. | |
1575 | // | |
1576 | // if P osition > Len then | |
1577 | // ra ise EJclMs BuildError .CreateRes Fmt(@RsEEn dOfString, [S]); | |
1578 | end; | |
1579 | ||
1580 | var | |
1581 | Start, P osition: I nteger; | |
1582 | Property Name, Prop ertyValue: string; | |
1583 | begin | |
1584 | Result : = True; | |
1585 | repeat | |
1586 | // sta rt with th e last mat ch in orde r to conve rt $(some$ (other)) | |
1587 | // eva luate prop erties | |
1588 | Start := StrLast Pos('$(', Value); | |
1589 | if Sta rt > 0 the n | |
1590 | begin | |
1591 | Posi tion := St art; | |
1592 | if n ot FindClo singBrace( Value, Pos ition) the n | |
1593 | Br eak; | |
1594 | Prop ertyName : = Copy(Val ue, Start + 2, Posit ion - Star t - 2); | |
1595 | ||
1596 | Prop ertyValue := Vars.Va lues[Prope rtyName]; | |
1597 | ||
1598 | if P ropertyVal ue <> '' t hen | |
1599 | St rReplace(V alue, | |
1600 | C opy(Value, Start, Po sition - S tart + 1), // $(Prop ertyName) | |
1601 | P ropertyVal ue, | |
1602 | [ rfReplaceA ll, rfIgno reCase]) | |
1603 | else | |
1604 | begi n | |
1605 | Re sult := Fa lse; | |
1606 | St art := 0; | |
1607 | end; | |
1608 | end; | |
1609 | until St art = 0; | |
1610 | end; | |
1611 | ||
1612 | {$IFDEF UN IX} | |
1613 | ||
1614 | function G etEnvironm entVar(con st Name: s tring; var Value: st ring): Boo lean; | |
1615 | begin | |
1616 | Value := getenv(PC har(Name)) ; | |
1617 | Result : = Value <> ''; | |
1618 | end; | |
1619 | ||
1620 | function G etEnvironm entVar(con st Name: s tring; var Value: st ring; Expa nd: Boolea n): Boolea n; | |
1621 | begin | |
1622 | Result : = GetEnvir onmentVar( Name, Valu e); // Exp and is the re just fo r x-platfo rm compati bility | |
1623 | end; | |
1624 | ||
1625 | {$ENDIF UN IX} | |
1626 | ||
1627 | {$IFDEF MS WINDOWS} | |
1628 | ||
1629 | function G etEnvironm entVar(con st Name: s tring; out Value: st ring): Boo lean; | |
1630 | begin | |
1631 | Result : = GetEnvir onmentVar( Name, Valu e, True); | |
1632 | end; | |
1633 | ||
1634 | function G etEnvironm entVar(con st Name: s tring; out Value: st ring; Expa nd: Boolea n): Boolea n; | |
1635 | var | |
1636 | R: DWORD ; | |
1637 | begin | |
1638 | R := {$I FDEF HAS_U NITSCOPE}W inapi.{$EN DIF}Window s.GetEnvir onmentVari able(PChar (Name), ni l, 0); | |
1639 | SetLengt h(Value, R ); | |
1640 | R := {$I FDEF HAS_U NITSCOPE}W inapi.{$EN DIF}Window s.GetEnvir onmentVari able(PChar (Name), PC har(Value) , R); | |
1641 | Result : = R <> 0; | |
1642 | if not R esult then | |
1643 | Value := '' | |
1644 | else | |
1645 | begin | |
1646 | SetLen gth(Value, R); | |
1647 | if Exp and then | |
1648 | Expa ndEnvironm entVar(Val ue); | |
1649 | end; | |
1650 | end; | |
1651 | ||
1652 | {$ENDIF MS WINDOWS} | |
1653 | ||
1654 | {$IFDEF LI NUX} | |
1655 | function G etEnvironm entVars(co nst Vars: TStrings): Boolean; | |
1656 | var | |
1657 | P: PPCha r; | |
1658 | begin | |
1659 | Vars.Beg inUpdate; | |
1660 | try | |
1661 | Vars.C lear; | |
1662 | P := S ystem.envp ; | |
1663 | Result := P <> n il; | |
1664 | while (P <> nil) and (P^ < > nil) do | |
1665 | begin | |
1666 | Vars .Add(P^); | |
1667 | Inc( P); | |
1668 | end; | |
1669 | finally | |
1670 | Vars.E ndUpdate; | |
1671 | end; | |
1672 | end; | |
1673 | ||
1674 | function G etEnvironm entVars(co nst Vars: TStrings; Expand: Bo olean): Bo olean; | |
1675 | begin | |
1676 | Result : = GetEnvir onmentVars (Vars); // Expand is there jus t for x-pl atform com patibility | |
1677 | end; | |
1678 | {$ENDIF LI NUX} | |
1679 | ||
1680 | {$IFDEF MS WINDOWS} | |
1681 | function G etEnvironm entVars(co nst Vars: TStrings): Boolean; | |
1682 | begin | |
1683 | Result : = GetEnvir onmentVars (Vars, Tru e); | |
1684 | end; | |
1685 | ||
1686 | function G etEnvironm entVars(co nst Vars: TStrings; Expand: Bo olean): Bo olean; | |
1687 | var | |
1688 | Raw: PCh ar; | |
1689 | Expanded : string; | |
1690 | I: Integ er; | |
1691 | begin | |
1692 | Vars.Beg inUpdate; | |
1693 | try | |
1694 | Vars.C lear; | |
1695 | Raw := GetEnviro nmentStrin gs; | |
1696 | try | |
1697 | Mult iSzToStrin gs(Vars, R aw); | |
1698 | Resu lt := True ; | |
1699 | finall y | |
1700 | Free Environmen tStrings(R aw); | |
1701 | end; | |
1702 | if Exp and then | |
1703 | begin | |
1704 | for I := 0 to Vars.Count - 1 do | |
1705 | begi n | |
1706 | Ex panded := Vars[I]; | |
1707 | if ExpandEnv ironmentVa r(Expanded ) then | |
1708 | Vars[I] := Expanded; | |
1709 | end; | |
1710 | end; | |
1711 | finally | |
1712 | Vars.E ndUpdate; | |
1713 | end; | |
1714 | end; | |
1715 | ||
1716 | {$ENDIF MS WINDOWS} | |
1717 | ||
1718 | function S etEnvironm entVar(con st Name, V alue: stri ng): Boole an; | |
1719 | begin | |
1720 | {$IFDEF UNIX} | |
1721 | SetEnv(P Char(Name) , PChar(Va lue), 1); | |
1722 | Result : = True; | |
1723 | {$ENDIF UNIX} | |
1724 | {$IFDEF MSWINDOWS} | |
1725 | Result : = SetEnvir onmentVari able(PChar (Name), PC har(Value) ); | |
1726 | {$ENDIF MSWINDOWS} | |
1727 | end; | |
1728 | ||
1729 | {$IFDEF MS WINDOWS} | |
1730 | ||
1731 | function C reateEnvir onmentBloc k(const Op tions: TEn vironmentO ptions; co nst Additi onalVars: TStrings): PChar; | |
1732 | const | |
1733 | RegLocal Environmen t = 'SYSTE M\CurrentC ontrolSet\ Control\Se ssion Mana ger\Enviro nment'; | |
1734 | RegUserE nvironment = '\Envir onment\'; | |
1735 | var | |
1736 | KeyNames , TempList : TStrings ; | |
1737 | Temp, Na me, Value: string; | |
1738 | I: Integ er; | |
1739 | begin | |
1740 | TempList := TStrin gList.Crea te; | |
1741 | try | |
1742 | // add additiona l environm ent variab les | |
1743 | if eoA dditional in Options then | |
1744 | for I := 0 to Additional Vars.Count - 1 do | |
1745 | begi n | |
1746 | Te mp := Addi tionalVars [I]; | |
1747 | Ex pandEnviro nmentVar(T emp); | |
1748 | Te mpList.Add (Temp); | |
1749 | end; | |
1750 | // get environme nt strings from loca l machine | |
1751 | if eoL ocalMachin e in Optio ns then | |
1752 | begin | |
1753 | KeyN ames := TS tringList. Create; | |
1754 | try | |
1755 | if RegGetVal ueNames(HK EY_LOCAL_M ACHINE, Re gLocalEnvi ronment, K eyNames) t hen | |
1756 | be gin | |
1757 | for I := 0 to KeyNam es.Count - 1 do | |
1758 | begin | |
1759 | Name := KeyNames[I ]; | |
1760 | Value := RegReadSt ring(HKEY_ LOCAL_MACH INE, RegLo calEnviron ment, Name ); | |
1761 | ExpandEn vironmentV ar(Value); | |
1762 | TempList .Add(Name + '=' + Va lue); | |
1763 | end; | |
1764 | en d; | |
1765 | fina lly | |
1766 | Fr eeAndNil(K eyNames); | |
1767 | end; | |
1768 | end; | |
1769 | // get environme nt strings from curr ent user | |
1770 | if eoC urrentUser in Option s then | |
1771 | begin | |
1772 | KeyN ames := TS tringLIst. Create; | |
1773 | try | |
1774 | if RegGetVal ueNames(HK EY_CURRENT _USER, Reg UserEnviro nment, Key Names) the n | |
1775 | be gin | |
1776 | for I := 0 to KeyNam es.Count - 1 do | |
1777 | begin | |
1778 | Name := KeyNames[I ]; | |
1779 | Value := RegReadSt ring(HKEY_ CURRENT_US ER, RegUse rEnvironme nt, Name); | |
1780 | ExpandEn vironmentV ar(Value); | |
1781 | TempList .Add(Name + '=' + Va lue); | |
1782 | end; | |
1783 | en d; | |
1784 | fina lly | |
1785 | Ke yNames.Fre e; | |
1786 | end; | |
1787 | end; | |
1788 | // tra nsform str inglist in to multi-P Char | |
1789 | Result := nil; | |
1790 | String sToMultiSz (Result, T empList); | |
1791 | finally | |
1792 | FreeAn dNil(TempL ist); | |
1793 | end; | |
1794 | end; | |
1795 | ||
1796 | // frees a n environm ent block allocated by CreateE nvironment Block and | |
1797 | // sets En v to nil | |
1798 | ||
1799 | procedure DestroyEnv ironmentBl ock(var En v: PChar); | |
1800 | begin | |
1801 | FreeMult iSz(Env); | |
1802 | end; | |
1803 | ||
1804 | procedure SetGlobalE nvironment Variable(V ariableNam e, Variabl eContent: string); | |
1805 | const | |
1806 | cEnviron ment = 'En vironment' ; | |
1807 | begin | |
1808 | if Varia bleName = '' then | |
1809 | Exit; | |
1810 | if Varia bleContent = '' then | |
1811 | begin | |
1812 | RegDel eteEntry(H KEY_CURREN T_USER, cE nvironment , Variable Name); | |
1813 | SetEnv ironmentVa riable(PCh ar(Variabl eName), ni l); | |
1814 | end | |
1815 | else | |
1816 | begin | |
1817 | RegWri teString(H KEY_CURREN T_USER, cE nvironment , Variable Name, Vari ableConten t); | |
1818 | SetEnv ironmentVa riable(PCh ar(Variabl eName), PC har(Variab leContent) ); | |
1819 | end; | |
1820 | SendMess age(HWND_B ROADCAST, WM_SETTING CHANGE, 0, LPARAM(PC har(cEnvir onment))); | |
1821 | end; | |
1822 | ||
1823 | //=== Comm on Folders ========= ========== ========== ========== ========== ======== | |
1824 | ||
1825 | // Utility function which retu rns the Wi ndows inde pendent Cu rrentVersi on key | |
1826 | // inside HKEY_LOCAL _MACHINE | |
1827 | ||
1828 | const | |
1829 | HKLM_CUR RENT_VERSI ON_WINDOWS = 'SOFTWA RE\Microso ft\Windows \CurrentVe rsion'; | |
1830 | HKLM_CUR RENT_VERSI ON_NT = 'SOFTWA RE\Microso ft\Windows NT\Curren tVersion'; | |
1831 | ||
1832 | function R EG_CURRENT _VERSION: string; | |
1833 | begin | |
1834 | if IsWin NT then | |
1835 | Result := HKLM_C URRENT_VER SION_NT | |
1836 | else | |
1837 | Result := HKLM_C URRENT_VER SION_WINDO WS; | |
1838 | end; | |
1839 | ||
1840 | { TODO : C heck for d ocumented solution } | |
1841 | function G etCommonFi lesFolder: string; | |
1842 | begin | |
1843 | Result : = RegReadS tringDef(H KEY_LOCAL_ MACHINE, H KLM_CURREN T_VERSION_ WINDOWS, | |
1844 | 'Commo nFilesDir' , ''); | |
1845 | end; | |
1846 | ||
1847 | {$ENDIF MS WINDOWS} | |
1848 | ||
1849 | function G etCurrentF older: str ing; | |
1850 | {$IFDEF UN IX} | |
1851 | const | |
1852 | InitialS ize = 64; | |
1853 | var | |
1854 | Size: In teger; | |
1855 | begin | |
1856 | Size := InitialSiz e; | |
1857 | while Tr ue do | |
1858 | begin | |
1859 | SetLen gth(Result , Size); | |
1860 | if get cwd(PChar( Result), S ize) <> ni l then | |
1861 | begin | |
1862 | StrR esetLength (Result); | |
1863 | Exit ; | |
1864 | end; | |
1865 | {$IFDE F FPC} | |
1866 | if Get LastOSErro r <> ERANG E then | |
1867 | {$ELSE ~FPC} | |
1868 | if Get LastError <> ERANGE then | |
1869 | {$ENDI F ~FPC} | |
1870 | Rais eLastOSErr or; | |
1871 | Size : = Size * 2 ; | |
1872 | end; | |
1873 | end; | |
1874 | {$ENDIF UN IX} | |
1875 | {$IFDEF MS WINDOWS} | |
1876 | var | |
1877 | Required : Cardinal ; | |
1878 | begin | |
1879 | Result : = ''; | |
1880 | Required := GetCur rentDirect ory(0, nil ); | |
1881 | if Requi red <> 0 t hen | |
1882 | begin | |
1883 | SetLen gth(Result , Required ); | |
1884 | GetCur rentDirect ory(Requir ed, PChar( Result)); | |
1885 | StrRes etLength(R esult); | |
1886 | end; | |
1887 | end; | |
1888 | {$ENDIF MS WINDOWS} | |
1889 | ||
1890 | {$IFDEF MS WINDOWS} | |
1891 | { TODO : C heck for d ocumented solution } | |
1892 | function G etProgramF ilesFolder : string; | |
1893 | begin | |
1894 | Result : = RegReadS tringDef(H KEY_LOCAL_ MACHINE, H KLM_CURREN T_VERSION_ WINDOWS, ' ProgramFil esDir', '' ); | |
1895 | end; | |
1896 | ||
1897 | { TODO : C heck for d ocumented solution } | |
1898 | function G etWindowsF older: str ing; | |
1899 | var | |
1900 | Required : Cardinal ; | |
1901 | begin | |
1902 | Result : = ''; | |
1903 | Required := GetWin dowsDirect ory(nil, 0 ); | |
1904 | if Requi red <> 0 t hen | |
1905 | begin | |
1906 | SetLen gth(Result , Required ); | |
1907 | GetWin dowsDirect ory(PChar( Result), R equired); | |
1908 | StrRes etLength(R esult); | |
1909 | end; | |
1910 | end; | |
1911 | ||
1912 | { TODO : C heck for d ocumented solution } | |
1913 | function G etWindowsS ystemFolde r: string; | |
1914 | var | |
1915 | Required : Cardinal ; | |
1916 | begin | |
1917 | Result : = ''; | |
1918 | Required := GetSys temDirecto ry(nil, 0) ; | |
1919 | if Requi red <> 0 t hen | |
1920 | begin | |
1921 | SetLen gth(Result , Required ); | |
1922 | GetSys temDirecto ry(PChar(R esult), Re quired); | |
1923 | StrRes etLength(R esult); | |
1924 | end; | |
1925 | end; | |
1926 | ||
1927 | function G etWindowsT empFolder: string; | |
1928 | begin | |
1929 | Result : = PathRemo veSeparato r(PathGetT empPath); | |
1930 | end; | |
1931 | ||
1932 | function G etDesktopF older: str ing; | |
1933 | begin | |
1934 | Result : = GetSpeci alFolderLo cation(CSI DL_DESKTOP ); | |
1935 | end; | |
1936 | ||
1937 | { TODO : C heck GetPr ogramsFold er = GetPr ogramFiles Folder } | |
1938 | function G etPrograms Folder: st ring; | |
1939 | begin | |
1940 | Result : = GetSpeci alFolderLo cation(CSI DL_PROGRAM S); | |
1941 | end; | |
1942 | ||
1943 | {$ENDIF MS WINDOWS} | |
1944 | function G etPersonal Folder: st ring; | |
1945 | begin | |
1946 | {$IFDEF UNIX} | |
1947 | Result : = GetEnvir onmentVari able('HOME '); | |
1948 | {$ENDIF UNIX} | |
1949 | {$IFDEF MSWINDOWS} | |
1950 | Result : = GetSpeci alFolderLo cation(CSI DL_PERSONA L); | |
1951 | {$ENDIF MSWINDOWS} | |
1952 | end; | |
1953 | ||
1954 | {$IFDEF MS WINDOWS} | |
1955 | function G etFavorite sFolder: s tring; | |
1956 | begin | |
1957 | Result : = GetSpeci alFolderLo cation(CSI DL_FAVORIT ES); | |
1958 | end; | |
1959 | ||
1960 | function G etStartupF older: str ing; | |
1961 | begin | |
1962 | Result : = GetSpeci alFolderLo cation(CSI DL_STARTUP ); | |
1963 | end; | |
1964 | ||
1965 | function G etRecentFo lder: stri ng; | |
1966 | begin | |
1967 | Result : = GetSpeci alFolderLo cation(CSI DL_RECENT) ; | |
1968 | end; | |
1969 | ||
1970 | function G etSendToFo lder: stri ng; | |
1971 | begin | |
1972 | Result : = GetSpeci alFolderLo cation(CSI DL_SENDTO) ; | |
1973 | end; | |
1974 | ||
1975 | function G etStartmen uFolder: s tring; | |
1976 | begin | |
1977 | Result : = GetSpeci alFolderLo cation(CSI DL_STARTME NU); | |
1978 | end; | |
1979 | ||
1980 | function G etDesktopD irectoryFo lder: stri ng; | |
1981 | begin | |
1982 | Result : = GetSpeci alFolderLo cation(CSI DL_DESKTOP DIRECTORY) ; | |
1983 | end; | |
1984 | ||
1985 | function G etCommonDo cumentsFol der: strin g; | |
1986 | begin | |
1987 | Result : = GetSpeci alFolderLo cation(CSI DL_COMMON_ DOCUMENTS) ; | |
1988 | end; | |
1989 | ||
1990 | function G etNethoodF older: str ing; | |
1991 | begin | |
1992 | Result : = GetSpeci alFolderLo cation(CSI DL_NETHOOD ); | |
1993 | end; | |
1994 | ||
1995 | function G etFontsFol der: strin g; | |
1996 | begin | |
1997 | Result : = GetSpeci alFolderLo cation(CSI DL_FONTS); | |
1998 | end; | |
1999 | ||
2000 | function G etCommonSt artmenuFol der: strin g; | |
2001 | begin | |
2002 | Result : = GetSpeci alFolderLo cation(CSI DL_COMMON_ STARTMENU) ; | |
2003 | end; | |
2004 | ||
2005 | function G etCommonPr ogramsFold er: string ; | |
2006 | begin | |
2007 | Result : = GetSpeci alFolderLo cation(CSI DL_COMMON_ PROGRAMS); | |
2008 | end; | |
2009 | ||
2010 | function G etCommonSt artupFolde r: string; | |
2011 | begin | |
2012 | Result : = GetSpeci alFolderLo cation(CSI DL_COMMON_ STARTUP); | |
2013 | end; | |
2014 | ||
2015 | function G etCommonDe sktopdirec toryFolder : string; | |
2016 | begin | |
2017 | Result : = GetSpeci alFolderLo cation(CSI DL_COMMON_ DESKTOPDIR ECTORY); | |
2018 | end; | |
2019 | ||
2020 | function G etCommonAp pdataFolde r: string; | |
2021 | begin | |
2022 | Result : = GetSpeci alFolderLo cation(CSI DL_COMMON_ APPDATA); | |
2023 | end; | |
2024 | ||
2025 | function G etAppdataF older: str ing; | |
2026 | begin | |
2027 | Result : = GetSpeci alFolderLo cation(CSI DL_APPDATA ); | |
2028 | end; | |
2029 | ||
2030 | function G etLocalApp Data: stri ng; | |
2031 | begin | |
2032 | Result : = GetSpeci alFolderLo cation(CSI DL_LOCAL_A PPDATA); | |
2033 | end; | |
2034 | ||
2035 | function G etPrinthoo dFolder: s tring; | |
2036 | begin | |
2037 | Result : = GetSpeci alFolderLo cation(CSI DL_PRINTHO OD); | |
2038 | end; | |
2039 | ||
2040 | function G etCommonFa voritesFol der: strin g; | |
2041 | begin | |
2042 | Result : = GetSpeci alFolderLo cation(CSI DL_COMMON_ FAVORITES) ; | |
2043 | end; | |
2044 | ||
2045 | function G etTemplate sFolder: s tring; | |
2046 | begin | |
2047 | Result : = GetSpeci alFolderLo cation(CSI DL_TEMPLAT ES); | |
2048 | end; | |
2049 | ||
2050 | function G etInternet CacheFolde r: string; | |
2051 | begin | |
2052 | Result : = GetSpeci alFolderLo cation(CSI DL_INTERNE T_CACHE); | |
2053 | end; | |
2054 | ||
2055 | function G etCookiesF older: str ing; | |
2056 | begin | |
2057 | Result : = GetSpeci alFolderLo cation(CSI DL_COOKIES ); | |
2058 | end; | |
2059 | ||
2060 | function G etHistoryF older: str ing; | |
2061 | begin | |
2062 | Result : = GetSpeci alFolderLo cation(CSI DL_HISTORY ); | |
2063 | end; | |
2064 | ||
2065 | function G etProfileF older: str ing; | |
2066 | begin | |
2067 | Result : = GetSpeci alFolderLo cation(CSI DL_PROFILE ); | |
2068 | end; | |
2069 | ||
2070 | // the fol lowing spe cial folde rs are pur e virtual and cannot be | |
2071 | // mapped to a direc tory path: | |
2072 | // CSIDL_I NTERNET | |
2073 | // CSIDL_C ONTROLS | |
2074 | // CSIDL_P RINTERS | |
2075 | // CSIDL_B ITBUCKET | |
2076 | // CSIDL_D RIVES | |
2077 | // CSIDL_N ETWORK | |
2078 | // CSIDL_A LTSTARTUP | |
2079 | // CSIDL_C OMMON_ALTS TARTUP | |
2080 | ||
2081 | // Identif ication | |
2082 | type | |
2083 | TVolumeI nfoKind = (vikName, vikSerial, vikFileSy stem); | |
2084 | ||
2085 | function G etVolumeIn foHelper(c onst Drive : string; InfoKind: TVolumeInf oKind): st ring; | |
2086 | var | |
2087 | VolumeSe rialNumber : DWORD; | |
2088 | MaximumC omponentLe ngth: DWOR D; | |
2089 | Flags: D WORD; | |
2090 | Name: ar ray [0..MA X_PATH] of Char; | |
2091 | FileSyst em: array [0..15] of Char; | |
2092 | ErrorMod e: Cardina l; | |
2093 | DriveStr : string; | |
2094 | begin | |
2095 | { TODO : Change to RootPath } | |
2096 | { TODO : Perform b etter chec king of Dr ive param or documen t that no checking | |
2097 | is per formed. RM Suggested : | |
2098 | DriveS tr := Driv e; | |
2099 | if (Le ngth(Drive ) < 2) or (Drive[2] <> ':') th en | |
2100 | Driv eStr := Ge tCurrentFo lder; | |
2101 | DriveS tr := Dri veStr[1] + ':\'; } | |
2102 | Result : = ''; | |
2103 | DriveStr := Drive + ':\'; | |
2104 | ErrorMod e := SetEr rorMode(SE M_FAILCRIT ICALERRORS ); | |
2105 | try | |
2106 | Flags := 0; | |
2107 | Maximu mComponent Length := 0; | |
2108 | if Get VolumeInfo rmation(PC har(DriveS tr), Name, SizeOf(Na me), @Volu meSerialNu mber, | |
2109 | Maxi mumCompone ntLength, Flags, Fil eSystem, S izeOf(File System)) t hen | |
2110 | case I nfoKind of | |
2111 | vikN ame: | |
2112 | Re sult := St rPas(Name) ; | |
2113 | vikS erial: | |
2114 | be gin | |
2115 | Result := IntToHex(H iWord(Volu meSerialNu mber), 4) + '-' + | |
2116 | IntToHex(L oWord(Volu meSerialNu mber), 4); | |
2117 | en d; | |
2118 | vikF ileSystem: | |
2119 | Re sult := St rPas(FileS ystem); | |
2120 | end; | |
2121 | finally | |
2122 | SetErr orMode(Err orMode); | |
2123 | end; | |
2124 | end; | |
2125 | ||
2126 | function G etVolumeNa me(const D rive: stri ng): strin g; | |
2127 | begin | |
2128 | Result : = GetVolum eInfoHelpe r(Drive, v ikName); | |
2129 | end; | |
2130 | ||
2131 | function G etVolumeSe rialNumber (const Dri ve: string ): string; | |
2132 | begin | |
2133 | Result : = GetVolum eInfoHelpe r(Drive, v ikSerial); | |
2134 | end; | |
2135 | ||
2136 | function G etVolumeFi leSystem(c onst Drive : string): string; | |
2137 | begin | |
2138 | Result : = GetVolum eInfoHelpe r(Drive, v ikFileSyst em); | |
2139 | end; | |
2140 | ||
2141 | { TODO -cH elp : Dona tor (incl. TFileSyst emFlag[s]) : Robert R ossmair } | |
2142 | ||
2143 | function G etVolumeFi leSystemFl ags(const Volume: st ring): TFi leSystemFl ags; | |
2144 | const | |
2145 | FileSyst emFlags: a rray [TFil eSystemFla g] of DWOR D = | |
2146 | ( FILE _CASE_SENS ITIVE_SEAR CH, // f sCaseSensi tive | |
2147 | FILE _CASE_PRES ERVED_NAME S, // f sCasePrese rvedNames | |
2148 | FILE _UNICODE_O N_DISK, // f sSupportsU nicodeOnDi sk | |
2149 | FILE _PERSISTEN T_ACLS, // f sPersisten tACLs | |
2150 | FILE _FILE_COMP RESSION, // f sSupportsF ileCompres sion | |
2151 | FILE _VOLUME_QU OTAS, // f sSupportsV olumeQuota s | |
2152 | FILE _SUPPORTS_ SPARSE_FIL ES, // f sSupportsS parseFiles | |
2153 | FILE _SUPPORTS_ REPARSE_PO INTS, // f sSupportsR eparsePoin ts | |
2154 | FILE _SUPPORTS_ REMOTE_STO RAGE, // f sSupportsR emoteStora ge | |
2155 | FILE _VOLUME_IS _COMPRESSE D, // f sVolumeIsC ompressed | |
2156 | FILE _SUPPORTS_ OBJECT_IDS , // f sSupportsO bjectIds | |
2157 | FILE _SUPPORTS_ ENCRYPTION , // f sSupportsE ncryption | |
2158 | FILE _NAMED_STR EAMS, // f sSupportsN amedStream s | |
2159 | FILE _READ_ONLY _VOLUME // f sVolumeIsR eadOnly | |
2160 | ); | |
2161 | var | |
2162 | MaximumC omponentLe ngth, Flag s: Cardina l; | |
2163 | Flag: TF ileSystemF lag; | |
2164 | begin | |
2165 | Flags := 0; | |
2166 | MaximumC omponentLe ngth := 0; | |
2167 | if not G etVolumeIn formation( PChar(Path AddSeparat or(Volume) ), nil, 0, nil, | |
2168 | Maximu mComponent Length, Fl ags, nil, 0) then | |
2169 | RaiseL astOSError ; | |
2170 | Result : = []; | |
2171 | for Flag := Low(TF ileSystemF lag) to Hi gh(TFileSy stemFlag) do | |
2172 | if (Fl ags and Fi leSystemFl ags[Flag]) <> 0 then | |
2173 | Incl ude(Result , Flag); | |
2174 | end; | |
2175 | ||
2176 | {$ENDIF MS WINDOWS} | |
2177 | ||
2178 | { TODO -cD oc: Contri butor: twm } | |
2179 | ||
2180 | function G etIPAddres s(const Ho stName: st ring): str ing; | |
2181 | var | |
2182 | {$IFDEF MSWINDOWS} | |
2183 | R: Integ er; | |
2184 | WSAData: TWSAData; | |
2185 | {$ENDIF MSWINDOWS} | |
2186 | HostEnt: PHostEnt; | |
2187 | Host: An siString; | |
2188 | SockAddr : TSockAdd rIn; | |
2189 | begin | |
2190 | Result : = ''; | |
2191 | {$IFDEF MSWINDOWS} | |
2192 | WSAData. wVersion : = 0; | |
2193 | R := WSA Startup(Ma keWord(1, 1), WSADat a); | |
2194 | if R = 0 then | |
2195 | try | |
2196 | {$ENDIF MSWINDOWS} | |
2197 | Host := AnsiSt ring(HostN ame); | |
2198 | if H ost = '' t hen | |
2199 | begi n | |
2200 | Se tLength(Ho st, MAX_PA TH); | |
2201 | Ge tHostName( PAnsiChar( Host), MAX _PATH); | |
2202 | end; | |
2203 | Host Ent := Get HostByName (PAnsiChar (Host)); | |
2204 | if H ostEnt <> nil then | |
2205 | begi n | |
2206 | So ckAddr.sin _addr.S_ad dr := Long int(PLongi nt(HostEnt ^.h_addr_l ist^)^); | |
2207 | Re sult := st ring(AnsiS tring(inet _ntoa(Sock Addr.sin_a ddr))); | |
2208 | end; | |
2209 | {$IFDE F MSWINDOW S} | |
2210 | finall y | |
2211 | WSAC leanup; | |
2212 | end; | |
2213 | {$ENDI F MSWINDOW S} | |
2214 | end; | |
2215 | ||
2216 | { TODO -cD oc: Donato r: twm } | |
2217 | ||
2218 | {$IFDEF MS WINDOWS} | |
2219 | procedure GetIpAddre sses(Resul ts: TStrin gs); | |
2220 | begin | |
2221 | GetIpAdd resses(Res ults, ''); | |
2222 | end; | |
2223 | ||
2224 | procedure GetIpAddre sses(Resul ts: TStrin gs; const HostName: AnsiString ); | |
2225 | type | |
2226 | TaPInAdd r = array[ 0..10] of PInAddr; | |
2227 | PaPInAdd r = ^TaPIn Addr; | |
2228 | var | |
2229 | R: Integ er; | |
2230 | HostEnt: PHostEnt; | |
2231 | pptr: Pa PInAddr; | |
2232 | Host: An siString; | |
2233 | i: Integ er; | |
2234 | WSAData: TWSAData; | |
2235 | begin | |
2236 | //need a socket fo r ioctl() | |
2237 | WSAData. wVersion : = 0; | |
2238 | R := WSA Startup(Ma keWord(1, 1), WSADat a); | |
2239 | if R = 0 then begi n | |
2240 | try | |
2241 | if H ostName = '' then | |
2242 | begi n | |
2243 | Se tLength(Ho st, MAX_PA TH); | |
2244 | Ge tHostName( PAnsiChar( Host), MAX _PATH); | |
2245 | end | |
2246 | else | |
2247 | Ho st := Host Name; | |
2248 | ||
2249 | Host Ent := Get HostByName (PAnsiChar (Host)); | |
2250 | if H ostEnt <> nil then | |
2251 | begi n | |
2252 | pP tr := PaPI nAddr(Host Ent^.h_add r_list); | |
2253 | i := 0; | |
2254 | wh ile pPtr^[ I] <> nil do begin | |
2255 | Results.Ad d(string(A nsiString( inet_ntoa( pptr^[i]^) ))); // OF AnsiStrin g to TStri ngs | |
2256 | Inc(i); | |
2257 | en d; | |
2258 | end; | |
2259 | finall y | |
2260 | WSAC leanup; | |
2261 | end; | |
2262 | end; | |
2263 | end; | |
2264 | {$ENDIF MS WINDOWS} | |
2265 | ||
2266 | {$IFDEF UN IX} | |
2267 | ||
2268 | { TODO -cD oc: Donato r: twm, Co ntributor rrossmair } | |
2269 | ||
2270 | // Returns all IP ad dresses of the local machine i n the form | |
2271 | // <interf ace>=<IP-A ddress> (w hich allow s for acce ss to the interface names | |
2272 | // by mean s of Resul ts.Names a nd the add resses thr ough Resul ts.Values) | |
2273 | // | |
2274 | // Example : | |
2275 | // | |
2276 | // lo=127. 0.0.1 | |
2277 | // eth0= IP | |
2278 | // ppp0=21 7.82.187.1 30 | |
2279 | // | |
2280 | // note th at this wi ll append to Results ! | |
2281 | // | |
2282 | ||
2283 | procedure GetIpAddre sses(Resul ts: TStrin gs); | |
2284 | var | |
2285 | Sock: In teger; | |
2286 | IfReq: T IfReq; | |
2287 | SockAddr Ptr: PSock AddrIn; | |
2288 | ListSave , IfList: PIfNameInd ex; | |
2289 | begin | |
2290 | //need a socket fo r ioctl() | |
2291 | Sock := socket(AF_ INET, SOCK _STREAM, 0 ); | |
2292 | if Sock < 0 then | |
2293 | RaiseL astOSError ; | |
2294 | ||
2295 | try | |
2296 | //retu rns pointe r to dynam ically all ocated lis t of struc ts | |
2297 | ListSa ve := if_n ameindex() ; | |
2298 | try | |
2299 | IfLi st := List Save; | |
2300 | //wa lk thru th e array re turned and query for each | |
2301 | //in terface's address | |
2302 | whil e IfList^. if_index < > 0 do | |
2303 | begi n | |
2304 | // copy in th e interfac e name to look up ad dress of | |
2305 | {$ IFDEF FPC} | |
2306 | st rncpy(IfRe q.ifr_ifrn .ifrn_name , IfList^. if_name, I FNAMSIZ); | |
2307 | {$ ELSE ~FPC} | |
2308 | st rncpy(IfRe q.ifrn_nam e, IfList^ .if_name, IFNAMSIZ); | |
2309 | {$ ENDIF ~FPC } | |
2310 | // get the ad dress for this inter face | |
2311 | if ioctl(Soc k, SIOCGIF ADDR, @IfR eq) <> 0 t hen | |
2312 | RaiseLastO SError; | |
2313 | // print out the addres s | |
2314 | {$ IFDEF FPC} | |
2315 | So ckAddrPtr := PSockAd drIn(@IfRe q.ifr_ifru .ifru_addr ); | |
2316 | Re sults.Add( Format('%s =%s', [IfR eq.ifr_ifr n.ifrn_nam e, inet_nt oa(SockAdd rPtr^.sin_ addr)])); | |
2317 | {$ ELSE ~FPC} | |
2318 | So ckAddrPtr := PSockAd drIn(@IfRe q.ifru_add r); | |
2319 | Re sults.Add( Format('%s =%s', [IfR eq.ifrn_na me, inet_n toa(SockAd drPtr^.sin _addr)])); | |
2320 | {$ ENDIF ~FPC } | |
2321 | In c(IfList); | |
2322 | end; | |
2323 | finall y | |
2324 | //fr ee the dyn amic memor y kernel a llocated f or us | |
2325 | if_f reenameind ex(ListSav e); | |
2326 | end; | |
2327 | finally | |
2328 | Libc._ _close(Soc k) | |
2329 | end; | |
2330 | end; | |
2331 | ||
2332 | {$ENDIF UN IX} | |
2333 | ||
2334 | function G etLocalCom puterName: string; | |
2335 | // (rom) U NIX or LIN UX? | |
2336 | {$IFDEF LI NUX} | |
2337 | var | |
2338 | MachineI nfo: utsna me; | |
2339 | begin | |
2340 | uname(Ma chineInfo) ; | |
2341 | Result : = MachineI nfo.nodena me; | |
2342 | end; | |
2343 | {$ENDIF LI NUX} | |
2344 | {$IFDEF MS WINDOWS} | |
2345 | var | |
2346 | Count: D WORD; | |
2347 | begin | |
2348 | Count := MAX_COMPU TERNAME_LE NGTH + 1; | |
2349 | // set b uffer size to MAX_CO MPUTERNAME _LENGTH + 2 characte rs for saf ety | |
2350 | { TODO : Win2k sol ution } | |
2351 | SetLengt h(Result, Count); | |
2352 | if GetCo mputerName (PChar(Res ult), Coun t) then | |
2353 | StrRes etLength(R esult) | |
2354 | else | |
2355 | Result := ''; | |
2356 | end; | |
2357 | {$ENDIF MS WINDOWS} | |
2358 | ||
2359 | function G etLocalUse rName: str ing; | |
2360 | {$IFDEF UN IX} | |
2361 | begin | |
2362 | Result : = GetEnv(' USER'); | |
2363 | end; | |
2364 | {$ENDIF UN IX} | |
2365 | {$IFDEF MS WINDOWS} | |
2366 | var | |
2367 | Count: D WORD; | |
2368 | begin | |
2369 | Count := 256 + 1; // UNLEN + 1 | |
2370 | // set b uffer size to 256 + 2 characte rs | |
2371 | { TODO : Win2k sol ution } | |
2372 | SetLengt h(Result, Count); | |
2373 | if GetUs erName(PCh ar(Result) , Count) t hen | |
2374 | StrRes etLength(R esult) | |
2375 | else | |
2376 | Result := ''; | |
2377 | end; | |
2378 | {$ENDIF MS WINDOWS} | |
2379 | ||
2380 | {$IFDEF MS WINDOWS} | |
2381 | function G etRegister edCompany: string; | |
2382 | begin | |
2383 | { TODO : check for MSDN docu mentation } | |
2384 | Result : = RegReadS tringDef(H KEY_LOCAL_ MACHINE, R EG_CURRENT _VERSION, 'Registere dOrganizat ion', ''); | |
2385 | end; | |
2386 | ||
2387 | function G etRegister edOwner: s tring; | |
2388 | begin | |
2389 | { TODO : check for MSDN docu mentation } | |
2390 | Result : = RegReadS tringDef(H KEY_LOCAL_ MACHINE, R EG_CURRENT _VERSION, 'Registere dOwner', ' '); | |
2391 | end; | |
2392 | ||
2393 | { TODO: Ch eck suppor ted platfo rms, maybe complete rewrite } | |
2394 | ||
2395 | function G etUserDoma inName(con st CurUser : string): string; | |
2396 | var | |
2397 | Count1, Count2: DW ORD; | |
2398 | Sd: PSID ; // PSecu rityDescri ptor; // F PC require s PSID | |
2399 | Snu: SID _Name_Use; | |
2400 | begin | |
2401 | Count1 : = 0; | |
2402 | Count2 : = 0; | |
2403 | Sd := ni l; | |
2404 | Snu := S IDTypeUser ; | |
2405 | Result : = ''; | |
2406 | LookUpAc countName( nil, PChar (CurUser), Sd, Count 1, PChar(R esult), Co unt2, Snu) ; | |
2407 | // set b uffer size to Count2 + 2 chara cters for safety | |
2408 | SetLengt h(Result, Count2 + 1 ); | |
2409 | Sd := Al locMem(Cou nt1); | |
2410 | try | |
2411 | if Loo kUpAccount Name(nil, PChar(CurU ser), Sd, Count1, PC har(Result ), Count2, Snu) then | |
2412 | StrR esetLength (Result) | |
2413 | else | |
2414 | Resu lt := Empt yStr; | |
2415 | finally | |
2416 | FreeMe m(Sd); | |
2417 | end; | |
2418 | end; | |
2419 | ||
2420 | function G etWorkGrou pName: Wid eString; | |
2421 | var | |
2422 | WkstaInf o: PByte; | |
2423 | WkstaInf o100: PWKS TA_INFO_10 0; | |
2424 | begin | |
2425 | if NetWk staGetInfo (nil, 100, WkstaInfo ) <> NERR_ Success th en | |
2426 | raise EJclWin32E rror.Creat eRes(@RsEN etWkstaGet Info); | |
2427 | WkstaInf o100 := PW KSTA_INFO_ 100(WkstaI nfo); | |
2428 | Result : = WideStri ng(PWideCh ar(WkstaIn fo100^.wki 100_langro up)); | |
2429 | NetApiBu fferFree(P ointer(Wks taInfo)); | |
2430 | end; | |
2431 | ||
2432 | {$ENDIF MS WINDOWS} | |
2433 | function G etDomainNa me: string ; | |
2434 | {$IFDEF UN IX} | |
2435 | var | |
2436 | MachineI nfo: utsna me; | |
2437 | begin | |
2438 | uname(Ma chineInfo) ; | |
2439 | Result : = MachineI nfo.domain name; | |
2440 | end; | |
2441 | {$ENDIF UN IX} | |
2442 | {$IFDEF MS WINDOWS} | |
2443 | //091123 H A Use Look upAccountS id to fetc h the curr ent users domain ... | |
2444 | //begin | |
2445 | // Result := GetUse rDomainNam e(GetLocal UserName); | |
2446 | //end; | |
2447 | var | |
2448 | hProcess , hAccessT oken: THan dle; | |
2449 | InfoBuff er: PChar; | |
2450 | AccountN ame: array [0..UNLEN ] of Char; | |
2451 | DomainNa me: array [0..UNLEN] of Char; | |
2452 | ||
2453 | InfoBuff erSize: Ca rdinal; | |
2454 | AccountS ize: Cardi nal; | |
2455 | DomainSi ze: Cardin al; | |
2456 | snu: SID _NAME_USE; | |
2457 | begin | |
2458 | InfoBuff erSize := 1000; | |
2459 | AccountS ize := Siz eOf(Accoun tName); | |
2460 | DomainSi ze := Size Of(DomainN ame); | |
2461 | ||
2462 | hProcess := GetCur rentProces s; | |
2463 | if OpenP rocessToke n(hProcess , TOKEN_RE AD, hAcces sToken) th en | |
2464 | try | |
2465 | GetMem (InfoBuffe r, InfoBuf ferSize); | |
2466 | try | |
2467 | if G etTokenInf ormation(h AccessToke n, TokenUs er, InfoBu ffer, Info BufferSize , InfoBuff erSize) th en | |
2468 | Lo okupAccoun tSid(nil, PSIDAndAtt ributes(In foBuffer)^ .sid, Acco untName, A ccountSize , | |
2469 | Domai nName, Dom ainSize, s nu) | |
2470 | else | |
2471 | Ra iseLastOSE rror; | |
2472 | finall y | |
2473 | Free Mem(InfoBu ffer) | |
2474 | end; | |
2475 | Result := Domain Name; | |
2476 | finally | |
2477 | CloseH andle(hAcc essToken); | |
2478 | end | |
2479 | end; | |
2480 | {$ENDIF MS WINDOWS} | |
2481 | ||
2482 | {$IFDEF MS WINDOWS} | |
2483 | // Referen ce: How to Obtain BI OS Informa tion from the Regist ry | |
2484 | // http:// support.mi crosoft.co m/default. aspx?scid= kb;en-us;q 195268 | |
2485 | ||
2486 | function G etBIOSName : string; | |
2487 | const | |
2488 | Win9xBIO SInfoKey = 'Enum\Roo t\*PNP0C01 \0000'; | |
2489 | begin | |
2490 | if IsWin NT then | |
2491 | Result := '' | |
2492 | else | |
2493 | Result := RegRea dStringDef (HKEY_LOCA L_MACHINE, Win9xBIOS InfoKey, ' BIOSName', ''); | |
2494 | end; | |
2495 | ||
2496 | function G etBIOSCopy right: str ing; | |
2497 | const | |
2498 | ADR_BIOS COPYRIGHT = $FE091; | |
2499 | begin | |
2500 | Result : = ''; | |
2501 | if not I sWinNT and not IsBad ReadPtr(Po inter(ADR_ BIOSCOPYRI GHT), 2) t hen | |
2502 | try | |
2503 | Result := string (AnsiStrin g(PAnsiCha r(ADR_BIOS COPYRIGHT) )); | |
2504 | except | |
2505 | Result := ''; | |
2506 | end; | |
2507 | end; | |
2508 | ||
2509 | function G etBIOSExte ndedInfo: string; | |
2510 | const | |
2511 | ADR_BIOS EXTENDEDIN FO = $FEC7 1; | |
2512 | begin | |
2513 | Result : = ''; | |
2514 | if not I sWinNT and not IsBad ReadPtr(Po inter(ADR_ BIOSEXTEND EDINFO), 2 ) then | |
2515 | try | |
2516 | Result := string (AnsiStrin g(PAnsiCha r(ADR_BIOS EXTENDEDIN FO))); | |
2517 | except | |
2518 | Result := ''; | |
2519 | end; | |
2520 | end; | |
2521 | ||
2522 | // Referen ce: How to Obtain BI OS Informa tion from the Regist ry | |
2523 | // http:// support.mi crosoft.co m/default. aspx?scid= kb;en-us;q 195268 | |
2524 | ||
2525 | { TODO : t he date st ring can b e e.g. 00/ 00/00 } | |
2526 | function G etBIOSDate : TDateTim e; | |
2527 | const | |
2528 | WinNT_RE G_PATH = ' HARDWARE\D ESCRIPTION \System'; | |
2529 | WinNT_RE G_KEY = ' SystemBios Date'; | |
2530 | Win9x_RE G_PATH = ' Enum\Root\ *PNP0C01\0 000'; | |
2531 | Win9x_RE G_KEY = ' BiosDate'; | |
2532 | var | |
2533 | RegStr: string; | |
2534 | {$IFDEF RTL150_UP} | |
2535 | FormatSe ttings: TF ormatSetti ngs; | |
2536 | {$ELSE ~ RTL150_UP} | |
2537 | RegForma t: string; | |
2538 | RegSepar ator: Char ; | |
2539 | {$ENDIF ~RTL150_UP } | |
2540 | begin | |
2541 | if IsWin NT then | |
2542 | RegStr := RegRea dString(HK EY_LOCAL_M ACHINE, Wi nNT_REG_PA TH, WinNT_ REG_KEY) | |
2543 | else | |
2544 | RegStr := RegRea dString(HK EY_LOCAL_M ACHINE, Wi n9x_REG_PA TH, Win9x_ REG_KEY); | |
2545 | {$IFDEF RTL150_UP} | |
2546 | FillChar (FormatSet tings, Siz eOf(Format Settings), 0); | |
2547 | FormatSe ttings.Dat eSeparator := '/'; | |
2548 | FormatSe ttings.Sho rtDateForm at := 'm/d /y'; | |
2549 | if not T ryStrToDat e(RegStr, Result, Fo rmatSettin gs) then | |
2550 | begin | |
2551 | Format Settings.S hortDateFo rmat := 'y /m/d'; | |
2552 | if not TryStrToD ate(RegStr , Result, FormatSett ings) then | |
2553 | Resu lt := 0; | |
2554 | end; | |
2555 | {$ELSE ~ RTL150_UP} | |
2556 | Result : = 0; | |
2557 | { TODO : change to a threads afe soluti on } | |
2558 | RegForma t := Short DateFormat ; | |
2559 | RegSepar ator := Da teSeparato r; | |
2560 | try | |
2561 | DateSe parator := '/'; | |
2562 | try | |
2563 | Shor tDateForma t := 'm/d/ y'; | |
2564 | Resu lt := StrT oDate(RegS tr); | |
2565 | except | |
2566 | try | |
2567 | Sh ortDateFor mat := 'y/ m/d'; | |
2568 | Re sult := St rToDate(Re gStr); | |
2569 | exce pt | |
2570 | end; | |
2571 | end; | |
2572 | finally | |
2573 | ShortD ateFormat := RegForm at; | |
2574 | DateSe parator := RegSepara tor; | |
2575 | end; | |
2576 | {$ENDIF ~RTL150_UP } | |
2577 | end; | |
2578 | ||
2579 | {$ENDIF MS WINDOWS} | |
2580 | ||
2581 | //=== Proc esses, Tas ks and Mod ules ===== ========== ========== ========== ======== | |
2582 | ||
2583 | {$IFDEF UN IX} | |
2584 | const | |
2585 | CommLen = 16; // synchroniz e with siz e of comm in struct task_struc t in | |
2586 | // /usr/i nclude/lin ux/sched.h | |
2587 | SProcDir ectory = ' /proc'; | |
2588 | ||
2589 | function R unningProc essesList( const List : TStrings ; FullPath : Boolean) : Boolean; | |
2590 | var | |
2591 | ProcDir: PDirector yStream; | |
2592 | PtrDirEn t: PDirEnt ; | |
2593 | Scratch: TDirEnt; | |
2594 | ProcID: __pid_t; | |
2595 | E: Integ er; | |
2596 | FileName : string; | |
2597 | F: PIOFi le; | |
2598 | begin | |
2599 | Result : = False; | |
2600 | ProcDir := opendir (SProcDire ctory); | |
2601 | if ProcD ir <> nil then | |
2602 | begin | |
2603 | PtrDir Ent := nil ; | |
2604 | {$IFDE F FPC} | |
2605 | if rea ddir_r(Pro cDir, @Scr atch, @Ptr DirEnt) <> 0 then | |
2606 | Exit ; | |
2607 | {$ELSE ~FPC} | |
2608 | if rea ddir_r(Pro cDir, @Scr atch, PtrD irEnt) <> 0 then | |
2609 | Exit ; | |
2610 | {$ENDI F ~FPC} | |
2611 | List.B eginUpdate ; | |
2612 | try | |
2613 | whil e PtrDirEn t <> nil d o | |
2614 | begi n | |
2615 | Va l(PtrDirEn t^.d_name, ProcID, E ); | |
2616 | if E = 0 the n // name was proces s id | |
2617 | be gin | |
2618 | FileName : = ''; | |
2619 | ||
2620 | if FullPat h then | |
2621 | FileName := Symbol icLinkTarg et(Format( '/proc/%s/ exe', [Ptr DirEnt^.d_ name])); | |
2622 | ||
2623 | if FileNam e = '' the n // usual ly due to insufficie nt access rights | |
2624 | begin | |
2625 | // read stat | |
2626 | FileName := Format ('/proc/%s /stat', [P trDirEnt^. d_name]); | |
2627 | F := fop en(PChar(F ileName), 'r'); | |
2628 | if F = n il then | |
2629 | raise EJclError. CreateResF mt(@RsInva lidProcess ID, [ProcI D]); | |
2630 | try | |
2631 | SetLen gth(FileNa me, CommLe n); | |
2632 | if fsc anf(F, PCh ar(Format( '%%*d (%%% d[^)])', [ CommLen])) , PChar(Fi leName)) < > 1 then | |
2633 | Rais eLastOSErr or; | |
2634 | StrRes etLength(F ileName); | |
2635 | finally | |
2636 | fclose (F); | |
2637 | end; | |
2638 | end; | |
2639 | ||
2640 | List.AddOb ject(FileN ame, Point er(ProcID) ); | |
2641 | en d; | |
2642 | {$ IFDEF FPC} | |
2643 | if readdir_r (ProcDir, @Scratch, @PtrDirEnt ) <> 0 the n | |
2644 | Break; | |
2645 | {$ ELSE ~FPC} | |
2646 | if readdir_r (ProcDir, @Scratch, PtrDirEnt) <> 0 then | |
2647 | Break; | |
2648 | {$ ENDIF ~FPC } | |
2649 | end; | |
2650 | finall y | |
2651 | List .EndUpdate ; | |
2652 | end; | |
2653 | end; | |
2654 | end; | |
2655 | ||
2656 | {$ENDIF UN IX} | |
2657 | ||
2658 | {$IFDEF MS WINDOWS} | |
2659 | ||
2660 | function R unningProc essesList( const List : TStrings ; FullPath : Boolean) : Boolean; | |
2661 | ||
2662 | // This function a lways retu rns an emp ty string on Win9x | |
2663 | function ProcessFi leName(PID : DWORD): string; | |
2664 | var | |
2665 | Handle : THandle; | |
2666 | begin | |
2667 | Result := ''; | |
2668 | Handle := OpenPr ocess(PROC ESS_QUERY_ INFORMATIO N or PROCE SS_VM_READ , False, P ID); | |
2669 | if Han dle <> 0 t hen | |
2670 | try | |
2671 | SetL ength(Resu lt, MAX_PA TH); | |
2672 | if F ullPath th en | |
2673 | begi n | |
2674 | if GetModule FileNameEx (Handle, 0 , PChar(Re sult), MAX _PATH) > 0 then | |
2675 | StrResetLe ngth(Resul t) | |
2676 | el se | |
2677 | Result := ''; | |
2678 | end | |
2679 | else | |
2680 | begi n | |
2681 | if GetModule BaseName(H andle, 0, PChar(Resu lt), MAX_P ATH) > 0 t hen | |
2682 | StrResetLe ngth(Resul t) | |
2683 | el se | |
2684 | Result := ''; | |
2685 | end; | |
2686 | finall y | |
2687 | Clos eHandle(Ha ndle); | |
2688 | end; | |
2689 | end; | |
2690 | ||
2691 | { TODO: Check retu rn value o f CreateTo olhelp32Sn apshot on Windows NT (0?) } | |
2692 | function BuildList TH: Boolea n; | |
2693 | var | |
2694 | SnapPr ocHandle: THandle; | |
2695 | ProcEn try: TProc essEntry32 ; | |
2696 | NextPr oc: Boolea n; | |
2697 | FileNa me: string ; | |
2698 | Win2kO rNewer: Bo olean; | |
2699 | begin | |
2700 | SnapPr ocHandle : = CreateTo olhelp32Sn apshot(TH3 2CS_SNAPPR OCESS, 0); | |
2701 | Result := (SnapP rocHandle <> INVALID _HANDLE_VA LUE); | |
2702 | if Res ult then | |
2703 | try | |
2704 | Win2 kOrNewer : = JclCheck WinVersion (5, 0); // Win2k or newer | |
2705 | Proc Entry.dwSi ze := Size Of(ProcEnt ry); | |
2706 | Next Proc := Pr ocess32Fir st(SnapPro cHandle, P rocEntry); | |
2707 | whil e NextProc do | |
2708 | begi n | |
2709 | if ProcEntry .th32Proce ssID = 0 t hen | |
2710 | be gin | |
2711 | // PID 0 i s always t he "System Idle Proc ess" but t his name c annot be | |
2712 | // retriev ed from th e system a nd has to be fabrica ted. | |
2713 | FileName : = LoadResS tring(@RsS ystemIdleP rocess); | |
2714 | en d | |
2715 | el se | |
2716 | be gin | |
2717 | if Win2kOr Newer then | |
2718 | begin | |
2719 | FileName := Proces sFileName( ProcEntry. th32Proces sID); | |
2720 | if FileN ame = '' t hen | |
2721 | FileNa me := Proc Entry.szEx eFile; | |
2722 | end | |
2723 | else | |
2724 | begin | |
2725 | FileName := ProcEn try.szExeF ile; | |
2726 | if not F ullPath th en | |
2727 | FileNa me := Extr actFileNam e(FileName ); | |
2728 | end; | |
2729 | en d; | |
2730 | Li st.AddObje ct(FileNam e, Pointer (ProcEntry .th32Proce ssID)); | |
2731 | Ne xtProc := Process32N ext(SnapPr ocHandle, ProcEntry) ; | |
2732 | end; | |
2733 | finall y | |
2734 | Clos eHandle(Sn apProcHand le); | |
2735 | end; | |
2736 | end; | |
2737 | ||
2738 | function BuildList PS: Boolea n; | |
2739 | var | |
2740 | PIDs: array [0.. 1024] of D WORD; | |
2741 | Needed : DWORD; | |
2742 | I: Int eger; | |
2743 | FileNa me: string ; | |
2744 | begin | |
2745 | Needed := 0; | |
2746 | Result := EnumPr ocesses(@P IDs, SizeO f(PIDs), N eeded); | |
2747 | if Res ult then | |
2748 | begin | |
2749 | for I := 0 to (Needed di v SizeOf(D WORD)) - 1 do | |
2750 | begi n | |
2751 | ca se PIDs[I] of | |
2752 | 0: | |
2753 | // PID 0 is always the "Syst em Idle Pr ocess" but this name cannot be | |
2754 | // retri eved from the system and has t o be fabri cated. | |
2755 | FileName := LoadRe sString(@R sSystemIdl eProcess); | |
2756 | 2: | |
2757 | // On NT 4 PID 2 i s the "Sys tem Proces s" but thi s name can not be | |
2758 | // retri eved from the system and has t o be fabri cated. | |
2759 | if IsWin NT4 then | |
2760 | FileNa me := Load ResString( @RsSystemP rocess) | |
2761 | else | |
2762 | FileNa me := Proc essFileNam e(PIDs[I]) ; | |
2763 | 8: | |
2764 | // On Wi n2K PID 8 is the "Sy stem Proce ss" but th is name ca nnot be | |
2765 | // retri eved from the system and has t o be fabri cated. | |
2766 | if IsWin 2k or IsWi nXP then | |
2767 | FileNa me := Load ResString( @RsSystemP rocess) | |
2768 | else | |
2769 | FileNa me := Proc essFileNam e(PIDs[I]) ; | |
2770 | el se | |
2771 | FileName : = ProcessF ileName(PI Ds[I]); | |
2772 | en d; | |
2773 | if FileName <> '' then | |
2774 | List.AddOb ject(FileN ame, Point er(PIDs[I] )); | |
2775 | end; | |
2776 | end; | |
2777 | end; | |
2778 | ||
2779 | begin | |
2780 | { TODO : safer sol ution? } | |
2781 | List.Beg inUpdate; | |
2782 | try | |
2783 | if Get WindowsVer sion in [w vWinNT31, wvWinNT35, wvWinNT35 1, wvWinNT 4] then | |
2784 | Resu lt := Buil dListPS | |
2785 | else | |
2786 | Resu lt := Buil dListTH; | |
2787 | finally | |
2788 | List.E ndUpdate; | |
2789 | end; | |
2790 | end; | |
2791 | ||
2792 | { TODO Win dows 9x ? } | |
2793 | ||
2794 | function L oadedModul esList(con st List: T Strings; P rocessID: DWORD; Han dlesOnly: Boolean): Boolean; | |
2795 | ||
2796 | procedur e AddToLis t(ProcessH andle: THa ndle; Modu le: HMODUL E); | |
2797 | var | |
2798 | FileNa me: array [0..MAX_PA TH] of Cha r; | |
2799 | Module Info: TMod uleInfo; | |
2800 | begin | |
2801 | Module Info.Entry Point := n il; | |
2802 | {$IFDE F FPC} | |
2803 | if Get ModuleInfo rmation(Pr ocessHandl e, Module, ModuleInf o, SizeOf( ModuleInfo )) then | |
2804 | {$ELSE ~FPC} | |
2805 | if Get ModuleInfo rmation(Pr ocessHandl e, Module, @ModuleIn fo, SizeOf (ModuleInf o)) then | |
2806 | {$ENDI F ~FPC} | |
2807 | begin | |
2808 | if H andlesOnly then | |
2809 | Li st.AddObje ct('', Poi nter(Modul eInfo.lpBa seOfDll)) | |
2810 | else | |
2811 | if G etModuleFi leNameEx(P rocessHand le, Module , Filename , SizeOf(F ilename)) > 0 then | |
2812 | Li st.AddObje ct(FileNam e, Pointer (ModuleInf o.lpBaseOf Dll)); | |
2813 | end; | |
2814 | end; | |
2815 | ||
2816 | function EnumModul esVQ(Proce ssHandle: THandle): Boolean; | |
2817 | var | |
2818 | MemInf o: TMemory BasicInfor mation; | |
2819 | Base: PChar; | |
2820 | LastAl locBase: P ointer; | |
2821 | Res: D WORD; | |
2822 | begin | |
2823 | Base : = nil; | |
2824 | LastAl locBase := nil; | |
2825 | ResetM emory(MemI nfo, SizeO f(MemInfo) ); | |
2826 | Res := VirtualQu eryEx(Proc essHandle, Base, Mem Info, Size Of(MemInfo )); | |
2827 | Result := (Res = SizeOf(Me mInfo)); | |
2828 | while Res = Size Of(MemInfo ) do | |
2829 | begin | |
2830 | if M emInfo.All ocationBas e <> LastA llocBase t hen | |
2831 | begi n | |
2832 | {$ IFDEF FPC} | |
2833 | if MemInfo._ Type = MEM _IMAGE the n | |
2834 | {$ ELSE ~FPC} | |
2835 | if MemInfo.T ype_9 = ME M_IMAGE th en | |
2836 | {$ ENDIF ~FPC } | |
2837 | AddToList( ProcessHan dle, HMODU LE(MemInfo .Allocatio nBase)); | |
2838 | La stAllocBas e := MemIn fo.Allocat ionBase; | |
2839 | end; | |
2840 | Inc( Base, MemI nfo.Region Size); | |
2841 | Res := Virtual QueryEx(Pr ocessHandl e, Base, M emInfo, Si zeOf(MemIn fo)); | |
2842 | end; | |
2843 | end; | |
2844 | ||
2845 | function EnumModul esPS: Bool ean; | |
2846 | var | |
2847 | Proces sHandle: T Handle; | |
2848 | Needed : DWORD; | |
2849 | Module s: array o f THandle; | |
2850 | I, Cnt : Integer; | |
2851 | begin | |
2852 | Result := False; | |
2853 | Proces sHandle := OpenProce ss(PROCESS _QUERY_INF ORMATION o r PROCESS_ VM_READ, F alse, Proc essID); | |
2854 | if Pro cessHandle <> 0 then | |
2855 | try | |
2856 | Need ed := 0; | |
2857 | Resu lt := Enum ProcessMod ules(Proce ssHandle, nil, 0, Ne eded); | |
2858 | if R esult then | |
2859 | begi n | |
2860 | Cn t := Neede d div Size Of(HMODULE ); | |
2861 | Se tLength(Mo dules, Cnt ); | |
2862 | if EnumProce ssModules( ProcessHan dle, @Modu les[0], Ne eded, Need ed) then | |
2863 | for I := 0 to Cnt - 1 do | |
2864 | AddToLis t(ProcessH andle, Mod ules[I]); | |
2865 | end | |
2866 | else | |
2867 | Re sult := En umModulesV Q(ProcessH andle); | |
2868 | finall y | |
2869 | Clos eHandle(Pr ocessHandl e); | |
2870 | end; | |
2871 | end; | |
2872 | ||
2873 | { TODO: C heck retur n value of CreateToo lhelp32Sna pshot on W indows NT (0?) } | |
2874 | ||
2875 | function EnumModul esTH: Bool ean; | |
2876 | var | |
2877 | SnapPr ocHandle: THandle; | |
2878 | Module : TModuleE ntry32; | |
2879 | Next: Boolean; | |
2880 | begin | |
2881 | SnapPr ocHandle : = CreateTo olhelp32Sn apshot(TH3 2CS_SNAPMO DULE, Proc essID); | |
2882 | Result := (SnapP rocHandle <> INVALID _HANDLE_VA LUE); | |
2883 | if Res ult then | |
2884 | try | |
2885 | Rese tMemory(Mo dule, Size Of(Module) ); | |
2886 | Modu le.dwSize := SizeOf( Module); | |
2887 | Next := Module 32First(Sn apProcHand le, Module ); | |
2888 | whil e Next do | |
2889 | begi n | |
2890 | if HandlesOn ly then | |
2891 | List.AddOb ject('', P ointer(Mod ule.hModul e)) | |
2892 | el se | |
2893 | List.AddOb ject(Modul e.szExePat h, Pointer (Module.hM odule)); | |
2894 | Ne xt := Modu le32Next(S napProcHan dle, Modul e); | |
2895 | end; | |
2896 | finall y | |
2897 | Clos eHandle(Sn apProcHand le); | |
2898 | end; | |
2899 | end; | |
2900 | ||
2901 | begin | |
2902 | List.Beg inUpdate; | |
2903 | try | |
2904 | if IsW inNT then | |
2905 | Resu lt := Enum ModulesPS | |
2906 | else | |
2907 | Resu lt := Enum ModulesTH; | |
2908 | finally | |
2909 | List.E ndUpdate; | |
2910 | end; | |
2911 | end; | |
2912 | ||
2913 | function E numTaskWin dowsProc(W nd: THandl e; List: T Strings): Boolean; s tdcall; | |
2914 | var | |
2915 | Caption: array [0. .1024] of Char; | |
2916 | begin | |
2917 | if IsMai nAppWindow (Wnd) and (GetWindow Text(Wnd, Caption, S izeOf(Capt ion)) > 0) then | |
2918 | List.A ddObject(C aption, Po inter(Wnd) ); | |
2919 | Result : = True; | |
2920 | end; | |
2921 | ||
2922 | function G etTasksLis t(const Li st: TStrin gs): Boole an; | |
2923 | begin | |
2924 | List.Beg inUpdate; | |
2925 | try | |
2926 | Result := EnumWi ndows(@Enu mTaskWindo wsProc, LP ARAM(List) ); | |
2927 | finally | |
2928 | List.E ndUpdate; | |
2929 | end; | |
2930 | end; | |
2931 | ||
2932 | function M oduleFromA ddr(const Addr: Poin ter): HMOD ULE; | |
2933 | var | |
2934 | MI: TMem oryBasicIn formation; | |
2935 | begin | |
2936 | MI.Alloc ationBase := nil; | |
2937 | VirtualQ uery(Addr, MI, SizeO f(MI)); | |
2938 | if MI.St ate <> MEM _COMMIT th en | |
2939 | Result := 0 | |
2940 | else | |
2941 | Result := HMODUL E(MI.Alloc ationBase) ; | |
2942 | end; | |
2943 | ||
2944 | function I sSystemMod ule(const Module: HM ODULE): Bo olean; | |
2945 | var | |
2946 | CurModul e: PLibMod ule; | |
2947 | begin | |
2948 | Result : = False; | |
2949 | if Modul e <> 0 the n | |
2950 | begin | |
2951 | CurMod ule := Lib ModuleList ; | |
2952 | while CurModule <> nil do | |
2953 | begin | |
2954 | if C urModule.I nstance = Module the n | |
2955 | begi n | |
2956 | Re sult := Tr ue; | |
2957 | Br eak; | |
2958 | end; | |
2959 | CurM odule := C urModule.N ext; | |
2960 | end; | |
2961 | end; | |
2962 | end; | |
2963 | ||
2964 | // Referen ce: http:/ /msdn.micr osoft.com/ library/pe riodic/per iod97/win3 21197.htm | |
2965 | { TODO : w rong link } | |
2966 | ||
2967 | function I sMainAppWi ndow(Wnd: THandle): Boolean; | |
2968 | var | |
2969 | ParentWn d: THandle ; | |
2970 | ExStyle: DWORD; | |
2971 | begin | |
2972 | if IsWin dowVisible (Wnd) then | |
2973 | begin | |
2974 | Parent Wnd := THa ndle(GetWi ndowLongPt r(Wnd, GWL P_HWNDPARE NT)); | |
2975 | ExStyl e := GetWi ndowLongPt r(Wnd, GWL _EXSTYLE); | |
2976 | Result := ((Pare ntWnd = 0) or (Paren tWnd = Get DesktopWin dow)) and | |
2977 | ((Ex Style and WS_EX_TOOL WINDOW = 0 ) or (ExSt yle and WS _EX_APPWIN DOW <> 0)) ; | |
2978 | end | |
2979 | else | |
2980 | Result := False; | |
2981 | end; | |
2982 | ||
2983 | function I sWindowRes ponding(Wn d: THandle ; Timeout: Integer): Boolean; | |
2984 | var | |
2985 | Res: DWO RD; | |
2986 | begin | |
2987 | Res := 0 ; | |
2988 | Result : = SendMess ageTimeout (Wnd, WM_N ULL, 0, 0, SMTO_ABOR TIFHUNG, T imeout, {$ IFDEF RTL2 30_UP}@{$E NDIF}Res) <> 0; | |
2989 | end; | |
2990 | ||
2991 | function G etWindowIc on(Wnd: TH andle; Lar geIcon: Bo olean): HI CON; | |
2992 | var | |
2993 | Width, H eight: Int eger; | |
2994 | TempIcon : HICON; | |
2995 | IconType : DWORD; | |
2996 | begin | |
2997 | if Large Icon then | |
2998 | begin | |
2999 | Width := GetSyst emMetrics( SM_CXICON) ; | |
3000 | Height := GetSys temMetrics (SM_CYICON ); | |
3001 | IconTy pe := ICON _BIG; | |
3002 | TempIc on := GetC lassLong(W nd, GCL_HI CON); | |
3003 | end | |
3004 | else | |
3005 | begin | |
3006 | Width := GetSyst emMetrics( SM_CXSMICO N); | |
3007 | Height := GetSys temMetrics (SM_CYSMIC ON); | |
3008 | IconTy pe := ICON _SMALL; | |
3009 | TempIc on := GetC lassLong(W nd, GCL_HI CONSM); | |
3010 | end; | |
3011 | if TempI con = 0 th en | |
3012 | TempIc on := Send Message(Wn d, WM_GETI CON, IconT ype, 0); | |
3013 | if (Temp Icon = 0) and not La rgeIcon th en | |
3014 | TempIc on := Send Message(Wn d, WM_GETI CON, ICON_ BIG, 0); | |
3015 | Result : = CopyImag e(TempIcon , IMAGE_IC ON, Width, Height, 0 ); | |
3016 | end; | |
3017 | ||
3018 | function G etWindowCa ption(Wnd: THandle): string; | |
3019 | var | |
3020 | Buffer: string; | |
3021 | Size: In teger; | |
3022 | begin | |
3023 | Size := GetWindowT extLength( Wnd); | |
3024 | if Size = 0 then | |
3025 | Size : = 1; / / always a llocate at least one byte, oth erwise PCh ar(Buffer) returns n il | |
3026 | SetLengt h(Buffer, Size); | |
3027 | // strin gs always have an ad ditional n ull charac ter | |
3028 | Size := GetWindowT ext(Wnd, P Char(Buffe r), Size + 1); | |
3029 | Result : = Copy(Buf fer, 1, Si ze); | |
3030 | end; | |
3031 | ||
3032 | // Q178893 | |
3033 | // http:// support.mi crosoft.co m/default. aspx?scid= kb;en-us;1 78893 | |
3034 | ||
3035 | function E numTermina teAppWindo wsProc(Wnd : THandle; ProcessID : DWORD): Boolean; s tdcall; | |
3036 | var | |
3037 | PID: DWO RD; | |
3038 | begin | |
3039 | GetWindo wThreadPro cessId(Wnd , @PID); | |
3040 | if Proce ssID = PID then | |
3041 | PostMe ssage(Wnd, WM_CLOSE, 0, 0); | |
3042 | Result : = True; | |
3043 | end; | |
3044 | ||
3045 | function T erminateAp p(ProcessI D: DWORD; Timeout: I nteger): T JclTermina teAppResul t; | |
3046 | var | |
3047 | ProcessH andle: THa ndle; | |
3048 | begin | |
3049 | Result : = taError; | |
3050 | if Proce ssID <> Ge tCurrentPr ocessId th en | |
3051 | begin | |
3052 | Proces sHandle := OpenProce ss(SYNCHRO NIZE or PR OCESS_TERM INATE, Fal se, Proces sID); | |
3053 | if Pro cessHandle <> 0 then | |
3054 | try | |
3055 | Enum Windows(@E numTermina teAppWindo wsProc, LP ARAM(Proce ssID)); | |
3056 | if W aitForSing leObject(P rocessHand le, Timeou t) = WAIT_ OBJECT_0 t hen | |
3057 | Re sult := ta Clean | |
3058 | else | |
3059 | if T erminatePr ocess(Proc essHandle, 0) then | |
3060 | Re sult := ta Kill; | |
3061 | finall y | |
3062 | Clos eHandle(Pr ocessHandl e); | |
3063 | end; | |
3064 | end; | |
3065 | end; | |
3066 | ||
3067 | function T erminateTa sk(Wnd: TH andle; Tim eout: Inte ger): TJcl TerminateA ppResult; | |
3068 | var | |
3069 | PID: DWO RD; | |
3070 | begin | |
3071 | if GetWi ndowThread ProcessId( Wnd, @PID) <> 0 then | |
3072 | Result := Termin ateApp(PID , Timeout) | |
3073 | else | |
3074 | Result := taErro r; | |
3075 | end; | |
3076 | ||
3077 | function G etProcessN ameFromWnd (Wnd: THan dle): stri ng; | |
3078 | var | |
3079 | List: TS tringList; | |
3080 | PID: THa ndle; | |
3081 | I: Integ er; | |
3082 | begin | |
3083 | Result : = ''; | |
3084 | if IsWin dow(Wnd) t hen | |
3085 | begin | |
3086 | PID := INVALID_H ANDLE_VALU E; | |
3087 | GetWin dowThreadP rocessId(W nd, @PID); | |
3088 | List : = TStringL ist.Create ; | |
3089 | try | |
3090 | if R unningProc essesList( List, True ) then | |
3091 | begi n | |
3092 | I := List.In dexOfObjec t(Pointer( PID)); | |
3093 | if I > -1 th en | |
3094 | Result := List[I]; | |
3095 | end; | |
3096 | finall y | |
3097 | List .Free; | |
3098 | end; | |
3099 | end; | |
3100 | end; | |
3101 | ||
3102 | function G etPidFromP rocessName (const Pro cessName: string): T Handle; | |
3103 | var | |
3104 | List: TS tringList; | |
3105 | I: Integ er; | |
3106 | HasFullP ath: Boole an; | |
3107 | begin | |
3108 | Result : = INVALID_ HANDLE_VAL UE; | |
3109 | List := TStringLis t.Create; | |
3110 | try | |
3111 | HasFul lPath := E xtractFile Path(Proce ssName) <> ''; | |
3112 | if Run ningProces sesList(Li st, HasFul lPath) the n | |
3113 | begin | |
3114 | I := List.Inde xOf(Proces sName); | |
3115 | if I > -1 then | |
3116 | Re sult := DW ORD(List.O bjects[I]) ; | |
3117 | end; | |
3118 | finally | |
3119 | List.F ree; | |
3120 | end; | |
3121 | end; | |
3122 | ||
3123 | function G etProcessN ameFromPid (PID: DWOR D): string ; | |
3124 | var | |
3125 | List: TS tringList; | |
3126 | I: Integ er; | |
3127 | begin | |
3128 | // Note: there are other way s to retri eve the na me of the process gi ven it's | |
3129 | // PID b ut this im plementati on seems t o work bes t without making ass umptions | |
3130 | // altho ugh it may not be th e most eff icient imp lementatio n. | |
3131 | Result : = ''; | |
3132 | List := TStringLis t.Create; | |
3133 | try | |
3134 | if Run ningProces sesList(Li st, True) then | |
3135 | begin | |
3136 | I := List.Inde xOfObject( Pointer(PI D)); | |
3137 | if I > -1 then | |
3138 | Re sult := Li st[I]; | |
3139 | end; | |
3140 | finally | |
3141 | List.F ree; | |
3142 | end; | |
3143 | end; | |
3144 | ||
3145 | type | |
3146 | PSearch = ^TSearch ; | |
3147 | TSearch = record | |
3148 | PID: D WORD; | |
3149 | Wnd: T Handle; | |
3150 | end; | |
3151 | ||
3152 | function E numMainApp WindowsPro c(Wnd: THa ndle; Res: PSearch): Boolean; stdcall; | |
3153 | var | |
3154 | WindowPi d: DWORD; | |
3155 | begin | |
3156 | WindowPi d := 0; | |
3157 | GetWindo wThreadPro cessId(Wnd , @WindowP id); | |
3158 | if (Wind owPid = Re s^.PID) an d IsMainAp pWindow(Wn d) then | |
3159 | begin | |
3160 | Res^.W nd := Wnd; | |
3161 | Result := False; | |
3162 | end | |
3163 | else | |
3164 | Result := True; | |
3165 | end; | |
3166 | ||
3167 | function G etMainAppW ndFromPid( PID: DWORD ): THandle ; | |
3168 | var | |
3169 | SearchRe c: TSearch ; | |
3170 | begin | |
3171 | SearchRe c.PID := P ID; | |
3172 | SearchRe c.Wnd := 0 ; | |
3173 | EnumWind ows(@EnumM ainAppWind owsProc, L PARAM(@Sea rchRec)); | |
3174 | Result : = SearchRe c.Wnd; | |
3175 | end; | |
3176 | ||
3177 | type | |
3178 | PEnumWnd Struct = ^ TEnumWndSt ruct; | |
3179 | TEnumWnd Struct = r ecord | |
3180 | PID: DWORD; | |
3181 | WndC lassName: string; | |
3182 | Resu ltWnd: HWN D; | |
3183 | end; | |
3184 | ||
3185 | function E numPidWinP roc(Wnd: H WND; Enum: PEnumWndS truct): BO OL; stdcal l; | |
3186 | var | |
3187 | PID: DWO RD; | |
3188 | C: PChar ; | |
3189 | CLen: In teger; | |
3190 | begin | |
3191 | Result : = True; | |
3192 | GetWindo wThreadPro cessId(Wnd , @PID); | |
3193 | if (PID = Enum.PID ) then | |
3194 | begin | |
3195 | CLen : = Length(E num.WndCla ssName)+1; | |
3196 | C := S trAlloc(CL en); | |
3197 | if (Ge tClassName (Wnd, C, C Len) > 0) then | |
3198 | if ( C = Enum.W ndClassNam e) then | |
3199 | begin | |
3200 | Resu lt := Fals e; | |
3201 | Enum .ResultWnd := Wnd; | |
3202 | end; | |
3203 | StrDis pose(C); | |
3204 | end; | |
3205 | end; | |
3206 | ||
3207 | function G etWndFromP id(PID: DW ORD; const WindowCla ssName: st ring): HWN D; | |
3208 | var | |
3209 | EnumWndS truct: TEn umWndStruc t; | |
3210 | begin | |
3211 | EnumWndS truct.PID := PID; | |
3212 | EnumWndS truct.WndC lassName : = WindowCl assName; | |
3213 | EnumWndS truct.Resu ltWnd := 0 ; | |
3214 | EnumWind ows(@EnumP idWinProc, LPARAM(@E numWndStru ct)); | |
3215 | Result : = EnumWndS truct.Resu ltWnd; | |
3216 | end; | |
3217 | ||
3218 | function G etShellPro cessName: string; | |
3219 | const | |
3220 | cShellKe y = 'SOFTW ARE\Micros oft\Window s NT\Curre ntVersion\ WinLogon'; | |
3221 | cShellVa lue = 'She ll'; | |
3222 | cShellDe fault = 'e xplorer.ex e'; | |
3223 | cShellSy stemIniFil eName = 's ystem.ini' ; | |
3224 | cShellBo otSection = 'boot'; | |
3225 | begin | |
3226 | if IsWin NT then | |
3227 | Result := RegRea dStringDef (HKEY_LOCA L_MACHINE, cShellKey , cShellVa lue, '') | |
3228 | else | |
3229 | Result := IniRea dString(Pa thAddSepar ator(GetWi ndowsFolde r) + cShel lSystemIni FileName, cShellBoot Section, c ShellValue ); | |
3230 | if Resul t = '' the n | |
3231 | Result := cShell Default; | |
3232 | end; | |
3233 | ||
3234 | function G etShellPro cessHandle : THandle; | |
3235 | var | |
3236 | Pid: Lon gword; | |
3237 | begin | |
3238 | Pid := G etPidFromP rocessName (GetShellP rocessName ); | |
3239 | Result : = OpenProc ess(PROCES S_ALL_ACCE SS, False, Pid); | |
3240 | if Resul t = 0 then | |
3241 | RaiseL astOSError ; | |
3242 | end; | |
3243 | ||
3244 | //=== Vers ion Inform ation ==== ========== ========== ========== ========== ======== | |
3245 | ||
3246 | { Q159/238 | |
3247 | ||
3248 | Windows 95 retail, OEM 4. 00.950 7/ 11/95 | |
3249 | Windows 95 retail SP1 4. 00.950A 7/ 11/95-12/3 1/95 | |
3250 | OEM Serv ice Releas e 2 4. 00.1111* ( 4.00.950B) 8/ 24/96 | |
3251 | OEM Serv ice Releas e 2.1 4. 03.1212-12 14* (4.00. 950B) 8/ 24/96-8/27 /97 | |
3252 | OEM Serv ice Releas e 2.5 4. 03.1214* ( 4.00.950C) 8/ 24/96-11/1 8/97 | |
3253 | Windows 98 retail, OEM 4. 10.1998 5/ 11/98 | |
3254 | Windows 98 Second Edition 4. 10.2222A 4/ 23/99 | |
3255 | Windows Millennium 4. 90.3000 | |
3256 | } | |
3257 | { TODO : D istinquish between a ll these d ifferent r eleases? } | |
3258 | ||
3259 | var | |
3260 | KernelVe rsionHi: D WORD; | |
3261 | ||
3262 | function G etWindowsV ersion: TW indowsVers ion; | |
3263 | var | |
3264 | TrimmedW in32CSDVer sion: stri ng; | |
3265 | SystemIn fo: TSyste mInfo; | |
3266 | OSVersio nInfoEx: T OSVersionI nfoEx; | |
3267 | Win32Maj orVersionE x, Win32Mi norVersion Ex: intege r; | |
3268 | ProductN ame: strin g; | |
3269 | const | |
3270 | SM_SERVE RR2 = 89; | |
3271 | begin | |
3272 | Win32Maj orVersionE x := -1; | |
3273 | Result : = wvUnknow n; | |
3274 | TrimmedW in32CSDVer sion := Tr im(Win32CS DVersion); | |
3275 | case Win 32Platform of | |
3276 | VER_PL ATFORM_WIN 32_WINDOWS : | |
3277 | case Win32Mino rVersion o f | |
3278 | 0. .9: | |
3279 | if (Trimme dWin32CSDV ersion = ' B') or (Tr immedWin32 CSDVersion = 'C') th en | |
3280 | Result : = wvWin95O SR2 | |
3281 | else | |
3282 | Result : = wvWin95; | |
3283 | 10 ..89: | |
3284 | // On Wind ows ME Win 32MinorVer sion can b e 10 (indi cating Win dows 98 | |
3285 | // under c ertain cir cumstances (image na me is setu p.exe). Ch ecking | |
3286 | // the ker nel versio n is one w ay of work ing around that. | |
3287 | if KernelV ersionHi = $0004005A then // 4 .90.x.x | |
3288 | Result : = wvWinME | |
3289 | else | |
3290 | if (Trimme dWin32CSDV ersion = ' A') or (Tr immedWin32 CSDVersion = 'B') th en | |
3291 | Result : = wvWin98S E | |
3292 | else | |
3293 | Result : = wvWin98; | |
3294 | 90 : | |
3295 | Result := wvWinME; | |
3296 | end; | |
3297 | VER_PL ATFORM_WIN 32_NT: | |
3298 | case Win32Majo rVersion o f | |
3299 | 3: | |
3300 | case Win32 MinorVersi on of | |
3301 | 1: | |
3302 | Result := wvWinN T31; | |
3303 | 5: | |
3304 | Result := wvWinN T35; | |
3305 | 51: | |
3306 | Result := wvWinN T351; | |
3307 | end; | |
3308 | 4: | |
3309 | Result := wvWinNT4; | |
3310 | 5: | |
3311 | case Win32 MinorVersi on of | |
3312 | 0: | |
3313 | Result := wvWin2 000; | |
3314 | 1: | |
3315 | Result := wvWinX P; | |
3316 | 2: | |
3317 | begin | |
3318 | OSVe rsionInfoE x.dwOSVers ionInfoSiz e := SizeO f(OSVersio nInfoEx); | |
3319 | Syst emInfo.dwO emId := 0; | |
3320 | GetN ativeSyste mInfo(Syst emInfo); | |
3321 | if G etSystemMe trics(SM_S ERVERR2) < > 0 then | |
3322 | Re sult := wv Win2003R2 | |
3323 | else | |
3324 | if ( SystemInfo .wProcesso rArchitect ure <> PRO CESSOR_ARC HITECTURE_ INTEL) and | |
3325 | Ge tVersionEx (OSVersion InfoEx) an d (OSVersi onInfoEx.w ProductTyp e = VER_NT _WORKSTATI ON) then | |
3326 | Re sult := wv WinXP64 | |
3327 | else | |
3328 | Re sult := wv Win2003; | |
3329 | end; | |
3330 | end; | |
3331 | 6: | |
3332 | be gin | |
3333 | // Startin g with Win dows 8.1, the GetVer sion(Ex) A PI is depr ecated and will dete ct the | |
3334 | // applica tion as Wi ndows 8 (k ernel vers ion 6.2) u ntil an ap plication manifest i s included | |
3335 | // See htt ps://msdn. microsoft. com/en-us/ library/wi ndows/desk top/dn3020 74.aspx | |
3336 | ||
3337 | if Win32Mi norVersion = 2 then | |
3338 | begin | |
3339 | ProductN ame := Reg ReadString Def(HKEY_L OCAL_MACHI NE, 'SOFTW ARE\Micros oft\Window s NT\Curre ntVersion' , 'Product Name', '') ; | |
3340 | if (pos( RsOSVersio nWin81, Pr oductName) = 1) or ( pos(RsOSVe rsionWinSe rver2012R2 , ProductN ame) = 1) then | |
3341 | Win32M inorVersio nEx := 3 / / Windows 8.1 and Wi ndows Serv er 2012R2 | |
3342 | else | |
3343 | if (pos( RsOSVersio nWin8, Pro ductName) = 1) or (p os(RsOSVer sionWinSer ver2012, P roductName ) = 1) the n | |
3344 | Win32M inorVersio nEx := 2 / / Windows 8 and Wind ows Server 2012 | |
3345 | else | |
3346 | begin | |
3347 | Win32M ajorVersio nEx := Get WindowsMaj orVersionN umber; | |
3348 | if Win 32MajorVer sionEx = 6 then | |
3349 | Win 32MinorVer sionEx := 4 // Windo ws 10 (bui lds < 9926 ) and Wind ows Server 2016 (bui lds < 1007 4) | |
3350 | else | |
3351 | if Win 32MajorVer sionEx = 1 0 then | |
3352 | Win 32MinorVer sionEx := -1 // Wind ows 10 (bu ilds >= 99 26) and Wi ndows Serv er 2016 (b uilds >= 1 0074), set to -1 to escape cas e block | |
3353 | else | |
3354 | Win 32MinorVer sionEx := Win32Minor Version; | |
3355 | end; | |
3356 | end | |
3357 | else | |
3358 | Win32Min orVersionE x := Win32 MinorVersi on; | |
3359 | ||
3360 | case Win32 MinorVersi onEx of | |
3361 | 0: | |
3362 | begin | |
3363 | // W indows Vis ta and Win dows Serve r 2008 | |
3364 | OSVe rsionInfoE x.dwOSVers ionInfoSiz e := SizeO f(OSVersio nInfoEx); | |
3365 | if G etVersionE x(OSVersio nInfoEx) a nd (OSVers ionInfoEx. wProductTy pe = VER_N T_WORKSTAT ION) then | |
3366 | Re sult := wv WinVista | |
3367 | else | |
3368 | Re sult := wv WinServer2 008; | |
3369 | end; | |
3370 | 1: | |
3371 | begin | |
3372 | // W indows 7 a nd Windows Server 20 08 R2 | |
3373 | OSVe rsionInfoE x.dwOSVers ionInfoSiz e := SizeO f(OSVersio nInfoEx); | |
3374 | if G etVersionE x(OSVersio nInfoEx) a nd (OSVers ionInfoEx. wProductTy pe = VER_N T_WORKSTAT ION) then | |
3375 | Re sult := wv Win7 | |
3376 | else | |
3377 | Re sult := wv WinServer2 008R2; | |
3378 | end; | |
3379 | 2: | |
3380 | begin | |
3381 | // W indows 8 a nd Windows Server 20 12 | |
3382 | OSVe rsionInfoE x.dwOSVers ionInfoSiz e := SizeO f(OSVersio nInfoEx); | |
3383 | if G etVersionE x(OSVersio nInfoEx) a nd (OSVers ionInfoEx. wProductTy pe = VER_N T_WORKSTAT ION) then | |
3384 | Re sult := wv Win8 | |
3385 | else | |
3386 | Re sult := wv WinServer2 012; | |
3387 | end; | |
3388 | 3: | |
3389 | begin | |
3390 | // W indows 8.1 and Windo ws Server 2012 R2 | |
3391 | OSVe rsionInfoE x.dwOSVers ionInfoSiz e := SizeO f(OSVersio nInfoEx); | |
3392 | if G etVersionE x(OSVersio nInfoEx) a nd (OSVers ionInfoEx. wProductTy pe = VER_N T_WORKSTAT ION) then | |
3393 | Re sult := wv Win81 | |
3394 | else | |
3395 | Re sult := wv WinServer2 012R2; | |
3396 | end; | |
3397 | 4: | |
3398 | begin | |
3399 | // W indows 10 (builds < 9926) and Windows Se rver 2016 (builds < 10074) | |
3400 | OSVe rsionInfoE x.dwOSVers ionInfoSiz e := SizeO f(OSVersio nInfoEx); | |
3401 | if G etVersionE x(OSVersio nInfoEx) a nd (OSVers ionInfoEx. wProductTy pe = VER_N T_WORKSTAT ION) then | |
3402 | Re sult := wv Win10 | |
3403 | else | |
3404 | Re sult := wv WinServer2 016; | |
3405 | end; | |
3406 | end; | |
3407 | en d; | |
3408 | 10 : | |
3409 | Win32Majo rVersionEx := Win32M ajorVersio n; | |
3410 | end; | |
3411 | end; | |
3412 | ||
3413 | // This part will only be hi t with Win dows 10 an d Windows Server 201 6 (and new er) where an applica tion manif est is not included | |
3414 | if (Win3 2MajorVers ionEx >= 1 0) then | |
3415 | begin | |
3416 | case W in32MajorV ersionEx o f | |
3417 | 10: | |
3418 | begi n | |
3419 | Wi n32MinorVe rsionEx := GetWindow sMinorVers ionNumber; | |
3420 | ca se Win32Mi norVersion Ex of | |
3421 | 0: | |
3422 | begin | |
3423 | // Win dows 10 (b uilds >= 9 926) and W indows Ser ver 2016 ( builds >= 10074) | |
3424 | OSVers ionInfoEx. dwOSVersio nInfoSize := SizeOf( OSVersionI nfoEx); | |
3425 | if Get VersionEx( OSVersionI nfoEx) and (OSVersio nInfoEx.wP roductType = VER_NT_ WORKSTATIO N) then | |
3426 | Resu lt := wvWi n10 | |
3427 | else | |
3428 | Resu lt := wvWi nServer201 6; | |
3429 | end; | |
3430 | en d; | |
3431 | end; | |
3432 | end; | |
3433 | end; | |
3434 | ||
3435 | end; | |
3436 | ||
3437 | function G etWindowsE dition: TW indowsEdit ion; | |
3438 | const | |
3439 | ProductN ame = 'SOF TWARE\Micr osoft\Wind ows NT\Cur rentVersio n'; | |
3440 | var | |
3441 | Edition: string; | |
3442 | begin | |
3443 | Result : = weUnknow n; | |
3444 | Edition := RegRead StringDef( HKEY_LOCAL _MACHINE, ProductNam e, 'Produc tName', '' ); | |
3445 | ||
3446 | // Remov e (tm) in 'Windows ( TM) Vista Ultimate' | |
3447 | Edition := StringR eplace(Edi tion, '(TM ) ', '', [ rfReplaceA ll, rfIgno reCase]); | |
3448 | ||
3449 | if Pos(' Windows XP ', Edition ) = 1 then | |
3450 | begin | |
3451 | // Wind ows XP Edi tions | |
3452 | if Pos( 'Home Edit ion N', Ed ition) > 0 then | |
3453 | Resu lt := weWi nXPHomeN | |
3454 | else | |
3455 | if Pos( 'Professio nal N', Ed ition) > 0 then | |
3456 | Resu lt := weWi nXPProN | |
3457 | else | |
3458 | if Pos( 'Home Edit ion K', Ed ition) > 0 then | |
3459 | Resu lt := weWi nXPHomeK | |
3460 | else | |
3461 | if Pos( 'Professio nal K', Ed ition) > 0 then | |
3462 | Resu lt := weWi nXPProK | |
3463 | else | |
3464 | if Pos( 'Home Edit ion KN', E dition) > 0 then | |
3465 | Resu lt := weWi nXPHomeKN | |
3466 | else | |
3467 | if Pos( 'Professio nal KN', E dition) > 0 then | |
3468 | Resu lt := weWi nXPProKN | |
3469 | else | |
3470 | if Pos( 'Home', Ed ition) > 0 then | |
3471 | Resu lt := weWi nXPHome | |
3472 | else | |
3473 | if Pos( 'Professio nal', Edit ion) > 0 t hen | |
3474 | Resu lt := weWi nXPPro | |
3475 | else | |
3476 | if Pos( 'Starter', Edition) > 0 then | |
3477 | Resu lt := weWi nXPStarter | |
3478 | else | |
3479 | if Pos( 'Media Cen ter', Edit ion) > 0 t hen | |
3480 | Resu lt := weWi nXPMediaCe nter | |
3481 | else | |
3482 | if Pos( 'Tablet', Edition) > 0 then | |
3483 | Resu lt := weWi nXPTablet; | |
3484 | end | |
3485 | else | |
3486 | if (Pos( 'Windows V ista', Edi tion) = 1) then | |
3487 | begin | |
3488 | // Wind ows Vista Editions | |
3489 | if Pos( 'Starter', Edition) > 0 then | |
3490 | Resu lt := weWi nVistaStar ter | |
3491 | else | |
3492 | if Pos( 'Home Basi c N', Edit ion) > 0 t hen | |
3493 | Resu lt := weWi nVistaHome BasicN | |
3494 | else | |
3495 | if Pos( 'Home Basi c', Editio n) > 0 the n | |
3496 | Resu lt := weWi nVistaHome Basic | |
3497 | else | |
3498 | if Pos( 'Home Prem ium', Edit ion) > 0 t hen | |
3499 | Resu lt := weWi nVistaHome Premium | |
3500 | else | |
3501 | if Pos( 'Business N', Editio n) > 0 the n | |
3502 | Resu lt := weWi nVistaBusi nessN | |
3503 | else | |
3504 | if Pos( 'Business' , Edition) > 0 then | |
3505 | Resu lt := weWi nVistaBusi ness | |
3506 | else | |
3507 | if Pos( 'Enterpris e', Editio n) > 0 the n | |
3508 | Resu lt := weWi nVistaEnte rprise | |
3509 | else | |
3510 | if Pos( 'Ultimate' , Edition) > 0 then | |
3511 | Resu lt := weWi nVistaUlti mate; | |
3512 | end | |
3513 | else | |
3514 | if Pos(' Windows 7' , Edition) = 1 then | |
3515 | begin | |
3516 | // Wind ows 7 Edit ions | |
3517 | if Pos( 'Starter', Edition) > 0 then | |
3518 | Resu lt := weWi n7Starter | |
3519 | else | |
3520 | if Pos( 'Home Basi c', Editio n) > 0 the n | |
3521 | Resu lt := weWi n7HomeBasi c | |
3522 | else | |
3523 | if Pos( 'Home Prem ium', Edit ion) > 0 t hen | |
3524 | Resu lt := weWi n7HomePrem ium | |
3525 | else | |
3526 | if Pos( 'Professio nal', Edit ion) > 0 t hen | |
3527 | Resu lt := weWi n7Professi onal | |
3528 | else | |
3529 | if Pos( 'Enterpris e', Editio n) > 0 the n | |
3530 | Resu lt := weWi n7Enterpri se | |
3531 | else | |
3532 | if Pos( 'Ultimate' , Edition) > 0 then | |
3533 | Resu lt := weWi n7Ultimate ; | |
3534 | end | |
3535 | else | |
3536 | if Pos(' Windows 8. 1', Editio n) = 1 the n | |
3537 | begin | |
3538 | // Wind ows 8.1 Ed itions | |
3539 | if Pos( 'Pro', Edi tion) > 0 then | |
3540 | Resu lt := weWi n81Pro | |
3541 | else | |
3542 | if Pos( 'Enterpris e', Editio n) > 0 the n | |
3543 | Resu lt := weWi n81Enterpr ise | |
3544 | else | |
3545 | Resu lt := weWi n81; | |
3546 | end | |
3547 | else | |
3548 | if Pos(' Windows 8' , Edition) = 1 then | |
3549 | begin | |
3550 | // Wind ows 8 Edit ions | |
3551 | if Pos( 'Pro', Edi tion) > 0 then | |
3552 | Resu lt := weWi n8Pro | |
3553 | else | |
3554 | if Pos( 'Enterpris e', Editio n) > 0 the n | |
3555 | Resu lt := weWi n8Enterpri se | |
3556 | else | |
3557 | Resu lt := weWi n8; | |
3558 | end | |
3559 | else | |
3560 | if Pos(' Windows RT 8.1', Edi tion) = 1 then | |
3561 | Result := weWin8 1RT | |
3562 | else | |
3563 | if Pos(' Windows RT ', Edition ) = 1 then | |
3564 | Result := weWin8 RT | |
3565 | else | |
3566 | if Pos(' Windows 10 ', Edition ) = 1 then | |
3567 | begin | |
3568 | // Wind ows 10 Edi tions | |
3569 | if Pos( 'Home', Ed ition) > 0 then | |
3570 | Resu lt := weWi n10Home | |
3571 | else | |
3572 | if Pos( 'Pro', Edi tion) > 0 then | |
3573 | Resu lt := weWi n10Pro | |
3574 | else | |
3575 | if Pos( 'Enterpris e', Editio n) > 0 the n | |
3576 | Resu lt := weWi n10Enterpr ise | |
3577 | else | |
3578 | if Pos( 'Education ', Edition ) > 0 then | |
3579 | Resu lt := weWi n10Educati on | |
3580 | else | |
3581 | Resu lt := weWi n10; | |
3582 | end | |
3583 | ||
3584 | end; | |
3585 | ||
3586 | function N tProductTy pe: TNtPro ductType; | |
3587 | const | |
3588 | ProductT ype = 'SYS TEM\Curren tControlSe t\Control\ ProductOpt ions'; | |
3589 | var | |
3590 | Product: string; | |
3591 | OSVersio nInfo: TOS VersionInf oEx; | |
3592 | SystemIn fo: TSyste mInfo; | |
3593 | begin | |
3594 | Result : = ptUnknow n; | |
3595 | ResetMem ory(OSVers ionInfo, S izeOf(OSVe rsionInfo) ); | |
3596 | ResetMem ory(System Info, Size Of(SystemI nfo)); | |
3597 | OSVersio nInfo.dwOS VersionInf oSize := S izeOf(OSVe rsionInfo) ; | |
3598 | GetNativ eSystemInf o(SystemIn fo); | |
3599 | ||
3600 | // Favor documente d API over registry | |
3601 | if IsWin NT4 and (G etWindowsS ervicePack Version >= 6) then | |
3602 | begin | |
3603 | if Get VersionEx( OSVersionI nfo) then | |
3604 | begin | |
3605 | if ( OSVersionI nfo.wProdu ctType = V ER_NT_WORK STATION) t hen | |
3606 | Re sult := pt Workstatio n | |
3607 | else | |
3608 | if ( OSVersionI nfo.wSuite Mask and V ER_SUITE_E NTERPRISE) = VER_SUI TE_ENTERPR ISE then | |
3609 | Re sult := pt Enterprise | |
3610 | else | |
3611 | Re sult := pt Server; | |
3612 | end; | |
3613 | end | |
3614 | else | |
3615 | if IsWin 2K then | |
3616 | begin | |
3617 | if Get VersionEx( OSVersionI nfo) then | |
3618 | begin | |
3619 | if O SVersionIn fo.wProduc tType in [VER_NT_SE RVER, VER_ NT_DOMAIN_ CONTROLLER ] then | |
3620 | begi n | |
3621 | if (OSVersio nInfo.wSui teMask and VER_SUITE _DATACENTE R) <> 0 th en | |
3622 | Result := ptDatacent erServer | |
3623 | el se | |
3624 | if (OSVersio nInfo.wSui teMask and VER_SUITE _ENTERPRIS E) <> 0 th en | |
3625 | Result := ptAdvanced Server | |
3626 | el se | |
3627 | Result := ptServer; | |
3628 | end | |
3629 | else | |
3630 | Re sult := pt Profession al; | |
3631 | end; | |
3632 | end | |
3633 | else | |
3634 | if IsWin XP64 or Is Win2003 or IsWin2003 R2 then // all (5.2) | |
3635 | begin | |
3636 | if Get VersionEx( OSVersionI nfo) then | |
3637 | begin | |
3638 | if O SVersionIn fo.wProduc tType in [ VER_NT_SER VER, VER_N T_DOMAIN_C ONTROLLER] then | |
3639 | begi n | |
3640 | if (OSVersio nInfo.wSui teMask and VER_SUITE _DATACENTE R) = VER_S UITE_DATAC ENTER then | |
3641 | Result := ptDatacent erServer | |
3642 | el se | |
3643 | if (OSVersio nInfo.wSui teMask and VER_SUITE _ENTERPRIS E) = VER_S UITE_ENTER PRISE then | |
3644 | Result := ptEnterpri se | |
3645 | el se | |
3646 | if (OSVersio nInfo.wSui teMask = V ER_SUITE_B LADE) then | |
3647 | Result := ptWebEditi on | |
3648 | el se | |
3649 | Result := ptServer; | |
3650 | end | |
3651 | else | |
3652 | if ( OSVersionI nfo.wProdu ctType = V ER_NT_WORK STATION) t hen | |
3653 | Re sult := pt Profession al; | |
3654 | end; | |
3655 | end | |
3656 | else | |
3657 | if JclCh eckWinVers ion(5, 1) then // Wi ndows XP o r newer | |
3658 | begin | |
3659 | if Get VersionEx( OSVersionI nfo) then | |
3660 | begin | |
3661 | //if IsWinXP o r IsWinVis ta or IsWi n7 or IsWi n8 or IsWi n81 or IsW in10 then | |
3662 | if O SVersionIn fo.wProduc tType = VE R_NT_WORKS TATION the n // works tation | |
3663 | begi n | |
3664 | if (OSVersio nInfo.wSui teMask and VER_SUITE _PERSONAL) = VER_SUI TE_PERSONA L then | |
3665 | Result := ptPersonal | |
3666 | el se | |
3667 | Result := ptProfessi onal; | |
3668 | end | |
3669 | else | |
3670 | //if IsWinServ er2008 or IsWinServe r2008R2 or IsWinServ er2012 or IsWinServe r2012R2 th en | |
3671 | if O SVersionIn fo.wProduc tType in [ VER_NT_SER VER, VER_N T_DOMAIN_C ONTROLLER] then // s erver | |
3672 | begi n | |
3673 | if (OSVersio nInfo.wSui teMask and VER_SUITE _DATACENTE R) = VER_S UITE_DATAC ENTER then | |
3674 | Result := ptDatacent erServer | |
3675 | el se | |
3676 | if (OSVersio nInfo.wSui teMask and VER_SUITE _ENTERPRIS E) = VER_S UITE_ENTER PRISE then | |
3677 | Result := ptEnterpri se | |
3678 | el se | |
3679 | Result := ptServer; | |
3680 | end; | |
3681 | end; | |
3682 | end; | |
3683 | ||
3684 | if Resul t = ptUnkn own then | |
3685 | begin | |
3686 | // Non Windows 2 000/XP sys tem or the above met hod failed , try regi stry | |
3687 | Produc t := RegRe adStringDe f(HKEY_LOC AL_MACHINE , ProductT ype, 'Prod uctType', ''); | |
3688 | if Com pareText(P roduct, 'W INNT') = 0 then | |
3689 | Resu lt := ptW orkStation | |
3690 | else | |
3691 | if Com pareText(P roduct, 'S ERVERNT') = 0 then | |
3692 | Resu lt := {ptS erver} ptA dvancedSer ver | |
3693 | else | |
3694 | if Com pareText(P roduct, 'L ANMANNT') = 0 then | |
3695 | Resu lt := {ptA dvancedSer ver} ptSer ver | |
3696 | else | |
3697 | Resu lt := ptUn known; | |
3698 | end; | |
3699 | end; | |
3700 | ||
3701 | function G etWindowsV ersionStri ng: string ; | |
3702 | begin | |
3703 | case Get WindowsVer sion of | |
3704 | wvWin9 5: | |
3705 | Resu lt := Load ResString( @RsOSVersi onWin95); | |
3706 | wvWin9 5OSR2: | |
3707 | Resu lt := Load ResString( @RsOSVersi onWin95OSR 2); | |
3708 | wvWin9 8: | |
3709 | Resu lt := Load ResString( @RsOSVersi onWin98); | |
3710 | wvWin9 8SE: | |
3711 | Resu lt := Load ResString( @RsOSVersi onWin98SE) ; | |
3712 | wvWinM E: | |
3713 | Resu lt := Load ResString( @RsOSVersi onWinME); | |
3714 | wvWinN T31, wvWin NT35, wvWi nNT351: | |
3715 | Resu lt := Form at(LoadRes String(@Rs OSVersionW inNT3), [W in32MinorV ersion]); | |
3716 | wvWinN T4: | |
3717 | Resu lt := Form at(LoadRes String(@Rs OSVersionW inNT4), [W in32MinorV ersion]); | |
3718 | wvWin2 000: | |
3719 | Resu lt := Load ResString( @RsOSVersi onWin2000) ; | |
3720 | wvWinX P: | |
3721 | Resu lt := Load ResString( @RsOSVersi onWinXP); | |
3722 | wvWin2 003: | |
3723 | Resu lt := Load ResString( @RsOSVersi onWin2003) ; | |
3724 | wvWin2 003R2: | |
3725 | Resu lt := Load ResString( @RsOSVersi onWin2003R 2); | |
3726 | wvWinX P64: | |
3727 | Resu lt := Load ResString( @RsOSVersi onWinXP64) ; | |
3728 | wvWinV ista: | |
3729 | Resu lt := Load ResString( @RsOSVersi onWinVista ); | |
3730 | wvWinS erver2008: | |
3731 | Resu lt := Load ResString( @RsOSVersi onWinServe r2008); | |
3732 | wvWin7 : | |
3733 | Resu lt := Load ResString( @RsOSVersi onWin7); | |
3734 | wvWinS erver2008R 2: | |
3735 | Resu lt := Load ResString( @RsOSVersi onWinServe r2008R2); | |
3736 | wvWin8 : | |
3737 | Resu lt := Load ResString( @RsOSVersi onWin8); | |
3738 | wvWin8 RT: | |
3739 | Resu lt := Load ResString( @RsOSVersi onWin8RT); | |
3740 | wvWinS erver2012: | |
3741 | Resu lt := Load ResString( @RsOSVersi onWinServe r2012); | |
3742 | wvWin8 1: | |
3743 | Resu lt := Load ResString( @RsOSVersi onWin81); | |
3744 | wvWin8 1RT: | |
3745 | Resu lt := Load ResString( @RsOSVersi onWin81RT) ; | |
3746 | wvWinS erver2012R 2: | |
3747 | Resu lt := Load ResString( @RsOSVersi onWinServe r2012R2); | |
3748 | wvWin1 0: | |
3749 | Resu lt := Load ResString( @RsOSVersi onWin10); | |
3750 | wvWinS erver2016: | |
3751 | Resu lt := Load ResString( @RsOSVersi onWinServe r2016); | |
3752 | else | |
3753 | Result := ''; | |
3754 | end; | |
3755 | end; | |
3756 | ||
3757 | function G etWindowsE ditionStri ng: string ; | |
3758 | begin | |
3759 | case Get WindowsEdi tion of | |
3760 | weWinX PHome: | |
3761 | Resu lt := Load ResString( @RsEdition WinXPHome) ; | |
3762 | weWinX PPro: | |
3763 | Resu lt := Load ResString( @RsEdition WinXPPro); | |
3764 | weWinX PHomeN: | |
3765 | Resu lt := Load ResString( @RsEdition WinXPHomeN ); | |
3766 | weWinX PProN: | |
3767 | Resu lt := Load ResString( @RsEdition WinXPProN) ; | |
3768 | weWinX PHomeK: | |
3769 | Resu lt := Load ResString( @RsEdition WinXPHomeK ); | |
3770 | weWinX PProK: | |
3771 | Resu lt := Load ResString( @RsEdition WinXPProK) ; | |
3772 | weWinX PHomeKN: | |
3773 | Resu lt := Load ResString( @RsEdition WinXPHomeK N); | |
3774 | weWinX PProKN: | |
3775 | Resu lt := Load ResString( @RsEdition WinXPProKN ); | |
3776 | weWinX PStarter: | |
3777 | Resu lt := Load ResString( @RsEdition WinXPStart er); | |
3778 | weWinX PMediaCent er: | |
3779 | Resu lt := Load ResString( @RsEdition WinXPMedia Center); | |
3780 | weWinX PTablet: | |
3781 | Resu lt := Load ResString( @RsEdition WinXPTable t); | |
3782 | weWinV istaStarte r: | |
3783 | Resu lt := Load ResString( @RsEdition WinVistaSt arter); | |
3784 | weWinV istaHomeBa sic: | |
3785 | Resu lt := Load ResString( @RsEdition WinVistaHo meBasic); | |
3786 | weWinV istaHomeBa sicN: | |
3787 | Resu lt := Load ResString( @RsEdition WinVistaHo meBasicN); | |
3788 | weWinV istaHomePr emium: | |
3789 | Resu lt := Load ResString( @RsEdition WinVistaHo mePremium) ; | |
3790 | weWinV istaBusine ss: | |
3791 | Resu lt := Load ResString( @RsEdition WinVistaBu siness); | |
3792 | weWinV istaBusine ssN: | |
3793 | Resu lt := Load ResString( @RsEdition WinVistaBu sinessN); | |
3794 | weWinV istaEnterp rise: | |
3795 | Resu lt := Load ResString( @RsEdition WinVistaEn terprise); | |
3796 | weWinV istaUltima te: | |
3797 | Resu lt := Load ResString( @RsEdition WinVistaUl timate); | |
3798 | weWin7 Starter: | |
3799 | Resu lt := Load ResString( @RsEdition Win7Starte r); | |
3800 | weWin7 HomeBasic: | |
3801 | Resu lt := Load ResString( @RsEdition Win7HomeBa sic); | |
3802 | weWin7 HomePremiu m: | |
3803 | Resu lt := Load ResString( @RsEdition Win7HomePr emium); | |
3804 | weWin7 Profession al: | |
3805 | Resu lt := Load ResString( @RsEdition Win7Profes sional); | |
3806 | weWin7 Enterprise : | |
3807 | Resu lt := Load ResString( @RsEdition Win7Enterp rise); | |
3808 | weWin7 Ultimate: | |
3809 | Resu lt := Load ResString( @RsEdition Win7Ultima te); | |
3810 | weWin8 Pro: | |
3811 | Resu lt := Load ResString( @RsEdition Win8Pro); | |
3812 | weWin8 Enterprise : | |
3813 | Resu lt := Load ResString( @RsEdition Win8Enterp rise); | |
3814 | weWin8 RT: | |
3815 | Resu lt := Load ResString( @RsEdition Win8RT); | |
3816 | weWin8 1Pro: | |
3817 | Resu lt := Load ResString( @RsEdition Win81Pro); | |
3818 | weWin8 1Enterpris e: | |
3819 | Resu lt := Load ResString( @RsEdition Win81Enter prise); | |
3820 | weWin8 1RT: | |
3821 | Resu lt := Load ResString( @RsEdition Win81RT); | |
3822 | weWin1 0Home: | |
3823 | Resu lt := Load ResString( @RsEdition Win10Home) ; | |
3824 | weWin1 0Pro: | |
3825 | Resu lt := Load ResString( @RsEdition Win10Pro); | |
3826 | weWin1 0Enterpris e: | |
3827 | Resu lt := Load ResString( @RsEdition Win10Enter prise); | |
3828 | weWin1 0Education : | |
3829 | Resu lt := Load ResString( @RsEdition Win10Educa tion); | |
3830 | else | |
3831 | Result := ''; | |
3832 | end; | |
3833 | end; | |
3834 | ||
3835 | function G etWindowsP roductStri ng: string ; | |
3836 | begin | |
3837 | Result : = GetWindo wsVersionS tring; | |
3838 | if GetWi ndowsEditi onString < > '' then | |
3839 | Result := Result + ' ' + G etWindowsE ditionStri ng; | |
3840 | end; | |
3841 | ||
3842 | function N tProductTy peString: string; | |
3843 | begin | |
3844 | case NtP roductType of | |
3845 | ptWork Station: | |
3846 | Resu lt := Load ResString( @RsProduct TypeWorkSt ation); | |
3847 | ptServ er: | |
3848 | Resu lt := Load ResString( @RsProduct TypeServer ); | |
3849 | ptAdva ncedServer : | |
3850 | Resu lt := Load ResString( @RsProduct TypeAdvanc edServer); | |
3851 | ptPers onal: | |
3852 | Resu lt := Load ResString( @RsProduct TypePerson al); | |
3853 | ptProf essional: | |
3854 | Resu lt := Load ResString( @RsProduct TypeProfes sional); | |
3855 | ptData centerServ er: | |
3856 | Resu lt := Load ResString( @RsProduct TypeDatace nterServer ); | |
3857 | ptEnte rprise: | |
3858 | Resu lt := Load ResString( @RsProduct TypeEnterp rise); | |
3859 | ptWebE dition: | |
3860 | Resu lt := Load ResString( @RsProduct TypeWebEdi tion); | |
3861 | else | |
3862 | Result := ''; | |
3863 | end; | |
3864 | end; | |
3865 | ||
3866 | function G etWindowsB uildNumber : Integer; | |
3867 | begin | |
3868 | // Start ing with W indows 8.1 , the GetV ersion(Ex) API is de precated a nd will de tect the | |
3869 | // appli cation as Windows 8 (kernel ve rsion 6.2) until an applicatio n manifest is includ ed | |
3870 | // See h ttps://msd n.microsof t.com/en-u s/library/ windows/de sktop/dn30 2074.aspx | |
3871 | if (Win3 2MajorVers ion = 6) a nd (Win32M inorVersio n = 2) the n | |
3872 | Result := strToI nt(RegRead StringDef( HKEY_LOCAL _MACHINE, 'SOFTWARE\ Microsoft\ Windows NT \CurrentVe rsion', 'C urrentBuil dNumber', intToStr(W in32BuildN umber))) | |
3873 | else | |
3874 | Result := Win32B uildNumber ; | |
3875 | end; | |
3876 | ||
3877 | function G etWindowsM ajorVersio nNumber: I nteger; | |
3878 | begin | |
3879 | // Start ing with W indows 8.1 , the GetV ersion(Ex) API is de precated a nd will de tect the | |
3880 | // appli cation as Windows 8 (kernel ve rsion 6.2) until an applicatio n manifest is includ ed | |
3881 | // See h ttps://msd n.microsof t.com/en-u s/library/ windows/de sktop/dn30 2074.aspx | |
3882 | if (Win3 2MajorVers ion = 6) a nd (Win32M inorVersio n = 2) the n | |
3883 | begin | |
3884 | // Cur rentMajorV ersionNumb er present in regist ry startin g with Win dows 10 | |
3885 | // If CurrentMaj orVersionN umber not present in registry then use C urrentVers ion | |
3886 | Result := RegRea dIntegerDe f(HKEY_LOC AL_MACHINE , 'SOFTWAR E\Microsof t\Windows NT\Current Version', 'CurrentMa jorVersion Number', - 1); | |
3887 | if Res ult = -1 t hen | |
3888 | Resu lt := strT oInt(StrBe fore('.', RegReadStr ingDef(HKE Y_LOCAL_MA CHINE, 'SO FTWARE\Mic rosoft\Win dows NT\Cu rrentVersi on', 'Curr entVersion ', intToSt r(Win32Maj orVersion) + '.' + i ntToStr(Wi n32MinorVe rsion)))); | |
3889 | end | |
3890 | else | |
3891 | Result := Win32M ajorVersio n; | |
3892 | end; | |
3893 | ||
3894 | function G etWindowsM inorVersio nNumber: I nteger; | |
3895 | begin | |
3896 | // Start ing with W indows 8.1 , the GetV ersion(Ex) API is de precated a nd will de tect the | |
3897 | // appli cation as Windows 8 (kernel ve rsion 6.2) until an applicatio n manifest is includ ed | |
3898 | // See h ttps://msd n.microsof t.com/en-u s/library/ windows/de sktop/dn30 2074.aspx | |
3899 | if (Win3 2MajorVers ion = 6) a nd (Win32M inorVersio n = 2) the n | |
3900 | begin | |
3901 | // Cur rentMinorV ersionNumb er present in regist ry startin g with Win dows 10 | |
3902 | // If CurrentMin orVersionN umber not present th en use Cur rentVersio n | |
3903 | Result := RegRea dIntegerDe f(HKEY_LOC AL_MACHINE , 'SOFTWAR E\Microsof t\Windows NT\Current Version', 'CurrentMi norVersion Number', - 1); | |
3904 | if Res ult = -1 t hen | |
3905 | Resu lt := strT oInt(StrAf ter('.', R egReadStri ngDef(HKEY _LOCAL_MAC HINE, 'SOF TWARE\Micr osoft\Wind ows NT\Cur rentVersio n', 'Curre ntVersion' , intToStr (Win32Majo rVersion) + '.' + in tToStr(Win 32MinorVer sion)))); | |
3906 | end | |
3907 | else | |
3908 | Result := Win32M ajorVersio n; | |
3909 | end; | |
3910 | ||
3911 | function G etWindowsV ersionNumb er: string ; | |
3912 | begin | |
3913 | // Retur ns version number as MajorVers ionNumber. MinorVersi onNumber ( string typ e) | |
3914 | Result : = intToStr (GetWindow sMajorVers ionNumber) + '.' + i ntToStr(Ge tWindowsMi norVersion Number); | |
3915 | end; | |
3916 | ||
3917 | function G etWindowsS ervicePack Version: I nteger; | |
3918 | const | |
3919 | RegWindo wsControl = 'SYSTEM\ CurrentCon trolSet\Co ntrol\Wind ows'; | |
3920 | var | |
3921 | SP: Inte ger; | |
3922 | VersionI nfo: TOSVe rsionInfoE x; | |
3923 | begin | |
3924 | Result : = 0; | |
3925 | if (Win3 2Platform = VER_PLAT FORM_WIN32 _NT) and ( Win32Major Version >= 5) then | |
3926 | begin | |
3927 | ResetM emory(Vers ionInfo, S izeOf(Vers ionInfo)); | |
3928 | Versio nInfo.dwOS VersionInf oSize := S izeOf(Vers ionInfo); | |
3929 | if Get VersionEx( VersionInf o) then | |
3930 | Resu lt := Vers ionInfo.wS ervicePack Major; | |
3931 | end | |
3932 | else | |
3933 | begin | |
3934 | SP := RegReadInt egerDef(HK EY_LOCAL_M ACHINE, Re gWindowsCo ntrol, 'CS DVersion', 0); | |
3935 | Result := StrToI nt(IntToHe x(SP, 4)) div 100; | |
3936 | end; | |
3937 | end; | |
3938 | ||
3939 | function G etWindowsS ervicePack VersionStr ing: strin g; | |
3940 | var | |
3941 | SP: Inte ger; | |
3942 | begin | |
3943 | SP := Ge tWindowsSe rvicePackV ersion; | |
3944 | if SP > 0 then | |
3945 | Result := Format (LoadResSt ring(@RsSP Info), [SP ]) | |
3946 | else | |
3947 | Result := ''; | |
3948 | end; | |
3949 | ||
3950 | // Imports copied fr om OpenGL unit. Dire ct using o f OpenGL u nit might cause unex pected pro blems due | |
3951 | // setting 8087CW in the intia lization s ection | |
3952 | { | |
3953 | function g lGetString (name: Car dinal): PC har; stdca ll; extern al opengl3 2; | |
3954 | function g lGetError: Cardinal; stdcall; external o pengl32; | |
3955 | function g luErrorStr ing(errCod e: Cardina l): PChar; stdcall; external ' glu32.dll' ; | |
3956 | } | |
3957 | ||
3958 | type | |
3959 | TglGetSt ringFunc = function( name: Card inal): PAn siChar; st dcall; | |
3960 | TglGetEr rorFunc = function: Cardinal; stdcall; | |
3961 | TgluErro rStringFun c = functi on(errCode : Cardinal ): PAnsiCh ar; stdcal l; | |
3962 | ||
3963 | TwglCrea teContextF unc = func tion(DC: H DC): HGLRC ; stdcall; | |
3964 | TwglDele teContextF unc = func tion(p1: H GLRC): BOO L; stdcall ; | |
3965 | TwglMake CurrentFun c = functi on(DC: HDC ; p2: HGLR C): BOOL; stdcall; | |
3966 | ||
3967 | const | |
3968 | glu32 = 'glu32.dll '; // do n ot localiz e | |
3969 | glGetStr ingName = 'glGetStri ng'; // do not local ize | |
3970 | glGetErr orName = ' glGetError '; // do n ot localiz e | |
3971 | gluError StringName = 'gluErr orString'; // do not localize | |
3972 | wglCreat eContextNa me = 'wglC reateConte xt'; // do not local ize | |
3973 | wglDelet eContextNa me = 'wglD eleteConte xt'; // do not local ize | |
3974 | wglMakeC urrentName = 'wglMak eCurrent'; // do not localize | |
3975 | ChoosePi xelFormatN ame = 'Cho osePixelFo rmat'; // do not loc alize | |
3976 | SetPixel FormatName = 'SetPix elFormat'; // do not localize | |
3977 | ||
3978 | function G etOpenGLVe rsion(cons t Win: THa ndle; out Version, V endor: Ans iString): Boolean; | |
3979 | const | |
3980 | GL_NO_ER ROR = 0; | |
3981 | GL_VENDO R = $1F0 0; | |
3982 | GL_VERSI ON = $1F0 2; | |
3983 | var | |
3984 | OpenGlLi b, Glu32Li b: HModule ; | |
3985 | ||
3986 | glGetStr ingFunc: T glGetStrin gFunc; | |
3987 | glGetErr orFunc: Tg lGetErrorF unc; | |
3988 | gluError StringFunc : TgluErro rStringFun c; | |
3989 | ||
3990 | wglCreat eContextFu nc: TwglCr eateContex tFunc; | |
3991 | wglDelet eContextFu nc: TwglDe leteContex tFunc; | |
3992 | wglMakeC urrentFunc : TwglMake CurrentFun c; | |
3993 | ||
3994 | pfd: TPi xelFormatD escriptor; | |
3995 | iFormatI ndex: Inte ger; | |
3996 | hGLConte xt: HGLRC; | |
3997 | hGLDC: H DC; | |
3998 | pcTemp: PAnsiChar; | |
3999 | glErr: C ardinal; | |
4000 | bError: Boolean; | |
4001 | sOpenGLV ersion, sO penGLVendo r: AnsiStr ing; | |
4002 | Save8087 CW: Word; | |
4003 | ||
4004 | procedur e Function FailedErro r(Name: st ring); | |
4005 | begin | |
4006 | raise EJclError. CreateResF mt(@RsEOpe nGLInfo, [ Name]); | |
4007 | end; | |
4008 | ||
4009 | begin | |
4010 | @glGetSt ringFunc : = nil; | |
4011 | @glGetEr rorFunc := nil; | |
4012 | @gluErro rStringFun c := nil; | |
4013 | ||
4014 | @wglCrea teContextF unc := nil ; | |
4015 | @wglDele teContextF unc := nil ; | |
4016 | @wglMake CurrentFun c := nil; | |
4017 | ||
4018 | Glu32Lib := 0; | |
4019 | OpenGlLi b := SafeL oadLibrary (opengl32) ; | |
4020 | try | |
4021 | if Ope nGlLib <> 0 then | |
4022 | begin | |
4023 | Glu3 2Lib := Sa feLoadLibr ary(glu32) ; // do no t localize | |
4024 | if ( OpenGlLib <> 0) and (Glu32Lib <> 0) then | |
4025 | begi n | |
4026 | gl GetStringF unc := Get ProcAddres s(OpenGlLi b, glGetSt ringName); | |
4027 | gl GetErrorFu nc := GetP rocAddress (OpenGlLib , glGetErr orName); | |
4028 | gl uErrorStri ngFunc := GetProcAdd ress(Glu32 Lib, gluEr rorStringN ame); | |
4029 | ||
4030 | wg lCreateCon textFunc : = GetProcA ddress(Ope nGlLib, wg lCreateCon textName); | |
4031 | wg lDeleteCon textFunc : = GetProcA ddress(Ope nGlLib, wg lDeleteCon textName); | |
4032 | wg lMakeCurre ntFunc := GetProcAdd ress(OpenG lLib, wglM akeCurrent Name); | |
4033 | end; | |
4034 | end; | |
4035 | ||
4036 | if not (Assigned (glGetStri ngFunc) an d Assigned (glGetErro rFunc) and Assigned( gluErrorSt ringFunc) and | |
4037 | Assigned (wglCreate ContextFun c) and Ass igned(wglD eleteConte xtFunc) an d Assigned (wglMakeCu rrentFunc) ) then | |
4038 | begin | |
4039 | @glG etStringFu nc := nil; | |
4040 | Resu lt := Fals e; | |
4041 | Vend or := Ansi String(Loa dResString (@RsOpenGL InfoError) ); | |
4042 | Vers ion := Ans iString(Lo adResStrin g(@RsOpenG LInfoError )); | |
4043 | Exit ; | |
4044 | end; | |
4045 | ||
4046 | { To c all for th e version informatio n string w e must fir st have an active | |
4047 | cont ext establ ished for use. We c an, of cou rse, close this afte r use } | |
4048 | Save80 87CW := Ge t8087Contr olWord; | |
4049 | try | |
4050 | Set8 087CW($133 F); | |
4051 | hGLC ontext := 0; | |
4052 | Resu lt := Fals e; | |
4053 | bErr or := Fals e; | |
4054 | ||
4055 | if W in = 0 the n | |
4056 | begi n | |
4057 | Re sult := Fa lse; | |
4058 | Ve ndor := An siString(L oadResStri ng(@RsOpen GLInfoErro r)); | |
4059 | Ve rsion := A nsiString( LoadResStr ing(@RsOpe nGLInfoErr or)); | |
4060 | Ex it; | |
4061 | end; | |
4062 | ||
4063 | Rese tMemory(pf d, SizeOf( pfd)); | |
4064 | with pfd do | |
4065 | begi n | |
4066 | nS ize := Siz eOf(pfd); | |
4067 | nV ersion := 1; { The Current Ve rsion of t he descrip tor is 1 } | |
4068 | dw Flags := P FD_DRAW_TO _WINDOW or PFD_SUPPO RT_OPENGL; | |
4069 | iP ixelType : = PFD_TYPE _RGBA; | |
4070 | cC olorBits : = 24; { s upport 24- bit colour } | |
4071 | cD epthBits : = 32; { D epth of th e z-buffer } | |
4072 | iL ayerType : = PFD_MAIN _PLANE; | |
4073 | end; | |
4074 | ||
4075 | hGLD C := GetDC (Win); | |
4076 | try | |
4077 | iF ormatIndex := Choose PixelForma t(hGLDC, @ pfd); | |
4078 | if iFormatIn dex = 0 th en | |
4079 | FunctionFa iledError( ChoosePixe lFormatNam e); | |
4080 | ||
4081 | if not SetPi xelFormat( hGLDC, iFo rmatIndex, @pfd) the n | |
4082 | FunctionFa iledError( SetPixelFo rmatName); | |
4083 | ||
4084 | hG LContext : = wglCreat eContextFu nc(hGLDC); | |
4085 | if hGLContex t = 0 then | |
4086 | FunctionFa iledError( wglCreateC ontextName ); | |
4087 | ||
4088 | if not wglMa keCurrentF unc(hGLDC, hGLContex t) then | |
4089 | FunctionFa iledError( wglMakeCur rentName); | |
4090 | ||
4091 | { TODO : Rev iew the fo llowing. Not sure I am 100% h appy with this code | |
4092 | in its curren t structur e. } | |
4093 | pc Temp := gl GetStringF unc(GL_VER SION); | |
4094 | if pcTemp <> nil then | |
4095 | be gin | |
4096 | { TODO : S tore this informatio n in a Glo bal Variab le, and re turn that? ? | |
4097 | T his would save this work being performed again wit h later ca lls } | |
4098 | sOpenGLVer sion := St rPasA(pcTe mp); | |
4099 | en d | |
4100 | el se | |
4101 | be gin | |
4102 | bError := True; | |
4103 | glErr := g lGetErrorF unc; | |
4104 | if glErr < > GL_NO_ER ROR then | |
4105 | begin | |
4106 | sOpenGLV ersion := gluErrorSt ringFunc(g lErr); | |
4107 | sOpenGLV endor := ' '; | |
4108 | end; | |
4109 | en d; | |
4110 | ||
4111 | pc Temp := gl GetStringF unc(GL_VEN DOR); | |
4112 | if pcTemp <> nil then | |
4113 | be gin | |
4114 | { TODO : S tore this informatio n in a Glo bal Variab le, and re turn that? ? | |
4115 | T his would save this work being performed again wit h later ca lls } | |
4116 | sOpenGLVen dor := Str PasA(pcTem p); | |
4117 | en d | |
4118 | el se | |
4119 | be gin | |
4120 | bError := True; | |
4121 | glErr := g lGetErrorF unc; | |
4122 | if glErr < > GL_NO_ER ROR then | |
4123 | begin | |
4124 | sOpenGLV endor := g luErrorStr ingFunc(gl Err); | |
4125 | Exit; | |
4126 | end; | |
4127 | en d; | |
4128 | ||
4129 | Re sult := (n ot bError) ; | |
4130 | Ve rsion := s OpenGLVers ion; | |
4131 | Ve ndor := sO penGLVendo r; | |
4132 | fina lly | |
4133 | { Close all resources } | |
4134 | wg lMakeCurre ntFunc(hGL DC, 0); | |
4135 | if hGLContex t <> 0 the n | |
4136 | wglDeleteC ontextFunc (hGLContex t); | |
4137 | end; | |
4138 | finall y | |
4139 | Set8 087CW(Save 8087CW); | |
4140 | end; | |
4141 | finally | |
4142 | if (Op enGlLib <> 0) then | |
4143 | Free Library(Op enGlLib); | |
4144 | if (Gl u32Lib <> 0) then | |
4145 | Free Library(Gl u32Lib); | |
4146 | end; | |
4147 | end; | |
4148 | ||
4149 | function G etNativeSy stemInfo(v ar SystemI nfo: TSyst emInfo): B oolean; | |
4150 | type | |
4151 | TGetNati veSystemIn fo = proce dure (var SystemInfo : TSystemI nfo); stdc all; | |
4152 | var | |
4153 | LibraryH andle: HMO DULE; | |
4154 | _GetNati veSystemIn fo: TGetNa tiveSystem Info; | |
4155 | begin | |
4156 | Result : = False; | |
4157 | LibraryH andle := G etModuleHa ndle(kerne l32); | |
4158 | ||
4159 | if Libra ryHandle < > 0 then | |
4160 | begin | |
4161 | _GetNa tiveSystem Info := Ge tProcAddre ss(Library Handle, PA nsiChar('G etNativeSy stemInfo') ); | |
4162 | if Ass igned(_Get NativeSyst emInfo) th en | |
4163 | begin | |
4164 | _Get NativeSyst emInfo(Sys temInfo); | |
4165 | Resu lt := True ; | |
4166 | end | |
4167 | else | |
4168 | GetS ystemInfo( SystemInfo ); | |
4169 | end | |
4170 | else | |
4171 | GetSys temInfo(Sy stemInfo); | |
4172 | end; | |
4173 | ||
4174 | function G etProcesso rArchitect ure: TProc essorArchi tecture; | |
4175 | var | |
4176 | ASystemI nfo: TSyst emInfo; | |
4177 | begin | |
4178 | ASystemI nfo.dwOemI d := 0; | |
4179 | GetNativ eSystemInf o(ASystemI nfo); | |
4180 | case ASy stemInfo.w ProcessorA rchitectur e of | |
4181 | PROCES SOR_ARCHIT ECTURE_INT EL: | |
4182 | Resu lt := pax8 632; | |
4183 | PROCES SOR_ARCHIT ECTURE_IA6 4: | |
4184 | Resu lt := paIA 64; | |
4185 | PROCES SOR_ARCHIT ECTURE_AMD 64: | |
4186 | Resu lt := pax8 664; | |
4187 | else | |
4188 | Resu lt := paUn known; | |
4189 | end; | |
4190 | end; | |
4191 | ||
4192 | function I sWindows64 : Boolean; | |
4193 | var | |
4194 | ASystemI nfo: TSyst emInfo; | |
4195 | begin | |
4196 | ASystemI nfo.dwOemI d := 0; | |
4197 | GetNativ eSystemInf o(ASystemI nfo); | |
4198 | Result : = ASystemI nfo.wProce ssorArchit ecture in [PROCESSOR _ARCHITECT URE_IA64,P ROCESSOR_A RCHITECTUR E_AMD64]; | |
4199 | end; | |
4200 | ||
4201 | function J clCheckWin Version(Ma jor, Minor : Integer) : Boolean; | |
4202 | begin | |
4203 | {$IFDEF RTL150_UP} | |
4204 | Result : = CheckWin 32Version( Major, Min or); | |
4205 | {$ELSE} | |
4206 | // Delph i 6 and ol der have a wrong imp lementatio n | |
4207 | Result : = (Win32Ma jorVersion > Major) or | |
4208 | ((Win32M ajorVersio n = Major) and (Win3 2MinorVers ion >= Min or)); | |
4209 | {$ENDIF RTL150_UP} | |
4210 | end; | |
4211 | ||
4212 | {$ENDIF MS WINDOWS} | |
4213 | ||
4214 | function G etOSVersio nString: s tring; | |
4215 | {$IFDEF UN IX} | |
4216 | var | |
4217 | MachineI nfo: utsna me; | |
4218 | begin | |
4219 | uname(Ma chineInfo) ; | |
4220 | Result : = Format(' %s %s', [M achineInfo .sysname, MachineInf o.release] ); | |
4221 | end; | |
4222 | {$ENDIF UN IX} | |
4223 | {$IFDEF MS WINDOWS} | |
4224 | begin | |
4225 | Result : = Format(' %s %s', [G etWindowsV ersionStri ng, GetWin dowsServic ePackVersi onString]) ; | |
4226 | end; | |
4227 | {$ENDIF MS WINDOWS} | |
4228 | ||
4229 | //=== Hard ware ===== ========== ========== ========== ========== ========== ======== | |
4230 | ||
4231 | // Helper function f or GetMacA ddress() | |
4232 | // Convert s the adap ter_addres s array to a string | |
4233 | ||
4234 | function A dapterToSt ring(Adapt er: PJclBy teArray): string; | |
4235 | begin | |
4236 | Result : = Format(' %2.2x-%2.2 x-%2.2x-%2 .2x-%2.2x- %2.2x', | |
4237 | [Intege r(Adapter[ 0]), Integ er(Adapter [1]), | |
4238 | Intege r(Adapter[ 2]), Integ er(Adapter [3]), | |
4239 | Intege r(Adapter[ 4]), Integ er(Adapter [5])]); | |
4240 | end; | |
4241 | ||
4242 | { TODO: RT LD version of NetBio s } | |
4243 | {$IFDEF MS WINDOWS} | |
4244 | type | |
4245 | TNetBios = functio n(P: PNCB) : Byte; st dcall; | |
4246 | ||
4247 | var | |
4248 | NetBiosL ib: HINST = 0; | |
4249 | _NetBios : TNetBios ; | |
4250 | {$IFDEF FPC} | |
4251 | NullAdap terAddress : array [0 ..5] of By te = ($00, $00, $00, $00, $00, $00); | |
4252 | OID_ipMA CEntAddr: array [0.. 9] of UINT = (1, 3, 6, 1, 2, 1 , 2, 2, 1, 6); | |
4253 | OID_ifEn tryType: a rray [0..9 ] of UINT = (1, 3, 6 , 1, 2, 1, 2, 2, 1, 3); | |
4254 | OID_ifEn tryNum: ar ray [0..7] of UINT = (1, 3, 6, 1, 2, 1, 2, 1); | |
4255 | {$ENDIF FPC} | |
4256 | ||
4257 | function G etMacAddre sses(const Machine: string; co nst Addres ses: TStri ngs): Inte ger; | |
4258 | ||
4259 | procedur e ExitNetb ios; | |
4260 | begin | |
4261 | if Net BiosLib <> 0 then | |
4262 | begin | |
4263 | Free Library(Ne tBiosLib); | |
4264 | NetB iosLib := 0; | |
4265 | end; | |
4266 | end; | |
4267 | ||
4268 | function InitNetbi os: Boolea n; | |
4269 | begin | |
4270 | Result := True; | |
4271 | if Net BiosLib = 0 then | |
4272 | begin | |
4273 | NetB iosLib := SafeLoadLi brary('net api32.dll' ); | |
4274 | Resu lt := NetB iosLib <> 0; | |
4275 | if R esult then | |
4276 | begi n | |
4277 | @_ NetBios := GetProcAd dress(NetB iosLib, PA nsiChar('N etbios')); | |
4278 | Re sult := @_ NetBios <> nil; | |
4279 | if not Resul t then | |
4280 | ExitNetbio s; | |
4281 | end; | |
4282 | end; | |
4283 | end; | |
4284 | ||
4285 | function NetBios(P : PNCB): B yte; | |
4286 | begin | |
4287 | if Ini tNetbios t hen | |
4288 | Resu lt := _Net Bios(P) | |
4289 | else | |
4290 | Resu lt := 1; / / anything other tha n NRC_GOOD RET will d o | |
4291 | end; | |
4292 | ||
4293 | procedur e GetMacAd dressesNet Bios; | |
4294 | // Platf orm SDK | |
4295 | // http: //msdn.mic rosoft.com /library/d efault.asp ?url=/libr ary/en-us/ netbios/ne tbios_1l82 .asp | |
4296 | ||
4297 | // Micro soft Knowl edge Base Article - 118623 | |
4298 | // HOWTO : Get the MAC Addres s for an E thernet Ad apter | |
4299 | // http: //support. microsoft. com/defaul t.aspx?sci d=kb;en-us ;118623 | |
4300 | type | |
4301 | AStat = packed r ecord | |
4302 | adap t: TAdapte rStatus; | |
4303 | Name Buff: arra y [0..29] of TNameBu ffer; | |
4304 | end; | |
4305 | var | |
4306 | NCB: T NCB; | |
4307 | Enum: TLanaEnum; | |
4308 | I, L, NameLen: I nteger; | |
4309 | Adapte r: AStat; | |
4310 | Machin eName: Ans iString; | |
4311 | begin | |
4312 | Machin eName := A nsiString( UpperCase( Machine)); | |
4313 | if Mac hineName = '' then | |
4314 | Mach ineName := '*'; | |
4315 | NameLe n := Lengt h(MachineN ame); | |
4316 | L := N CBNAMSZ - NameLen; | |
4317 | if L > 0 then | |
4318 | begin | |
4319 | SetL ength(Mach ineName, N CBNAMSZ); | |
4320 | Fill Char(Machi neName[Nam eLen + 1], L, ' '); | |
4321 | end; | |
4322 | // Fro m Junior/R O in NG: M icrosoft's implement ation limi ts NETBIOS names to 15 charact ers | |
4323 | Machin eName[NCBN AMSZ] := # 0; | |
4324 | ResetM emory(NCB, SizeOf(NC B)); | |
4325 | NCB.nc b_command := NCBENUM ; | |
4326 | NCB.nc b_buffer : = Pointer( @Enum); | |
4327 | NCB.nc b_length : = SizeOf(E num); | |
4328 | if Net Bios(@NCB) = NRC_GOO DRET then | |
4329 | begin | |
4330 | Resu lt := Enum .Length; | |
4331 | for I := 0 to Ord(Enum.L ength) - 1 do | |
4332 | begi n | |
4333 | Re setMemory( NCB, SizeO f(NCB)); | |
4334 | NC B.ncb_comm and := NCB RESET; | |
4335 | NC B.ncb_lana _num := En um.lana[I] ; | |
4336 | if NetBios(@ NCB) = NRC _GOODRET t hen | |
4337 | be gin | |
4338 | ResetMemor y(NCB, Siz eOf(NCB)); | |
4339 | NCB.ncb_co mmand := N CBASTAT; | |
4340 | NCB.ncb_la na_num := Enum.lana[ I]; | |
4341 | Move(Machi neName[1], NCB.ncb_c allname, S izeOf(NCB. ncb_callna me)); | |
4342 | NCB.ncb_bu ffer := PU CHAR(@Adap ter); | |
4343 | NCB.ncb_le ngth := Si zeOf(Adapt er); | |
4344 | if NetBios (@NCB) = N RC_GOODRET then | |
4345 | Addresse s.Add(Adap terToStrin g(@Adapter .adapt)); | |
4346 | en d; | |
4347 | end; | |
4348 | end; | |
4349 | end; | |
4350 | ||
4351 | procedur e GetMacAd dressesSnm p; | |
4352 | const | |
4353 | InetMi b1 = 'inet mib1.dll'; | |
4354 | {$IFND EF FPC // can't reso lve addres s of const } | |
4355 | NullAd apterAddre ss: array [0..5] of Byte = ($0 0, $00, $0 0, $00, $0 0, $00); | |
4356 | OID_ip MACEntAddr : array [0 ..9] of UI NT = (1, 3 , 6, 1, 2, 1, 2, 2, 1, 6); | |
4357 | OID_if EntryType: array [0. .9] of UIN T = (1, 3, 6, 1, 2, 1, 2, 2, 1 , 3); | |
4358 | OID_if EntryNum: array [0.. 7] of UINT = (1, 3, 6, 1, 2, 1 , 2, 1); | |
4359 | {$ENDI F ~FPC} | |
4360 | var | |
4361 | PollFo rTrapEvent : THandle; | |
4362 | Suppor tedView: P AsnObjectI dentifier; | |
4363 | MIB_if MACEntAddr : TAsnObje ctIdentifi er; | |
4364 | MIB_if EntryType: TAsnObjec tIdentifie r; | |
4365 | MIB_if EntryNum: TAsnObject Identifier ; | |
4366 | VarBin dList: TSn mpVarBindL ist; | |
4367 | VarBin d: array [ 0..1] of T SnmpVarBin d; | |
4368 | ErrorS tatus, Err orIndex: T AsnInteger 32; | |
4369 | DTmp: Integer; | |
4370 | Ret: B oolean; | |
4371 | MAC: P JclByteArr ay; | |
4372 | begin | |
4373 | if Loa dSnmp then | |
4374 | try | |
4375 | if L oadSnmpExt ension(Ine tMib1) the n | |
4376 | try | |
4377 | MI B_ifMACEnt Addr.idLen gth := Len gth(OID_ip MACEntAddr ); | |
4378 | MI B_ifMACEnt Addr.ids : = @OID_ipM ACEntAddr; | |
4379 | MI B_ifEntryT ype.idLeng th := Leng th(OID_ifE ntryType); | |
4380 | MI B_ifEntryT ype.ids := @OID_ifEn tryType; | |
4381 | MI B_ifEntryN um.idLengt h := Lengt h(OID_ifEn tryNum); | |
4382 | MI B_ifEntryN um.ids := @OID_ifEnt ryNum; | |
4383 | Po llForTrapE vent := 0; | |
4384 | Su pportedVie w := nil; | |
4385 | if SnmpExten sionInit(G etTickCoun t, PollFor TrapEvent, Supported View) then | |
4386 | be gin | |
4387 | VarBindLis t.list := @VarBind[0 ]; | |
4388 | VarBind[0] .name := D EFINE_NULL OID; | |
4389 | VarBind[1] .name := D EFINE_NULL OID; | |
4390 | VarBindLis t.len := 1 ; | |
4391 | SnmpUtilOi dCpy(@VarB ind[0].nam e, @MIB_if EntryNum); | |
4392 | ErrorIndex := 0; | |
4393 | ErrorStatu s := 0; | |
4394 | Ret := Snm pExtension Query(SNMP _PDU_GETNE XT, VarBin dList, Err orStatus, ErrorIndex ); | |
4395 | if Ret the n | |
4396 | begin | |
4397 | Result : = VarBind[ 0].value.n umber; | |
4398 | VarBindL ist.len := 2; | |
4399 | SnmpUtil OidCpy(@Va rBind[0].n ame, @MIB_ ifEntryTyp e); | |
4400 | SnmpUtil OidCpy(@Va rBind[1].n ame, @MIB_ ifMACEntAd dr); | |
4401 | while Re t do | |
4402 | begin | |
4403 | Ret := SnmpExten sionQuery( SNMP_PDU_G ETNEXT, Va rBindList, ErrorStat us, ErrorI ndex); | |
4404 | if Ret then | |
4405 | begin | |
4406 | Ret := SnmpUti lOidNCmp(@ VarBind[0] .name, @MI B_ifEntryT ype, MIB_i fEntryType .idLength) = SNMP_ER RORSTATUS_ NOERROR; | |
4407 | if R et then | |
4408 | begi n | |
4409 | DT mp := VarB ind[0].val ue.number; | |
4410 | if DTmp = 6 then | |
4411 | be gin | |
4412 | Ret := Snm pUtilOidNC mp(@VarBin d[1].name, @MIB_ifMA CEntAddr, MIB_ifMACE ntAddr.idL ength) = S NMP_ERRORS TATUS_NOER ROR; | |
4413 | if Ret and (VarBind[ 1].value.a ddress.str eam <> nil ) then | |
4414 | begin | |
4415 | MAC := P JclByteArr ay(VarBind [1].value. address.st ream); | |
4416 | if not C ompareMem( MAC, @Null AdapterAdd ress, Size Of(NullAda pterAddres s)) then | |
4417 | Addres ses.Add(Ad apterToStr ing(MAC)); | |
4418 | end; | |
4419 | en d; | |
4420 | end; | |
4421 | end; | |
4422 | end; | |
4423 | end; | |
4424 | SnmpUtilVa rBindFree( @VarBind[0 ]); | |
4425 | SnmpUtilVa rBindFree( @VarBind[1 ]); | |
4426 | en d; | |
4427 | fina lly | |
4428 | Un loadSnmpEx tension; | |
4429 | end; | |
4430 | finall y | |
4431 | Unlo adSnmp; | |
4432 | end; | |
4433 | end; | |
4434 | ||
4435 | begin | |
4436 | Result : = -1; | |
4437 | Addresse s.BeginUpd ate; | |
4438 | try | |
4439 | Addres ses.Clear; | |
4440 | GetMac AddressesN etBios; | |
4441 | if (Re sult <= 0) and (Mach ine = '') then | |
4442 | GetM acAddresse sSnmp; | |
4443 | finally | |
4444 | Addres ses.EndUpd ate; | |
4445 | end; | |
4446 | end; | |
4447 | {$ENDIF MS WINDOWS} | |
4448 | function R eadTimeSta mpCounter: Int64; as sembler; | |
4449 | asm | |
4450 | DW $310 F | |
4451 | // TSC in ED X:EAX | |
4452 | {$ IFDEF CPU6 4} | |
4453 | SH L RDX, 32 | |
4454 | OR RAX, RDX | |
4455 | // Result in RAX | |
4456 | {$ ENDIF CPU6 4} | |
4457 | end; | |
4458 | ||
4459 | function G etIntelCac heDescript ion(const D: Byte): string; | |
4460 | var | |
4461 | I: Integ er; | |
4462 | begin | |
4463 | Result : = ''; | |
4464 | if D <> 0 then | |
4465 | for I := Low(Int elCacheDes cription) to High(In telCacheDe scription) do | |
4466 | if I ntelCacheD escription [I].D = D then | |
4467 | begi n | |
4468 | Re sult := Lo adResStrin g(IntelCac heDescript ion[I].I); | |
4469 | Br eak; | |
4470 | end; | |
4471 | // (outc hy) added a return v alue for u nknow D va lue | |
4472 | if Resul t = '' the n | |
4473 | Result := Format (LoadResSt ring(@RsIn telUnknown Cache),[D] ); | |
4474 | end; | |
4475 | ||
4476 | procedure GetCpuInfo (var CpuIn fo: TCpuIn fo); | |
4477 | begin | |
4478 | CpuInfo := CPUID; | |
4479 | CpuInfo. IsFDIVOK : = TestFDIV Instructio n; | |
4480 | if CpuIn fo.HasInst ruction th en | |
4481 | begin | |
4482 | {$IFDE F MSWINDOW S} | |
4483 | if (Cp uInfo.Feat ures and T SC_FLAG) = TSC_FLAG then | |
4484 | GetC puSpeed(Cp uInfo.Freq uencyInfo) ; | |
4485 | {$ENDI F MSWINDOW S} | |
4486 | end; | |
4487 | end; | |
4488 | ||
4489 | function R oundFreque ncy(const Frequency: Integer): Integer; | |
4490 | const | |
4491 | NF: arra y [0..8] o f Integer = (0, 20, 33, 50, 60 , 66, 80, 90, 100); | |
4492 | var | |
4493 | Freq, RF : Integer; | |
4494 | I: Byte; | |
4495 | Hi, Lo: Byte; | |
4496 | begin | |
4497 | RF := 0; | |
4498 | Freq := Frequency mod 100; | |
4499 | for I := 0 to 8 do | |
4500 | begin | |
4501 | if Fre q < NF[I] then | |
4502 | begin | |
4503 | Hi : = I; | |
4504 | Lo : = I - 1; | |
4505 | if ( NF[Hi] - F req) > (Fr eq - NF[Lo ]) then | |
4506 | RF := NF[Lo] - Freq | |
4507 | else | |
4508 | RF := NF[Hi] - Freq; | |
4509 | Brea k; | |
4510 | end; | |
4511 | end; | |
4512 | Result : = Frequenc y + RF; | |
4513 | end; | |
4514 | ||
4515 | function G etCPUSpeed (var CpuSp eed: TFreq Info): Boo lean; | |
4516 | {$IFDEF UN IX} | |
4517 | begin | |
4518 | { TODO : GetCPUSpe ed: Soluti on for Lin ux } | |
4519 | Result : = False; | |
4520 | end; | |
4521 | {$ENDIF UN IX} | |
4522 | {$IFDEF MS WINDOWS} | |
4523 | ||
4524 | var | |
4525 | T0, T1: Int64; | |
4526 | CountFre q: Int64; | |
4527 | Freq, Fr eq2, Freq3 , Total: I nt64; | |
4528 | TotalCyc les, Cycle s: Int64; | |
4529 | Stamp0, Stamp1: In t64; | |
4530 | TotalTic ks, Ticks: Double; | |
4531 | Tries, P riority: I nteger; | |
4532 | Thread: THandle; | |
4533 | begin | |
4534 | Stamp0 : = 0; | |
4535 | Stamp1 : = 0; | |
4536 | Freq := 0; | |
4537 | Freq2 := 0; | |
4538 | Freq3 := 0; | |
4539 | Tries := 0; | |
4540 | TotalCyc les := 0; | |
4541 | TotalTic ks := 0; | |
4542 | Total := 0; | |
4543 | ||
4544 | Thread : = GetCurre ntThread() ; | |
4545 | CountFre q := 0; | |
4546 | Result : = QueryPer formanceFr equency(Co untFreq); | |
4547 | if Resul t then | |
4548 | begin | |
4549 | while ((Tries < 3) or ((Tr ies < 20) and ((Abs( 3 * Freq - Total) > 3) or | |
4550 | (Abs (3 * Freq2 - Total) > 3) or (A bs(3 * Fre q3 - Total ) > 3)))) do | |
4551 | begin | |
4552 | Inc( Tries); | |
4553 | Freq 3 := Freq2 ; | |
4554 | Freq 2 := Freq; | |
4555 | T0 : = 0; | |
4556 | Quer yPerforman ceCounter( T0); | |
4557 | T1 : = T0; | |
4558 | ||
4559 | Prio rity := Ge tThreadPri ority(Thre ad); | |
4560 | if P riority <> THREAD_PR IORITY_ERR OR_RETURN then | |
4561 | Se tThreadPri ority(Thre ad, THREAD _PRIORITY_ TIME_CRITI CAL); | |
4562 | try | |
4563 | wh ile T1 - T 0 < 50 do | |
4564 | be gin | |
4565 | QueryPerfo rmanceCoun ter(T1); | |
4566 | Stamp0 := ReadTimeSt ampCounter ; | |
4567 | en d; | |
4568 | T0 := T1; | |
4569 | ||
4570 | wh ile T1 - T 0 < 1000 d o | |
4571 | be gin | |
4572 | QueryPerfo rmanceCoun ter(T1); | |
4573 | Stamp1 := ReadTimeSt ampCounter ; | |
4574 | en d; | |
4575 | fina lly | |
4576 | if Priority <> THREAD_ PRIORITY_E RROR_RETUR N then | |
4577 | SetThreadP riority(Th read, Prio rity); | |
4578 | end; | |
4579 | ||
4580 | Cycl es := Stam p1 - Stamp 0; | |
4581 | Tick s := T1 - T0; | |
4582 | Tick s := Ticks * 100000; | |
4583 | ||
4584 | // a void divis ion by zer o | |
4585 | if C ountFreq = 0 then | |
4586 | Ti cks := Hig h(Int64) | |
4587 | else | |
4588 | Ti cks := Tic ks / (Coun tFreq / 10 ); | |
4589 | ||
4590 | Tota lTicks := TotalTicks + Ticks; | |
4591 | Tota lCycles := TotalCycl es + Cycle s; | |
4592 | ||
4593 | // a void divis ion by zer o | |
4594 | if I sZero(Tick s) then | |
4595 | Fr eq := High (Freq) | |
4596 | else | |
4597 | Fr eq := Roun d(Cycles / Ticks); | |
4598 | ||
4599 | Tota l := Freq + Freq2 + Freq3; | |
4600 | end; | |
4601 | ||
4602 | // avo id divisio n by zero | |
4603 | if IsZ ero(TotalT icks) then | |
4604 | begin | |
4605 | Freq 3 := High( Freq3); | |
4606 | Freq 2 := High( Freq2); | |
4607 | CpuS peed.RawFr eq := High (CpuSpeed. RawFreq); | |
4608 | end | |
4609 | else | |
4610 | begin | |
4611 | Freq 3 := Round ((TotalCyc les * 10) / TotalTi cks); // f req. in mu ltiples of 10^5 Hz | |
4612 | Freq 2 := Round ((TotalCyc les * 100) / TotalTi cks); // f req. in mu ltiples of 10^4 Hz | |
4613 | CpuS peed.RawFr eq := Roun d(TotalCyc les / Tota lTicks); | |
4614 | end; | |
4615 | ||
4616 | CpuSpe ed.NormFre q := CpuSp eed.RawFre q; | |
4617 | ||
4618 | if Fre q2 - (Freq 3 * 10) >= 6 then | |
4619 | Inc( Freq3); | |
4620 | ||
4621 | ||
4622 | Freq : = CpuSpeed .RawFreq * 10; | |
4623 | if (Fr eq3 - Freq ) >= 6 the n | |
4624 | Inc( CpuSpeed.N ormFreq); | |
4625 | ||
4626 | CpuSpe ed.ExTicks := Round( TotalTicks ); | |
4627 | CpuSpe ed.InCycle s := Total Cycles; | |
4628 | ||
4629 | CpuSpe ed.NormFre q := Round Frequency( CpuSpeed.N ormFreq); | |
4630 | Result := True; | |
4631 | end; | |
4632 | end; | |
4633 | ||
4634 | function G etOSEnable dFeatures: TOSEnable dFeatures; | |
4635 | var | |
4636 | EnabledF eatures: I nt64; | |
4637 | begin | |
4638 | // Windo ws 7 or ne wer | |
4639 | if JclCh eckWinVers ion(6, 1) then | |
4640 | begin | |
4641 | Enable dFeatures := $FFFFFF FF; | |
4642 | Enable dFeatures := Enabled Features s hl 32; | |
4643 | Enable dFeatures := Enabled Features o r $FFFFFFF F; | |
4644 | Enable dFeatures := GetEnab ledExtende dFeatures( EnabledFea tures); | |
4645 | Result := []; | |
4646 | if (En abledFeatu res and XS TATE_MASK_ LEGACY_FLO ATING_POIN T) <> 0 th en | |
4647 | Incl ude(Result , oefFPU); | |
4648 | if (En abledFeatu res and XS TATE_MASK_ LEGACY_SSE ) <> 0 the n | |
4649 | Incl ude(Result , oefSSE); | |
4650 | if (En abledFeatu res and XS TATE_MASK_ GSSE) <> 0 then | |
4651 | Incl ude(Result , oefAVX); | |
4652 | end | |
4653 | else | |
4654 | Result := []; | |
4655 | end; | |
4656 | {$ENDIF MS WINDOWS} | |
4657 | ||
4658 | function C PUID: TCpu Info; | |
4659 | function HasCPUIDI nstruction : Boolean; | |
4660 | const | |
4661 | ID_FLA G = $20000 0; | |
4662 | {$IFNDEF DELPHI64_ TEMPORARY} | |
4663 | begin | |
4664 | {$ENDIF ~DELPHI64_ TEMPORARY} | |
4665 | asm | |
4666 | {$IF DEF CPU32} | |
4667 | PUSH FD | |
4668 | POP EAX | |
4669 | MOV ECX, E AX | |
4670 | XOR EAX, I D_FLAG | |
4671 | AND ECX, I D_FLAG | |
4672 | PUSH EAX | |
4673 | POPF D | |
4674 | PUSH FD | |
4675 | POP EAX | |
4676 | AND EAX, I D_FLAG | |
4677 | XOR EAX, E CX | |
4678 | SETN Z Result | |
4679 | {$EN DIF CPU32} | |
4680 | {$IF DEF CPU64} | |
4681 | {$IF DEF FPC} | |
4682 | {$ DEFINE DEL PHI64_TEMP ORARY} | |
4683 | {$EN DIF FPC} | |
4684 | {$IF DEF DELPHI 64_TEMPORA RY} | |
4685 | PUSH FQ | |
4686 | {$EL SE ~DELPHI 64_TEMPORA RY} | |
4687 | PUSH FD | |
4688 | {$EN DIF ~DELPH I64_TEMPOR ARY} | |
4689 | POP RAX | |
4690 | MOV RCX, R AX | |
4691 | XOR RAX, I D_FLAG | |
4692 | AND RCX, I D_FLAG | |
4693 | PUSH RAX | |
4694 | {$IF DEF DELPHI 64_TEMPORA RY} | |
4695 | POPF Q | |
4696 | {$EL SE ~DELPHI 64_TEMPORA RY} | |
4697 | POPF D | |
4698 | {$EN DIF ~DELPH I64_TEMPOR ARY} | |
4699 | {$IF DEF DELPHI 64_TEMPORA RY} | |
4700 | PUSH FQ | |
4701 | {$EL SE ~DELPHI 64_TEMPORA RY} | |
4702 | PUSH FD | |
4703 | {$EN DIF ~DELPH I64_TEMPOR ARY} | |
4704 | POP RAX | |
4705 | AND RAX, I D_FLAG | |
4706 | XOR RAX, R CX | |
4707 | SETN Z Result | |
4708 | {$IF DEF FPC} | |
4709 | {$ UNDEF DELP HI64_TEMPO RARY} | |
4710 | {$EN DIF FPC} | |
4711 | {$EN DIF CPU64} | |
4712 | end; | |
4713 | {$IFNDEF DELPHI64_ TEMPORARY} | |
4714 | end; | |
4715 | {$ENDIF ~DELPHI64_ TEMPORARY} | |
4716 | ||
4717 | procedur e CallCPUI D(ValueEAX , ValueECX : Cardinal ; out Retu rnedEAX, R eturnedEBX , Returned ECX, Retur nedEDX); | |
4718 | {$IFNDEF DELPHI64_ TEMPORARY} | |
4719 | begin | |
4720 | {$ENDIF ~DELPHI64_ TEMPORARY} | |
4721 | asm | |
4722 | {$IF DEF CPU32} | |
4723 | // s ave contex t | |
4724 | PUSH EDI | |
4725 | PUSH EBX | |
4726 | // i nit parame ters | |
4727 | MOV EAX, V alueEAX | |
4728 | MOV ECX, V alueECX | |
4729 | // C PUID | |
4730 | DB 0FH | |
4731 | DB 0A2H | |
4732 | // s tore resul ts | |
4733 | MOV EDI, R eturnedEAX | |
4734 | MOV Cardin al PTR [ED I], EAX | |
4735 | MOV EAX, R eturnedEBX | |
4736 | MOV EDI, R eturnedECX | |
4737 | MOV Cardin al PTR [EA X], EBX | |
4738 | MOV Cardin al PTR [ED I], ECX | |
4739 | MOV EAX, R eturnedEDX | |
4740 | MOV Cardin al PTR [EA X], EDX | |
4741 | // r estore con text | |
4742 | POP EBX | |
4743 | POP EDI | |
4744 | {$EN DIF CPU32} | |
4745 | {$IF DEF CPU64} | |
4746 | // s ave contex t | |
4747 | PUSH RBX | |
4748 | // i nit parame ters | |
4749 | MOV EAX, V alueEAX | |
4750 | MOV ECX, V alueECX | |
4751 | // C PUID | |
4752 | CPUI D | |
4753 | // s tore resul ts | |
4754 | MOV R8, Re turnedEAX | |
4755 | MOV R9, Re turnedEBX | |
4756 | MOV R10, R eturnedECX | |
4757 | MOV R11, R eturnedEDX | |
4758 | MOV Cardin al PTR [R8 ], EAX | |
4759 | MOV Cardin al PTR [R9 ], EBX | |
4760 | MOV Cardin al PTR [R1 0], ECX | |
4761 | MOV Cardin al PTR [R1 1], EDX | |
4762 | // r estore con text | |
4763 | POP RBX | |
4764 | {$EN DIF CPU64} | |
4765 | end; | |
4766 | {$IFNDEF DELPHI64_ TEMPORARY} | |
4767 | end; | |
4768 | {$ENDIF ~DELPHI64_ TEMPORARY} | |
4769 | ||
4770 | procedur e ProcessS tandard(va r CPUInfo: TCpuInfo; HiVal: Ca rdinal); | |
4771 | var | |
4772 | Versio nInfo, Add itionalInf o, ExFeatu res: Cardi nal; | |
4773 | begin | |
4774 | if HiV al >= 1 th en | |
4775 | begin | |
4776 | Call CPUID(1, 0 , VersionI nfo, Addit ionalInfo, ExFeature s, CPUInfo .Features) ; | |
4777 | ||
4778 | CPUI nfo.PType := (Versio nInfo and $00003000) shr 12; | |
4779 | CPUI nfo.Family := (Versi onInfo and $00000F00 ) shr 8; | |
4780 | CPUI nfo.Model := (Versio nInfo and $000000F0) shr 4; | |
4781 | CPUI nfo.Steppi ng := (Ver sionInfo a nd $000000 0F); | |
4782 | CPUI nfo.Extend edModel := (VersionI nfo and $0 00F0000) s hr 16; | |
4783 | CPUI nfo.Extend edFamily : = (Version Info and $ 0FF00000) shr 20; | |
4784 | ||
4785 | if C PUInfo.Cpu Type = CPU _TYPE_INTE L then | |
4786 | begi n | |
4787 | CP UInfo.Inte lSpecific. ExFeatures := ExFeat ures; | |
4788 | CP UInfo.Inte lSpecific. BrandID := Additiona lInfo and $000000FF; | |
4789 | CP UInfo.Inte lSpecific. FlushLineS ize := (Ad ditionalIn fo and $00 00FF00) sh r 8; | |
4790 | CP UInfo.Inte lSpecific. APICID := (Additiona lInfo and $FF000000) shr 24; | |
4791 | CP UInfo.Hype rThreading Technology := (CPUIn fo.Feature s and INTE L_HTT) <> 0; | |
4792 | if CPUInfo.H yperThread ingTechnol ogy then | |
4793 | be gin | |
4794 | CPUInfo.Lo gicalCore := (Additi onalInfo a nd $00FF00 00) shr 16 ; | |
4795 | if CPUInfo .LogicalCo re = 0 the n | |
4796 | CPUInfo. LogicalCor e := 1; | |
4797 | en d; | |
4798 | ||
4799 | if HiVal >= 2 then | |
4800 | be gin | |
4801 | CPUInfo.Ha sCacheInfo := True; | |
4802 | // TODO: m ultiple lo ops | |
4803 | CallCPUID( 2, 0, CPUI nfo.IntelS pecific.Ca cheDescrip tors[0], C PUInfo.Int elSpecific .CacheDesc riptors[4] , | |
4804 | CPUInfo. IntelSpeci fic.CacheD escriptors [8], CPUIn fo.IntelSp ecific.Cac heDescript ors[12]); | |
4805 | en d; | |
4806 | end; | |
4807 | end; | |
4808 | end; | |
4809 | ||
4810 | procedur e ProcessI ntel(var C PUInfo: TC puInfo; Hi Val: Cardi nal); | |
4811 | var | |
4812 | ExHiVa l, Unused, AddressSi ze, CoreIn fo: Cardin al; | |
4813 | I, J: Integer; | |
4814 | begin | |
4815 | CPUInf o.CpuType := CPU_TYP E_INTEL; | |
4816 | CPUInf o.Manufact urer := 'I ntel'; | |
4817 | ||
4818 | Proces sStandard( CPUInfo, H iVal); | |
4819 | ||
4820 | if HiV al >= 4 th en | |
4821 | begin | |
4822 | Call CPUID(4, 0 , CoreInfo , Unused, Unused, Un used); | |
4823 | CPUI nfo.Physic alCore := ((CoreInfo and $FC00 0000) shr 26) + 1; | |
4824 | end; | |
4825 | ||
4826 | if HiV al >= 6 th en | |
4827 | Call CPUID(6, 0 , CPUInfo. IntelSpeci fic.PowerM anagementF eatures, U nused, Unu sed, Unuse d); | |
4828 | ||
4829 | // che ck Intel e xtended | |
4830 | CallCP UID($80000 000, 0, Ex HiVal, Unu sed, Unuse d, Unused) ; | |
4831 | if ExH iVal >= $8 0000001 th en | |
4832 | begin | |
4833 | CPUI nfo.HasExt endedInfo := True; | |
4834 | Call CPUID($800 00001, 0, Unused, Un used, CPUI nfo.IntelS pecific.Ex 64Features 2, | |
4835 | CP UInfo.Inte lSpecific. Ex64Featur es); | |
4836 | end; | |
4837 | if ExH iVal >= $8 0000002 th en | |
4838 | Call CPUID($800 00002, 0, CPUInfo.Cp uName[0], CPUInfo.Cp uName[4], CPUInfo.Cp uName[8], CPUInfo.Cp uName[12]) ; | |
4839 | if ExH iVal >= $8 0000003 th en | |
4840 | Call CPUID($800 00003, 0, CPUInfo.Cp uName[16], CPUInfo.C puName[20] , CPUInfo. CpuName[24 ], CPUInfo .CpuName[2 8]); | |
4841 | if ExH iVal >= $8 0000004 th en | |
4842 | Call CPUID($800 00004, 0, CPUInfo.Cp uName[32], CPUInfo.C puName[36] , CPUInfo. CpuName[40 ], CPUInfo .CpuName[4 4]); | |
4843 | if ExH iVal >= $8 0000006 th en | |
4844 | Call CPUID($800 00006, 0, Unused, Un used, CPUI nfo.IntelS pecific.L2 Cache, Unu sed); | |
4845 | if ExH iVal >= $8 0000008 th en | |
4846 | begin | |
4847 | Call CPUID($800 00008, 0, AddressSiz e, Unused, Unused, U nused); | |
4848 | CPUI nfo.IntelS pecific.Ph ysicalAddr essBits := AddressSi ze and $00 0000FF; | |
4849 | CPUI nfo.IntelS pecific.Vi rtualAddre ssBits := (AddressSi ze and $00 00FF00) sh r 8; | |
4850 | end; | |
4851 | ||
4852 | if CPU Info.HasCa cheInfo th en | |
4853 | begin | |
4854 | if ( CPUInfo.In telSpecifi c.L2Cache <> 0) then | |
4855 | begi n | |
4856 | CP UInfo.L2Ca cheSize := CPUInfo.I ntelSpecif ic.L2Cache shr 16; | |
4857 | CP UInfo.L2Ca cheLineSiz e := CPUIn fo.IntelSp ecific.L2C ache and $ FF; | |
4858 | CP UInfo.L2Ca cheAssocia tivity := (CPUInfo.I ntelSpecif ic.L2Cache shr 12) a nd $F; | |
4859 | end; | |
4860 | for I := Low(C PUInfo.Int elSpecific .CacheDesc riptors) t o High(CPU Info.Intel Specific.C acheDescri ptors) do | |
4861 | if CPUInfo.I ntelSpecif ic.CacheDe scriptors[ I]<>0 then | |
4862 | for J := L ow(IntelCa cheDescrip tion) to H igh(IntelC acheDescri ption) do | |
4863 | if Intel CacheDescr iption[J]. D = CPUInf o.IntelSpe cific.Cach eDescripto rs[I] then | |
4864 | with I ntelCacheD escription [J] do | |
4865 | ca se Family of | |
4866 | //cfInstru ctionTLB: | |
4867 | //cfDataTL B: | |
4868 | cfL1Instru ctionCache : | |
4869 | begin | |
4870 | Inc(CP UInfo.L1In structionC acheSize,S ize); | |
4871 | CPUInf o.L1Instru ctionCache LineSize : = LineSize ; | |
4872 | CPUInf o.L1Instru ctionCache Associativ ity := Way sOfAssoc; | |
4873 | end; | |
4874 | cfL1DataCa che: | |
4875 | begin | |
4876 | Inc(CP UInfo.L1Da taCacheSiz e,Size); | |
4877 | CPUInf o.L1DataCa cheLineSiz e := LineS ize; | |
4878 | CPUInf o.L1DataCa cheAssocia tivity := WaysOfAsso c; | |
4879 | end; | |
4880 | cfL2Cache: | |
4881 | if (CPUI nfo.IntelS pecific.L2 Cache = 0) then | |
4882 | begin | |
4883 | Inc(CP UInfo.L2Ca cheSize,Si ze); | |
4884 | CPUInf o.L2CacheL ineSize := LineSize; | |
4885 | CPUInf o.L2CacheA ssociativi ty := Ways OfAssoc; | |
4886 | end; | |
4887 | cfL3Cache: | |
4888 | begin | |
4889 | Inc(CP UInfo.L3Ca cheSize,Si ze); | |
4890 | CPUInf o.L3CacheL ineSize := LineSize; | |
4891 | CPUInf o.L3CacheA ssociativi ty := Ways OfAssoc; | |
4892 | CPUInf o.L3LinesP erSector : = LinePerS ector; | |
4893 | end; | |
4894 | //cfTrace: // no numeric in formations | |
4895 | //cfOther: | |
4896 | en d; | |
4897 | end; | |
4898 | if not CPUInfo.H asExtended Info then | |
4899 | begin | |
4900 | case CPUInfo.F amily of | |
4901 | 4: | |
4902 | case CPUIn fo.Model o f | |
4903 | 1: | |
4904 | CPUInf o.CpuName := 'Intel 486DX Proc essor'; | |
4905 | 2: | |
4906 | CPUInf o.CpuName := 'Intel 486SX Proc essor'; | |
4907 | 3: | |
4908 | CPUInf o.CpuName := 'Intel DX2 Proces sor'; | |
4909 | 4: | |
4910 | CPUInf o.CpuName := 'Intel 486 Proces sor'; | |
4911 | 5: | |
4912 | CPUInf o.CpuName := 'Intel SX2 Proces sor'; | |
4913 | 7: | |
4914 | CPUInf o.CpuName := 'Write- Back Enhan ced Intel DX2 Proces sor'; | |
4915 | 8: | |
4916 | CPUInf o.CpuName := 'Intel DX4 Proces sor'; | |
4917 | else | |
4918 | CPUInfo. CpuName := 'Intel 48 6 Processo r'; | |
4919 | end; | |
4920 | 5: | |
4921 | CPUInfo.Cp uName := ' Pentium'; | |
4922 | 6: | |
4923 | case CPUIn fo.Model o f | |
4924 | 1: | |
4925 | CPUInf o.CpuName := 'Pentiu m Pro'; | |
4926 | 3: | |
4927 | CPUInf o.CpuName := 'Pentiu m II'; | |
4928 | 5: | |
4929 | case C PUInfo.L2C acheSize o f | |
4930 | 0: | |
4931 | CP UInfo.CpuN ame := 'Ce leron'; | |
4932 | 1024 : | |
4933 | CP UInfo.CpuN ame := 'Pe ntium II X eon'; | |
4934 | 2048 : | |
4935 | CP UInfo.CpuN ame := 'Pe ntium II X eon'; | |
4936 | else | |
4937 | CPUI nfo.CpuNam e := 'Pent ium II'; | |
4938 | end; | |
4939 | 6: | |
4940 | case C PUInfo.L2C acheSize o f | |
4941 | 0: | |
4942 | CP UInfo.CpuN ame := 'Ce leron'; | |
4943 | 128: | |
4944 | CP UInfo.CpuN ame := 'Ce leron'; | |
4945 | else | |
4946 | CPUI nfo.CpuNam e := 'Pent ium II'; | |
4947 | end; | |
4948 | 7: | |
4949 | case C PUInfo.L2C acheSize o f | |
4950 | 1024 : | |
4951 | CP UInfo.CpuN ame := 'Pe ntium III Xeon'; | |
4952 | 2048 : | |
4953 | CP UInfo.CpuN ame := 'Pe ntium III Xeon'; | |
4954 | else | |
4955 | CPUI nfo.CpuNam e := 'Pent ium III'; | |
4956 | end; | |
4957 | 8: | |
4958 | case C PUInfo.Int elSpecific .BrandID o f | |
4959 | 1: | |
4960 | CP UInfo.CpuN ame := 'Ce leron'; | |
4961 | 2: | |
4962 | CP UInfo.CpuN ame := 'Pe ntium III' ; | |
4963 | 3: | |
4964 | CP UInfo.CpuN ame := 'Pe ntium III Xeon'; | |
4965 | 4: | |
4966 | CP UInfo.CpuN ame := 'Pe ntium III' ; | |
4967 | else | |
4968 | CPUI nfo.CpuNam e := 'Pent ium III'; | |
4969 | end; | |
4970 | 10: | |
4971 | CPUInf o.CpuName := 'Pentiu m III Xeon '; | |
4972 | 11: | |
4973 | CPUInf o.CpuName := 'Pentiu m III'; | |
4974 | else | |
4975 | StrPCopy A(CPUInfo. CpuName, A nsiString( Format('P6 (Model %d )', [CPUIn fo.Model]) )); | |
4976 | end; | |
4977 | 15 : | |
4978 | case CPUIn fo.IntelSp ecific.Bra ndID of | |
4979 | 1: | |
4980 | CPUInf o.CpuName := 'Celero n'; | |
4981 | 8: | |
4982 | CPUInf o.CpuName := 'Pentiu m 4'; | |
4983 | 14: | |
4984 | CPUInf o.CpuName := 'Xeon'; | |
4985 | else | |
4986 | CPUInfo. CpuName := 'Pentium 4'; | |
4987 | end; | |
4988 | else | |
4989 | St rPCopyA(CP UInfo.CpuN ame, AnsiS tring(Form at('P%d', [CPUInfo.F amily]))); | |
4990 | end; | |
4991 | end; | |
4992 | ||
4993 | CPUInf o.Hardware HyperThrea dingTechno logy := CP UInfo.Logi calCore <> CPUInfo.P hysicalCor e; | |
4994 | CPUInf o.AES := ( CPUInfo.In telSpecifi c.ExFeatur es and EIN TEL_AES) < > 0; | |
4995 | CPUInf o.MMX := ( CPUInfo.Fe atures and MMX_FLAG) <> 0; | |
4996 | CPUInf o.SSE := [ ]; | |
4997 | if (CP UInfo.Feat ures and S SE_FLAG) < > 0 then | |
4998 | Incl ude(CPUInf o.SSE, sse ); | |
4999 | if (CP UInfo.Feat ures and S SE2_FLAG) <> 0 then | |
5000 | Incl ude(CPUInf o.SSE, sse 2); | |
5001 | if (CP UInfo.Inte lSpecific. ExFeatures and EINTE L_SSE3) <> 0 then | |
5002 | Incl ude(CPUInf o.SSE, sse 3); | |
5003 | if (CP UInfo.Inte lSpecific. ExFeatures and EINTE L_SSSE3) < > 0 then | |
5004 | Incl ude(CPUInf o.SSE, sss e3); | |
5005 | if (CP UInfo.Inte lSpecific. ExFeatures and EINTE L_SSE4_1) <> 0 then | |
5006 | Incl ude(CPUInf o.SSE, sse 41); | |
5007 | if (CP UInfo.Inte lSpecific. ExFeatures and EINTE L_SSE4_2) <> 0 then | |
5008 | Incl ude(CPUInf o.SSE, sse 42); | |
5009 | if (CP UInfo.Inte lSpecific. ExFeatures and EINTE L_AVX) <> 0 then | |
5010 | Incl ude(CPUInf o.SSE, avx ); | |
5011 | CPUInf o.Is64Bits := CPUInf o.HasExten dedInfo an d ((CPUInf o.IntelSpe cific.Ex64 Features a nd EINTEL6 4_EM64T)<> 0); | |
5012 | CPUInf o.DepCapab le := CPUI nfo.HasExt endedInfo and ((CPUI nfo.IntelS pecific.Ex 64Features and EINTE L64_XD) <> 0); | |
5013 | end; | |
5014 | ||
5015 | procedur e ProcessA MD(var CPU Info: TCpu Info; HiVa l: Cardina l); | |
5016 | var | |
5017 | ExHiVa l, Unused, VersionIn fo, Additi onalInfo: Cardinal; | |
5018 | begin | |
5019 | CPUInf o.CpuType := CPU_TYP E_AMD; | |
5020 | CPUInf o.Manufact urer := 'A MD'; | |
5021 | ||
5022 | // che ck AMD ext ended | |
5023 | if HiV al >= 1 th en | |
5024 | begin | |
5025 | Call CPUID(1, 0 , VersionI nfo, Addit ionalInfo, CPUInfo.A MDSpecific .Features2 , CPUInfo. Features); | |
5026 | ||
5027 | CPUI nfo.AMDSpe cific.Bran dID := Add itionalInf o and $000 000FF; | |
5028 | CPUI nfo.AMDSpe cific.Flus hLineSize := (Additi onalInfo a nd $0000FF 00) shr 8; | |
5029 | CPUI nfo.AMDSpe cific.APIC ID := (Add itionalInf o and $FF0 00000) shr 24; | |
5030 | CPUI nfo.HyperT hreadingTe chnology : = (CPUInfo .Features and AMD_HT T) <> 0; | |
5031 | if C PUInfo.Hyp erThreadin gTechnolog y then | |
5032 | begi n | |
5033 | CP UInfo.Logi calCore := (Addition alInfo and $00FF0000 ) shr 16; | |
5034 | if CPUInfo.L ogicalCore = 0 then | |
5035 | CPUInfo.Lo gicalCore := 1; | |
5036 | end; | |
5037 | end; | |
5038 | ||
5039 | CallCP UID($80000 000, 0, Ex HiVal, Unu sed, Unuse d, Unused) ; | |
5040 | if ExH iVal <> 0 then | |
5041 | begin | |
5042 | // A MD only | |
5043 | CPUI nfo.HasExt endedInfo := True; | |
5044 | ||
5045 | if E xHiVal >= $80000001 then | |
5046 | begi n | |
5047 | Ca llCPUID($8 0000001, 0 , VersionI nfo, Addit ionalInfo, CPUInfo.A MDSpecific .ExFeature s2, CPUInf o.AMDSpeci fic.ExFeat ures); | |
5048 | CP UInfo.Fami ly := (Ver sionInfo a nd $00000F 00) shr 8; | |
5049 | CP UInfo.Mode l := (Vers ionInfo an d $000000F 0) shr 4; | |
5050 | CP UInfo.Step ping := (V ersionInfo and $0000 000F); | |
5051 | CP UInfo.Exte ndedModel := (Versio nInfo and $000F0000) shr 16; | |
5052 | CP UInfo.Exte ndedFamily := (Versi onInfo and $0FF00000 ) shr 20; | |
5053 | CP UInfo.AMDS pecific.Ex BrandID := Additiona lInfo and $0000FFFF; | |
5054 | end; | |
5055 | if E xHiVal >= $80000002 then | |
5056 | Ca llCPUID($8 0000002, 0 , CPUInfo. CpuName[0] , CPUInfo. CpuName[4] , CPUInfo. CpuName[8] , CPUInfo. CpuName[12 ]); | |
5057 | if E xHiVal >= $80000003 then | |
5058 | Ca llCPUID($8 0000003, 0 , CPUInfo. CpuName[16 ], CPUInfo .CpuName[2 0], CPUInf o.CpuName[ 24], CPUIn fo.CpuName [28]); | |
5059 | if E xHiVal >= $80000004 then | |
5060 | Ca llCPUID($8 0000004, 0 , CPUInfo. CpuName[32 ], CPUInfo .CpuName[3 6], CPUInf o.CpuName[ 40], CPUIn fo.CpuName [44]); | |
5061 | if E xHiVal >= $80000005 then | |
5062 | begi n | |
5063 | CP UInfo.HasC acheInfo : = True; | |
5064 | Ca llCPUID($8 0000005, 0 , CPUInfo. AMDSpecifi c.L1MByteI nstruction TLB, CPUIn fo.AMDSpec ific.L1KBy teInstruct ionTLB, | |
5065 | CPUInfo.AM DSpecific. L1DataCach e, CPUInfo .AMDSpecif ic.L1Instr uctionCach e); | |
5066 | end; | |
5067 | if E xHiVal >= $80000006 then | |
5068 | Ca llCPUID($8 0000006, 0 , CPUInfo. AMDSpecifi c.L2MByteI nstruction TLB, CPUIn fo.AMDSpec ific.L2KBy teInstruct ionTLB, | |
5069 | CPUInfo.AM DSpecific. L2Cache, C PUInfo.AMD Specific.L 3Cache); | |
5070 | if C PUInfo.Has CacheInfo then | |
5071 | begi n | |
5072 | CP UInfo.L1Da taCacheSiz e := CPUIn fo.AMDSpec ific.L1Dat aCache[ciS ize]; | |
5073 | CP UInfo.L1Da taCacheLin eSize := C PUInfo.AMD Specific.L 1DataCache [ciLineSiz e]; | |
5074 | CP UInfo.L1Da taCacheAss ociativity := CPUInf o.AMDSpeci fic.L1Data Cache[ciAs sociativit y]; | |
5075 | CP UInfo.L1In structionC acheSize : = CPUInfo. AMDSpecifi c.L1Instru ctionCache [ciSize]; | |
5076 | CP UInfo.L1In structionC acheLineSi ze := CPUI nfo.AMDSpe cific.L1In structionC ache[ciLin eSize]; | |
5077 | CP UInfo.L1In structionC acheAssoci ativity := CPUInfo.A MDSpecific .L1Instruc tionCache[ ciAssociat ivity]; | |
5078 | CP UInfo.L2Ca cheLineSiz e := CPUIn fo.AMDSpec ific.L2Cac he and $FF ; | |
5079 | CP UInfo.L2Ca cheAssocia tivity := (CPUInfo.A MDSpecific .L2Cache s hr 12) and $F; | |
5080 | CP UInfo.L2Ca cheSize := CPUInfo.A MDSpecific .L2Cache s hr 16; | |
5081 | CP UInfo.L3Ca cheLineSiz e := CPUIn fo.AMDSpec ific.L3Cac he and $FF ; | |
5082 | CP UInfo.L3Ca cheAssocia tivity := (CPUInfo.A MDSpecific .L3Cache s hr 12) and $F; | |
5083 | CP UInfo.L3Ca cheSize := CPUInfo.A MDSpecific .L3Cache s hr 19 {MB} ; //(CPUIn fo.AMDSpec ific.L3Cac he shr 18) * 512 {kB }; | |
5084 | end; | |
5085 | if E xHiVal >= $80000007 then | |
5086 | Ca llCPUID($8 0000007, 0 , Unused, Unused, Un used, CPUI nfo.AMDSpe cific.Adva ncedPowerM anagement) ; | |
5087 | if E xHiVal >= $80000008 then | |
5088 | begi n | |
5089 | Ca llCPUID($8 0000008, 0 , Unused, VersionInf o, Additio nalInfo, U nused); | |
5090 | CP UInfo.AMDS pecific.Ph ysicalAddr essSize := VersionIn fo and $00 0000FF; | |
5091 | CP UInfo.AMDS pecific.Vi rtualAddre ssSize := (VersionIn fo and $00 00FF00) sh r 8; | |
5092 | CP UInfo.Phys icalCore : = (Additio nalInfo an d $000000F F) + 1; | |
5093 | end; | |
5094 | end | |
5095 | else | |
5096 | begin | |
5097 | Proc essStandar d(CPUInfo, HiVal); | |
5098 | case CPUInfo.F amily of | |
5099 | 4: | |
5100 | CPUInfo.Cp uName := ' Am486(R) o r Am5x86'; | |
5101 | 5: | |
5102 | case CPUIn fo.Model o f | |
5103 | 0: | |
5104 | CPUInf o.CpuName := 'AMD-K5 (Model 0) '; | |
5105 | 1: | |
5106 | CPUInf o.CpuName := 'AMD-K5 (Model 1) '; | |
5107 | 2: | |
5108 | CPUInf o.CpuName := 'AMD-K5 (Model 2) '; | |
5109 | 3: | |
5110 | CPUInf o.CpuName := 'AMD-K5 (Model 3) '; | |
5111 | 6: | |
5112 | CPUInf o.CpuName := 'AMD-K6 ® (Model 6 )'; | |
5113 | 7: | |
5114 | CPUInf o.CpuName := 'AMD-K6 ® (Model 7 )'; | |
5115 | 8: | |
5116 | CPUInf o.CpuName := 'AMD-K6 ®-2 (Model 8)'; | |
5117 | 9: | |
5118 | CPUInf o.CpuName := 'AMD-K6 ®-III (Mod el 9)'; | |
5119 | else | |
5120 | StrFmt A(CPUInfo. CpuName, P AnsiChar(A nsiString( LoadResStr ing(@RsUnk nownAMDMod el))), [CP UInfo.Mode l]); | |
5121 | end; | |
5122 | 6: | |
5123 | case CPUIn fo.Model o f | |
5124 | 1: | |
5125 | CPUInf o.CpuName := 'AMD At hlon™ (Mod el 1)'; | |
5126 | 2: | |
5127 | CPUInf o.CpuName := 'AMD At hlon™ (Mod el 2)'; | |
5128 | 3: | |
5129 | CPUInf o.CpuName := 'AMD Du ron™ (Mode l 3)'; | |
5130 | 4: | |
5131 | CPUInf o.CpuName := 'AMD At hlon™ (Mod el 4)'; | |
5132 | 6: | |
5133 | CPUInf o.CpuName := 'AMD At hlon™ XP ( Model 6)'; | |
5134 | 7: | |
5135 | CPUInf o.CpuName := 'AMD Du ron™ (Mode l 7)'; | |
5136 | 8: | |
5137 | CPUInf o.CpuName := 'AMD At hlon™ XP ( Model 8)'; | |
5138 | 10: | |
5139 | CPUInf o.CpuName := 'AMD At hlon™ XP ( Model 10)' ; | |
5140 | else | |
5141 | StrFmt A(CPUInfo. CpuName, P AnsiChar(A nsiString( LoadResStr ing(@RsUnk nownAMDMod el))), [CP UInfo.Mode l]); | |
5142 | end; | |
5143 | 8: | |
5144 | ||
5145 | el se | |
5146 | CPUInfo.Cp uName := ' Unknown AM D Chip'; | |
5147 | end; | |
5148 | end; | |
5149 | ||
5150 | CPUInf o.Hardware HyperThrea dingTechno logy := CP UInfo.Logi calCore <> CPUInfo.P hysicalCor e; | |
5151 | CPUInf o.AES := ( CPUInfo.AM DSpecific. Features2 and AMD2_A ES) <> 0; | |
5152 | CPUInf o.MMX := ( CPUInfo.Fe atures and AMD_MMX) <> 0; | |
5153 | CPUInf o.ExMMX := CPUInfo.H asExtended Info and ( (CPUInfo.A MDSpecific .ExFeature s and EAMD _EXMMX) <> 0); | |
5154 | CPUInf o._3DNow : = CPUInfo. HasExtende dInfo and ((CPUInfo. AMDSpecifi c.ExFeatur es and EAM D_3DNOW) < > 0); | |
5155 | CPUInf o.Ex3DNow := CPUInfo .HasExtend edInfo and ((CPUInfo .AMDSpecif ic.ExFeatu res and EA MD_EX3DNOW ) <> 0); | |
5156 | CPUInf o.SSE := [ ]; | |
5157 | if (CP UInfo.Feat ures and A MD_SSE) <> 0 then | |
5158 | Incl ude(CPUInf o.SSE, sse ); | |
5159 | if (CP UInfo.Feat ures and A MD_SSE2) < > 0 then | |
5160 | Incl ude(CPUInf o.SSE, sse 2); | |
5161 | if (CP UInfo.AMDS pecific.Fe atures2 an d AMD2_SSE 3) <> 0 th en | |
5162 | In clude(CPUI nfo.SSE, s se3); | |
5163 | if CPU Info.HasEx tendedInfo then | |
5164 | begin | |
5165 | if ( CPUInfo.AM DSpecific. ExFeatures 2 and EAMD 2_SSE4A) < > 0 then | |
5166 | In clude(CPUI nfo.SSE, s se4A); | |
5167 | if ( CPUInfo.AM DSpecific. Features2 and AMD2_S SE41) <> 0 then | |
5168 | In clude(CPUI nfo.SSE, s se41); | |
5169 | if ( CPUInfo.AM DSpecific. Features2 and AMD2_S SE42) <> 0 then | |
5170 | In clude(CPUI nfo.SSE, s se42); | |
5171 | end; | |
5172 | CPUInf o.Is64Bits := CPUInf o.HasExten dedInfo an d ((CPUInf o.AMDSpeci fic.ExFeat ures and E AMD_LONG) <> 0); | |
5173 | CPUInf o.DEPCapab le := CPUI nfo.HasExt endedInfo and ((CPUI nfo.AMDSpe cific.ExFe atures and EAMD_NX) <> 0); | |
5174 | end; | |
5175 | ||
5176 | procedur e ProcessC yrix(var C PUInfo: TC puInfo; Hi Val: Cardi nal); | |
5177 | var | |
5178 | ExHiVa l, Unused, VersionIn fo, Additi onalInfo: Cardinal; | |
5179 | begin | |
5180 | CPUInf o.CpuType := CPU_TYP E_CYRIX; | |
5181 | CPUInf o.Manufact urer := 'C yrix'; | |
5182 | ||
5183 | // che ck Cyrix e xtended | |
5184 | CallCP UID($80000 000, 0, Ex HiVal, Unu sed, Unuse d, Unused) ; | |
5185 | if ExH iVal <> 0 then | |
5186 | begin | |
5187 | // C yrix only | |
5188 | CPUI nfo.HasExt endedInfo := True; | |
5189 | if E xHiVal >= $80000001 then | |
5190 | begi n | |
5191 | Ca llCPUID($8 0000001, 0 , VersionI nfo, Addit ionalInfo, Unused, C PUInfo.Fea tures); | |
5192 | CP UInfo.PTyp e := (Vers ionInfo an d $0000F00 0) shr 12; | |
5193 | CP UInfo.Fami ly := (Ver sionInfo a nd $00000F 00) shr 8; | |
5194 | CP UInfo.Mode l := (Vers ionInfo an d $000000F 0) shr 4; | |
5195 | CP UInfo.Step ping := (V ersionInfo and $0000 000F); | |
5196 | end; | |
5197 | if E xHiVal >= $80000002 then | |
5198 | Ca llCPUID($8 0000002, 0 , CPUInfo. CpuName[0] , CPUInfo. CpuName[4] , CPUInfo. CpuName[8] , CPUInfo. CpuName[12 ]); | |
5199 | if E xHiVal >= $80000003 then | |
5200 | Ca llCPUID($8 0000003, 0 , CPUInfo. CpuName[16 ], CPUInfo .CpuName[2 0], CPUInf o.CpuName[ 24], CPUIn fo.CpuName [28]); | |
5201 | if E xHiVal >= $80000004 then | |
5202 | Ca llCPUID($8 0000004, 0 , CPUInfo. CpuName[32 ], CPUInfo .CpuName[3 6], CPUInf o.CpuName[ 40], CPUIn fo.CpuName [44]); | |
5203 | if E xHiVal >= $80000005 then | |
5204 | begi n | |
5205 | CP UInfo.HasC acheInfo : = True; | |
5206 | Ca llCPUID($8 0000005, 0 , Unused, CPUInfo.Cy rixSpecifi c.TLBInfo, CPUInfo.C yrixSpecif ic.L1Cache Info, Unus ed); | |
5207 | end; | |
5208 | end | |
5209 | else | |
5210 | begin | |
5211 | Proc essStandar d(CPUInfo, HiVal); | |
5212 | case CPUInfo.F amily of | |
5213 | 4: | |
5214 | CPUInfo.Cp uName := ' Cyrix Medi aGX'; | |
5215 | 5: | |
5216 | case CPUIn fo.Model o f | |
5217 | 2: | |
5218 | CPUInf o.CpuName := 'Cyrix 6x86'; | |
5219 | 4: | |
5220 | CPUInf o.CpuName := 'Cyrix GXm'; | |
5221 | end; | |
5222 | 6: | |
5223 | CPUInfo.Cp uName := ' 6x86MX'; | |
5224 | else | |
5225 | St rPCopyA(CP UInfo.CpuN ame, AnsiS tring(Form at('%dx86' , [CPUInfo .Family])) ); | |
5226 | end; | |
5227 | end; | |
5228 | end; | |
5229 | ||
5230 | procedur e ProcessV IA(var CPU Info: TCpu Info; HiVa l: Cardina l); | |
5231 | var | |
5232 | ExHiVa l, Unused, VersionIn fo: Cardin al; | |
5233 | begin | |
5234 | CPUInf o.CpuType := CPU_TYP E_VIA; | |
5235 | CPUInf o.Manufact urer := 'V ia'; | |
5236 | ||
5237 | // che ck VIA ext ended | |
5238 | CallCP UID($80000 000, 0, Ex HiVal, Unu sed, Unuse d, Unused) ; | |
5239 | if ExH iVal <> 0 then | |
5240 | begin | |
5241 | if E xHiVal >= $80000001 then | |
5242 | begi n | |
5243 | CP UInfo.HasE xtendedInf o := True; | |
5244 | Ca llCPUID($8 0000001, 0 , VersionI nfo, Unuse d, Unused, CPUInfo.V iaSpecific .ExFeature s); | |
5245 | CP UInfo.PTyp e := (Vers ionInfo an d $0000300 0) shr 12; | |
5246 | CP UInfo.Fami ly := (Ver sionInfo a nd $00000F 00) shr 8; | |
5247 | CP UInfo.Mode l := (Vers ionInfo an d $000000F 0) shr 4; | |
5248 | CP UInfo.Step ping := (V ersionInfo and $0000 000F); | |
5249 | end; | |
5250 | if E xHiVal >= $80000002 then | |
5251 | Ca llCPUID($8 0000002, 0 , CPUInfo. CpuName[0] , CPUInfo. CpuName[4] , CPUInfo. CpuName[8] , CPUInfo. CpuName[12 ]); | |
5252 | if E xHiVal >= $80000003 then | |
5253 | Ca llCPUID($8 0000003, 0 , CPUInfo. CpuName[16 ], CPUInfo .CpuName[2 0], CPUInf o.CpuName[ 24], CPUIn fo.CpuName [28]); | |
5254 | if E xHiVal >= $80000004 then | |
5255 | Ca llCPUID($8 0000004, 0 , CPUInfo. CpuName[32 ], CPUInfo .CpuName[3 6], CPUInf o.CpuName[ 40], CPUIn fo.CpuName [44]); | |
5256 | if E xHiVal >= $80000005 then | |
5257 | begi n | |
5258 | CP UInfo.HasC acheInfo : = True; | |
5259 | Ca llCPUID($8 0000005, 0 , Unused, CPUInfo.Vi aSpecific. Instructio nTLB, CPUI nfo.ViaSpe cific.L1Da taCache, | |
5260 | CPUInfo.Vi aSpecific. L1Instruct ionCache); | |
5261 | end; | |
5262 | if E xHiVal >= $80000006 then | |
5263 | Ca llCPUID($8 0000006, 0 , Unused, Unused, CP UInfo.ViaS pecific.L2 DataCache, Unused); | |
5264 | ||
5265 | if C PUInfo.Has CacheInfo then | |
5266 | begi n | |
5267 | CP UInfo.L1Da taCacheSiz e := CPUIn fo.VIASpec ific.L1Dat aCache[ciS ize]; | |
5268 | CP UInfo.L1Da taCacheLin eSize := C PUInfo.VIA Specific.L 1DataCache [ciLineSiz e]; | |
5269 | CP UInfo.L1Da taCacheAss ociativity := CPUInf o.VIASpeci fic.L1Data Cache[ciAs sociativit y]; | |
5270 | CP UInfo.L1In structionC acheSize : = CPUInfo. VIASpecifi c.L1Instru ctionCache [ciSize]; | |
5271 | CP UInfo.L1In structionC acheLineSi ze := CPUI nfo.VIASpe cific.L1In structionC ache[ciLin eSize]; | |
5272 | CP UInfo.L1In structionC acheAssoci ativity := CPUInfo.V IASpecific .L1Instruc tionCache[ ciAssociat ivity]; | |
5273 | CP UInfo.L2Ca cheLineSiz e := CPUIn fo.VIASpec ific.L2Dat aCache and $FF; | |
5274 | CP UInfo.L2Ca cheAssocia tivity := (CPUInfo.V IASpecific .L2DataCac he shr 12) and $F; | |
5275 | CP UInfo.L2Ca cheSize := CPUInfo.V IASpecific .L2DataCac he shr 16; | |
5276 | end; | |
5277 | ||
5278 | Call CPUID($C00 00000, 0, ExHiVal, U nused, Unu sed, Unuse d); | |
5279 | if E xHiVal >= $C0000001 then | |
5280 | Ca llCPUID($C 0000001, 0 , Unused, Unused, Un used, CPUI nfo.ViaSpe cific.ExFe atures); | |
5281 | end | |
5282 | else | |
5283 | Proc essStandar d(CPUInfo, HiVal); | |
5284 | ||
5285 | if not CPUInfo.H asExtended Info then | |
5286 | CPUI nfo.CpuNam e := 'C3'; | |
5287 | CPUInf o.MMX := ( CPUInfo.Fe atures and VIA_MMX) <> 0; | |
5288 | CPUInf o.SSE := [ ]; | |
5289 | if (CP UInfo.Feat ures and V IA_SSE) <> 0 then | |
5290 | Incl ude(CPUInf o.SSE, sse ); | |
5291 | CPUInf o._3DNow : = (CPUInfo .Features and VIA_3D NOW) <> 0; | |
5292 | end; | |
5293 | ||
5294 | procedur e ProcessT ransmeta(v ar CPUInfo : TCpuInfo ; HiVal: C ardinal); | |
5295 | var | |
5296 | ExHiVa l, Unused, VersionIn fo: Cardin al; | |
5297 | begin | |
5298 | CPUInf o.CpuType := CPU_TYP E_TRANSMET A; | |
5299 | CPUInf o.Manufact urer := 'T ransmeta'; | |
5300 | ||
5301 | if (Hi Val >= 1) then | |
5302 | begin | |
5303 | Call CPUID(1, 0 , VersionI nfo, Unuse d, Unused, CPUInfo.F eatures); | |
5304 | CPUI nfo.PType := (Versio nInfo and $00003000) shr 12; | |
5305 | CPUI nfo.Family := (Versi onInfo and $00000F00 ) shr 8; | |
5306 | CPUI nfo.Model := (Versio nInfo and $000000F0) shr 4; | |
5307 | CPUI nfo.Steppi ng := (Ver sionInfo a nd $000000 0F); | |
5308 | end; | |
5309 | // no informatio n when eax is 2 | |
5310 | // eax is 3 mean s Serial N umber, not detected there | |
5311 | ||
5312 | // sma ll CPU des cription, overriden if ExHiVal >= 800000 02 | |
5313 | CallCP UID($80000 000, 0, Ex HiVal, CPU Info.CpuNa me[0], CPU Info.CpuNa me[8], CPU Info.CpuNa me[4]); | |
5314 | if ExH iVal <> 0 then | |
5315 | begin | |
5316 | CPUI nfo.HasExt endedInfo := True; | |
5317 | ||
5318 | if E xHiVal >= $80000001 then | |
5319 | Ca llCPUID($8 0000001, 0 , Unused, Unused, Un used, CPUI nfo.Transm etaSpecifi c.ExFeatur es); | |
5320 | if E xHiVal >= $80000002 then | |
5321 | Ca llCPUID($8 0000002, 0 , CPUInfo. CpuName[0] , CPUInfo. CpuName[4] , CPUInfo. CpuName[8] , CPUInfo. CpuName[12 ]); | |
5322 | if E xHiVal >= $80000003 then | |
5323 | Ca llCPUID($8 0000003, 0 , CPUInfo. CpuName[16 ], CPUInfo .CpuName[2 0], CPUInf o.CpuName[ 24], CPUIn fo.CpuName [28]); | |
5324 | if E xHiVal >= $80000004 then | |
5325 | Ca llCPUID($8 0000004, 0 , CPUInfo. CpuName[32 ], CPUInfo .CpuName[3 6], CPUInf o.CpuName[ 40], CPUIn fo.CpuName [44]); | |
5326 | if E xHiVal >= $80000005 then | |
5327 | begi n | |
5328 | CP UInfo.HasC acheInfo : = True; | |
5329 | Ca llCPUID($8 0000005, 0 , Unused, CPUInfo.Tr ansmetaSpe cific.Code TLB, CPUIn fo.Transme taSpecific .L1DataCac he, | |
5330 | CPUInfo.Tr ansmetaSpe cific.L1Co deCache); | |
5331 | end; | |
5332 | if C PUInfo.Has CacheInfo then | |
5333 | begi n | |
5334 | CP UInfo.L1Da taCacheSiz e := CPUIn fo.Transme taSpecific .L1DataCac he[ciSize] ; | |
5335 | CP UInfo.L1Da taCacheLin eSize := C PUInfo.Tra nsmetaSpec ific.L1Dat aCache[ciL ineSize]; | |
5336 | CP UInfo.L1Da taCacheAss ociativity := CPUInf o.Transmet aSpecific. L1DataCach e[ciAssoci ativity]; | |
5337 | CP UInfo.L1In structionC acheSize : = CPUInfo. TransmetaS pecific.L1 CodeCache[ ciSize]; | |
5338 | CP UInfo.L1In structionC acheLineSi ze := CPUI nfo.Transm etaSpecifi c.L1CodeCa che[ciLine Size]; | |
5339 | CP UInfo.L1In structionC acheAssoci ativity := CPUInfo.T ransmetaSp ecific.L1C odeCache[c iAssociati vity]; | |
5340 | CP UInfo.L2Ca cheLineSiz e := CPUIn fo.Transme taSpecific .L2Cache a nd $FF; | |
5341 | CP UInfo.L2Ca cheAssocia tivity := (CPUInfo.T ransmetaSp ecific.L2C ache shr 1 2) and $F; | |
5342 | CP UInfo.L2Ca cheSize := CPUInfo.T ransmetaSp ecific.L2C ache shr 1 6; | |
5343 | end; | |
5344 | if E xHiVal >= $80000006 then | |
5345 | Ca llCPUID($8 0000006, 0 , Unused, Unused, CP UInfo.Tran smetaSpeci fic.L2Cach e, Unused) ; | |
5346 | end | |
5347 | else | |
5348 | CPUI nfo.CpuNam e := 'Crus oe'; | |
5349 | ||
5350 | CallCP UID($80860 000, 0, Ex HiVal, Unu sed, Unuse d, Unused) ; | |
5351 | if ExH iVal <> 0 then | |
5352 | begin | |
5353 | if E xHiVal >= $80860001 then | |
5354 | Ca llCPUID($8 0860001, 0 , Unused, CPUInfo.Tr ansmetaSpe cific.Revi sionABCD, CPUInfo.Tr ansmetaSpe cific.Revi sionXXXX, | |
5355 | CPUInfo.Tr ansmetaSpe cific.Tran smetaFeatu res); | |
5356 | if E xHiVal >= $80860002 then | |
5357 | Ca llCPUID($8 0860002, 0 , Unused, CPUInfo.Tr ansmetaSpe cific.Code MorphingAB CD, CPUInf o.Transmet aSpecific. CodeMorphi ngXXXX, Un used); | |
5358 | if E xHiVal >= $80860003 then | |
5359 | Ca llCPUID($8 0860003, 0 , CPUInfo. TransmetaS pecific.Tr ansmetaInf ormations[ 0], CPUInf o.Transmet aSpecific. TransmetaI nformation s[4], | |
5360 | CPUInfo.Tr ansmetaSpe cific.Tran smetaInfor mations[8] , CPUInfo. TransmetaS pecific.Tr ansmetaInf ormations[ 12]); | |
5361 | if E xHiVal >= $80860004 then | |
5362 | Ca llCPUID($8 0860004, 0 , CPUInfo. TransmetaS pecific.Tr ansmetaInf ormations[ 16], CPUIn fo.Transme taSpecific .Transmeta Informatio ns[20], | |
5363 | CPUInfo.Tr ansmetaSpe cific.Tran smetaInfor mations[24 ], CPUInfo .Transmeta Specific.T ransmetaIn formations [28]); | |
5364 | if E xHiVal >= $80860005 then | |
5365 | Ca llCPUID($8 0860005, 0 , CPUInfo. TransmetaS pecific.Tr ansmetaInf ormations[ 32], CPUIn fo.Transme taSpecific .Transmeta Informatio ns[36], | |
5366 | CPUInfo.Tr ansmetaSpe cific.Tran smetaInfor mations[40 ], CPUInfo .Transmeta Specific.T ransmetaIn formations [44]); | |
5367 | if E xHiVal >= $80860006 then | |
5368 | Ca llCPUID($8 0860006, 0 , CPUInfo. TransmetaS pecific.Tr ansmetaInf ormations[ 48], CPUIn fo.Transme taSpecific .Transmeta Informatio ns[52], | |
5369 | CPUInfo.Tr ansmetaSpe cific.Tran smetaInfor mations[56 ], CPUInfo .Transmeta Specific.T ransmetaIn formations [60]); | |
5370 | if ( ExHiVal >= $80860007 ) and ((CP UInfo.Tran smetaSpeci fic.Transm etaFeature s and STRA NSMETA_LON GRUN) <> 0 ) then | |
5371 | Ca llCPUID($8 0860007, 0 , CPUInfo. TransmetaS pecific.Cu rrentFrequ ency, CPUI nfo.Transm etaSpecifi c.CurrentV oltage, | |
5372 | CPUInfo.Tr ansmetaSpe cific.Curr entPerform ance, Unus ed); | |
5373 | end; | |
5374 | CPUInf o.MMX := ( CPUInfo.Fe atures and TRANSMETA _MMX) <> 0 ; | |
5375 | end; | |
5376 | ||
5377 | var | |
5378 | HiVal: C ardinal; | |
5379 | begin | |
5380 | ResetMem ory(Result , sizeof(R esult)); | |
5381 | Result.L ogicalCore := 1; | |
5382 | Result.P hysicalCor e := 1; | |
5383 | ||
5384 | if HasCP UIDInstruc tion then | |
5385 | begin | |
5386 | Result .HasInstru ction := T rue; | |
5387 | CallCP UID(0, 0, HiVal, Res ult.Vendor IDString[0 ], Result. VendorIDSt ring[8], | |
5388 | Resu lt.VendorI DString[4] ); | |
5389 | if Res ult.Vendor IDString = VendorIDI ntel then | |
5390 | Proc essIntel(R esult, HiV al) | |
5391 | else i f Result.V endorIDStr ing = Vend orIDAMD th en | |
5392 | Proc essAMD(Res ult, HiVal ) | |
5393 | else i f Result.V endorIDStr ing = Vend orIDCyrix then | |
5394 | Proc essCyrix(R esult, HiV al) | |
5395 | else i f Result.V endorIDStr ing = Vend orIDVIA th en | |
5396 | Proc essVIA(Res ult, HiVal ) | |
5397 | else i f Result.V endorIDStr ing = Vend orIDTransm eta then | |
5398 | Proc essTransme ta(Result, HiVal) | |
5399 | else | |
5400 | Proc essStandar d(Result, HiVal); | |
5401 | end | |
5402 | else | |
5403 | Result .Family := 4; | |
5404 | ||
5405 | if Resul t.CpuType = 0 then | |
5406 | begin | |
5407 | Result .Manufactu rer := 'Un known'; | |
5408 | Result .CpuName : = 'Unknown '; | |
5409 | end; | |
5410 | end; | |
5411 | ||
5412 | function T estFDIVIns truction: Boolean; | |
5413 | {$IFDEF CP U32} | |
5414 | var | |
5415 | TopNum: Double; | |
5416 | BottomNu m: Double; | |
5417 | One: Dou ble; | |
5418 | ISOK: Bo olean; | |
5419 | begin | |
5420 | // The f ollowing c ode was fo und in Bor lands fdiv .asm file in the | |
5421 | // Delph i 3\Source \RTL\SYS d irectory, (I made so me minor m odificatio ns) | |
5422 | // there fore I can not take c redit for it. | |
5423 | TopNum : = 2658955; | |
5424 | BottomNu m := PI; | |
5425 | One := 1 ; | |
5426 | asm | |
5427 | PU SH EAX | |
5428 | FL D [Top Num] | |
5429 | FD IV [Bot tomNum] | |
5430 | FM UL [Bot tomNum] | |
5431 | FS UBR [Top Num] | |
5432 | FC OMP [One ] | |
5433 | FS TSW AX | |
5434 | SH R EAX, 8 | |
5435 | AN D EAX, 01H | |
5436 | MO V ISOK , AL | |
5437 | PO P EAX | |
5438 | end; | |
5439 | Result : = ISOK; | |
5440 | end; | |
5441 | {$ENDIF CP U32} | |
5442 | {$IFDEF CP U64} | |
5443 | begin | |
5444 | Result : = True; | |
5445 | end; | |
5446 | {$ENDIF CP U64} | |
5447 | ||
5448 | //=== Allo c granular ity ====== ========== ========== ========== ========== ======== | |
5449 | ||
5450 | procedure RoundToAll ocGranular ity64(var Value: Int 64; Up: Bo olean); | |
5451 | begin | |
5452 | if (Valu e mod Allo cGranulari ty) <> 0 t hen | |
5453 | if Up then | |
5454 | Valu e := ((Val ue div All ocGranular ity) + 1) * AllocGra nularity | |
5455 | else | |
5456 | Valu e := (Valu e div Allo cGranulari ty) * Allo cGranulari ty; | |
5457 | end; | |
5458 | ||
5459 | procedure RoundToAll ocGranular ityPtr(var Value: Po inter; Up: Boolean); | |
5460 | var | |
5461 | Addr: TJ clAddr; | |
5462 | begin | |
5463 | Addr := TJclAddr(V alue); | |
5464 | if (Addr mod Alloc Granularit y) <> 0 th en | |
5465 | begin | |
5466 | if Up then | |
5467 | Addr := ((Addr div Alloc Granularit y) + 1) * AllocGranu larity | |
5468 | else | |
5469 | Addr := (Addr div AllocG ranularity ) * AllocG ranularity ; | |
5470 | Value := Pointer (Addr); | |
5471 | end; | |
5472 | end; | |
5473 | ||
5474 | //=== Adva nced Power Managemen t (APM) == ========== ========== ========== ======== | |
5475 | ||
5476 | {$IFDEF MS WINDOWS} | |
5477 | function G etAPMLineS tatus: TAP MLineStatu s; | |
5478 | var | |
5479 | SystemPo werStatus: TSystemPo werStatus; | |
5480 | begin | |
5481 | Result : = alsUnkno wn; | |
5482 | ||
5483 | if (Win3 2Platform = VER_PLAT FORM_WIN32 _NT) and ( Win32Major Version < 5) then // Windows N T doesn't support Ge tSystemPow erStatus | |
5484 | Exit; // so we ret urn alsUnk nown | |
5485 | ||
5486 | SystemPo werStatus. ACLineStat us := 0; | |
5487 | if not G etSystemPo werStatus( SystemPowe rStatus) t hen | |
5488 | RaiseL astOSError | |
5489 | else | |
5490 | begin | |
5491 | case S ystemPower Status.ACL ineStatus of | |
5492 | 0: | |
5493 | Re sult := al sOffline; | |
5494 | 1: | |
5495 | Re sult := al sOnline; | |
5496 | 255: | |
5497 | Re sult := al sUnknown; | |
5498 | end; | |
5499 | end; | |
5500 | end; | |
5501 | ||
5502 | function G etAPMBatte ryFlag: TA PMBatteryF lag; | |
5503 | var | |
5504 | SystemPo werStatus: TSystemPo werStatus; | |
5505 | begin | |
5506 | Result : = abfUnkno wn; | |
5507 | ||
5508 | if (Win3 2Platform = VER_PLAT FORM_WIN32 _NT) and ( Win32Major Version < 5) then // Windows N T doesn't support Ge tSystemPow erStatus | |
5509 | Exit; // so we ret urn abfUnk nown | |
5510 | ||
5511 | SystemPo werStatus. ACLineStat us := 0; | |
5512 | if not G etSystemPo werStatus( SystemPowe rStatus) t hen | |
5513 | RaiseL astOSError | |
5514 | else | |
5515 | begin | |
5516 | case S ystemPower Status.Bat teryFlag o f | |
5517 | 1: | |
5518 | Res ult := abf High; | |
5519 | 2: | |
5520 | Re sult := ab fLow; | |
5521 | 4: | |
5522 | Re sult := ab fCritical; | |
5523 | 8: | |
5524 | Re sult := ab fCharging; | |
5525 | 128: | |
5526 | Re sult := ab fNoBattery ; | |
5527 | 255: | |
5528 | Re sult := ab fUnknown; | |
5529 | end; | |
5530 | end; | |
5531 | end; | |
5532 | ||
5533 | ||
5534 | function G etAPMBatte ryFlags: T APMBattery Flags; | |
5535 | var | |
5536 | SystemPo werStatus: TSystemPo werStatus; | |
5537 | begin | |
5538 | Result : = []; | |
5539 | ||
5540 | if (Win3 2Platform = VER_PLAT FORM_WIN32 _NT) and ( Win32Major Version < 5) then // Windows N T doesn't support Ge tSystemPow erStatus | |
5541 | begin | |
5542 | Result := [abfUn known]; | |
5543 | Exit; // so we ret urn [abfUn known] | |
5544 | end; | |
5545 | ||
5546 | SystemPo werStatus. ACLineStat us := 0; | |
5547 | if not G etSystemPo werStatus( SystemPowe rStatus) t hen | |
5548 | RaiseL astOSError | |
5549 | else | |
5550 | begin | |
5551 | if (Sy stemPowerS tatus.Batt eryFlag an d 1) <> 0 then | |
5552 | Resu lt := Resu lt + [abfH igh]; | |
5553 | if (Sy stemPowerS tatus.Batt eryFlag an d 2) <> 0 then | |
5554 | Resu lt := Resu lt + [abfL ow]; | |
5555 | if (Sy stemPowerS tatus.Batt eryFlag an d 4) <> 0 then | |
5556 | Resu lt := Resu lt + [abfC ritical]; | |
5557 | if (Sy stemPowerS tatus.Batt eryFlag an d 8) <> 0 then | |
5558 | Resu lt := Resu lt + [abfC harging]; | |
5559 | if (Sy stemPowerS tatus.Batt eryFlag an d 128) <> 0 then | |
5560 | Resu lt := Resu lt + [abfN oBattery]; | |
5561 | if Sys temPowerSt atus.Batte ryFlag = 2 55 then | |
5562 | Resu lt := Resu lt + [abfU nknown]; | |
5563 | end; | |
5564 | end; | |
5565 | ||
5566 | function G etAPMBatte ryLifePerc ent: Integ er; | |
5567 | var | |
5568 | SystemPo werStatus: TSystemPo werStatus; | |
5569 | begin | |
5570 | Result : = 0; | |
5571 | ||
5572 | if (Win3 2Platform = VER_PLAT FORM_WIN32 _NT) and ( Win32Major Version < 5) then // Windows N T doesn't support Ge tSystemPow erStatus | |
5573 | Exit; | |
5574 | ||
5575 | SystemPo werStatus. ACLineStat us := 0; | |
5576 | if not G etSystemPo werStatus( SystemPowe rStatus) t hen | |
5577 | RaiseL astOSError | |
5578 | else | |
5579 | Result := System PowerStatu s.BatteryL ifePercent ; | |
5580 | end; | |
5581 | ||
5582 | function G etAPMBatte ryLifeTime : DWORD; | |
5583 | var | |
5584 | SystemPo werStatus: TSystemPo werStatus; | |
5585 | begin | |
5586 | Result : = 0; | |
5587 | ||
5588 | if (Win3 2Platform = VER_PLAT FORM_WIN32 _NT) and ( Win32Major Version < 5) then // Windows N T doesn't support Ge tSystemPow erStatus | |
5589 | Exit; | |
5590 | ||
5591 | SystemPo werStatus. ACLineStat us := 0; | |
5592 | if not G etSystemPo werStatus( SystemPowe rStatus) t hen | |
5593 | RaiseL astOSError | |
5594 | else | |
5595 | Result := System PowerStatu s.BatteryL ifeTime; | |
5596 | end; | |
5597 | ||
5598 | function G etAPMBatte ryFullLife Time: DWOR D; | |
5599 | var | |
5600 | SystemPo werStatus: TSystemPo werStatus; | |
5601 | begin | |
5602 | Result : = 0; | |
5603 | ||
5604 | if (Win3 2Platform = VER_PLAT FORM_WIN32 _NT) and ( Win32Major Version < 5) then // Windows N T doesn't support Ge tSystemPow erStatus | |
5605 | Exit; | |
5606 | ||
5607 | SystemPo werStatus. ACLineStat us := 0; | |
5608 | if not G etSystemPo werStatus( SystemPowe rStatus) t hen | |
5609 | RaiseL astOSError | |
5610 | else | |
5611 | Result := System PowerStatu s.BatteryF ullLifeTim e; | |
5612 | end; | |
5613 | ||
5614 | //=== Memo ry Informa tion ===== ========== ========== ========== ========== ======== | |
5615 | ||
5616 | function G etMaxAppAd dress: TJc lAddr; | |
5617 | var | |
5618 | SystemIn fo: TSyste mInfo; | |
5619 | begin | |
5620 | ResetMem ory(System Info, Size Of(SystemI nfo)); | |
5621 | GetSyste mInfo(Syst emInfo); | |
5622 | Result : = TJclAddr (SystemInf o.lpMaximu mApplicati onAddress) ; | |
5623 | end; | |
5624 | ||
5625 | function G etMinAppAd dress: TJc lAddr; | |
5626 | var | |
5627 | SystemIn fo: TSyste mInfo; | |
5628 | begin | |
5629 | ResetMem ory(System Info, Size Of(SystemI nfo)); | |
5630 | GetSyste mInfo(Syst emInfo); | |
5631 | Result : = TJclAddr (SystemInf o.lpMinimu mApplicati onAddress) ; | |
5632 | end; | |
5633 | {$ENDIF MS WINDOWS} | |
5634 | ||
5635 | function G etMemoryLo ad: Byte; | |
5636 | {$IFDEF UN IX} | |
5637 | var | |
5638 | SystemIn f: TSysInf o; | |
5639 | begin | |
5640 | {$IFDEF FPC} | |
5641 | SysInfo( @SystemInf ); | |
5642 | {$ELSE ~ FPC} | |
5643 | SysInfo( SystemInf) ; | |
5644 | {$ENDIF ~FPC} | |
5645 | with Sys temInf do | |
5646 | Result := 100 - Round(100 * freeram / totalram ); | |
5647 | end; | |
5648 | {$ENDIF UN IX} | |
5649 | {$IFDEF MS WINDOWS} | |
5650 | var | |
5651 | MemorySt atusEx: TM emoryStatu sEx; | |
5652 | begin | |
5653 | ResetMem ory(Memory StatusEx, SizeOf(Mem oryStatusE x)); | |
5654 | MemorySt atusEx.dwL ength := S izeOf(Memo ryStatusEx ); | |
5655 | if not G lobalMemor yStatusEx( MemoryStat usEx) then | |
5656 | RaiseL astOSError ; | |
5657 | Result : = MemorySt atusEx.dwM emoryLoad; | |
5658 | end; | |
5659 | {$ENDIF MS WINDOWS} | |
5660 | ||
5661 | function G etSwapFile Size: Int6 4; | |
5662 | {$IFDEF UN IX} | |
5663 | var | |
5664 | SystemIn f: TSysInf o; | |
5665 | begin | |
5666 | {$IFDEF FPC} | |
5667 | SysInfo( @SystemInf ); | |
5668 | {$ELSE ~ FPC} | |
5669 | SysInfo( SystemInf) ; | |
5670 | {$ENDIF ~FPC} | |
5671 | Result : = SystemIn f.totalswa p; | |
5672 | end; | |
5673 | {$ENDIF UN IX} | |
5674 | {$IFDEF MS WINDOWS} | |
5675 | var | |
5676 | MemorySt atusEx: TM emoryStatu sEx; | |
5677 | begin | |
5678 | ResetMem ory(Memory StatusEx, SizeOf(Mem oryStatusE x)); | |
5679 | MemorySt atusEx.dwL ength := S izeOf(Memo ryStatusEx ); | |
5680 | if not G lobalMemor yStatusEx( MemoryStat usEx) then | |
5681 | RaiseL astOSError ; | |
5682 | Result : = MemorySt atusEx.ull TotalPageF ile - Memo ryStatusEx .ullAvailP ageFile; | |
5683 | end; | |
5684 | {$ENDIF MS WINDOWS} | |
5685 | ||
5686 | function G etSwapFile Usage: Byt e; | |
5687 | {$IFDEF UN IX} | |
5688 | var | |
5689 | SystemIn f: TSysInf o; | |
5690 | begin | |
5691 | {$IFDEF FPC} | |
5692 | SysInfo( @SystemInf ); | |
5693 | {$ELSE ~ FPC} | |
5694 | SysInfo( SystemInf) ; | |
5695 | {$ENDIF ~FPC} | |
5696 | with Sys temInf do | |
5697 | Result := 100 - Trunc(100 * FreeSwap / TotalSw ap); | |
5698 | end; | |
5699 | {$ENDIF UN IX} | |
5700 | {$IFDEF MS WINDOWS} | |
5701 | var | |
5702 | MemorySt atusEx: TM emoryStatu sEx; | |
5703 | begin | |
5704 | ResetMem ory(Memory StatusEx, SizeOf(Mem oryStatusE x)); | |
5705 | MemorySt atusEx.dwL ength := S izeOf(Memo ryStatusEx ); | |
5706 | if not G lobalMemor yStatusEx( MemoryStat usEx) then | |
5707 | RaiseL astOSError ; | |
5708 | if Memor yStatusEx. ullTotalPa geFile > 0 then | |
5709 | Resu lt := 100 - Trunc(Me moryStatus Ex.ullAvai lPageFile / MemorySt atusEx.ull TotalPageF ile * 100) | |
5710 | else | |
5711 | Resu lt := 0; | |
5712 | end; | |
5713 | {$ENDIF MS WINDOWS} | |
5714 | ||
5715 | function G etTotalPhy sicalMemor y: Int64; | |
5716 | {$IFDEF UN IX} | |
5717 | var | |
5718 | SystemIn f: TSysInf o; | |
5719 | begin | |
5720 | {$IFDEF FPC} | |
5721 | SysInfo( @SystemInf ); | |
5722 | {$ELSE ~ FPC} | |
5723 | SysInfo( SystemInf) ; | |
5724 | {$ENDIF ~FPC} | |
5725 | Result : = SystemIn f.totalram ; | |
5726 | end; | |
5727 | {$ENDIF UN IX} | |
5728 | {$IFDEF MS WINDOWS} | |
5729 | var | |
5730 | MemorySt atusEx: TM emoryStatu sEx; | |
5731 | begin | |
5732 | ResetMem ory(Memory StatusEx, SizeOf(Mem oryStatusE x)); | |
5733 | MemorySt atusEx.dwL ength := S izeOf(Memo ryStatusEx ); | |
5734 | if not G lobalMemor yStatusEx( MemoryStat usEx) then | |
5735 | RaiseL astOSError ; | |
5736 | Result : = MemorySt atusEx.ull TotalPhys; | |
5737 | end; | |
5738 | {$ENDIF MS WINDOWS} | |
5739 | ||
5740 | function G etFreePhys icalMemory : Int64; | |
5741 | {$IFDEF UN IX} | |
5742 | var | |
5743 | SystemIn f: TSysInf o; | |
5744 | begin | |
5745 | {$IFDEF FPC} | |
5746 | SysInfo( @SystemInf ); | |
5747 | {$ELSE ~ FPC} | |
5748 | SysInfo( SystemInf) ; | |
5749 | {$ENDIF ~FPC} | |
5750 | Result : = SystemIn f.freeram; | |
5751 | end; | |
5752 | {$ENDIF UN IX} | |
5753 | {$IFDEF MS WINDOWS} | |
5754 | var | |
5755 | MemorySt atusEx: TM emoryStatu sEx; | |
5756 | begin | |
5757 | ResetMem ory(Memory StatusEx, SizeOf(Mem oryStatusE x)); | |
5758 | MemorySt atusEx.dwL ength := S izeOf(Memo ryStatusEx ); | |
5759 | if not G lobalMemor yStatusEx( MemoryStat usEx) then | |
5760 | RaiseL astOSError ; | |
5761 | Result : = MemorySt atusEx.ull AvailPhys; | |
5762 | end; | |
5763 | ||
5764 | function G etTotalPag eFileMemor y: Int64; | |
5765 | var | |
5766 | MemorySt atusEx: TM emoryStatu sEx; | |
5767 | begin | |
5768 | ResetMem ory(Memory StatusEx, SizeOf(Mem oryStatusE x)); | |
5769 | MemorySt atusEx.dwL ength := S izeOf(Memo ryStatusEx ); | |
5770 | if not G lobalMemor yStatusEx( MemoryStat usEx) then | |
5771 | RaiseL astOSError ; | |
5772 | Result : = MemorySt atusEx.ull TotalPageF ile; | |
5773 | end; | |
5774 | ||
5775 | function G etFreePage FileMemory : Int64; | |
5776 | var | |
5777 | MemorySt atusEx: TM emoryStatu sEx; | |
5778 | begin | |
5779 | ResetMem ory(Memory StatusEx, SizeOf(Mem oryStatusE x)); | |
5780 | MemorySt atusEx.dwL ength := S izeOf(Memo ryStatusEx ); | |
5781 | if not G lobalMemor yStatusEx( MemoryStat usEx) then | |
5782 | RaiseL astOSError ; | |
5783 | Result : = MemorySt atusEx.ull AvailPageF ile; | |
5784 | end; | |
5785 | ||
5786 | function G etTotalVir tualMemory : Int64; | |
5787 | var | |
5788 | MemorySt atusEx: TM emoryStatu sEx; | |
5789 | begin | |
5790 | ResetMem ory(Memory StatusEx, SizeOf(Mem oryStatusE x)); | |
5791 | MemorySt atusEx.dwL ength := S izeOf(Memo ryStatusEx ); | |
5792 | if not G lobalMemor yStatusEx( MemoryStat usEx) then | |
5793 | RaiseL astOSError ; | |
5794 | Result : = MemorySt atusEx.ull TotalVirtu al; | |
5795 | end; | |
5796 | ||
5797 | function G etFreeVirt ualMemory: Int64; | |
5798 | var | |
5799 | MemorySt atusEx: TM emoryStatu sEx; | |
5800 | begin | |
5801 | ResetMem ory(Memory StatusEx, SizeOf(Mem oryStatusE x)); | |
5802 | MemorySt atusEx.dwL ength := S izeOf(Memo ryStatusEx ); | |
5803 | if not G lobalMemor yStatusEx( MemoryStat usEx) then | |
5804 | RaiseL astOSError ; | |
5805 | Result : = MemorySt atusEx.ull AvailVirtu al; | |
5806 | end; | |
5807 | ||
5808 | //=== Keyb oard Infor mation === ========== ========== ========== ========== ======== | |
5809 | ||
5810 | function G etKeybStat eHelper(Vi rtualKey: Cardinal; Mask: Byte ): Boolean ; | |
5811 | var | |
5812 | Keys: TK eyboardSta te; | |
5813 | begin | |
5814 | Keys[0] := 0; | |
5815 | Result : = GetKeyBo ardState(K eys) and ( Keys[Virtu alKey] and Mask <> 0 ); | |
5816 | end; | |
5817 | ||
5818 | function G etKeyState (const Vir tualKey: C ardinal): Boolean; | |
5819 | begin | |
5820 | Result : = GetKeybS tateHelper (VirtualKe y, $80); | |
5821 | end; | |
5822 | ||
5823 | function G etNumLockK eyState: B oolean; | |
5824 | begin | |
5825 | Result : = GetKeybS tateHelper (VK_NUMLOC K, $01); | |
5826 | end; | |
5827 | ||
5828 | function G etScrollLo ckKeyState : Boolean; | |
5829 | begin | |
5830 | Result : = GetKeybS tateHelper (VK_SCROLL , $01); | |
5831 | end; | |
5832 | ||
5833 | function G etCapsLock KeyState: Boolean; | |
5834 | begin | |
5835 | Result : = GetKeybS tateHelper (VK_CAPITA L, $01); | |
5836 | end; | |
5837 | ||
5838 | //=== Wind ows 95/98/ ME system resources informatio n ======== ========== ======== | |
5839 | ||
5840 | { TODO -oP JH : compa re to Win9 xFreeSysRe sources } | |
5841 | var | |
5842 | Resmeter LibHandle: THandle; | |
5843 | MyGetFre eSystemRes ources: fu nction(Res Type: UINT ): UINT; s tdcall; | |
5844 | ||
5845 | procedure UnloadSyst emResource sMeterLib; | |
5846 | begin | |
5847 | if Resme terLibHand le <> 0 th en | |
5848 | begin | |
5849 | FreeLi brary(Resm eterLibHan dle); | |
5850 | Resmet erLibHandl e := 0; | |
5851 | @MyGet FreeSystem Resources := nil; | |
5852 | end; | |
5853 | end; | |
5854 | ||
5855 | function I sSystemRes ourcesMete rPresent: Boolean; | |
5856 | ||
5857 | procedur e LoadResm eter; | |
5858 | begin | |
5859 | Resmet erLibHandl e := SafeL oadLibrary ('rsrc32.d ll', SEM_F AILCRITICA LERRORS); | |
5860 | if Res meterLibHa ndle <> 0 then | |
5861 | begin | |
5862 | @MyG etFreeSyst emResource s := GetPr ocAddress( ResmeterLi bHandle, P AnsiChar(' _MyGetFree SystemReso urces32@4' )); | |
5863 | if n ot Assigne d(MyGetFre eSystemRes ources) th en | |
5864 | Un loadSystem ResourcesM eterLib; | |
5865 | end; | |
5866 | end; | |
5867 | ||
5868 | begin | |
5869 | if not I sWinNT and (Resmeter LibHandle = 0) then | |
5870 | LoadRe smeter; | |
5871 | Result : = (Resmete rLibHandle <> 0); | |
5872 | end; | |
5873 | ||
5874 | function G etFreeSyst emResource s(const Re sourceType : TFreeSys ResKind): Integer; | |
5875 | const | |
5876 | ParamVal ues: array [TFreeSys ResKind] o f UINT = ( 0, 1, 2); | |
5877 | begin | |
5878 | if IsSys temResourc esMeterPre sent then | |
5879 | Result := MyGetF reeSystemR esources(P aramValues [ResourceT ype]) | |
5880 | else | |
5881 | Result := -1; | |
5882 | end; | |
5883 | ||
5884 | function G etFreeSyst emResource s: TFreeSy stemResour ces; | |
5885 | begin | |
5886 | with Res ult do | |
5887 | begin | |
5888 | System Res := Get FreeSystem Resources( rtSystem); | |
5889 | GdiRes := GetFre eSystemRes ources(rtG di); | |
5890 | UserRe s := GetFr eeSystemRe sources(rt User); | |
5891 | end; | |
5892 | end; | |
5893 | ||
5894 | function G etBPP: Car dinal; | |
5895 | var | |
5896 | DC: HDC; | |
5897 | begin | |
5898 | DC := Ge tDC(HWND_D ESKTOP); | |
5899 | if DC <> 0 then | |
5900 | begin | |
5901 | Result := GetDev iceCaps(DC , BITSPIXE L) * GetDe viceCaps(D C, PLANES) ; | |
5902 | Releas eDC(HWND_D ESKTOP, DC ); | |
5903 | end | |
5904 | else | |
5905 | Result := 0; | |
5906 | end; | |
5907 | ||
5908 | //=== Inst alled prog rams ===== ========== ========== ========== ========== ======== | |
5909 | ||
5910 | function P rogIDExist s(const Pr ogID: stri ng): Boole an; | |
5911 | var | |
5912 | Tmp: TGU ID; | |
5913 | WideProg ID: WideSt ring; | |
5914 | begin | |
5915 | WideProg ID := Prog ID; | |
5916 | Result : = Succeede d(CLSIDFro mProgID(PW ideChar(Wi deProgID), Tmp)); | |
5917 | end; | |
5918 | ||
5919 | function I sWordInsta lled: Bool ean; | |
5920 | begin | |
5921 | Result : = ProgIDEx ists('Word .Applicati on'); | |
5922 | end; | |
5923 | ||
5924 | function I sExcelInst alled: Boo lean; | |
5925 | begin | |
5926 | Result : = ProgIDEx ists('Exce l.Applicat ion'); | |
5927 | end; | |
5928 | ||
5929 | function I sAccessIns talled: Bo olean; | |
5930 | begin | |
5931 | Result : = ProgIDEx ists('Acce ss.Applica tion'); | |
5932 | end; | |
5933 | ||
5934 | function I sPowerPoin tInstalled : Boolean; | |
5935 | begin | |
5936 | Result : = ProgIDEx ists('Powe rPoint.App lication') ; | |
5937 | end; | |
5938 | ||
5939 | function I sFrontPage Installed: Boolean; | |
5940 | begin | |
5941 | Result : = ProgIDEx ists('Fron tPage.Appl ication'); | |
5942 | end; | |
5943 | ||
5944 | function I sOutlookIn stalled: B oolean; | |
5945 | begin | |
5946 | Result : = ProgIDEx ists('Outl ook.Applic ation'); | |
5947 | end; | |
5948 | ||
5949 | function I sInternetE xplorerIns talled: Bo olean; | |
5950 | begin | |
5951 | Result : = ProgIDEx ists('Inte rnetExplor er.Applica tion'); | |
5952 | end; | |
5953 | ||
5954 | function I sMSProject Installed: Boolean; | |
5955 | begin | |
5956 | Result : = ProgIDEx ists('MSPr oject.Appl ication'); | |
5957 | end; | |
5958 | ||
5959 | function I sOpenOffic eInstalled : Boolean; | |
5960 | begin | |
5961 | Result : = ProgIDEx ists('com. sun.star.S erviceMana ger'); | |
5962 | end; | |
5963 | ||
5964 | function I sLibreOffi ceInstalle d: Boolean ; | |
5965 | begin | |
5966 | Result : = ProgIDEx ists('com. sun.star.S erviceMana ger.1'); | |
5967 | end; | |
5968 | ||
5969 | //=== Init ialization /Finalizat ion ====== ========== ========== ========== ======== | |
5970 | ||
5971 | procedure InitSysInf o; | |
5972 | var | |
5973 | SystemIn fo: TSyste mInfo; | |
5974 | Kernel32 FileName: string; | |
5975 | VerFixed FileInfo: TVSFixedFi leInfo; | |
5976 | begin | |
5977 | { proces sor inform ation rela ted initia lization } | |
5978 | ||
5979 | ResetMem ory(System Info, Size Of(SystemI nfo)); | |
5980 | GetSyste mInfo(Syst emInfo); | |
5981 | Processo rCount := SystemInfo .dwNumberO fProcessor s; | |
5982 | AllocGra nularity : = SystemIn fo.dwAlloc ationGranu larity; | |
5983 | PageSize := System Info.dwPag eSize; | |
5984 | ||
5985 | { Window s version informatio n } | |
5986 | ||
5987 | IsWinNT := Win32Pl atform = V ER_PLATFOR M_WIN32_NT ; | |
5988 | ||
5989 | Kernel32 FileName : = GetModul ePath(GetM oduleHandl e(kernel32 )); | |
5990 | VerFixed FileInfo.d wFileDateL S := 0; | |
5991 | if (not IsWinNT) a nd Version FixedFileI nfo(Kernel 32FileName , VerFixed FileInfo) then | |
5992 | Kernel VersionHi := VerFixe dFileInfo. dwProductV ersionMS | |
5993 | else | |
5994 | Kernel VersionHi := 0; | |
5995 | ||
5996 | case Get WindowsVer sion of | |
5997 | wvUnkn own: | |
5998 | ; | |
5999 | wvWin9 5: | |
6000 | IsWi n95 := Tru e; | |
6001 | wvWin9 5OSR2: | |
6002 | IsWi n95OSR2 := True; | |
6003 | wvWin9 8: | |
6004 | IsWi n98 := Tru e; | |
6005 | wvWin9 8SE: | |
6006 | IsWi n98SE := T rue; | |
6007 | wvWinM E: | |
6008 | IsWi nME := Tru e; | |
6009 | wvWinN T31: | |
6010 | begi n | |
6011 | Is WinNT3 := True; | |
6012 | Is WinNT31 := True; | |
6013 | end; | |
6014 | wvWinN T35: | |
6015 | begi n | |
6016 | Is WinNT3 := True; | |
6017 | Is WinNT35 := True; | |
6018 | end; | |
6019 | wvWinN T351: | |
6020 | begi n | |
6021 | Is WinNT3 := True; | |
6022 | Is WinNT35 := True; | |
6023 | Is WinNT351 : = True; | |
6024 | end; | |
6025 | wvWinN T4: | |
6026 | IsWi nNT4 := Tr ue; | |
6027 | wvWin2 000: | |
6028 | IsWi n2K := Tru e; | |
6029 | wvWinX P: | |
6030 | IsWi nXP := Tru e; | |
6031 | wvWin2 003: | |
6032 | IsWi n2003 := T rue; | |
6033 | wvWinX P64: | |
6034 | IsWi nXP64 := T rue; | |
6035 | wvWin2 003R2: | |
6036 | IsWi n2003R2 := True; | |
6037 | wvWinV ista: | |
6038 | IsWi nVista := True; | |
6039 | wvWinS erver2008: | |
6040 | IsWi nServer200 8 := True; | |
6041 | wvWin7 : | |
6042 | IsWi n7 := True ; | |
6043 | wvWinS erver2008R 2: | |
6044 | IsWi nServer200 8R2 := Tru e; | |
6045 | wvWin8 : | |
6046 | IsWi n8 := True ; | |
6047 | wvWin8 RT: | |
6048 | IsWi n8RT := Tr ue; | |
6049 | wvWinS erver2012: | |
6050 | IsWi nServer201 2 := True; | |
6051 | wvWin8 1: | |
6052 | IsWi n81 := Tru e; | |
6053 | wvWin8 1RT: | |
6054 | IsWi n81RT := T rue; | |
6055 | wvWinS erver2012R 2: | |
6056 | IsWi nServer201 2R2 := Tru e; | |
6057 | wvWin1 0: | |
6058 | IsWi n10 := Tru e; | |
6059 | wvWinS erver2016: | |
6060 | IsWi nServer201 6 := True; | |
6061 | end; | |
6062 | end; | |
6063 | ||
6064 | procedure FinalizeSy sInfo; | |
6065 | begin | |
6066 | UnloadSy stemResour cesMeterLi b; | |
6067 | end; | |
6068 | ||
6069 | initializa tion | |
6070 | InitSysI nfo; | |
6071 | {$IFDEF UNITVERSIO NING} | |
6072 | Register UnitVersio n(HInstanc e, UnitVer sioning); | |
6073 | {$ENDIF UNITVERSIO NING} | |
6074 | ||
6075 | finalizati on | |
6076 | {$IFDEF UNITVERSIO NING} | |
6077 | Unregist erUnitVers ion(HInsta nce); | |
6078 | {$ENDIF UNITVERSIO NING} | |
6079 | Finalize SysInfo; | |
6080 | ||
6081 | {$ENDIF MS WINDOWS} | |
6082 | ||
6083 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.