[Win32forth-cvs] win32forth/src Winversion.f,NONE,1.1

[George H. <geo...@us...>]

Update of /cvsroot/win32forth/win32forth/src
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv29588

Added Files:
	Winversion.f 
Log Message:
New file of code from primutils.f

--- NEW FILE: Winversion.f ---
\ $Id: Winversion.f,v 1.1 2013/12/17 20:35:23 georgeahubert Exp $

\ ---------------- Operating System Checking --------------------------

\ Moved here from PrimUtil.f


1 PROC GetVersionEx
version# ((version)) 0. 2swap >number 3drop 7 <  [if]  \ For V6.xx.xx suporting older OSs
1  constant win95
2  constant win98
3  constant winme
4  constant winnt351
5  constant winnt4
[then]
6  constant win2k
7  constant winxp
8  constant win2003   \ Windows Server 2003 R2
9  constant winvista  \ Windows Vista
10 constant win2008   \ Windows Server 2008
11 constant win2008r2 \ Windows Server 2008 R2
12 constant win7      \ Windows 7
13 constant win8      \ Windows 8

\ To check for a version, say Win2K or greater, try WINVER WIN2K >=
\ NOTE The future V7.xx.xx and later will only support WIN2K or greaeter anyway.

0 value winver

: winver-init ( -- )                \ get windows version
            156 dup _localalloc dup>r ! \ set length of OSVERSIONINFOEX structure
            r@ call GetVersionEx \ call os for version
[ version# ((version)) 0. 2swap >number 3drop 7 < ] [if]  \ For V6.xx.xx suporting older OSs
            dup 0= if drop 148 r@ ! r@ call GetVersionEx then  \ try lower size for win98FE (and possibly win95)
[then]      0= abort" call failed"
            r@ 4 cells+ @        \ get osplatformid
            case
[ version# ((version)) 0. 2swap >number 3drop 7 < ] [if]  \ For V6.xx.xx suporting older OSs
              1 of                  \ 95, 98, and me
                r@ 2 cells+ @       \ minorversion
                case
                  0  of win95 endof \ 95
                  10 of win98 endof \ 98
                  90 of winme endof \ me
                endcase
              endof
[then]
              2 of                  \ nt, 2k, xp
                r@ cell+ @          \ majorversion
                case
[ version# ((version)) 0. 2swap >number 3drop 7 < ] [if]  \ For V6.xx.xx suporting older OSs
                  3  of winnt351 endof \ nt351
                  4  of winnt4 endof \ nt4
[then]            5  of
                     r@ 2 cells+ @  \ minor version
                     case
                       0 of win2k endof \ win2k
                       1 of winxp endof \ winxp
                       2 of win2003 endof \ 2003
                     endcase
                  endof
                  6  of
                    r@ 2 cells+ @  \ minor version
                     case
                       0 of r@ 154 + c@ \ Product Type
                            VER_NT_WORKSTATION = if winvista  \ Windows Vista
                                                 else win2008 \ Windows Server 2008
                                                 then
                       endof
                       1 of r@ 154 + c@ \ Product Type
                            VER_NT_WORKSTATION = if win7  \ Windows 7
                                                 else win2008r2 \ Windows Server 2008 R2
                                                 then
                       endof
                       2 of r@ 154 + c@ \ Product Type
                            VER_NT_WORKSTATION = if win8  \ Windows 8
                                                 else win2008r2 \ Windows Server 2008 R2
                                                 then
                       endof
                     drop -2 dup   \ unknown product Type
                     endcase
                  endof
                drop -1 dup   \ unknown windows version
                endcase
              endof
            endcase to winver
            rdrop _localfree
            ;

initialization-chain chain-add winver-init
winver-init