home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 May / Chip_1999-05_cd.bin / zkuste / vbasic / Data / Priklady / versinfo.cls < prev   
Text File  |  1999-03-06  |  9KB  |  257 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsVersionInfo"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. 'Zjiti verzi souboru dll nebo exe
  15. Option Explicit
  16.  
  17. #Const Win32 = 1  'Bezi v prostredi Win32
  18.  
  19. Private iFile              As String
  20.  
  21. Private iFileVersion       As String
  22. Private iProductVersion    As String
  23. Private iFlags             As String
  24. Private iOS                As String
  25. Private iFileType          As String
  26. Private iSubType           As String
  27.  
  28. ' Verze souboru
  29. Private Type VS_VERSION
  30.    dwSignature As Long
  31.    dwStrucVersion As Long         '  e.g. 0x00000042 = "0.42"
  32.    dwFileVersionMS As Long        '  e.g. 0x00030075 = "3.75"
  33.    dwFileVersionLS As Long        '  e.g. 0x00000031 = "0.31"
  34.    dwProductVersionMS As Long     '  e.g. 0x00030010 = "3.10"
  35.    dwProductVersionLS As Long     '  e.g. 0x00000031 = "0.31"
  36.    dwFileFlagsMask As Long        '  = 0x3F for version "0.42"
  37.    dwFileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
  38.    dwFileOS As Long               '  e.g. VOS_DOS_WINDOWS16
  39.    dwFileType As Long             '  e.g. VFT_DRIVER
  40.    dwFileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
  41.    dwFileDateMS As Long           '  e.g. 0
  42.    dwFileDateLS As Long           '  e.g. 0
  43. End Type
  44.  
  45. #If Win32 Then
  46.    Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
  47.    Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Byte) As Long
  48.    Private Declare Function VerLanguageName Lib "version.dll" Alias "VerLanguageNameA" (ByVal wLang As Long, ByVal szLang As String, ByVal nSize As Long) As Long
  49.    Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Byte, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long
  50.    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (stvDest As Any, stvSource As Any, ByVal cbCopy As Long)
  51. #Else
  52.    Private Declare Function GetFileVersionInfo% Lib "ver.dll" (ByVal lpszFileName$, ByVal Handle&, ByVal cbBuf&, lpvData As Byte)
  53.    Private Declare Function GetFileVersionInfoSize% Lib "ver.dll" (ByVal lpszFileName$, lpdwHandle&)
  54.    Private Declare Function VerLanguageName% Lib "ver.dll" (ByVal Lang%, ByVal lpszLang$, ByVal cbLang%)
  55.    Private Declare Function VerQueryValue% Lib "ver.dll" (lpvBlock As Byte, ByVal SubBlock$, lpBuffer&, lpcb%)
  56.    Private Declare Sub CopyMemory Lib "Kernel" Alias "hmemcpy" (stvDest As Any, stvSource As Any, ByVal cbCopy As Long)
  57. #End If
  58.  
  59. 'VS_VERSION.dwFileFlags
  60. Private Const VS_FF_DEBUG = &H1
  61. Private Const VS_FF_PRERELEASE = &H2
  62. Private Const VS_FF_PATCHED = &H4
  63. Private Const VS_FF_PRIVATEBUILD = &H8
  64. Private Const VS_FF_INFOINFERRED = &H10
  65. Private Const VS_FF_SPECIALBUILD = &H20
  66.  
  67. 'VS_VERSION.dwFileOS
  68. Private Const VOS_UNKNOWN = &H0
  69. Private Const VOS_DOS = &H10000
  70. Private Const VOS_OS216 = &H20000
  71. Private Const VOS_OS232 = &H30000
  72. Private Const VOS_NT = &H40000
  73. Private Const VOS__BASE = &H0
  74. Private Const VOS__WINDOWS16 = &H1
  75. Private Const VOS__PM16 = &H2
  76. Private Const VOS__PM32 = &H3
  77. Private Const VOS__WINDOWS32 = &H4
  78. Private Const VOS_DOS_WINDOWS16 = &H10001
  79. Private Const VOS_DOS_WINDOWS32 = &H10004
  80. Private Const VOS_OS216_PM16 = &H20002
  81. Private Const VOS_OS232_PM32 = &H30003
  82. Private Const VOS_NT_WINDOWS32 = &H40004
  83.  
  84. 'VS_VERSION.dwFileType
  85. Private Const VFT_UNKNOWN = &H0
  86. Private Const VFT_APP = &H1
  87. Private Const VFT_DLL = &H2
  88. Private Const VFT_DRV = &H3
  89. Private Const VFT_FONT = &H4
  90. Private Const VFT_VXD = &H5
  91. Private Const VFT_STATIC_LIB = &H7
  92.  
  93. 'VS_VERSION.dwFileSubtype pro VFT_WINDOWS_DRV
  94. Private Const VFT2_UNKNOWN = &H0
  95. Private Const VFT2_DRV_PRINTER = &H1
  96. Private Const VFT2_DRV_KEYBOARD = &H2
  97. Private Const VFT2_DRV_LANGUAGE = &H3
  98. Private Const VFT2_DRV_DISPLAY = &H4
  99. Private Const VFT2_DRV_MOUSE = &H5
  100. Private Const VFT2_DRV_NETWORK = &H6
  101. Private Const VFT2_DRV_SYSTEM = &H7
  102. Private Const VFT2_DRV_INSTALLABLE = &H8
  103. Private Const VFT2_DRV_SOUND = &H9
  104. Private Const VFT2_DRV_COMM = &HA
  105.  
  106. 'VS_VERSION.dwFileSubtype pro VFT_WINDOWS_FONT
  107. Private Const VFT2_FONT_RASTER = &H1
  108. Private Const VFT2_FONT_VECTOR = &H2
  109. Private Const VFT2_FONT_TRUETYPE = &H3
  110.  
  111. Public Property Get File() As clsFile
  112.   Set File = iFile
  113. End Property
  114.  
  115. Public Property Let File(strFile As String)
  116.   iFile = strFile
  117.   Update  'Update informaci
  118. End Property
  119.  
  120. Public Property Get FileType() As String
  121.   FileType = iFileType
  122. End Property
  123.  
  124. Public Property Get FileVersion() As String
  125.   FileVersion = iFileVersion
  126. End Property
  127.  
  128. Public Property Get OS() As String
  129.   OS = iOS
  130. End Property
  131.  
  132. Public Property Get ProductVersion() As String
  133.   ProductVersion = iProductVersion
  134. End Property
  135.  
  136. Public Property Get SubType() As String
  137.   SubType = iSubType
  138. End Property
  139.  
  140. Private Sub Update()
  141.   Dim x As VS_VERSION, BufSize As Long, r As Long, dwHandle As Long
  142.   Dim InfoAddr As Long, InfoLen As Long, lpvData() As Byte
  143.  
  144.   iFileVersion = ""
  145.   iProductVersion = ""
  146.   iFlags = ""
  147.   iOS = ""
  148.   iFileType = ""
  149.  
  150.   BufSize = GetFileVersionInfoSize(iFile.Name, dwHandle)
  151.  
  152.   If BufSize = 0 Then Exit Sub
  153.  
  154.   ReDim lpvData(BufSize + 1)
  155.   r = GetFileVersionInfo(iFile.Name, dwHandle, BufSize, lpvData(0))
  156.   r = VerQueryValue(lpvData(0), "\", InfoAddr, InfoLen)
  157.  
  158.   If r = 0 Then Exit Sub
  159.    
  160.   CopyMemory ByVal InfoAddr, x, InfoLen
  161.  
  162.   'Zjisti verzi souboru
  163.   iFileVersion = LTrim(Str(HiWord(x.dwFileVersionMS))) + "."
  164.   iFileVersion = iFileVersion + LTrim(Str(LoWord(x.dwFileVersionMS))) + "."
  165.   iFileVersion = iFileVersion + LTrim(Str(HiWord(x.dwFileVersionLS))) + "."
  166.   iFileVersion = iFileVersion + LTrim(Str(LoWord(x.dwFileVersionLS)))
  167.  
  168.   'Zjisti produkt verzi
  169.   iProductVersion = LTrim(Str(HiWord(x.dwFileVersionMS))) + "."
  170.   iProductVersion = iProductVersion + LTrim(Str(LoWord(x.dwProductVersionMS))) + "."
  171.   iProductVersion = iProductVersion + LTrim(Str(HiWord(x.dwProductVersionLS))) + "."
  172.   iProductVersion = iProductVersion + LTrim(Str(LoWord(x.dwProductVersionLS)))
  173.  
  174.   'Zjisti dalsi atributy souboru
  175.   If x.dwFileFlags And VS_FF_DEBUG Then iFlags = "Debug"
  176.   If x.dwFileFlags And VS_FF_PRERELEASE Then iFlags = iFlags + "Pre release"
  177.   If x.dwFileFlags And VS_FF_PATCHED Then iFlags = iFlags + "Patched"
  178.   If x.dwFileFlags And VS_FF_PRIVATEBUILD Then iFlags = iFlags + "Private build"
  179.   If x.dwFileFlags And VS_FF_INFOINFERRED Then iFlags = iFlags + "Info"
  180.   If x.dwFileFlags And VS_FF_DEBUG Then iFlags = iFlags + "Special"
  181.   If x.dwFileFlags And &HFF00 Then iFlags = iFlags + "Unknown"
  182.  
  183.   'Zjisti OS pro kter² byl soubor navr₧en
  184.   Select Case x.dwFileOS
  185.     Case VOS_DOS_WINDOWS16
  186.       iOS = "DOS-Win16"
  187.     Case VOS_DOS_WINDOWS32
  188.       iOS = "DOS-Win32"
  189.     Case VOS_OS216_PM16
  190.       iOS = "OS/2-16 PM-16"
  191.     Case VOS_OS232_PM32
  192.       iOS = "OS/2-32 PM-32"
  193.     Case VOS_NT_WINDOWS32
  194.       iOS = "NT-Win32"
  195.     Case Else
  196.       iOS = "Unknown"
  197.   End Select
  198.  
  199.   'Zjisti Typ a SubTyp souboru
  200.   Select Case x.dwFileType
  201.     Case VFT_APP
  202.       iFileType = "App"
  203.     Case VFT_DLL
  204.       iFileType = "DLL"
  205.     Case VFT_DRV
  206.       iFileType = "Driver"
  207.       Select Case x.dwFileSubtype
  208.         Case VFT2_DRV_PRINTER
  209.           iSubType = "Printer drv"
  210.         Case VFT2_DRV_KEYBOARD
  211.           iSubType = "Keyboard drv"
  212.         Case VFT2_DRV_LANGUAGE
  213.           iSubType = "Language drv"
  214.         Case VFT2_DRV_DISPLAY
  215.           iSubType = "Display drv"
  216.         Case VFT2_DRV_MOUSE
  217.           iSubType = "Mouse drv"
  218.         Case VFT2_DRV_NETWORK
  219.           iSubType = "Network drv"
  220.         Case VFT2_DRV_SYSTEM
  221.           iSubType = "System drv"
  222.         Case VFT2_DRV_INSTALLABLE
  223.           iSubType = "Installable"
  224.         Case VFT2_DRV_SOUND
  225.           iSubType = "Sound drv"
  226.         Case VFT2_DRV_COMM
  227.           iSubType = "Comm drv"
  228.         Case VFT2_UNKNOWN
  229.           iSubType = "Unknown"
  230.       End Select
  231.     Case VFT_FONT
  232.       iFileType = "Font"
  233.       Select Case x.dwFileSubtype
  234.         Case VFT2_FONT_RASTER
  235.           iSubType = "Raster Font"
  236.         Case VFT2_FONT_VECTOR
  237.           iSubType = "Vector Font"
  238.         Case VFT2_FONT_TRUETYPE
  239.           iSubType = "TrueType Font"
  240.       End Select
  241.     Case VFT_VXD
  242.       iFileType = "VxD"
  243.     Case VFT_STATIC_LIB
  244.       iFileType = "Lib"
  245.     Case Else
  246.       iFileType = "Unknown"
  247.   End Select
  248. End Sub
  249.  
  250. Private Function LoWord(ByVal x As Long) As Integer
  251.   LoWord = x And &HFFFF
  252. End Function
  253.  
  254. Private Function HiWord(ByVal x As Long) As Integer
  255.   HiWord = x \ &HFFFF
  256. End Function
  257.