home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d56 / MSYSINFO.ZIP / Source / MSI_OS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-07-24  |  22.0 KB  |  609 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {               OS Detection Part                       }
  6. {           version 6.0 for Delphi 5,6                  }
  7. {                                                       }
  8. {       Copyright ⌐ 1997,2001 Michal Mutl               }
  9. {                                                       }
  10. {*******************************************************}
  11.  
  12. {$INCLUDE MITEC_DEF.INC}
  13.  
  14. unit MSI_OS;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, Windows, Classes;
  20.  
  21. type
  22.   TTimeZone = class(TPersistent)
  23.   private
  24.     FStdBias: integer;
  25.     FDayBias: integer;
  26.     FBias: integer;
  27.     FDisp: string;
  28.     FStd: string;
  29.     FDayStart: TDatetime;
  30.     FStdStart: TDatetime;
  31.     FDay: string;
  32.     FMap: string;
  33.   public
  34.     procedure GetInfo;
  35.     procedure Report(var sl :TStringList);
  36.     property MapID: string read FMap;
  37.   published
  38.     property DisplayName: string read FDisp {$IFNDEF D6PLUS} write FDisp {$ENDIF} stored False;
  39.     property StandardName: string read FStd {$IFNDEF D6PLUS} write FStd {$ENDIF} stored False;
  40.     property DaylightName: string read FDay {$IFNDEF D6PLUS} write FDay {$ENDIF} stored False;
  41.     property DaylightStart: TDatetime read FDayStart {$IFNDEF D6PLUS} write FDayStart {$ENDIF} stored False;
  42.     property StandardStart: TDatetime read FStdStart {$IFNDEF D6PLUS} write FStdStart {$ENDIF} stored False;
  43.     property Bias: integer read FBias {$IFNDEF D6PLUS} write FBias {$ENDIF} stored False;
  44.     property DaylightBias: integer read FDayBias {$IFNDEF D6PLUS} write FDayBias {$ENDIF} stored False;
  45.     property StandardBias: integer read FStdBias {$IFNDEF D6PLUS} write FStdBias {$ENDIF} stored False;
  46.   end;
  47.  
  48. const
  49.   VER_NT_WORKSTATION       = $0000001;
  50.   VER_NT_DOMAIN_CONTROLLER = $0000002;
  51.   VER_NT_SERVER            = $0000003;
  52.  
  53.   VER_SUITE_SMALLBUSINESS            = $0000002;
  54.   VER_SUITE_ENTERPRISE               = $0000004;
  55.   VER_SUITE_BACKOFFICE               = $0000008;
  56.   VER_SUITE_COMMUNICATIONS           = $0000010;
  57.   VER_SUITE_TERMINAL                 = $0000020;
  58.   VER_SUITE_SMALLBUSINESS_RESTRICTED = $0000040;
  59.   VER_SUITE_EMBEDDEDNT               = $0000080;
  60.   VER_SUITE_DATACENTER               = $0000100;
  61.  
  62.  
  63. type
  64.   POSVersionInfoEx = ^TOSVersionInfoEx;
  65.   TOSVersionInfoEx = record
  66.     dwOSVersionInfoSize: DWORD;
  67.     dwMajorVersion: DWORD;
  68.     dwMinorVersion: DWORD;
  69.     dwBuildNumber: DWORD;
  70.     dwPlatformId: DWORD;
  71.     szCSDVersion: array [0..127] of Char;
  72.     wServicePackMajor: Word;
  73.     wServicePackMinor: Word;
  74.     wSuiteMask: Word;
  75.     wProductType: Byte;
  76.     wReserved: Byte;
  77.   end;
  78.  
  79.   TNtProductType = (ptUnknown, ptWorkStation, ptServer, ptAdvancedServer);
  80.  
  81.   TNTSuite = (suSmallBusiness, suEnterprise, suBackOffice, suCommunications,
  82.               suTerminal, suSmallBusinessRestricted, suEmbeddedNT, suDataCenter);
  83.   TNTSuites = set of TNTSuite;
  84.  
  85.   TNTSpecific = class(TPersistent)
  86.   private
  87.     FSPMinorVer: Word;
  88.     FSPMajorVer: Word;
  89.     FProduct: TNTProductType;
  90.     FSuites: TNTSuites;
  91.   public
  92.     procedure GetInfo;
  93.     procedure Report(var sl: TStringList);
  94.     procedure Report_InstalledSuites(var sl: TStringList);
  95.   published
  96.     property ProductType: TNTProductType read FProduct {$IFNDEF D6PLUS} write FProduct {$ENDIF} stored False;
  97.     property InstalledSuites: TNTSuites read FSuites {$IFNDEF D6PLUS} write FSuites {$ENDIF} stored False;
  98.     property ServicePackMajorVersion: Word read FSPMajorVer {$IFNDEF D6PLUS} write FSPMajorVer {$ENDIF} stored False;
  99.     property ServicePackMinorVersion: Word read FSPMinorVer {$IFNDEF D6PLUS} write FSPMinorVer {$ENDIF} stored False;
  100.   end;
  101.  
  102.   TOperatingSystem = class(TPersistent)
  103.   private
  104.     FBuildNumber: integer;
  105.     FMajorVersion: integer;
  106.     FMinorVersion: integer;
  107.     FPlatform: string;
  108.     FCSD: string;
  109.     FVersion: string;
  110.     FRegUser: string;
  111.     FProductID: string;
  112.     FRegOrg: string;
  113.     FEnv: TStrings;
  114.     FDirs: TStrings;
  115.     FTZ: TTimeZone;
  116.     FNTSpec: TNTSpecific;
  117.     FProductKey: string;
  118.     FDVD: string;
  119.   protected
  120.   public
  121.     constructor Create;
  122.     destructor Destroy; override;
  123.     procedure GetInfo;
  124.     procedure Report(var sl :TStringList);
  125.   published
  126.     property MajorVersion :integer read FMajorVersion {$IFNDEF D6PLUS} write FMajorVersion {$ENDIF} stored false;
  127.     property MinorVersion :integer read FMinorVersion {$IFNDEF D6PLUS} write FMinorVersion {$ENDIF} stored false;
  128.     property BuildNumber :integer read FBuildNumber {$IFNDEF D6PLUS} write FBuildNumber {$ENDIF} stored false;
  129.     property Platform :string read FPlatform {$IFNDEF D6PLUS} write FPlatform {$ENDIF} stored false;
  130.     property Version :string read FVersion {$IFNDEF D6PLUS} write FVersion {$ENDIF} stored false;
  131.     property CSD :string read FCSD {$IFNDEF D6PLUS} write FCSD {$ENDIF} stored false;
  132.     property ProductID :string read FProductID {$IFNDEF D6PLUS} write FProductID {$ENDIF} stored false;
  133.     property ProductKey :string read FProductKey {$IFNDEF D6PLUS} write FProductKey {$ENDIF} stored False;
  134.     property RegisteredUser :string read FRegUser {$IFNDEF D6PLUS} write FRegUser {$ENDIF} stored false;
  135.     property RegisteredOrg :string read FRegOrg {$IFNDEF D6PLUS} write FRegOrg {$ENDIF} stored false;
  136.     property TimeZone :TTimeZone read FTZ {$IFNDEF D6PLUS} write FTZ {$ENDIF} stored false;
  137.     property Environment :TStrings read FEnv {$IFNDEF D6PLUS} write FEnv {$ENDIF} stored false;
  138.     property Folders: TStrings read FDirs {$IFNDEF D6PLUS} write FDirs {$ENDIF} stored False;
  139.     property NTSpecific: TNTSpecific read FNTSpec {$IFNDEF D6PLUS} write FNTSpec {$ENDIF} stored False;
  140.     property DVDRegion: string read FDVD {$IFNDEF D6PLUS} write FDVD {$ENDIF} stored False;
  141.   end;
  142.  
  143. function GetVersionEx(lpVersionInformation: POSVersionInfoEx): BOOL; stdcall;
  144.  
  145. implementation
  146.  
  147. uses
  148.   ShlObj, Registry, MiTeC_Routines;
  149.  
  150. function GetVersionEx; external kernel32 name 'GetVersionExA';
  151.  
  152. { TTimeZone }
  153.  
  154. type
  155.   TRegTimeZoneInfo = packed record
  156.     Bias: Longint;
  157.     StandardBias: Longint;
  158.     DaylightBias: Longint;
  159.     StandardDate: TSystemTime;
  160.     DaylightDate: TSystemTime;
  161.   end;
  162.  
  163. function GetTZDaylightSavingInfoForYear(
  164.     TZ: TTimeZoneInformation; year: word;
  165.     var DaylightDate, StandardDate: TDateTime;
  166.     var DaylightBias, StandardBias: longint): boolean;
  167. begin
  168.   Result:=false;
  169.   try
  170.     if (TZ.DaylightDate.wMonth <> 0) and
  171.        (TZ.StandardDate.wMonth <> 0) then begin
  172.       DaylightDate:=DSTDate2Date(TZ.DaylightDate,year);
  173.       StandardDate:=DSTDate2Date(TZ.StandardDate,year);
  174.       DaylightBias:=TZ.Bias+TZ.DaylightBias;
  175.       StandardBias:=TZ.Bias+TZ.StandardBias;
  176.       Result:=true;
  177.     end;
  178.   except
  179.   end;
  180. end;
  181.  
  182. function CompareSysTime(st1, st2: TSystemTime): integer;
  183. begin
  184.   if st1.wYear<st2.wYear then
  185.     Result:=-1
  186.   else
  187.     if st1.wYear>st2.wYear then
  188.       Result:=1
  189.     else
  190.       if st1.wMonth<st2.wMonth then
  191.         Result:=-1
  192.       else
  193.         if st1.wMonth>st2.wMonth then
  194.           Result:=1
  195.         else
  196.           if st1.wDayOfWeek<st2.wDayOfWeek then
  197.             Result:=-1
  198.           else
  199.             if st1.wDayOfWeek>st2.wDayOfWeek then
  200.               Result:=1
  201.             else
  202.               if st1.wDay<st2.wDay then
  203.                 Result:=-1
  204.               else
  205.                 if st1.wDay>st2.wDay then
  206.                   Result:=1
  207.                 else
  208.                   if st1.wHour<st2.wHour then
  209.                     Result:=-1
  210.                   else
  211.                     if st1.wHour>st2.wHour then
  212.                       Result:=1
  213.                     else
  214.                       if st1.wMinute<st2.wMinute then
  215.                         Result:=-1
  216.                       else
  217.                         if st1.wMinute>st2.wMinute then
  218.                           Result:=1
  219.                          else
  220.                            if st1.wSecond<st2.wSecond then
  221.                              Result:=-1
  222.                            else
  223.                              if st1.wSecond>st2.wSecond then
  224.                                Result:=1
  225.                              else
  226.                                if st1.wMilliseconds<st2.wMilliseconds then
  227.                                  Result:=-1
  228.                                else
  229.                                  if st1.wMilliseconds>st2.wMilliseconds then
  230.                                    Result:=1
  231.                                  else
  232.                                    Result:=0;
  233. end;
  234.  
  235. function IsEqualTZ(tz1, tz2: TTimeZoneInformation): boolean;
  236. begin
  237.   Result:=(tz1.Bias=tz2.Bias) and
  238.           (tz1.StandardBias=tz2.StandardBias) and
  239.           (tz1.DaylightBias=tz2.DaylightBias) and
  240.           (CompareSysTime(tz1.StandardDate,tz2.StandardDate)=0) and
  241.           (CompareSysTime(tz1.DaylightDate,tz2.DaylightDate)=0) and
  242.           (WideCharToString(tz1.StandardName)=WideCharToString(tz2.StandardName)) and
  243.           (WideCharToString(tz1.DaylightName)=WideCharToString(tz2.DaylightName));
  244. end;
  245.  
  246. procedure TTimeZone.GetInfo;
  247. var
  248.   TZKey: string;
  249.   RTZ: TRegTimeZoneInfo;
  250.   HomeTZ, RegTZ: TTimeZoneInformation;
  251.   y,m,d,i: Word;
  252.   sl: TStringList;
  253. const
  254.   rkNTTimeZones = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones';
  255.   rk9xTimeZones = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones';
  256.   rkTimeZone = {HKEY_LOCAL_MACHINE\}'SYSTEM\CurrentControlSet\Control\TimeZoneInformation';
  257.   rvTimeZone = 'StandardName';
  258. begin
  259.   GetTimeZoneInformation(HomeTZ);
  260.   sl:=TStringList.Create;
  261.   with TRegistry.create do begin
  262.     rootkey:=HKEY_LOCAL_MACHINE;
  263.     if IsNT then
  264.       TZKey:=rkNTTimeZones
  265.     else
  266.       TZKey:=rk9xTimeZones;
  267.     if OpenKey(TZKey,False) then begin
  268.       GetKeyNames(sl);
  269.       CloseKey;
  270.       for i:=0 to sl.Count-1 do
  271.         if OpenKey(TZKey+'\'+sl[i],False) then begin
  272.           if GetDataSize('TZI')=SizeOf(RTZ) then begin
  273.             ReadBinaryData('TZI',RTZ,SizeOf(RTZ));
  274.             StringToWideChar(ReadString('Std'),@RegTZ.StandardName,SizeOf(RegTZ.StandardName) div SizeOf(WideChar));
  275.             StringToWideChar(ReadString('Dlt'),@RegTZ.DaylightName,SizeOf(RegTZ.DaylightName) div SizeOf(WideChar));
  276.             RegTZ.Bias:=RTZ.Bias;
  277.             RegTZ.StandardBias:=RTZ.StandardBias;
  278.             RegTZ.DaylightBias:=RTZ.DaylightBias;
  279.             RegTZ.StandardDate:=RTZ.StandardDate;
  280.             RegTZ.DaylightDate:=RTZ.DaylightDate;
  281.             if IsEqualTZ(HomeTZ,RegTZ) then begin
  282.               FDisp:=ReadString('Display');
  283.               try
  284.                 FMap:=ReadString('MapID');
  285.               except
  286.                 FMap:='';
  287.               end;
  288.               Break;
  289.             end;
  290.           end;
  291.           CloseKey;
  292.         end;
  293.     end;
  294.     Free;
  295.   end;
  296.   FBias:=HomeTZ.Bias;
  297.   FStd:=HomeTZ.StandardName;
  298.   FDay:=HomeTZ.DaylightName;
  299.   DecodeDate(Date,y,m,d);
  300.   GetTZDaylightSavingInfoForYear(HomeTZ,y,FDayStart,FStdStart,FDayBias,FStdBias);
  301.   sl.Free;
  302. end;
  303.  
  304. procedure TTimeZone.Report(var sl: TStringList);
  305. begin
  306.   with sl do begin
  307.     Add('[Time Zone]');
  308.     Add(Format('TimeZone=%s',[DisplayName]));
  309.     Add(Format('StdName=%s',[DateTimeToStr(StandardStart)]));
  310.     Add(Format('StdBias=%d',[StandardBias]));
  311.     Add(Format('DlghtName=%s',[DateTimeToStr(DaylightStart)]));
  312.     Add(Format('DlghtBias=%d',[DaylightBias]));
  313.   end;
  314. end;
  315.  
  316.  
  317. { TOperatingSystem }
  318.  
  319. constructor TOperatingSystem.Create;
  320. begin
  321.   inherited;
  322.   FEnv:=TStringList.Create;
  323.   FDirs:=TStringList.Create;
  324.   FTZ:=TTimeZone.Create;
  325.   FNTSpec:=TNTSpecific.Create;
  326. end;
  327.  
  328. destructor TOperatingSystem.Destroy;
  329. begin
  330.   FEnv.Free;
  331.   FDirs.Free;
  332.   FTZ.Free;
  333.   FNTSpec.Free;
  334.   inherited;
  335. end;
  336.  
  337.  
  338. procedure TOperatingSystem.GetInfo;
  339. var
  340.   OS :TOSVersionInfo;
  341.   OK: Boolean;
  342.   p: pchar;
  343.   n: DWORD;
  344.   WinH: HWND;
  345.   s: string;
  346. const
  347.   rkOSInfo95 = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\Windows\CurrentVersion';
  348.   rkOSInfoNT = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\Windows NT\CurrentVersion';
  349.   rkSP6a = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\WindowsNT\CurrentVersion\Hotfix\Q246009';
  350.  
  351.   rvInstalled = 'Installed';
  352.   rvVersionName95 = 'Version';
  353.   rvVersionNameNT = 'CurrentType';
  354.   rvRegOrg = 'RegisteredOrganization';
  355.   rvRegOwn = 'RegisteredOwner';
  356.   rvProductID = 'ProductID';
  357.   rvProductKey = 'ProductKey';
  358.   rvDVD = 'DVD_Region';
  359.  
  360.   cUserProfile = 'USERPROFILE';
  361.   cUserProfileReg = {HKEY_CURRENT_USER\}'Software\Microsoft\Windows\CurrentVersion\ProfileList';
  362.   cUserProfileRec = {HKEY_CURRENT_USER\}'SOFTWARE\Microsoft\Windows\CurrentVersion\ProfileReconciliation';
  363.   cProfileDir = 'ProfileDirectory';
  364. begin
  365.   FDirs.Clear;
  366.   TimeZone.GetInfo;
  367.   NTSpecific.GetInfo;
  368.   ZeroMemory(@OS,SizeOf(OS));
  369.   OS.dwOSVersionInfoSize:=SizeOf(OS);
  370.   Windows.GetVersionEx(OS);
  371.   FMajorVersion:=OS.dwMajorVersion;
  372.   FMinorVersion:=OS.dwMinorVersion;
  373.   FBuildNumber:=word(OS.dwBuildNumber);
  374.   case OS.dwPlatformId of
  375.     VER_PLATFORM_WIN32s        :FPlatform:='Windows 3.1x';
  376.     VER_PLATFORM_WIN32_WINDOWS :FPlatform:='Windows 9x';
  377.     VER_PLATFORM_WIN32_NT      :FPlatform:='Windows NT';
  378.   end;
  379.   FCSD:=strpas(OS.szCSDVersion);
  380.  
  381.   FVersion:='';
  382.   FRegUser:='';
  383.   FRegOrg:='';
  384.   FProductID:='';
  385.   with TRegistry.create do begin
  386.     rootkey:=HKEY_LOCAL_MACHINE;
  387.     if IsNT then
  388.       OK:=OpenKey(rkOSInfoNT,False)
  389.     else
  390.       OK:=OpenKey(rkOSInfo95,False);
  391.     if OK then begin
  392.       if isnt then begin
  393.         if ValueExists(rvVersionNameNT) then
  394.           FVersion:=ReadString(rvVersionNameNT);
  395.       end else
  396.         if ValueExists(rvVersionName95) then
  397.            FVersion:=ReadString(rvVersionName95);
  398.       if ValueExists(rvRegOrg) then
  399.         FRegOrg:=ReadString(rvRegOrg);
  400.       if ValueExists(rvRegOwn) then
  401.         FRegUser:=ReadString(rvRegOwn);
  402.       if ValueExists(rvProductID) then
  403.         FProductID:=ReadString(rvProductID);
  404.       if ValueExists(rvProductKey) then
  405.         FProductKey:=ReadString(rvProductKey);
  406.       if ValueExists(rvDVD) then
  407.         FDVD:=ReadString(rvDVD);
  408.  
  409.       FDirs.Add('CommonFiles='+ReadString('CommonFilesDir'));
  410.       FDirs.Add('ProgramFiles='+ReadString('ProgramFilesDir'));
  411.       FDirs.Add('Device='+ReadString('DevicePath'));
  412.       FDirs.Add('OtherDevice='+ReadString('OtherDevicePath'));
  413.       FDirs.Add('Media='+ReadString('MediaPath'));
  414.       FDirs.Add('Config='+ReadString('ConfigPath'));
  415.       FDirs.Add('Wallpaper='+ReadString('WallPaperDir'));
  416.       CloseKey;
  417.  
  418.       if IsNT then  begin
  419.         if CSD='Service Pack 6' then
  420.           if OpenKey(rkSP6a,False) then begin
  421.             if ValueExists(rvInstalled) then
  422.               if ReadInteger(rvInstalled)=1 then
  423.                 FCSD:='Service Pack 6a';
  424.             CloseKey;
  425.           end;
  426.       end;
  427.     end;
  428.     Free;
  429.   end;
  430.  
  431.   n:=MAX_PATH;
  432.   p:=StrAlloc(n);
  433.  
  434.   GetWindowsDirectory(p,n);
  435.   FDirs.Add('Windows='+StrPas(p));
  436.  
  437.   GetSystemDirectory(p,n);
  438.   FDirs.Add('System='+StrPas(p));
  439.  
  440.   GetTempPath(n,p);
  441.   FDirs.Add('Temp='+StrPas(p));
  442.  
  443.   StrDispose(p);
  444.  
  445.   WinH:=GetDesktopWindow;
  446.   FDirs.Add('AppData='+GetSpecialFolder(WinH,CSIDL_APPDATA));
  447.   FDirs.Add('CommonDesktopDir='+GetSpecialFolder(WinH,CSIDL_COMMON_DESKTOPDIRECTORY));
  448.   FDirs.Add('CommonAltStartUp='+GetSpecialFolder(WinH,CSIDL_COMMON_ALTSTARTUP));
  449.   FDirs.Add('RecycleBin='+GetSpecialFolder(WinH,CSIDL_BITBUCKET));
  450.   FDirs.Add('CommonPrograms='+GetSpecialFolder(WinH,CSIDL_COMMON_PROGRAMS));
  451.   FDirs.Add('CommonStartMenu='+GetSpecialFolder(WinH,CSIDL_COMMON_STARTMENU));
  452.   FDirs.Add('CommonStartup='+GetSpecialFolder(WinH,CSIDL_COMMON_STARTUP));
  453.   FDirs.Add('CommonFavorites='+GetSpecialFolder(WinH,CSIDL_COMMON_FAVORITES));
  454.   FDirs.Add('Cookies='+GetSpecialFolder(WinH,CSIDL_COOKIES));
  455.   FDirs.Add('Controls='+GetSpecialFolder(WinH,CSIDL_CONTROLS));
  456.   FDirs.Add('Desktop='+GetSpecialFolder(WinH,CSIDL_DESKTOP));
  457.   FDirs.Add('DesktopDir='+GetSpecialFolder(WinH,CSIDL_DESKTOPDIRECTORY));
  458.   FDirs.Add('Favorites='+GetSpecialFolder(WinH,CSIDL_FAVORITES));
  459.   FDirs.Add('Drives='+GetSpecialFolder(WinH,CSIDL_DRIVES));
  460.   FDirs.Add('Fonts='+GetSpecialFolder(WinH,CSIDL_FONTS));
  461.   FDirs.Add('History='+GetSpecialFolder(WinH,CSIDL_HISTORY));
  462.   FDirs.Add('Internet='+GetSpecialFolder(WinH,CSIDL_INTERNET));
  463.   FDirs.Add('InternetCache='+GetSpecialFolder(WinH,CSIDL_INTERNET_CACHE));
  464.   FDirs.Add('NetWork='+GetSpecialFolder(WinH,CSIDL_NETWORK));
  465.   FDirs.Add('NetHood='+GetSpecialFolder(WinH,CSIDL_NETHOOD));
  466.   FDirs.Add('MyDocuments='+GetSpecialFolder(WinH,CSIDL_PERSONAL));
  467.   FDirs.Add('PrintHood='+GetSpecialFolder(WinH,CSIDL_PRINTHOOD));
  468.   FDirs.Add('Printers='+GetSpecialFolder(WinH,CSIDL_PRINTERS));
  469.   FDirs.Add('Programs='+GetSpecialFolder(WinH,CSIDL_PROGRAMS));
  470.   FDirs.Add('Recent='+GetSpecialFolder(WinH,CSIDL_RECENT));
  471.   FDirs.Add('SendTo='+GetSpecialFolder(WinH,CSIDL_SENDTO));
  472.   FDirs.Add('StartMenu='+GetSpecialFolder(WinH,CSIDL_STARTMENU));
  473.   FDirs.Add('StartUp='+GetSpecialFolder(WinH,CSIDL_STARTUP));
  474.   FDirs.Add('Templates='+GetSpecialFolder(WinH,CSIDL_TEMPLATES));
  475.   s:=ReverseStr(FDirs.Values['Desktop']);
  476.   s:=ReverseStr(Copy(s,Pos('\',s)+1,255));
  477.   FDirs.Add('Profile='+s);
  478.   FEnv.Clear;
  479.   GetEnvironment(FEnv);
  480. end;
  481.  
  482. procedure TOperatingSystem.Report(var sl: TStringList);
  483. begin
  484.   with sl do begin
  485.     Add('[Operating System]');
  486.     Add(Format('Platform=%s',[Platform]));
  487.     Add(Format('VersionName=%s',[Version]));
  488.     Add(Format('Version=%d.%d',[MajorVersion,MinorVersion]));
  489.     Add(Format('BuildNumber=%d',[BuildNumber]));
  490.     Add(Format('CSD=%s',[CSD]));
  491.     Add(Format('ProductID=%s',[ProductID]));
  492.     Add(Format('ProductKey=%s',[ProductKey]));
  493.     Add(Format('RegUser=%s',[RegisteredUser]));
  494.     Add(Format('RegOrganization=%s',[RegisteredOrg]));
  495.     Add(Format('DVDRegion=%s',[DVDRegion]));
  496.     NTSpecific.Report(sl);
  497.     Add('[Environment]');
  498.     AddStrings(Environment);
  499.     Add('[Folders]');
  500.     AddStrings(Folders);
  501.     TimeZone.Report(sl);
  502.   end;
  503. end;
  504.  
  505.  
  506. { TNTSpecific }
  507.  
  508. procedure TNTSpecific.GetInfo;
  509. var
  510.   VersionInfo: TOSVersionInfoEx;
  511.   OS :TOSVersionInfo;
  512.   s: string;
  513. const
  514.   rkProductTypeNT = {HKEY_LOCAL_MACHINE\}'System\CurrentControlSet\Control\ProductOptions';
  515.   rvProductType = 'ProductType';
  516. begin
  517.   ZeroMemory(@OS,SizeOf(OS));
  518.   OS.dwOSVersionInfoSize:=SizeOf(OS);
  519.   Windows.GetVersionEx(OS);
  520.   if (OS.dwPlatformId=VER_PLATFORM_WIN32_NT) and (OS.dwMajorVersion=5) then begin
  521.     ZeroMemory(@VersionInfo,SizeOf(VersionInfo));
  522.     VersionInfo.dwOSVersionInfoSize:=SizeOf(VersionInfo);
  523.     if GetVersionEx(@VersionInfo) then begin
  524.       case VersionInfo.wProductType of
  525.         VER_NT_WORKSTATION: FProduct:=ptWorkStation;
  526.         VER_NT_DOMAIN_CONTROLLER: FProduct:=ptAdvancedServer;
  527.         VER_NT_SERVER: FProduct:=ptServer;
  528.       end;
  529.       FSuites:=[];
  530.       if VersionInfo.wSuiteMask and VER_SUITE_SMALLBUSINESS=VER_SUITE_SMALLBUSINESS then
  531.         FSuites:=FSuites+[suSmallBusiness];
  532.       if VersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE=VER_SUITE_ENTERPRISE then
  533.         FSuites:=FSuites+[suEnterprise];
  534.       if VersionInfo.wSuiteMask and VER_SUITE_BACKOFFICE=VER_SUITE_BACKOFFICE then
  535.         FSuites:=FSuites+[suBackOffice];
  536.       if VersionInfo.wSuiteMask and VER_SUITE_COMMUNICATIONS=VER_SUITE_COMMUNICATIONS then
  537.         FSuites:=FSuites+[suCommunications];
  538.       if VersionInfo.wSuiteMask and VER_SUITE_TERMINAL=VER_SUITE_TERMINAL then
  539.         FSuites:=FSuites+[suTerminal];
  540.       if VersionInfo.wSuiteMask and VER_SUITE_SMALLBUSINESS_RESTRICTED=VER_SUITE_SMALLBUSINESS_RESTRICTED then
  541.         FSuites:=FSuites+[suSmallBusinessRestricted];
  542.       if VersionInfo.wSuiteMask and VER_SUITE_EMBEDDEDNT=VER_SUITE_EMBEDDEDNT then
  543.         FSuites:=FSuites+[suEmbeddedNT];
  544.       if VersionInfo.wSuiteMask and VER_SUITE_DATACENTER=VER_SUITE_DATACENTER then
  545.         FSuites:=FSuites+[suDataCenter];
  546.       FSPMajorVer:=VersionInfo.wServicePackMajor;
  547.       FSPMinorVer:=VersionInfo.wServicePackMinor;
  548.     end;
  549.   end;
  550.   if FProduct=ptUnknown then
  551.     with TRegistry.Create do begin
  552.       if OpenKey(rkProductTypeNT,False) then begin
  553.         s:=ReadString(rvProductType);
  554.         if s='WinNT' then
  555.           FProduct:=ptWorkStation
  556.         else
  557.           if s='ServerNT' then
  558.             FProduct:=ptServer
  559.           else
  560.             if s='LanmanNT' then
  561.               FProduct:=ptAdvancedServer;
  562.         CloseKey;
  563.       end;
  564.       Free;
  565.     end;
  566. end;
  567.  
  568. procedure TNTSpecific.Report(var sl: TStringList);
  569. begin
  570.   with sl do begin
  571.     Add('[NT Specific]');
  572.     case ProductType of
  573.       ptUnknown: Add('ProductType=Unknown');
  574.       ptWorkStation: Add('ProductType=Workstation');
  575.       ptServer: Add('ProductType=Server');
  576.       ptAdvancedServer: Add('ProductType=Advanced Server');
  577.     end;
  578.     Report_InstalledSuites(sl);
  579.     Add(Format('ServicePackMajorVersion=%d',[ServicePackMajorVersion]));
  580.     Add(Format('ServicePackMinorVersion=%d',[ServicePackMinorVersion]));
  581.   end;
  582. end;
  583.  
  584. procedure TNTSpecific.Report_InstalledSuites(var sl: TStringList);
  585. begin
  586.   with sl do begin
  587.     Add(Format('Microsoft Small Business Server=%d',
  588.                [integer(suSmallBusiness in InstalledSuites)]));
  589.     Add(Format('Windows 2000 Advanced Server=%d',
  590.                [integer(suEnterprise in InstalledSuites)]));
  591.     Add(Format('Microsoft BackOffice Components=%d',
  592.                [integer(suBackOffice in InstalledSuites)]));
  593.     Add(Format('Communications=%d',
  594.                [integer(suCommunications in InstalledSuites)]));
  595.     Add(Format('Terminal Services=%d',
  596.                [integer(suSmallBusiness in InstalledSuites)]));
  597.     Add(Format('Microsoft Small Business Server with the restrictive client license in force=%d',
  598.                [integer(suSmallBusinessRestricted in InstalledSuites)]));
  599.     Add(Format('Terminal Services=%d',
  600.                [integer(suSmallBusiness in InstalledSuites)]));
  601.     Add(Format('Embedded NT=%d',
  602.                [integer(suEmbeddedNT in InstalledSuites)]));
  603.     Add(Format('Windows 2000 Datacenter Server=%d',
  604.                [integer(suDataCenter in InstalledSuites)]));
  605.   end;
  606. end;
  607.  
  608. end.
  609.