[Jcl-checkins] jcl/source/common JclResources.pas,1.34,1.35 JclSysInfo.pas,1.53,1.54

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 454-5900

Update of /cvsroot/jcl/jcl/source/common
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27181/source/common

Modified Files:
	JclResources.pas JclSysInfo.pas 
Log Message:
Detection of Windows Vista/Longhorn/2003 R2/XP 64.
From: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/getting_the_system_version.asp

Index: JclResources.pas
===================================================================
RCS file: /cvsroot/jcl/jcl/source/common/JclResources.pas,v
retrieving revision 1.34
retrieving revision 1.35
diff -C2 -d -r1.34 -r1.35
*** JclResources.pas	14 Mar 2005 08:46:53 -0000	1.34
--- JclResources.pas	21 Nov 2005 11:50:22 -0000	1.35
***************
*** 1539,1552 ****
    RsIntelCacheDescrF1  = '128-Byte Prefetching';
  
!   RsOSVersionWin95     = 'Windows 95';
!   RsOSVersionWin95OSR2 = 'Windows 95 OSR2';
!   RsOSVersionWin98     = 'Windows 98';
!   RsOSVersionWin98SE   = 'Windows 98 SE';
!   RsOSVersionWinME     = 'Windows ME';
!   RsOSVersionWinNT3    = 'Windows NT 3.%u';
!   RsOSVersionWinNT4    = 'Windows NT 4.%u';
!   RsOSVersionWin2000   = 'Windows 2000';
!   RsOSVersionWinXP     = 'Windows XP';
!   RsOSVersionWin2003   = 'Windows Server 2003';
  
    RsProductTypeWorkStation      = 'Workstation';
--- 1539,1556 ----
    RsIntelCacheDescrF1  = '128-Byte Prefetching';
  
!   RsOSVersionWin95       = 'Windows 95';
!   RsOSVersionWin95OSR2   = 'Windows 95 OSR2';
!   RsOSVersionWin98       = 'Windows 98';
!   RsOSVersionWin98SE     = 'Windows 98 SE';
!   RsOSVersionWinME       = 'Windows ME';
!   RsOSVersionWinNT3      = 'Windows NT 3.%u';
!   RsOSVersionWinNT4      = 'Windows NT 4.%u';
!   RsOSVersionWin2000     = 'Windows 2000';
!   RsOSVersionWinXP       = 'Windows XP';
!   RsOSVersionWin2003     = 'Windows Server 2003';
!   RsOSVersionWin2003R2   = 'Windows Server 2003 "R2"';
!   RsOSVersionWinXP64     = 'Windows XP x64';
!   RsOSVersionWinVista    = 'Windows Vista';
!   RsOSVersionWinLonghorn = 'Windows Server "Longhorn"';
  
    RsProductTypeWorkStation      = 'Workstation';
***************
*** 1556,1559 ****
--- 1560,1565 ----
    RsProductTypeProfessional     = 'Professional';
    RsProductTypeDatacenterServer = 'Datacenter Server';
+   RsProductTypeEnterprise       = 'Enterprise';
+   RsProductTypeWebEdition       = 'Web Edition';
  
    RsOpenGLInfoError = 'Err';
***************
*** 1644,1647 ****
--- 1650,1657 ----
  
  // $Log$
+ // Revision 1.35  2005/11/21 11:50:22  outchy
+ // Detection of Windows Vista/Longhorn/2003 R2/XP 64.
+ // From: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/getting_the_system_version.asp
+ //
  // Revision 1.34  2005/03/14 08:46:53  rrossmair
  // - check-in in preparation for release 1.95

Index: JclSysInfo.pas
===================================================================
RCS file: /cvsroot/jcl/jcl/source/common/JclSysInfo.pas,v
retrieving revision 1.53
retrieving revision 1.54
diff -C2 -d -r1.53 -r1.54
*** JclSysInfo.pas	30 Oct 2005 01:51:27 -0000	1.53
--- JclSysInfo.pas	21 Nov 2005 11:50:22 -0000	1.54
***************
*** 262,269 ****
    TWindowsVersion =
     (wvUnknown, wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME,
!     wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4, wvWin2000, wvWinXP, wvWin2003);
    TNtProductType =
     (ptUnknown, ptWorkStation, ptServer, ptAdvancedServer,
!     ptPersonal, ptProfessional, ptDatacenterServer);
  
  var
