home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / MSYSINFO.ZIP / Source / MSI_OS.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-21  |  22KB  |  633 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {               OS Detection Part                       }
  6. {           version 5.6 for Delphi 3,4,5                }
  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 write FDisp stored False;
  39.     property StandardName: string read FStd write FStd stored False;
  40.     property DaylightName: string read FDay write FDay stored False;
  41.     property DaylightStart: TDatetime read FDayStart write FDayStart stored False;
  42.     property StandardStart: TDatetime read FStdStart write FStdStart stored False;
  43.     property Bias: integer read FBias write FBias stored False;
  44.     property DaylightBias: integer read FDayBias write FDayBias stored False;
  45.     property StandardBias: integer read FStdBias write FStdBias 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 write FProduct stored False;
  97.     property InstalledSuites: TNTSuites read FSuites write FSuites stored False;
  98.     property ServicePackMajorVersion: Word read FSPMajorVer write FSPMajorVer stored False;
  99.     property ServicePackMinorVersion: Word read FSPMinorVer write FSPMinorVer 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 write FMajorVersion stored false;
  127.     property MinorVersion :integer read FMinorVersion write FMinorVersion stored false;
  128.     property BuildNumber :integer read FBuildNumber write FBuildNumber stored false;
  129.     property Platform :string read FPlatform write FPlatform stored false;
  130.     property Version :string read FVersion write FVersion stored false;
  131.     property CSD :string read FCSD write FCSD stored false;
  132.     property ProductID :string read FProductID write FProductID stored false;
  133.     property ProductKey :string read FProductKey write FProductKey stored False;
  134.     property RegisteredUser :string read FRegUser write FRegUser stored false;
  135.     property RegisteredOrg :string read FRegOrg write FRegOrg stored false;
  136.     property TimeZone :TTimeZone read FTZ write FTZ stored false;
  137.     property Environment :TStrings read FEnv write FEnv stored false;
  138.     property Folders: TStrings read FDirs write FDirs stored False;
  139.     property NTSpecific: TNTSpecific read FNTSpec write FNTSpec stored False;
  140.     property DVDRegion: string read FDVD write FDVD 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.   try
  260.  
  261.   GetTimeZoneInformation(HomeTZ);
  262.   sl:=TStringList.Create;
  263.   with TRegistry.create do begin
  264.     rootkey:=HKEY_LOCAL_MACHINE;
  265.     if IsNT then
  266.       TZKey:=rkNTTimeZones
  267.     else
  268.       TZKey:=rk9xTimeZones;
  269.     if OpenKey(TZKey,False) then begin
  270.       GetKeyNames(sl);
  271.       CloseKey;
  272.       for i:=0 to sl.Count-1 do
  273.         if OpenKey(TZKey+'\'+sl[i],False) then begin
  274.           if GetDataSize('TZI')=SizeOf(RTZ) then begin
  275.             ReadBinaryData('TZI',RTZ,SizeOf(RTZ));
  276.             StringToWideChar(ReadString('Std'),@RegTZ.StandardName,SizeOf(RegTZ.StandardName) div SizeOf(WideChar));
  277.             StringToWideChar(ReadString('Dlt'),@RegTZ.DaylightName,SizeOf(RegTZ.DaylightName) div SizeOf(WideChar));
  278.             RegTZ.Bias:=RTZ.Bias;
  279.             RegTZ.StandardBias:=RTZ.StandardBias;
  280.             RegTZ.DaylightBias:=RTZ.DaylightBias;
  281.             RegTZ.StandardDate:=RTZ.StandardDate;
  282.             RegTZ.DaylightDate:=RTZ.DaylightDate;
  283.             if IsEqualTZ(HomeTZ,RegTZ) then begin
  284.               FDisp:=ReadString('Display');
  285.               try
  286.                 FMap:=ReadString('MapID');
  287.               except
  288.                 FMap:='';
  289.               end;
  290.               Break;
  291.             end;
  292.           end;
  293.           CloseKey;
  294.         end;
  295.     end;
  296.     Free;
  297.   end;
  298.   FBias:=HomeTZ.Bias;
  299.   FStd:=HomeTZ.StandardName;
  300.   FDay:=HomeTZ.DaylightName;
  301.   DecodeDate(Date,y,m,d);
  302.   GetTZDaylightSavingInfoForYear(HomeTZ,y,FDayStart,FStdStart,FDayBias,FStdBias);
  303.   sl.Free;
  304.  
  305.   except
  306.     on e:Exception do begin
  307.       MessageBox(0,PChar(e.message),'TTimeZone.GetInfo',MB_OK or MB_ICONERROR);
  308.     end;
  309.   end;
  310. end;
  311.  
  312. procedure TTimeZone.Report(var sl: TStringList);
  313. begin
  314.   with sl do begin
  315.     Add('[Time Zone]');
  316.     Add(Format('TimeZone=%s',[DisplayName]));
  317.     Add(Format('StdName=%s',[DateTimeToStr(StandardStart)]));
  318.     Add(Format('StdBias=%d',[StandardBias]));
  319.     Add(Format('DlghtName=%s',[DateTimeToStr(DaylightStart)]));
  320.     Add(Format('DlghtBias=%d',[DaylightBias]));
  321.   end;
  322. end;
  323.  
  324.  
  325. { TOperatingSystem }
  326.  
  327. constructor TOperatingSystem.Create;
  328. begin
  329.   inherited;
  330.   FEnv:=TStringList.Create;
  331.   FDirs:=TStringList.Create;
  332.   FTZ:=TTimeZone.Create;
  333.   FNTSpec:=TNTSpecific.Create;
  334. end;
  335.  
  336. destructor TOperatingSystem.Destroy;
  337. begin
  338.   FEnv.Free;
  339.   FDirs.Free;
  340.   FTZ.Free;
  341.   FNTSpec.Free;
  342.   inherited;
  343. end;
  344.  
  345.  
  346. procedure TOperatingSystem.GetInfo;
  347. var
  348.   OS :TOSVersionInfo;
  349.   OK: Boolean;
  350.   p: pchar;
  351.   n: DWORD;
  352.   WinH: HWND;
  353.   s: string;
  354. const
  355.   rkOSInfo95 = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\Windows\CurrentVersion';
  356.   rkOSInfoNT = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\Windows NT\CurrentVersion';
  357.   rkSP6a = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\WindowsNT\CurrentVersion\Hotfix\Q246009';
  358.  
  359.   rvInstalled = 'Installed';
  360.   rvVersionName95 = 'Version';
  361.   rvVersionNameNT = 'CurrentType';
  362.   rvRegOrg = 'RegisteredOrganization';
  363.   rvRegOwn = 'RegisteredOwner';
  364.   rvProductID = 'ProductID';
  365.   rvProductKey = 'ProductKey';
  366.   rvDVD = 'DVD_Region';
  367.  
  368.   cUserProfile = 'USERPROFILE';
  369.   cUserProfileReg = {HKEY_CURRENT_USER\}'Software\Microsoft\Windows\CurrentVersion\ProfileList';
  370.   cUserProfileRec = {HKEY_CURRENT_USER\}'SOFTWARE\Microsoft\Windows\CurrentVersion\ProfileReconciliation';
  371.   cProfileDir = 'ProfileDirectory';
  372. begin
  373.   try
  374.  
  375.   FDirs.Clear;
  376.   TimeZone.GetInfo;
  377.   NTSpecific.GetInfo;
  378.   ZeroMemory(@OS,SizeOf(OS));
  379.   OS.dwOSVersionInfoSize:=SizeOf(OS);
  380.   Windows.GetVersionEx(OS);
  381.   MajorVersion:=OS.dwMajorVersion;
  382.   MinorVersion:=OS.dwMinorVersion;
  383.   BuildNumber:=word(OS.dwBuildNumber);
  384.   case OS.dwPlatformId of
  385.     VER_PLATFORM_WIN32s        :Platform:='Windows 3.1x';
  386.     VER_PLATFORM_WIN32_WINDOWS :Platform:='Windows 9x';
  387.     VER_PLATFORM_WIN32_NT      :Platform:='Windows NT';
  388.   end;
  389.   CSD:=strpas(OS.szCSDVersion);
  390.  
  391.   Version:='';
  392.   RegisteredUser:='';
  393.   RegisteredOrg:='';
  394.   ProductID:='';
  395.   with TRegistry.create do begin
  396.     rootkey:=HKEY_LOCAL_MACHINE;
  397.     if IsNT then
  398.       OK:=OpenKey(rkOSInfoNT,False)
  399.     else
  400.       OK:=OpenKey(rkOSInfo95,False);
  401.     if OK then begin
  402.       if isnt then begin
  403.         if ValueExists(rvVersionNameNT) then
  404.           Version:=ReadString(rvVersionNameNT);
  405.       end else
  406.         if ValueExists(rvVersionName95) then
  407.            Version:=ReadString(rvVersionName95);
  408.       if ValueExists(rvRegOrg) then
  409.         RegisteredOrg:=ReadString(rvRegOrg);
  410.       if ValueExists(rvRegOwn) then
  411.         RegisteredUser:=ReadString(rvRegOwn);
  412.       if ValueExists(rvProductID) then
  413.         ProductID:=ReadString(rvProductID);
  414.       if ValueExists(rvProductKey) then
  415.         ProductKey:=ReadString(rvProductKey);
  416.       if ValueExists(rvDVD) then
  417.         DVDRegion:=ReadString(rvDVD);
  418.  
  419.       FDirs.Add('CommonFiles='+ReadString('CommonFilesDir'));
  420.       FDirs.Add('ProgramFiles='+ReadString('ProgramFilesDir'));
  421.       FDirs.Add('Device='+ReadString('DevicePath'));
  422.       FDirs.Add('OtherDevice='+ReadString('OtherDevicePath'));
  423.       FDirs.Add('Media='+ReadString('MediaPath'));
  424.       FDirs.Add('Config='+ReadString('ConfigPath'));
  425.       FDirs.Add('Wallpaper='+ReadString('WallPaperDir'));
  426.       CloseKey;
  427.  
  428.       if IsNT then  begin
  429.         if CSD='Service Pack 6' then
  430.           if OpenKey(rkSP6a,False) then begin
  431.             if ValueExists(rvInstalled) then
  432.               if ReadInteger(rvInstalled)=1 then
  433.                 CSD:='Service Pack 6a';
  434.             CloseKey;
  435.           end;
  436.       end;
  437.     end;
  438.     Free;
  439.   end;
  440.  
  441.   n:=MAX_PATH;
  442.   p:=StrAlloc(n);
  443.  
  444.   GetWindowsDirectory(p,n);
  445.   FDirs.Add('Windows='+StrPas(p));
  446.  
  447.   GetSystemDirectory(p,n);
  448.   FDirs.Add('System='+StrPas(p));
  449.  
  450.   GetTempPath(n,p);
  451.   FDirs.Add('Temp='+StrPas(p));
  452.  
  453.   StrDispose(p);
  454.  
  455.   WinH:=GetDesktopWindow;
  456.   FDirs.Add('AppData='+GetSpecialFolder(WinH,CSIDL_APPDATA));
  457.   FDirs.Add('CommonDesktopDir='+GetSpecialFolder(WinH,CSIDL_COMMON_DESKTOPDIRECTORY));
  458.   FDirs.Add('CommonAltStartUp='+GetSpecialFolder(WinH,CSIDL_COMMON_ALTSTARTUP));
  459.   FDirs.Add('RecycleBin='+GetSpecialFolder(WinH,CSIDL_BITBUCKET));
  460.   FDirs.Add('CommonPrograms='+GetSpecialFolder(WinH,CSIDL_COMMON_PROGRAMS));
  461.   FDirs.Add('CommonStartMenu='+GetSpecialFolder(WinH,CSIDL_COMMON_STARTMENU));
  462.   FDirs.Add('CommonStartup='+GetSpecialFolder(WinH,CSIDL_COMMON_STARTUP));
  463.   FDirs.Add('CommonFavorites='+GetSpecialFolder(WinH,CSIDL_COMMON_FAVORITES));
  464.   FDirs.Add('Cookies='+GetSpecialFolder(WinH,CSIDL_COOKIES));
  465.   FDirs.Add('Controls='+GetSpecialFolder(WinH,CSIDL_CONTROLS));
  466.   FDirs.Add('Desktop='+GetSpecialFolder(WinH,CSIDL_DESKTOP));
  467.   FDirs.Add('DesktopDir='+GetSpecialFolder(WinH,CSIDL_DESKTOPDIRECTORY));
  468.   FDirs.Add('Favorites='+GetSpecialFolder(WinH,CSIDL_FAVORITES));
  469.   FDirs.Add('Drives='+GetSpecialFolder(WinH,CSIDL_DRIVES));
  470.   FDirs.Add('Fonts='+GetSpecialFolder(WinH,CSIDL_FONTS));
  471.   FDirs.Add('History='+GetSpecialFolder(WinH,CSIDL_HISTORY));
  472.   FDirs.Add('Internet='+GetSpecialFolder(WinH,CSIDL_INTERNET));
  473.   FDirs.Add('InternetCache='+GetSpecialFolder(WinH,CSIDL_INTERNET_CACHE));
  474.   FDirs.Add('NetWork='+GetSpecialFolder(WinH,CSIDL_NETWORK));
  475.   FDirs.Add('NetHood='+GetSpecialFolder(WinH,CSIDL_NETHOOD));
  476.   FDirs.Add('MyDocuments='+GetSpecialFolder(WinH,CSIDL_PERSONAL));
  477.   FDirs.Add('PrintHood='+GetSpecialFolder(WinH,CSIDL_PRINTHOOD));
  478.   FDirs.Add('Printers='+GetSpecialFolder(WinH,CSIDL_PRINTERS));
  479.   FDirs.Add('Programs='+GetSpecialFolder(WinH,CSIDL_PROGRAMS));
  480.   FDirs.Add('Recent='+GetSpecialFolder(WinH,CSIDL_RECENT));
  481.   FDirs.Add('SendTo='+GetSpecialFolder(WinH,CSIDL_SENDTO));
  482.   FDirs.Add('StartMenu='+GetSpecialFolder(WinH,CSIDL_STARTMENU));
  483.   FDirs.Add('StartUp='+GetSpecialFolder(WinH,CSIDL_STARTUP));
  484.   FDirs.Add('Templates='+GetSpecialFolder(WinH,CSIDL_TEMPLATES));
  485.   s:=ReverseStr(FDirs.Values['Desktop']);
  486.   s:=ReverseStr(Copy(s,Pos('\',s)+1,255));
  487.   FDirs.Add('Profile='+s);
  488.   FEnv.Clear;
  489.   GetEnvironment(FEnv);
  490.  
  491.   except
  492.     on e:Exception do begin
  493.       MessageBox(0,PChar(e.message),'TOperatingSystem.GetInfo',MB_OK or MB_ICONERROR);
  494.     end;
  495.   end;
  496. end;
  497.  
  498. procedure TOperatingSystem.Report(var sl: TStringList);
  499. begin
  500.   with sl do begin
  501.     Add('[Operating System]');
  502.     Add(Format('Platform=%s',[Platform]));
  503.     Add(Format('VersionName=%s',[Version]));
  504.     Add(Format('Version=%d.%d',[MajorVersion,MinorVersion]));
  505.     Add(Format('BuildNumber=%d',[BuildNumber]));
  506.     Add(Format('CSD=%s',[CSD]));
  507.     Add(Format('ProductID=%s',[ProductID]));
  508.     Add(Format('ProductKey=%s',[ProductKey]));
  509.     Add(Format('RegUser=%s',[RegisteredUser]));
  510.     Add(Format('RegOrganization=%s',[RegisteredOrg]));
  511.     Add(Format('DVDRegion=%s',[DVDRegion]));
  512.     NTSpecific.Report(sl);
  513.     Add('[Environment]');
  514.     AddStrings(Environment);
  515.     Add('[Folders]');
  516.     AddStrings(Folders);
  517.     TimeZone.Report(sl);
  518.   end;
  519. end;
  520.  
  521.  
  522. { TNTSpecific }
  523.  
  524. procedure TNTSpecific.GetInfo;
  525. var
  526.   VersionInfo: TOSVersionInfoEx;
  527.   OS :TOSVersionInfo;
  528.   s: string;
  529. const
  530.   rkProductTypeNT = {HKEY_LOCAL_MACHINE\}'System\CurrentControlSet\Control\ProductOptions';
  531.   rvProductType = 'ProductType';
  532. begin
  533.   try
  534.  
  535.   ZeroMemory(@OS,SizeOf(OS));
  536.   OS.dwOSVersionInfoSize:=SizeOf(OS);
  537.   Windows.GetVersionEx(OS);
  538.   if (OS.dwPlatformId=VER_PLATFORM_WIN32_NT) and (OS.dwMajorVersion=5) then begin
  539.     ZeroMemory(@VersionInfo,SizeOf(VersionInfo));
  540.     VersionInfo.dwOSVersionInfoSize:=SizeOf(VersionInfo);
  541.     if GetVersionEx(@VersionInfo) then begin
  542.       case VersionInfo.wProductType of
  543.         VER_NT_WORKSTATION: FProduct:=ptWorkStation;
  544.         VER_NT_DOMAIN_CONTROLLER: FProduct:=ptAdvancedServer;
  545.         VER_NT_SERVER: FProduct:=ptServer;
  546.       end;
  547.       FSuites:=[];
  548.       if VersionInfo.wSuiteMask and VER_SUITE_SMALLBUSINESS=VER_SUITE_SMALLBUSINESS then
  549.         FSuites:=FSuites+[suSmallBusiness];
  550.       if VersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE=VER_SUITE_ENTERPRISE then
  551.         FSuites:=FSuites+[suEnterprise];
  552.       if VersionInfo.wSuiteMask and VER_SUITE_BACKOFFICE=VER_SUITE_BACKOFFICE then
  553.         FSuites:=FSuites+[suBackOffice];
  554.       if VersionInfo.wSuiteMask and VER_SUITE_COMMUNICATIONS=VER_SUITE_COMMUNICATIONS then
  555.         FSuites:=FSuites+[suCommunications];
  556.       if VersionInfo.wSuiteMask and VER_SUITE_TERMINAL=VER_SUITE_TERMINAL then
  557.         FSuites:=FSuites+[suTerminal];
  558.       if VersionInfo.wSuiteMask and VER_SUITE_SMALLBUSINESS_RESTRICTED=VER_SUITE_SMALLBUSINESS_RESTRICTED then
  559.         FSuites:=FSuites+[suSmallBusinessRestricted];
  560.       if VersionInfo.wSuiteMask and VER_SUITE_EMBEDDEDNT=VER_SUITE_EMBEDDEDNT then
  561.         FSuites:=FSuites+[suEmbeddedNT];
  562.       if VersionInfo.wSuiteMask and VER_SUITE_DATACENTER=VER_SUITE_DATACENTER then
  563.         FSuites:=FSuites+[suDataCenter];
  564.       FSPMajorVer:=VersionInfo.wServicePackMajor;
  565.       FSPMinorVer:=VersionInfo.wServicePackMinor;
  566.     end;
  567.   end;
  568.   if FProduct=ptUnknown then
  569.     with TRegistry.Create do begin
  570.       if OpenKey(rkProductTypeNT,False) then begin
  571.         s:=ReadString(rvProductType);
  572.         if s='WinNT' then
  573.           FProduct:=ptWorkStation
  574.         else
  575.           if s='ServerNT' then
  576.             FProduct:=ptServer
  577.           else
  578.             if s='LanmanNT' then
  579.               FProduct:=ptAdvancedServer;
  580.         CloseKey;
  581.       end;
  582.       Free;
  583.     end;
  584.  
  585.   except
  586.     on e:Exception do begin
  587.       MessageBox(0,PChar(e.message),'TNTSpecific.GetInfo',MB_OK or MB_ICONERROR);
  588.     end;
  589.   end;
  590. end;
  591.  
  592. procedure TNTSpecific.Report(var sl: TStringList);
  593. begin
  594.   with sl do begin
  595.     Add('[NT Specific]');
  596.     case ProductType of
  597.       ptUnknown: Add('ProductType=Unknown');
  598.       ptWorkStation: Add('ProductType=Workstation');
  599.       ptServer: Add('ProductType=Server');
  600.       ptAdvancedServer: Add('ProductType=Advanced Server');
  601.     end;
  602.     Report_InstalledSuites(sl);
  603.     Add(Format('ServicePackMajorVersion=%d',[ServicePackMajorVersion]));
  604.     Add(Format('ServicePackMinorVersion=%d',[ServicePackMinorVersion]));
  605.   end;
  606. end;
  607.  
  608. procedure TNTSpecific.Report_InstalledSuites(var sl: TStringList);
  609. begin
  610.   with sl do begin
  611.     Add(Format('Microsoft Small Business Server=%d',
  612.                [integer(suSmallBusiness in InstalledSuites)]));
  613.     Add(Format('Windows 2000 Advanced Server=%d',
  614.                [integer(suEnterprise in InstalledSuites)]));
  615.     Add(Format('Microsoft BackOffice Components=%d',
  616.                [integer(suBackOffice in InstalledSuites)]));
  617.     Add(Format('Communications=%d',
  618.                [integer(suCommunications in InstalledSuites)]));
  619.     Add(Format('Terminal Services=%d',
  620.                [integer(suSmallBusiness in InstalledSuites)]));
  621.     Add(Format('Microsoft Small Business Server with the restrictive client license in force=%d',
  622.                [integer(suSmallBusinessRestricted in InstalledSuites)]));
  623.     Add(Format('Terminal Services=%d',
  624.                [integer(suSmallBusiness in InstalledSuites)]));
  625.     Add(Format('Embedded NT=%d',
  626.                [integer(suEmbeddedNT in InstalledSuites)]));
  627.     Add(Format('Windows 2000 Datacenter Server=%d',
  628.                [integer(suDataCenter in InstalledSuites)]));
  629.   end;
  630. end;
  631.  
  632. end.
  633.