获得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[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 XP Home Edition'
                else
                  SProduct := 'Microsoft Windows XP 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

智能推荐

注意!

本站转载的文章为个人学习借鉴使用,本站对版权不负任何法律责任。如果侵犯了您的隐私权益,请联系我们删除。



 
© 2014-2019 ITdaan.com 粤ICP备14056181号  

赞助商广告