| history | TOP |
2003/08/07:作成
2003/08/09:自信のない部分で何かが起きた時のための保険追加・見せる必要の無いコードを隠蔽
2005/02/19:「オペランドの拡張」警告が出ないように出ないように調節したものを別のところで作成したので、そこへのリンクを追加(HTML化しているソースでは出ます)。
| download | TOP |
20030807iOsInfo.zip(2,530bytes)
20030809iOsInfo.zip(2,814bytes)(保険付き)
20050127winbeads.zip(186,982bytes)(オペランドの拡張とかいう警告が出なくしたもの)
| memo | TOP |
MSのPlatform SDK(C言語)に書いてあるとおりにDelphiに翻訳し(ようとし)たものです。
びっくりするほど自身がありません...でも、誰かの役に立ちますように。
最初に断っておきますが、Windows2000(Pro,sp4)でしか試していません。つまり、コードの大部分は通過していません。 試した環境では望みどおりの答えが得られていますが、何かを何かし忘れてたりどれかがどうにかなっていたりする可能性があります。
| code | TOP |
(*
#######################################################
目的 : OS のバージョン取得
注意 : 全く自信なし
履歴 : 2003/08/07 作成
------------------------------------------------------
ms-help://MS.PSDK.1033/sysinfo/base/osversioninfo_str.htm
------------------------------------------------------
#######################################################
*)
unit iOsInfo;
interface
uses
Windows, SysUtils, Registry;
type
TOSVersionInfoEx = record
dwOSVersionInfoSize : DWORD;
dwMajorVersion : DWORD;
dwMinorVersion : DWORD;
dwBuildNumber : DWORD;
dwPlatformId : DWORD;
szCSDVersion : array[0..127] of AnsiChar;
wServicePackMajor : WORD;
wServicePackMinor : WORD;
wSuiteMask : WORD;
wProductType : BYTE;
wReserved : BYTE;
end;
function GetOsInfo(): string;
// Windows.pas
function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall;
function GetVersionEx; external kernel32 name 'GetVersionExA';
implementation
// http://www.geocities.jp/ht_deko/ft0203.html
// http://plaza5.mbn.or.jp/~heropa/vb25.htm
const
VER_NT_WORKSTATION = 1;
VER_NT_DOMAIN_CONTROLLER = 2;
VER_NT_SERVER = 3;
VER_SUITE_SMALLBUSINESS = $0001;
VER_SUITE_ENTERPRISE = $0002;
VER_SUITE_BACKOFFICE = $0004;
VER_SUITE_TERMINAL = $0010;
VER_SUITE_SMALLBUSINESS_RESTRICTED = $0020;
VER_SUITE_DATACENTER = $0080;
VER_SUITE_PERSONAL = $0200;
VER_SUITE_BLADE = $0400;
function GetOsInfo(): string;
var
osvi:TOSVersionInfoEx;
res : Boolean;
Key: HKEY;
szProductType: string;
dwBufLen: DWORD;
lRet: integer;
begin
Result := 'Unknown';
// OSVERSIONINFOEX で GetVersionEx をやってみる
// 失敗したら OSVERSIONINFO でやってみる
// 初期化
FillChar(osvi, SizeOf(TOSVersionInfoEx), #0);
// 構造体サイズセット
osvi.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
// やってみる
res := GetVersionEx(osvi);
// 失敗したら
if not res then
begin
// もうひとつの構造体で
osvi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
// それもだめならあきらめな
if not GetVersionEx(osvi) then Exit;
end;
// dwPlatformId で嫌になるほど場合わけ
case osvi.dwPlatformId of
// Windows NT 系.
VER_PLATFORM_WIN32_NT:
begin
// もっと特定してみる
if (osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 2) then
begin
Result := 'Microsoft Windows .NET Server 2003 family, ';
end else
if (osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 1) then
begin
Result := 'Microsoft Windows XP ';
end else
if (osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 0) then
begin
Result := 'Microsoft Windows 2000 ';
end else
begin
if (osvi.dwMajorVersion <= 4) then
begin
Result := 'Microsoft Windows NT ';
end else
Result := 'Windows NT product family? ';
end;
// Windows NT 4.0 SP6 以降をもっと突っ込んで調べる.
if res then
begin
// workstation タイプ
if (osvi.wProductType = VER_NT_WORKSTATION) then
begin
if (osvi.dwMajorVersion = 4) then
begin
Result := Result + 'Workstation 4.0 ';
end else
if (osvi.wSuiteMask and VER_SUITE_PERSONAL) = VER_SUITE_PERSONAL then
begin
Result := Result + 'Home Edition ';
end else
begin
Result := Result + 'Professional ';
end;
end else
// server タイプ
if (osvi.wProductType = VER_NT_SERVER) then
begin
if (osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 2) then
begin
if (osvi.wSuiteMask and VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER then
begin
Result := Result + 'Datacenter Edition ';
end else
if (osvi.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
begin
Result := Result + 'Enterprise Edition ';
end else
if (osvi.wSuiteMask = VER_SUITE_BLADE) then
begin
Result := Result + 'Web Edition ';
end else
begin
Result := Result + 'Standard Edition ';
end;
end else
if (osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 0) then
begin
if (osvi.wSuiteMask and VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER then
begin
Result := Result + 'Datacenter Server ';
end else
if (osvi.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
begin
Result := Result + 'Advanced Server ';
end else
begin
Result := Result + 'Server ';
end;
end else
// Windows NT 4.0
begin
if (osvi.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
begin
Result := Result + 'Server 4.0, Enterprise Edition ';
end else
begin
Result := Result + 'Server 4.0 ';
end;
end;
end;
end else
// Windows NT 4.0 SP5 以前のもの
begin
lRet := RegOpenKeyEx(
HKEY_LOCAL_MACHINE,
'SYSTEM\CurrentControlSet\Control\ProductOptions',
0,
KEY_QUERY_VALUE,
Key
);
if lRet <> ERROR_SUCCESS then Exit;
dwBufLen := 255;
szProductType := '';
SetLength(szProductType, dwBufLen);
lRet := RegQueryValueEx(
Key,
'ProductType',
nil,
nil,
@szProductType[1],
@dwBufLen
);
if (lRet <> ERROR_SUCCESS) or (dwBufLen > Length(szProductType)) then Exit;
SetLength(szProductType, dwBufLen);
RegCloseKey(Key);
if UpperCase(szProductType) = 'WINNT' then
begin
Result := Result + 'Workstation ';
end else
if UpperCase(szProductType) = 'LANMANNT' then
begin
Result := Result + 'Server ';
end else
if UpperCase(szProductType) = 'SERVERNT' then
begin
Result := Result + 'Advanced Server ';
end;
Result := Result + Format('%d.%d', [osvi.dwMajorVersion, osvi.dwMinorVersion]);
end;
// サービスパックとかビルド番号とか
if (osvi.dwMajorVersion = 4) and (lstrcmpi( osvi.szCSDVersion, 'Service Pack 6' ) = 0 ) then
begin
// SP6 ? SP6a?
lRet := RegOpenKeyEx(
HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Hotfix\Q246009',
0,
KEY_QUERY_VALUE,
Key
);
if (lRet = ERROR_SUCCESS) then
begin
Result := Result + Format('Service Pack 6a (Build %d)', [osvi.dwBuildNumber and $FFFF]);
end else
// Windows NT 4.0 prior to SP6a
begin
Result := Result + Format('%s (Build %d)', [osvi.szCSDVersion, osvi.dwBuildNumber and $FFFF]);
end;
RegCloseKey(Key);
end else
// Windows NT 3.51 and earlier or Windows 2000 and later
begin
Result := Result + Format('%s (Build %d)', [osvi.szCSDVersion, osvi.dwBuildNumber and $FFFF]);
end;
end;
// Windows 95 系.
VER_PLATFORM_WIN32_WINDOWS:
begin
// win95
if (osvi.dwMajorVersion = 4) and (osvi.dwMinorVersion = 0) then
begin
Result := 'Microsoft Windows 95 ';
if (osvi.szCSDVersion[1] = 'C') or (osvi.szCSDVersion[1] = 'B') then
begin
Result := Result + 'OSR2 ';
end;
end else
// win98
if (osvi.dwMajorVersion = 4) and (osvi.dwMinorVersion = 10) then
begin
Result := 'Microsoft Windows 98 ';
if ( osvi.szCSDVersion[1] = 'A') then
begin
Result := Result + 'SE ';
end;
end else
// winme
if (osvi.dwMajorVersion = 4) and (osvi.dwMinorVersion = 90) then
begin
Result := 'Microsoft Windows Millennium Edition';
end;
end;
// それ以外
VER_PLATFORM_WIN32s:
begin
Result := 'Microsoft Win32s';
end;
end;
end;
end.
| sample code | TOP |
こんな感じで使えるはずです。
uses iOsInfo;
:
ShowMessage(GetOsInfo());
ちなみにうちの環境ではこんな答えになっています。
Microsoft Windows 2000 Professional Service Pack 4 (Build 2195)
とりあえず正解です。
| EOF | TOP |