--- 262,275 ----
    TWindowsVersion =
     (wvUnknown, wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME,
!     wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4, wvWin2000, wvWinXP,
!     wvWin2003, wvWinXP64, wvWin2003R2, wvWinVista, wvWinLonghorn);
    TNtProductType =
     (ptUnknown, ptWorkStation, ptServer, ptAdvancedServer,
!     ptPersonal, ptProfessional, ptDatacenterServer, ptEnterprise, ptWebEdition);
!   TProcessorArchitecture =
!    (paUnknown, // unknown processor
!     pax8632,   // x86 32 bit processors (some P4, Celeron, Athlon and older)
!     pax8664,   // x86 64 bit processors (latest P4, Celeron and Athlon64)
!     paIA64);   // Itanium processors
  
  var
***************
*** 283,286 ****
--- 289,302 ----
    IsWinXP: Boolean = False;
    IsWin2003: Boolean = False;
+   IsWinXP64: Boolean = False;
+   IsWin2003R2: Boolean = False;
+   IsWinVista: Boolean = False;
+   IsWinLonghorn: Boolean = False;
+ 
+ const
+   PROCESSOR_ARCHITECTURE_INTEL = 0;
+   PROCESSOR_ARCHITECTURE_AMD64 = 9;
+   PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 = 10;
+   PROCESSOR_ARCHITECTURE_IA64 = 6;
  
  function GetWindowsVersion: TWindowsVersion;
***************
*** 291,294 ****
--- 307,313 ----
  function GetWindowsServicePackVersionString: string;
  function GetOpenGLVersion(const Win: HWND; out Version, Vendor: AnsiString): Boolean;
+ function GetNativeSystemInfo(var SystemInfo: TSystemInfo): Boolean;
+ function GetProcessorArchitecture: TProcessorArchitecture;
+ function IsWindows64: Boolean;
  {$ENDIF MSWINDOWS}
  
***************
*** 2314,2318 ****
          else
          begin
!           if IsWin2k or IsWinXP or IsWin2003 then
            begin
              FileName := ProcessFileName(ProcEntry.th32ProcessID);
--- 2333,2338 ----
          else
          begin
!           if   IsWin2k or IsWinXP or IsWin2003 or IsWin2003R2 or IsWinXP64
!             or IsWinVista or IsWinLonghorn then
            begin
              FileName := ProcessFileName(ProcEntry.th32ProcessID);
***************
*** 2833,2836 ****
--- 2853,2860 ----
  var
    TrimmedWin32CSDVersion: string;
+   SystemInfo: TSystemInfo;
+   OSVersionInfoEx: TOSVersionInfoEx;
+ const
+   SM_SERVERR2 = 89;
  begin
    Result := wvUnknown;
***************
*** 2878,2882 ****
                Result := wvWinXP;
              2:
!               Result := wvWin2003;
            end;
        end;
--- 2902,2925 ----
                Result := wvWinXP;
              2:
!               begin
!                 OSVersionInfoEx.dwOSVersionInfoSize := SizeOf(OSVersionInfoEx);
!                 GetNativeSystemInfo(SystemInfo);
!                 if GetSystemMetrics(SM_SERVERR2) <> 0 then
!                   Result := wvWin2003R2
!                 else if (SystemInfo.wProcessorArchitecture <> PROCESSOR_ARCHITECTURE_INTEL)
!                   and GetVersionEx(OSVersionInfoEx) and (OSVersionInfoEx.wProductType = VER_NT_WORKSTATION) then
!                   Result := wvWinXP64
!                 else
!                   Result := wvWin2003;
!               end;
!           end;
!         6:
!           if Win32MinorVersion = 0 then
!           begin
!             OSVersionInfoEx.dwOSVersionInfoSize := SizeOf(OSVersionInfoEx);
!             if GetVersionEx(OSVersionInfoEx) and (OSVersionInfoEx.wProductType = VER_NT_WORKSTATION) then
!               Result := wvWinVista
!             else
!               Result := wvWinLonghorn;
            end;
        end;
***************
*** 2889,2905 ****
  var
    Product: string;
!   VersionInfo: TOSVersionInfoEx;
  begin
    Result := ptUnknown;
!   FillChar(VersionInfo, SizeOf(VersionInfo), 0);
!   VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
  
    // Favor documented API over registry
    if IsWinNT4 and (GetWindowsServicePackVersion >= 6) then
    begin
