FileVersion, Clarion Program - submitted by Olivier Cretey

FileVersion.clw

  Program

  !Pragma('link(version.lib)')
  !Pragma('link(GetVersion.Version)')

_VS_FIXEDFILEINFO Group, Type
dwSignature         Long
dwStrucVersion      Long
dwFileVersionMS     Long
dwFileVersionLS     Long
dwProductVersionMS  Long
dwProductVersionLS  Long
dwFileFlagsMask     Long
dwFileFlags         Long
dwFileOS            Long
dwFileType          Long
dwFileSubtype       Long
dwFileDateMS        Long
dwFileDateLS        Long
                  End

_TransRec         Group, Type
Lang                Short
Charset             Short
                  End


  Map
    Module('Version')
    ! http://msdn.microsoft.com/en-us/library/ms646981(v=VS.85).aspx
      GetFileVersionInfo(*CString lptstrFilename, Long dwHandle,  Long dwLen, Long lpData), Bool, Pascal, Raw, Name('GetFileVersionInfoA')
      GetFileVersionInfoSize(*CString lptstrFilename, <*Long lpdwHandle>), Long, Pascal, Raw, Name('GetFileVersionInfoSizeA')
      VerLanguageName(Long wLang, *CString szLang, Long cchLang), Long, Pascal, Raw, Name('VerLanguageNameA')
      VerQueryValue(Long pBlock, *CString lpSubBlock, *Long lplpBuffer, *Long puLen),Bool, Pascal, Raw, Name('VerQueryValueA')
    End
    Module('Kernel32')
      GetLastError(), Long, Pascal
    End
    Main()
  End

  Code
    Main()
  Return

Main Procedure()
FileName      CString(256)
BufferSize    Long
VersionData   &CString

Ignored       Long

SubBlock      CString(256)
InfoAddr      Long
InfoSize      Long
InfoCStr      &CString

VI            &_VS_FIXEDFILEINFO
P             Long, Dim(4)
ProductVer    String(20)
FileVer       String(20)

TRec          &_TransRec
TRecCount     Long
ndx           Long
TransText     CString(128)

  Code
    FileName = Command('0')
    BufferSize = GetFileVersionInfoSize(FileName)
    Message('BufferSize = ' & BufferSize)

    If BufferSize = 0
       Return
    End
    VersionData &= New(CString(BufferSize))
    If GetFileVersionInfo(FileName, Ignored, BufferSize, Address(VersionData)) = 0
       Message('VersionInfo Error: ' & GetLastError(),'Error')
    Else
       SubBlock = '\'
       If VerQueryValue(Address(VersionData), SubBlock, InfoAddr, InfoSize)
          VI  &= (InfoAddr)
          p[1] = bShift(VI.dwProductVersionMS,-16)
          p[2] = bAnd(VI.dwProductVersionMS,0FFFFH)
          p[3] = bShift(VI.dwProductVersionLS,-16)
          p[4] = bAnd(VI.dwProductVersionLS,0FFFFH)
          ProductVer = p[1] & '.' & p[2] & '.' & p[3] & '.' & p[4]
          p[1] = bShift(VI.dwFileVersionMS,-16)
          p[2] = bAnd(VI.dwFileVersionMS,0FFFFH)
          p[3] = bShift(VI.dwFileVersionLS,-16)
          p[4] = bAnd(VI.dwFileVersionLS,0FFFFH)
          FileVer  = p[1] & '.' & p[2] & '.' & p[3] & '.' & p[4]
          Message('Product Version: ' & ProductVer & '<13,10>File Version: ' & FileVer)
       End

       SubBlock = '\StringFileInfo\' & '040C04E4' & '\FileVersion'
       If VerQueryValue(Address(VersionData), SubBlock, InfoAddr, InfoSize)
          InfoCStr &= (InfoAddr)
          Message('Version : ' & InfoCStr)
       End

       SubBlock = '\VarFileInfo\Translation'
       If VerQueryValue(Address(VersionData), SubBlock, InfoAddr, InfoSize)
          TRecCount = InfoSize / Size(_TransRec)
          Message('InfoSize= ' & InfoSize & ' / ' & Size(_TransRec) & ' = ' & TRecCount)
          Loop ndx = 0 to (TRecCount-1)
             TRec &= (InfoAddr + (ndx * Size(_TransRec)))
             message(VerLanguageName(TRec.Lang, TransText, Size(TransText)-1), 'Trans')
             Message('Translation: Lang = ' & TRec.Lang & ', ' & TransText & ', Charset= ' & TRec.Charset, 'TRecCount: ' & ndx + 1)
          End
       End

    End

    Dispose(VersionData)
    VersionData &= Null
    VI          &= Null
    InfoCStr    &= Null
    TRec        &= Null
  Return

This solution is very simple and useful for me.

Thanks & Regards,
Serhat