获得Windows的版本信息
最近写控件，因为想加入版本信息，而通常大多数情况下，几乎所有的公司或个人都会在自己软件的版本信息里提及Windows与内存信息。
参考MSDN的范例，我把它写成个函数了。由于Delphi6不提供OSVERSIONINFOEX结构（我没用过delphi7,8,2005等，不知道是否开始提供这个结构了），所以只好自己定义一个。为了不会受到有的版本里已经提供这个结构的影响，也不影响别的什么地方，直接把它定义到函数内部了。
函数：（2000，XP下测试通过，有其它版本的兄弟可以测试一下，有问题，发消息给我）
function GetVersionInfo(var SProduct, SVersion, SServicePack :String):BOOL;
type
_OSVERSIONINFOEXA = record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array of AnsiChar;
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: Word;
wProductType: Byte;
wReserved: Byte;
end;
_OSVERSIONINFOEXW = record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array of WideChar;
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: Word;
wProductType: Byte;
wReserved: Byte;
end;
{ this record only support Windows 4.0 SP6 and latter , Windows 2000 ,XP, 2003 }
OSVERSIONINFOEXA = _OSVERSIONINFOEXA;
OSVERSIONINFOEXW = _OSVERSIONINFOEXW;
OSVERSIONINFOEX = OSVERSIONINFOEXA;
const
VER_PLATFORM_WIN32_CE = 3;
{ wProductType defines }
VER_NT_WORKSTATION = 1;
VER_NT_DOMAIN_CONTROLLER = 2;
VER_NT_SERVER = 3;
{ wSuiteMask defines }
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;
VER_SUITE_SECURITY_APPLIANCE = $1000;
var
Info: OSVERSIONINFOEX;
bEx: BOOL;
begin
Result := False;
FillChar(Info, SizeOf(OSVERSIONINFOEX), 0);
Info.dwOSVersionInfoSize := SizeOf(OSVERSIONINFOEX);
bEx := GetVersionEx(POSVERSIONINFO(@Info)^);
if not bEx then
begin
Info.dwOSVersionInfoSize := SizeOf(OSVERSIONINFO);
if not GetVersionEx(POSVERSIONINFO(@Info)^) then Exit;
end;
with Info do
begin
SVersion := IntToStr(dwMajorVersion) + "." + IntToStr(dwMinorVersion)
+ "." + IntToStr(dwBuildNumber and $0000FFFF);
SProduct := "Microsoft Windows unknown";
case Info.dwPlatformId of
VER_PLATFORM_WIN32s: { Windows 3.1 and earliest }
SProduct := "Microsoft Win32s";
VER_PLATFORM_WIN32_WINDOWS:
case dwMajorVersion of
4: { Windows95,98,ME }
case dwMinorVersion of
0:
if szCSDVersion in then
begin
SProduct := "Microsoft Windows 95 OSR2";
SVersion := SVersion + szCSDVersion;
end
else
SProduct := "Microsoft Windows 95";
10:
if szCSDVersion = "A" then
begin
SProduct := "Microsoft Windows 98 SE";
SVersion := SVersion + szCSDVersion;
end
else
SProduct := "Microsoft Windows 98";
90:
SProduct := "Microsoft Windows Millennium Edition";
end;
end;
VER_PLATFORM_WIN32_NT:
begin
SServicePack := szCSDVersion;
case dwMajorVersion of
0..4:
if bEx then
begin
case wProductType of
VER_NT_WORKSTATION:
SProduct := "Microsoft Windows NT Workstation 4.0";
VER_NT_SERVER:
if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
SProduct := "Microsoft Windows NT Advanced Server 4.0"
else
SProduct := "Microsoft Windows NT Server 4.0";
end;
end
else { NT351 and NT4.0 SP5 earliest}
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey("SYSTEM\CurrentControlSet\Control\ProductOptions", False) then
begin
if ReadString("ProductType") = "WINNT" then
SProduct := "Microsoft Windows NT Workstation " + SVersion
else if ReadString("ProductType") = "LANMANNT" then
SProduct := "Microsoft Windows NT Server " + SVersion
else if ReadString("ProductType") = "LANMANNT" then
SProduct := "Microsoft Windows NT Advanced Server " + SVersion;
end;
finally
Free;
end;
5:
case dwMinorVersion of
0: { Windows 2000 }
case wProductType of
VER_NT_WORKSTATION:
SProduct := "Microsoft Windows 2000 Professional";
VER_NT_SERVER:
if wSuiteMask and VER_SUITE_DATACENTER <> 0 then
SProduct := "Microsoft Windows 2000 Datacenter Server"
else if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
SProduct := "Microsoft Windows 2000 Advanced Server"
else
SProduct := "Microsoft Windows 2000 Server";
end;
1: { Windows XP }
if wSuiteMask and VER_SUITE_PERSONAL <> 0 then
SProduct := "Microsoft Windows Home Edition"
else
SProduct := "Microsoft Windows Professional";
2: { Windows Server 2003 }
if wSuiteMask and VER_SUITE_DATACENTER <> 0 then
SProduct := "Microsoft Windows Server 2003 Datacenter Edition"
else if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
SProduct := "Microsoft Windows Server 2003 Enterprise Edition"
else if wSuiteMask and VER_SUITE_BLADE <> 0 then
SProduct := "Microsoft Windows Server 2003 Web Edition"
else
SProduct := "Microsoft Windows Server 2003 Standard Edition";
end;
end;
end;
VER_PLATFORM_WIN32_CE: { Windows CE }
SProduct := SProduct + " CE";
end;
end;
Result := True;
end;
测试
procedure TForm1.Button1Click(Sender: TObject);
var
a,b,c :String;
begin
GetVersionInfo(a,b,c);
ShowMessage(a + #10 + b + #10 + c);
end;
如果你得到的是"Microsoft Windows unknown"，请给我来信，写明你用的系统
Email: gpg@mail.csdn.net
-
相关文章
2秒记住本站域名
玩过泡泡龙吗？Readygo?Go! 再加上.Com.Cn的后缀，那就是大名小顶的ReadyGo.com.cn