9. EPMO Open Source Coordination Office Redaction File Detail Report

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.

9.1 Files compared

# 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

9.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 12164
Changed 1 2
Inserted 0 0
Removed 0 0

9.3 Comparison options

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

9.4 Active regular expressions

No regular expressions were active.

9.5 Comparison detail

  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.