Skip to content
Browse files

JCL failed with every newer Windows version because it didn't know it…

… and disabled features or raised "Not supported" exceptions.
  • Loading branch information...
1 parent d83e2af commit 694e34d55a4b8a9ebcb55ddcc66d392e5e794d01 @ahausladen ahausladen committed Dec 1, 2013
View
4 jcl/source/common/JclFileUtils.pas
@@ -4850,15 +4850,15 @@ function WindowToModuleFileName(const Window: HWND): string;
Result := '';
if Window <> 0 then
begin
- if GetWindowsVersion < WVWin2000 then
+ if not JclCheckWinVersion(5, 0) then // Win2k or newer required
raise EJclWin32Error.CreateRes(@RsEWindowsVersionNotSupported);
{$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetWindowThreadProcessId(Window, @ProcessID);
hProcess := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, ProcessID);
if hProcess <> 0 then
begin
try
- if GetWindowsVersion >= WvWinVista then
+ if JclCheckWinVersion(6, 0) then // WinVista or newer
begin
DllHinst := LoadLibrary('Kernel32.dll');
if DllHinst < HINSTANCE_ERROR then
View
179 jcl/source/common/JclSysInfo.pas
@@ -322,6 +322,7 @@ function GetOpenGLVersion(const Win: THandle; out Version, Vendor: AnsiString):
function GetNativeSystemInfo(var SystemInfo: TSystemInfo): Boolean;
function GetProcessorArchitecture: TProcessorArchitecture;
function IsWindows64: Boolean;
+function JclCheckWinVersion(Major, Minor: Integer): Boolean;
{$ENDIF MSWINDOWS}
function GetOSVersionString: string;
@@ -2683,11 +2684,13 @@ function RunningProcessesList(const List: TStrings; FullPath: Boolean): Boolean;
ProcEntry: TProcessEntry32;
NextProc: Boolean;
FileName: string;
+ Win2kOrNewer: Boolean;
begin
SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
Result := (SnapProcHandle <> INVALID_HANDLE_VALUE);
if Result then
try
+ Win2kOrNewer := JclCheckWinVersion(5, 0); // Win2k or newer
ProcEntry.dwSize := SizeOf(ProcEntry);
NextProc := Process32First(SnapProcHandle, ProcEntry);
while NextProc do
@@ -2700,9 +2703,7 @@ function RunningProcessesList(const List: TStrings; FullPath: Boolean): Boolean;
end
else
begin
- if IsWin2k or IsWinXP or IsWin2003 or IsWin2003R2 or IsWinXP64 or
- IsWinVista or IsWinServer2008 or IsWin7 or IsWinServer2008R2 or
- IsWin8 or IsWinServer2012 or IsWin81 or IsWinServer2012R2 then
+ if Win2kOrNewer then
begin
FileName := ProcessFileName(ProcEntry.th32ProcessID);
if FileName = '' then
@@ -3382,121 +3383,121 @@ function GetWindowsEdition: TWindowsEdition;
// Remove (tm) in 'Windows (TM) Vista Ultimate'
Edition := StringReplace(Edition, '(TM) ', '', [rfReplaceAll, rfIgnoreCase]);
- if pos('Windows XP', Edition) = 1 then
+ if Pos('Windows XP', Edition) = 1 then
begin
// Windows XP Editions
- if pos('Home Edition N', Edition) > 0 then
- Result := weWinXPHomeN
+ if Pos('Home Edition N', Edition) > 0 then
+ Result := weWinXPHomeN
else
- if pos('Professional N', Edition) > 0 then
- Result := weWinXPProN
+ if Pos('Professional N', Edition) > 0 then
+ Result := weWinXPProN
else
- if pos('Home Edition K', Edition) > 0 then
- Result := weWinXPHomeK
+ if Pos('Home Edition K', Edition) > 0 then
+ Result := weWinXPHomeK
else
- if pos('Professional K', Edition) > 0 then
- Result := weWinXPProK
+ if Pos('Professional K', Edition) > 0 then
+ Result := weWinXPProK
else
- if pos('Home Edition KN', Edition) > 0 then
- Result := weWinXPHomeKN
+ if Pos('Home Edition KN', Edition) > 0 then
+ Result := weWinXPHomeKN
else
- if pos('Professional KN', Edition) > 0 then
- Result := weWinXPProKN
+ if Pos('Professional KN', Edition) > 0 then
+ Result := weWinXPProKN
else
- if pos('Home', Edition) > 0 then
- Result := weWinXPHome
+ if Pos('Home', Edition) > 0 then
+ Result := weWinXPHome
else
- if pos('Professional', Edition) > 0 then
- Result := weWinXPPro
+ if Pos('Professional', Edition) > 0 then
+ Result := weWinXPPro
else
- if pos('Starter', Edition) > 0 then
- Result := weWinXPStarter
+ if Pos('Starter', Edition) > 0 then
+ Result := weWinXPStarter
else
- if pos('Media Center', Edition) > 0 then
- Result := weWinXPMediaCenter
+ if Pos('Media Center', Edition) > 0 then
+ Result := weWinXPMediaCenter
else
- if pos('Tablet', Edition) > 0 then
- Result := weWinXPTablet;
+ if Pos('Tablet', Edition) > 0 then
+ Result := weWinXPTablet;
end
else
- if (pos('Windows Vista', Edition) = 1) then
+ if (Pos('Windows Vista', Edition) = 1) then
begin
// Windows Vista Editions
- if pos('Starter', Edition) > 0 then
+ if Pos('Starter', Edition) > 0 then
Result := weWinVistaStarter
else
- if pos('Home Basic N', Edition) > 0 then
+ if Pos('Home Basic N', Edition) > 0 then
Result := weWinVistaHomeBasicN
else
- if pos('Home Basic', Edition) > 0 then
+ if Pos('Home Basic', Edition) > 0 then
Result := weWinVistaHomeBasic
else
- if pos('Home Premium', Edition) > 0 then
+ if Pos('Home Premium', Edition) > 0 then
Result := weWinVistaHomePremium
else
- if pos('Business N', Edition) > 0 then
+ if Pos('Business N', Edition) > 0 then
Result := weWinVistaBusinessN
else
- if pos('Business', Edition) > 0 then
+ if Pos('Business', Edition) > 0 then
Result := weWinVistaBusiness
else
- if pos('Enterprise', Edition) > 0 then
+ if Pos('Enterprise', Edition) > 0 then
Result := weWinVistaEnterprise
else
- if pos('Ultimate', Edition) > 0 then
+ if Pos('Ultimate', Edition) > 0 then
Result := weWinVistaUltimate;
end
else
- if pos('Windows 7', Edition) = 1 then
+ if Pos('Windows 7', Edition) = 1 then
begin
// Windows 7 Editions
- if pos('Starter', Edition) > 0 then
+ if Pos('Starter', Edition) > 0 then
Result := weWin7Starter
else
- if pos('Home Basic', Edition) > 0 then
+ if Pos('Home Basic', Edition) > 0 then
Result := weWin7HomeBasic
else
- if pos('Home Premium', Edition) > 0 then
+ if Pos('Home Premium', Edition) > 0 then
Result := weWin7HomePremium
else
- if pos('Professional', Edition) > 0 then
+ if Pos('Professional', Edition) > 0 then
Result := weWin7Professional
else
- if pos('Enterprise', Edition) > 0 then
+ if Pos('Enterprise', Edition) > 0 then
Result := weWin7Enterprise
else
- if pos('Ultimate', Edition) > 0 then
+ if Pos('Ultimate', Edition) > 0 then
Result := weWin7Ultimate;
end
else
- if pos('Windows 8.1', Edition) = 1 then
+ if Pos('Windows 8.1', Edition) = 1 then
begin
// Windows 8.1 Editions
if pos('Pro', Edition) > 0 then
Result := weWin81Pro
else
- if pos('Enterprise', Edition) > 0 then
+ if Pos('Enterprise', Edition) > 0 then
Result := weWin81Enterprise
else
Result := weWin81;
end
else
- if pos('Windows 8', Edition) = 1 then
+ if Pos('Windows 8', Edition) = 1 then
begin
// Windows 8 Editions
- if pos('Pro', Edition) > 0 then
+ if Pos('Pro', Edition) > 0 then
Result := weWin8Pro
else
- if pos('Enterprise', Edition) > 0 then
+ if Pos('Enterprise', Edition) > 0 then
Result := weWin8Enterprise
else
Result := weWin8;
end
else
- if pos('Windows RT 8.1', Edition) = 1 then
+ if Pos('Windows RT 8.1', Edition) = 1 then
Result := weWin81RT
else
- if pos('Windows RT', Edition) = 1 then
+ if Pos('Windows RT', Edition) = 1 then
Result := weWin8RT;
end;
@@ -3533,7 +3534,7 @@ function NtProductType: TNtProductType;
begin
if GetVersionEx(OSVersionInfo) then
begin
- if OSVersionInfo.wProductType in [VER_NT_SERVER,VER_NT_DOMAIN_CONTROLLER] then
+ if OSVersionInfo.wProductType in [VER_NT_SERVER, VER_NT_DOMAIN_CONTROLLER] then
begin
if (OSVersionInfo.wSuiteMask and VER_SUITE_DATACENTER) <> 0 then
Result := ptDatacenterServer
@@ -3552,7 +3553,7 @@ function NtProductType: TNtProductType;
begin
if GetVersionEx(OSVersionInfo) then
begin
- if OSVersionInfo.wProductType in [VER_NT_SERVER,VER_NT_DOMAIN_CONTROLLER] then
+ 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
@@ -3571,31 +3572,30 @@ function NtProductType: TNtProductType;
end;
end
else
- if IsWinXP or IsWinVista or IsWin7 or IsWin8 or IsWin81 then // workstation
+ if JclCheckWinVersion(5, 1) then // WinXP or newer
begin
if GetVersionEx(OSVersionInfo) then
begin
- if (OSVersionInfo.wProductType = VER_NT_WORKSTATION) then
+ //if IsWinXP or IsWinVista or IsWin7 or IsWin8 or IsWin81 then
+ if OSVersionInfo.wProductType = VER_NT_WORKSTATION then // workstation
begin
if (OSVersionInfo.wSuiteMask and VER_SUITE_PERSONAL) = VER_SUITE_PERSONAL then
Result := ptPersonal
else
Result := ptProfessional;
- end;
- end;
- end
- else
- if IsWinServer2008 or IsWinServer2008R2 or IsWinServer2012 or IsWinServer2012R2 then // server
- 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
+ end
else
- Result := ptServer;
+ //if IsWinServer2008 or IsWinServer2008R2 or IsWinServer2012 or IsWinServer2012R2 then
+ if OSVersionInfo.wProductType in [VER_NT_SERVER, VER_NT_DOMAIN_CONTROLLER] then // server
+ 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
+ Result := ptServer;
+ end;
end;
end;
@@ -3741,29 +3741,29 @@ function GetWindowsEditionString: string;
function GetWindowsProductString: string;
begin
Result := GetWindowsVersionString;
- if (GetWindowsEditionString <> '') then
+ if GetWindowsEditionString <> '' then
Result := Result + ' ' + GetWindowsEditionString;
end;
function NtProductTypeString: string;
begin
case NtProductType of
- ptWorkStation:
- Result := LoadResString(@RsProductTypeWorkStation);
- ptServer:
- Result := LoadResString(@RsProductTypeServer);
- ptAdvancedServer:
- Result := LoadResString(@RsProductTypeAdvancedServer);
- ptPersonal:
- Result := LoadResString(@RsProductTypePersonal);
- ptProfessional:
- Result := LoadResString(@RsProductTypeProfessional);
- ptDatacenterServer:
- Result := LoadResString(@RsProductTypeDatacenterServer);
- ptEnterprise:
- Result := LoadResString(@RsProductTypeEnterprise);
- ptWebEdition:
- Result := LoadResString(@RsProductTypeWebEdition);
+ ptWorkStation:
+ Result := LoadResString(@RsProductTypeWorkStation);
+ ptServer:
+ Result := LoadResString(@RsProductTypeServer);
+ ptAdvancedServer:
+ Result := LoadResString(@RsProductTypeAdvancedServer);
+ ptPersonal:
+ Result := LoadResString(@RsProductTypePersonal);
+ ptProfessional:
+ Result := LoadResString(@RsProductTypeProfessional);
+ ptDatacenterServer:
+ Result := LoadResString(@RsProductTypeDatacenterServer);
+ ptEnterprise:
+ Result := LoadResString(@RsProductTypeEnterprise);
+ ptWebEdition:
+ Result := LoadResString(@RsProductTypeWebEdition);
else
Result := '';
end;
@@ -4062,6 +4062,17 @@ function IsWindows64: Boolean;
Result := ASystemInfo.wProcessorArchitecture in [PROCESSOR_ARCHITECTURE_IA64,PROCESSOR_ARCHITECTURE_AMD64];
end;
+function JclCheckWinVersion(Major, Minor: Integer): Boolean;
+begin
+ {$IFDEF RTL150_UP}
+ Result := CheckWin32Version(Major, Minor);
+ {$ELSE}
+ // Delphi 6 and older have a wrong implementation
+ Result := (Win32MajorVersion > Major) or
+ ((Win32MajorVersion = Major) and (Win32MinorVersion >= Minor));
+ {$ENDIF RTL150_UP}
+end;
+
{$ENDIF MSWINDOWS}
function GetOSVersionString: string;
View
3 jcl/source/common/JclUnicode.pas
@@ -7740,8 +7740,7 @@ function GetCharSetFromLocale(Language: LCID; out FontCharSet: Byte): Boolean;
CP: Word;
CSI: TCharsetInfo;
begin
- if GetWindowsVersion in [wvUnknown, wvWin95, wvWin95OSR2, wvWin98, wvWin98SE,
- wvWinME, wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4] then
+ if not JclCheckWinVersion(5, 0) then // Win2k required
begin
// these versions of Windows don't support TCI_SRCLOCALE
CP := CodePageFromLocale(Language);
View
74 jcl/source/vcl/JclFont.pas
@@ -43,53 +43,47 @@ implementation
uses
{$IFDEF HAS_UNITSCOPE}
- Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Graphics, System.TypInfo,
+ WinApi.Windows, System.SysUtils, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Graphics, System.TypInfo,
{$ELSE ~HAS_UNITSCOPE}
- StdCtrls, ComCtrls, Graphics, TypInfo,
+ Windows, SysUtils, StdCtrls, ComCtrls, Graphics, TypInfo,
{$ENDIF ~HAS_UNITSCOPE}
JclSysUtils, JclSysInfo;
-// Save Windows version that way we will only determine it once here.
-// Might be even better if this variable was declared in JclSysInfo since
-// it is determined there anyway at startup.
-var
- WindowsVersion: TWindowsVersion;
-
procedure SetCaptionFont(const AObjectFont: TFont);
begin
- case WindowsVersion of
- wvWin95..wvWinNT4:
- begin
- AObjectFont.Name := 'MS Sans Serif';
- AObjectFont.Size := 8;
- end;
- wvWin2000..wvWin2003R2:
- begin
- AObjectFont.Name := 'Tahoma';
- AObjectFont.Size := 8;
- end;
- else
+ if JclCheckWinVersion(6, 0) then // WinVista or newer
+ begin
AObjectFont.Name := 'Segoe UI';
AObjectFont.Size := 9;
+ end
+ else if JclCheckWinVersion(5, 0) then // Win2k or newer
+ begin
+ AObjectFont.Name := 'Tahoma';
+ AObjectFont.Size := 8;
+ end
+ else // Win95..WinME/NT4
+ begin
+ AObjectFont.Name := 'MS Sans Serif';
+ AObjectFont.Size := 8;
end;
end;
procedure SetContentFont(const AObjectFont: TFont);
begin
- case WindowsVersion of
- wvWin95..wvWinNT4:
- begin
- AObjectFont.Name := 'MS Sans Serif';
- AObjectFont.Size := 8;
- end;
- wvWin2000..wvWin2003R2:
- begin
- AObjectFont.Name := 'Verdana';
- AObjectFont.Size := 8;
- end;
- else
+ if JclCheckWinVersion(6, 0) then // WinVista or newer
+ begin
AObjectFont.Name := 'Calibri';
AObjectFont.Size := 9;
+ end
+ else if JclCheckWinVersion(5, 0) then // Win2k or newer
+ begin
+ AObjectFont.Name := 'Verdana';
+ AObjectFont.Size := 8;
+ end
+ else // Win95..WinME/NT4
+ begin
+ AObjectFont.Name := 'MS Sans Serif';
+ AObjectFont.Size := 8;
end;
end;
@@ -98,12 +92,12 @@ procedure SetObjectFontToSystemFont(const AObject: TObject; const FontType: TFon
AObjectFont: TFont;
AFontType: TFontType;
begin
- if (AObject.ClassType = TFont) then
+ if AObject.ClassType = TFont then
AObjectFont := TFont(AObject)
else
AObjectFont := TFont(GetObjectProp(AObject, 'Font', TFont));
- if (FontType = ftAuto) then
+ if FontType = ftAuto then
begin
if (AObject.ClassType = TMemo) {$IFDEF BORLAND}or (AObject.ClassType = TRichEdit){$ENDIF} then
AFontType := ftContent
@@ -113,16 +107,10 @@ procedure SetObjectFontToSystemFont(const AObject: TObject; const FontType: TFon
else
AFontType := FontType;
- if (AFontType = ftCaption) then
- begin
- SetCaptionFont(AObjectFont);
- end
- else if (AFontType = ftContent) then
- begin
+ if AFontType = ftCaption then
+ SetCaptionFont(AObjectFont)
+ else if AFontType = ftContent then
SetContentFont(AObjectFont);
- end;
end;
-initialization
- WindowsVersion := GetWindowsVersion;
end.
View
2 jcl/source/vcl/JclOpenDialogHooks.pas
@@ -372,7 +372,7 @@ procedure TJclOpenDialogHook.DialogShow;
begin
// override to customize
FParentWnd := GetParent(FHandle);
- if GetWindowsVersion >= wvWin2000 then
+ if JclCheckWinVersion(5, 0) then // Win2k or newer
FOldParentWndInstance := Pointer(SetWindowLongPtr(FParentWnd, GWLP_WNDPROC, LONG_PTR(FParentWndInstance)));
DoShow;
end;
View
2 jcl/source/windows/JclCOM.pas
@@ -175,7 +175,7 @@ function IsDCOMInstalled: Boolean;
OLE32: HMODULE;
begin
{ DCOM is installed by default on all but Windows 95 }
- Result := not (GetWindowsVersion in [wvUnknown, wvWin95, wvWin95OSR2]);
+ Result := not (GetWindowsVersion in [wvWin95, wvWin95OSR2]);
if not Result then
begin
OLE32 := SafeLoadLibrary(pcOLE32);
View
2 jcl/source/windows/JclLocales.pas
@@ -345,7 +345,7 @@ function KeybLayoutFlagsToDWORD(const ActivateFlags: TJclKeybLayoutFlags;
Inc(Result, KLF_REORDER);
if (klUnloadPrevious in ActivateFlags) and IsWinNT then
Inc(Result, KLF_UNLOADPREVIOUS);
- if (klSetForProcess in ActivateFlags) and (GetWindowsVersion >= wvWin2000) then
+ if (klSetForProcess in ActivateFlags) and JclCheckWinVersion(5, 0) then // Win2k or newer
Inc(Result, KLF_SETFORPROCESS);
if LoadMode then
begin
View
4 jcl/source/windows/JclMiscel.pas
@@ -240,11 +240,11 @@ function KillLevelToFlags(KillLevel: TJclKillLevel): Cardinal;
Result := 0;
case KillLevel of
klNoSignal:
- if not (GetWindowsVersion in [wvUnknown, wvWin95, wvWin95OSR2, wvWin98,
+ if not (GetWindowsVersion in [wvWin95, wvWin95OSR2, wvWin98,
wvWin98SE, wvWinME]) then
Result := EWX_FORCE;
klTimeOut:
- if not (GetWindowsVersion in [wvUnknown, wvWin95, wvWin95OSR2, wvWin98,
+ if not (GetWindowsVersion in [wvWin95, wvWin95OSR2, wvWin98,
wvWin98SE, wvWinME, wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4]) then
Result := EWX_FORCEIFHUNG;
end;
View
4 jcl/source/windows/JclSecurity.pas
@@ -794,7 +794,7 @@ function GetComputerSID(SID: PSID; cbSID: DWORD): Boolean;
function IsUACEnabled: Boolean;
begin
- Result := (IsWinVista or IsWinServer2008 or IsWin7 or IsWinServer2008R2) and
+ Result := JclCheckWinVersion(6, 0) and
RegReadBoolDef(HKLM, '\Software\Microsoft\Windows\CurrentVersion\Policies\System', 'EnableLUA', False);
end;
@@ -811,7 +811,7 @@ TOKEN_ELEVATION = record
ResultLength: Cardinal;
ATokenElevation: TOKEN_ELEVATION;
begin
- if (IsWinVista or IsWinServer2008 or IsWin7 or IsWinServer2008R2) then
+ if JclCheckWinVersion(6, 0) then
begin
TokenHandle := 0;
if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then
View
2 jcl/source/windows/JclSvcCtrl.pas
@@ -1330,7 +1330,7 @@ function TJclSCManager.Install(const ServiceName, DisplayName, ImageName, Descri
RaiseLastOsError;
CloseServiceHandle(Svc);
- if (Description <> '') and (GetWindowsVersion >= wvWin2000) then
+ if (Description <> '') and JclCheckWinVersion(5, 0) then // Win2k or newer
RegWriteString(HKEY_LOCAL_MACHINE, '\' + REGSTR_PATH_SERVICES + '\' + ServiceName,
'Description', Description);

0 comments on commit 694e34d

Please sign in to comment.
Something went wrong with that request. Please try again.