最近写控件,因为想加入版本信息,而通常大多数情况下,几乎所有的公司或个人都会在自己软件的版本信息里提及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[0..127] 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[0..127] 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[1] in ['B', 'C'] then begin SProduct := 'Microsoft Windows 95 OSR2'; SVersion := SVersion + szCSDVersion[1]; end else SProduct := 'Microsoft Windows 95'; 10: if szCSDVersion[1] = 'A' then begin SProduct := 'Microsoft Windows 98 SE'; SVersion := SVersion + szCSDVersion[1]; 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
|