!     if GetVersionEx(VersionInfo) then
      begin
!       if (VersionInfo.wProductType = VER_NT_WORKSTATION) then
          Result := ptWorkstation
        else
          Result := ptServer;
--- 2932,2953 ----
  var
    Product: string;
!   OSVersionInfo: TOSVersionInfoEx;
!   SystemInfo: TSystemInfo;
  begin
    Result := ptUnknown;
!   FillChar(OSVersionInfo, SizeOf(OSVersionInfo), 0);
!   FillChar(SystemInfo, SizeOf(SystemInfo), 0);
!   OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
!   GetNativeSystemInfo(SystemInfo);
  
    // Favor documented API over registry
    if IsWinNT4 and (GetWindowsServicePackVersion >= 6) then
    begin
!     if GetVersionEx(OSVersionInfo) then
      begin
!       if (OSVersionInfo.wProductType = VER_NT_WORKSTATION) then
          Result := ptWorkstation
+       else if (OSVersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
+         Result := ptEnterprise
        else
          Result := ptServer;
***************
*** 2907,2937 ****
    end
    else
!   if IsWin2K or IsWin2003 then
    begin
!     if GetVersionEx(VersionInfo) then
      begin
!       if (VersionInfo.wProductType = VER_NT_SERVER) then
        begin
!         if (VersionInfo.wSuiteMask and VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER then
            Result := ptDatacenterServer
!         else
!         if (VersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
            Result := ptAdvancedServer
          else
!           result := ptServer;
        end
        else
-       if (VersionInfo.wProductType = VER_NT_WORKSTATION) then
          Result := ptProfessional;
      end;
    end
    else
!   if IsWinXP then
    begin
!     if GetVersionEx(VersionInfo) then
      begin
!       if VersionInfo.wProductType = VER_NT_WORKSTATION then
        begin
!         if (VersionInfo.wSuiteMask and VER_SUITE_PERSONAL) = VER_SUITE_PERSONAL then
            Result := ptPersonal
          else
--- 2955,3005 ----
    end
    else
!   if IsWin2K then
    begin
!     if GetVersionEx(OSVersionInfo) then
      begin
!       if OSVersionInfo.wProductType  in [VER_NT_SERVER,VER_NT_DOMAIN_CONTROLLER] then
        begin
!         if (OSVersionInfo.wSuiteMask and VER_SUITE_DATACENTER) <> 0 then
            Result := ptDatacenterServer
!         else if (OSVersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE) <> 0 then
            Result := ptAdvancedServer
          else
!           Result := ptServer;
        end
        else
          Result := ptProfessional;
      end;
    end
    else
!   if IsWinXP64 or IsWin2003 or IsWin2003R2 then // all (5.2)
    begin
!     if GetVersionEx(OSVersionInfo) then
      begin
!       if OSVersionInfo.wProductType in [VER_NT_SERVER,VER_NT_DOMAIN_CONTROLLER] then
        begin
!         if (OSVersionInfo.wSuiteMask and VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER then
!           Result := ptDatacenterServer
!         else
!         if (OSVersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
!           Result := ptEnterprise
!         else if (OSVersionInfo.wSuiteMask = VER_SUITE_BLADE) then
!           Result := ptWebEdition
!         else
!           Result := ptServer;
!       end
!       else
!       if (OSVersionInfo.wProductType = VER_NT_WORKSTATION) then
!         Result := ptProfessional;
!     end;
!   end
!   else
!   if IsWinXP or IsWinVista or IsWinLonghorn then // workstation
!   begin
!     if GetVersionEx(OSVersionInfo) then
!     begin
!       if OSVersionInfo.wProductType = VER_NT_WORKSTATION then
!       begin
!         if (OSVersionInfo.wSuiteMask and VER_SUITE_PERSONAL) = VER_SUITE_PERSONAL then
            Result := ptPersonal
          else
***************
*** 2981,2984 ****
--- 3049,3060 ----
      wvWin2003:
        Result := RsOSVersionWin2003;
+     wvWin2003R2:
+       Result := RsOSVersionWin2003R2;
+     wvWinXP64:
+       Result := RsOSVersionWinXP64;
+     wvWinLonghorn:
+       Result := RsOSVersionWinLonghorn;
+     wvWinVista:
+       Result := RsOSVersionWinVista;
    else
      Result := '';
***************
*** 3001,3004 ****
--- 3077,3084 ----
     ptDatacenterServer:
       Result := RsProductTypeDatacenterServer;
+    ptEnterprise:
+      Result := RsProductTypeEnterprise;
+    ptWebEdition:
+      Result := RsProductTypeWebEdition;
    else
      Result := '';
***************
*** 3014,3018 ****
  begin
    Result := 0;
!   if IsWin2K or IsWinXP or IsWin2003 then
    begin
      FillChar(VersionInfo, SizeOf(VersionInfo), 0);
--- 3094,3099 ----
  begin
    Result := 0;
!   if IsWin2K or IsWinXP or IsWin2003 or IsWinXP64 or IsWin2003R2 or IsWinVista
!     or IsWinLonghorn then
    begin
      FillChar(VersionInfo, SizeOf(VersionInfo), 0);
***************
*** 3164,3167 ****
--- 3245,3302 ----
  end;
  
+ function GetNativeSystemInfo(var SystemInfo: TSystemInfo): Boolean;
+ type
+   TGetNativeSystemInfo = procedure (var SystemInfo: TSystemInfo) stdcall;
+ var
+   LibraryHandle: HMODULE;
+   _GetNativeSystemInfo: TGetNativeSystemInfo;
+ begin
+   Result := False;
+   LibraryHandle := LoadLibrary('kernel32.dll');
+ 
+   if LibraryHandle <> 0 then
+   begin
+     try
+       _GetNativeSystemInfo := GetProcAddress(LibraryHandle,'GetNativeSystemInfo');
+       if Assigned(_GetNativeSystemInfo) then
+       begin
+         _GetNativeSystemInfo(SystemInfo);
+         Result := True;
+       end
+       else
+         GetSystemInfo(SystemInfo);
+     finally
+       FreeLibrary(LibraryHandle);
+     end;
+   end
+   else
+     GetSystemInfo(SystemInfo);
+ end;
+ 
+ function GetProcessorArchitecture: TProcessorArchitecture;
+ var
+   ASystemInfo: TSystemInfo;
+ begin
+   GetNativeSystemInfo(ASystemInfo);
+   case ASystemInfo.wProcessorArchitecture of
+     PROCESSOR_ARCHITECTURE_INTEL:
+       Result := pax8632;
+     PROCESSOR_ARCHITECTURE_IA64:
+       Result := paIA64;
+     PROCESSOR_ARCHITECTURE_AMD64:
+       Result := pax8664;
+     else
+       Result := paUnknown;
+   end;
+ end;
+ 
+ function IsWindows64: Boolean;
+ var
+   ASystemInfo: TSystemInfo;
+ begin
+   GetNativeSystemInfo(ASystemInfo);
+   Result := ASystemInfo.wProcessorArchitecture in [PROCESSOR_ARCHITECTURE_IA64,PROCESSOR_ARCHITECTURE_AMD64];
+ end;
+ 
  {$ENDIF ~CLR}
  {$ENDIF MSWINDOWS}
***************
*** 3738,3742 ****
      Is64Bits := HasExtendedInfo and ((IntelSpecific.Ex64Features and EINTEL64_EM64T)<>0);
    end;
!  end;
  
  // Helper function for CPUID. Initializes Cyrix specific fields.
--- 3873,3877 ----
      Is64Bits := HasExtendedInfo and ((IntelSpecific.Ex64Features and EINTEL64_EM64T)<>0);
    end;
! end;
  
  // Helper function for CPUID. Initializes Cyrix specific fields.
***************
*** 5115,5118 ****
--- 5250,5261 ----
      wvWin2003:
        IsWin2003 := True;
+     wvWinXP64:
+       IsWinXP64 := True;
+     wvWin2003R2:
+       IsWin2003R2 := True;
+     wvWinVista:
+       IsWinVista := True;
+     wvWinLonghorn:
+       IsWinLonghorn := True;
    end;
  end;
***************
*** 5135,5138 ****
--- 5278,5285 ----
  
  // $Log$
+ // Revision 1.54  2005/11/21 11:50:22  outchy
+ // Detection of Windows Vista/Longhorn/2003 R2/XP 64.
+ // From: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/getting_the_system_version.asp
+ //
  // Revision 1.53  2005/10/30 01:51:27  rrossmair
  // - introduce KEEP_DEPRECATED as alias for ~DROP_OBSOLETE_CODE