!  RedistTest.f90 
!
!  Tool to check if the Intel Fortran run-time redistributables are present.
!  Optionally, can check for a minimum version
!
!  Usage:  RedistTest [minver]
!
!  minver = Minimum major file version acceptable (example: 20)
!           If omitted, any version is OK
!
!  If process exit status is 0, that's good. A status of 1, 2 or 3 indicates
!  Redist not found or some other error. A status of 4 means the minimum
!  version test failed.
!
!  Author: Steve Lionel
!  License: Creative Commons BY https://creativecommons.org/licenses/by/4.0/
!
    program RedistTest
    
    use version
    use kernel32
    use, intrinsic :: ISO_C_BINDING

    implicit none
    
    integer(DWORD) :: verInfoSize
    integer(BOOL) :: ret
    integer(BYTE), allocatable :: verInfo(:)
    type(T_VS_FIXEDFILEINFO), pointer :: fixedFileInfo
    integer(C_INTPTR_T) :: p_fixedFileInfo,p_notused
    integer(WORD), pointer :: fileVersion(:)
    character(10) :: cmdarg
    integer :: argstat
    integer(WORD) :: minVer
    
    ! See if we were asked for a minimum version
    minver = 0
    call get_command_argument (1,cmdarg,status=argstat)
    if (argstat == 0) then
        read (cmdarg,'(BN,I10)',iostat=argstat) minver
        if (argstat /= 0) minver = 0
    end if
        
    ! Get the size of a version info buffer for this DLL
    verInfoSize = GetFileVersionInfoSize("libifcorert.dll",NULL)
    if (verInfoSize == 0) call ExitProcess(1_UINT) ! File not there
    ! Allocate the version info buffer and get the info
    allocate (verInfo(verInfoSize))
    ret = GetFileVersionInfo("libifcorert.dll",NULL,verInfoSize,loc(verInfo))
    if (ret == 0) call ExitProcess(2_UINT) ! Call failed for some reason
    ! Get a pointer to the VS_FIXEDFILEINFO block
    ret = VerQueryValue(loc(verInfo),"\\"C,p_fixedFileInfo,loc(p_notused))
    if (ret == 0) call ExitProcess(3_UINT) ! Call failed for some reason
    ! Cast the returned pointer to a Fortran pointer
    call c_f_pointer(transfer(p_fixedfileinfo,C_NULL_PTR),fixedFileInfo)
    ! Get a pointer to the file version info
    call c_f_pointer(c_loc(fixedFileInfo%dwFileVersionMS),fileVersion,[4])
    ! The upper 16 bits of dwFileVersionMS is the version to compare
    if (fileVersion(2) < minver) call ExitProcess(4_UINT) ! Old version
    ! Everything is OK
    call ExitProcess(0_UINT)
    end program RedistTest