獲得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('SYSTEMCurrentControlSetControlProductOptions', 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: [email protected]