home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD4559452000.psc / basFileVersion.bas next >
Encoding:
BASIC Source File  |  2000-04-05  |  18.5 KB  |  429 lines

  1. Attribute VB_Name = "basFileVersion"
  2. Option Explicit
  3.  
  4. Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILE_TIME, lpLastAccessTime As FILE_TIME, lpLastWriteTime As FILE_TIME) As Long
  5. Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
  6. Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
  7. Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
  8. Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OF_STRUCT, ByVal wStyle As Long) As Long
  9. Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
  10. Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILE_TIME, lpLocalFileTime As FILE_TIME) As Long
  11. Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILE_TIME, lpSystemTime As SYSTEM_TIME) As Long
  12. Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
  13. Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)
  14.  
  15. Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
  16.  
  17. Private Const OF_READ = &H0
  18. Private Const OF_SHARE_DENY_NONE = &H40
  19. Private Const OFS_MAXPATHNAME = 128
  20.  
  21. ' ===== From Win32 Ver.h =================
  22. ' ----- VS_VERSION.dwFileFlags -----
  23. Private Const VS_FFI_SIGNATURE = &HFEEF04BD
  24. Private Const VS_FFI_STRUCVERSION = &H10000
  25. Private Const VS_FFI_FILEFLAGSMASK = &H3F&
  26.  
  27. ' ----- VS_VERSION.dwFileFlags -----
  28. Private Const VS_FF_DEBUG = &H1
  29. Private Const VS_FF_PRERELEASE = &H2
  30. Private Const VS_FF_PATCHED = &H4
  31. Private Const VS_FF_PRIVATEBUILD = &H8
  32. Private Const VS_FF_INFOINFERRED = &H10
  33. Private Const VS_FF_SPECIALBUILD = &H20
  34.  
  35. ' ----- VS_VERSION.dwFileOS -----
  36. Private Const VOS_UNKNOWN = &H0
  37. Private Const VOS_DOS = &H10000
  38. Private Const VOS_OS216 = &H20000
  39. Private Const VOS_OS232 = &H30000
  40. Private Const VOS_NT = &H40000
  41. Private Const VOS__BASE = &H0
  42. Private Const VOS__WINDOWS16 = &H1
  43. Private Const VOS__PM16 = &H2
  44. Private Const VOS__PM32 = &H3
  45. Private Const VOS__WINDOWS32 = &H4
  46.  
  47. Private Const VOS_DOS_WINDOWS16 = &H10001
  48. Private Const VOS_DOS_WINDOWS32 = &H10004
  49. Private Const VOS_OS216_PM16 = &H20002
  50. Private Const VOS_OS232_PM32 = &H30003
  51. Private Const VOS_NT_WINDOWS32 = &H40004
  52.  
  53.  
  54. ' ----- VS_VERSION.dwFileType -----
  55. Private Const VFT_UNKNOWN = &H0
  56. Private Const VFT_APP = &H1
  57. Private Const VFT_DLL = &H2
  58. Private Const VFT_DRV = &H3
  59. Private Const VFT_FONT = &H4
  60. Private Const VFT_VXD = &H5
  61. Private Const VFT_STATIC_LIB = &H7
  62.  
  63. ' ----- VS_VERSION.dwFileSubtype for VFT_WINDOWS_DRV -----
  64. Private Const VFT2_UNKNOWN = &H0
  65. Private Const VFT2_DRV_PRINTER = &H1
  66. Private Const VFT2_DRV_KEYBOARD = &H2
  67. Private Const VFT2_DRV_LANGUAGE = &H3
  68. Private Const VFT2_DRV_DISPLAY = &H4
  69. Private Const VFT2_DRV_MOUSE = &H5
  70. Private Const VFT2_DRV_NETWORK = &H6
  71. Private Const VFT2_DRV_SYSTEM = &H7
  72. Private Const VFT2_DRV_INSTALLABLE = &H8
  73. Private Const VFT2_DRV_SOUND = &H9
  74. Private Const VFT2_DRV_COMM = &HA
  75.  
  76. Private Type VS_FIXEDFILEINFO
  77.     dwSignature As Long
  78.     dwStrucVersionl As Integer ' e.g. = &h0000 = 0
  79.     dwStrucVersionh As Integer ' e.g. = &h0042 = .42
  80.     dwFileVersionMSl As Integer ' e.g. = &h0003 = 3
  81.     dwFileVersionMSh As Integer ' e.g. = &h0075 = .75
  82.     dwFileVersionLSl As Integer ' e.g. = &h0000 = 0
  83.     dwFileVersionLSh As Integer ' e.g. = &h0031 = .31
  84.     dwProductVersionMSl As Integer ' e.g. = &h0003 = 3
  85.     dwProductVersionMSh As Integer ' e.g. = &h0010 = .1
  86.     dwProductVersionLSl As Integer ' e.g. = &h0000 = 0
  87.     dwProductVersionLSh As Integer ' e.g. = &h0031 = .31
  88.     dwFileFlagsMask As Long ' = &h3F For version "0.42"
  89.     dwFileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE
  90.     dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16
  91.     dwFileType As Long ' e.g. VFT_DRIVER
  92.     dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
  93.     dwFileDateMS As Long ' e.g. 0
  94.     dwFileDateLS As Long ' e.g. 0
  95. End Type
  96.  
  97.  
  98. Public Type FILE_ATTRIBUTES
  99.     bArchive As Boolean
  100.     bCompressed As Boolean
  101.     bDirectory As Boolean
  102.     bHidden As Boolean
  103.     bNormal As Boolean
  104.     bReadOnly As Boolean
  105.     bSystem As Boolean
  106.     bTemporary As Boolean
  107. End Type
  108.  
  109. Public Type FILE_INFORMATION
  110.     cFilename As String
  111.     cDirectory As String
  112.     cFullFilePath As String
  113.     cFileType As String
  114.     nVerMajor As Long
  115.     nVerMinor As Long
  116.     nVerRevision As Long
  117.     nVerNotUsedVB As Long
  118.     nFileSize As Long
  119.     nFileAttributes As Long
  120.     nFileType As Long
  121.     faFileAttributes As FILE_ATTRIBUTES
  122.     dtCreationDate As Date
  123.     dtLastModifyTime As Date
  124.     dtLastAccessTime As Date
  125.     sCompanyName As String
  126.     sFileDescription As String
  127.     sFileVersion As String
  128.     sInternalName As String
  129.     sLegalCopyright As String
  130.     sOriginalFileName As String
  131.     sProductName As String
  132.     sProductVersion As String
  133. End Type
  134.  
  135. Private Type SYSTEM_TIME
  136.     wYear As Integer
  137.     wMonth As Integer
  138.     wDayOfWeek As Integer
  139.     wDay As Integer
  140.     wHour As Integer
  141.     wMinute As Integer
  142.     wSecond As Integer
  143.     wMilliseconds As Integer
  144. End Type
  145.  
  146. Private Type FILE_TIME
  147.     dwLowDateTime As Long
  148.     dwHighDateTime As Long
  149. End Type
  150.  
  151. Private Type OF_STRUCT
  152.      cBytes As Byte
  153.      fFixedDisk As Byte
  154.      nErrCode As Integer
  155.      Reserved1 As Integer
  156.      Reserved2 As Integer
  157.      szPathName(OFS_MAXPATHNAME) As Byte
  158. End Type
  159.  
  160. Public Function GetFileInformation(ByVal fileFullPath As String, ByRef FileInformation As FILE_INFORMATION, Optional ByVal showMsgBox As Boolean = False) As Boolean
  161. Dim lDummy As Long, lsize As Long, rc As Long
  162. Dim lVerbufferLen As Long
  163. Dim sBuffer() As Byte
  164. Dim udtVerBuffer As VS_FIXEDFILEINFO
  165. Dim hFile As Integer
  166. Dim FileStruct As OF_STRUCT
  167. Dim CreationTime As FILE_TIME
  168. Dim LastAccessTime As FILE_TIME
  169. Dim LastWriteTime As FILE_TIME
  170. Dim LocalFileTime As SYSTEM_TIME
  171. Dim MessageString As String
  172.  
  173. Dim lBufferLen As Long
  174. Dim bytebuffer(255) As Byte
  175. Dim Lang_Charset_String As String
  176. Dim HexNumber As Long
  177. Dim i As Integer
  178. Dim strTemp As String
  179. Dim buffer As String
  180. Dim lVerPointer As Long
  181. Dim strVersionInfo(7) As String
  182.  
  183.     On Error GoTo e_HandleFileInformationError
  184.     
  185.     With FileInformation
  186.         lsize = GetFileVersionInfoSize(fileFullPath, lDummy)
  187.         If lsize >= 1 Then
  188.             ReDim sBuffer(lsize)
  189.             rc = GetFileVersionInfo(fileFullPath, 0&, lsize, sBuffer(0))
  190.             rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
  191.             MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
  192.         End If
  193.         
  194.         '**** Determine Filename Info ****
  195.         .cFullFilePath = fileFullPath
  196.         .cFilename = DetermineFilename(fileFullPath)
  197.         .cDirectory = DetermineDirectory(fileFullPath)
  198.         
  199.         '**** Determine File Date Info ****
  200.         hFile = OpenFile(fileFullPath, FileStruct, OF_READ Or OF_SHARE_DENY_NONE)
  201.         If GetFileTime(hFile, CreationTime, LastAccessTime, LastWriteTime) Then
  202.             Call FileTimeToLocalFileTime(LastAccessTime, LastAccessTime)
  203.             If Not FileTimeToSystemTime(LastAccessTime, LocalFileTime) Then
  204.                 .dtLastAccessTime = Format(LocalFileTime.wMonth, "00") & "/" & Format(LocalFileTime.wDay, "00") & "/" & Format(LocalFileTime.wYear, "0000") & " " & Format(LocalFileTime.wHour, "00") & ":" & Format(LocalFileTime.wMinute, "00") & ":" & Format(LocalFileTime.wSecond, "00")
  205.             End If
  206.             Call FileTimeToLocalFileTime(CreationTime, CreationTime)
  207.             If Not FileTimeToSystemTime(CreationTime, LocalFileTime) Then
  208.                 .dtCreationDate = Format(LocalFileTime.wMonth, "00") & "/" & Format(LocalFileTime.wDay, "00") & "/" & Format(LocalFileTime.wYear, "0000") & " " & Format(LocalFileTime.wHour, "00") & ":" & Format(LocalFileTime.wMinute, "00") & ":" & Format(LocalFileTime.wSecond, "00")
  209.             End If
  210.             Call FileTimeToLocalFileTime(LastWriteTime, LastWriteTime)
  211.             If Not FileTimeToSystemTime(LastWriteTime, LocalFileTime) Then
  212.                 .dtLastModifyTime = Format(LocalFileTime.wMonth, "00") & "/" & Format(LocalFileTime.wDay, "00") & "/" & Format(LocalFileTime.wYear, "0000") & " " & Format(LocalFileTime.wHour, "00") & ":" & Format(LocalFileTime.wMinute, "00") & ":" & Format(LocalFileTime.wSecond, "00")
  213.             End If
  214.         End If
  215.     
  216.         Call lclose(hFile)
  217.     
  218.         '**** Determine File Attributes and Size
  219.         .nFileType = udtVerBuffer.dwFileType
  220.         Select Case .nFileType
  221.             Case VFT_UNKNOWN
  222.                 .cFileType = "Unknown"
  223.             Case VFT_APP
  224.                 .cFileType = "Application"
  225.             Case VFT_DLL
  226.                 .cFileType = "DLL Library"
  227.             Case VFT_DRV
  228.                 .cFileType = "Driver"
  229.             Case VFT_FONT
  230.                 .cFileType = "Font"
  231.             Case VFT_VXD
  232.                 .cFileType = "VXD File"
  233.             Case VFT_STATIC_LIB
  234.                 .cFileType = "Static Library"
  235.             Case Else
  236.                 .cFileType = "Unknown"
  237.         End Select
  238.         
  239.         .nFileAttributes = GetFileAttributes(fileFullPath)
  240.         If .nFileAttributes And &H20 Then
  241.             .faFileAttributes.bArchive = True
  242.         Else
  243.             .faFileAttributes.bArchive = False
  244.         End If
  245.         If .nFileAttributes And &H800 Then
  246.             .faFileAttributes.bCompressed = True
  247.         Else
  248.             .faFileAttributes.bCompressed = False
  249.         End If
  250.         If .nFileAttributes And &H10 Then
  251.             .faFileAttributes.bDirectory = True
  252.         Else
  253.             .faFileAttributes.bDirectory = False
  254.         End If
  255.         If .nFileAttributes And &H2 Then
  256.             .faFileAttributes.bHidden = True
  257.         Else
  258.             .faFileAttributes.bHidden = False
  259.         End If
  260.         If .nFileAttributes And &H80 Then
  261.             .faFileAttributes.bNormal = True
  262.         Else
  263.             .faFileAttributes.bNormal = False
  264.         End If
  265.         If .nFileAttributes And &H1 Then
  266.             .faFileAttributes.bReadOnly = True
  267.         Else
  268.             .faFileAttributes.bReadOnly = False
  269.         End If
  270.         If .nFileAttributes And &H4 Then
  271.             .faFileAttributes.bSystem = True
  272.         Else
  273.             .faFileAttributes.bSystem = False
  274.         End If
  275.         If .nFileAttributes And &H100 Then
  276.             .faFileAttributes.bTemporary = True
  277.         Else
  278.             .faFileAttributes.bTemporary = False
  279.         End If
  280.     
  281.         .nFileSize = FileLen(fileFullPath)
  282.         
  283.     '**** Determine Product Version number ****
  284.         If lsize >= 1 Then
  285.             .nVerMajor = udtVerBuffer.dwProductVersionMSh
  286.             .nVerMinor = udtVerBuffer.dwProductVersionMSl
  287.             .nVerNotUsedVB = udtVerBuffer.dwFileVersionLSh
  288.             .nVerRevision = udtVerBuffer.dwFileVersionLSl
  289.         End If
  290.     End With
  291.     
  292. '**** Company Name and other String Info ****
  293.     
  294.      '*** We will check the FileDescription of the gdi32.dll****
  295.      buffer = String(255, 0)
  296.  
  297.      '*** Get size ****
  298.      lBufferLen = GetFileVersionInfoSize(fileFullPath, lDummy)
  299.      If lBufferLen >= 1 Then
  300.  
  301.          ReDim sBuffer(lBufferLen)
  302.          rc = GetFileVersionInfo(fileFullPath, 0&, lBufferLen, sBuffer(0))
  303.          If rc <> 0 Then
  304.  
  305.              rc = VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lVerPointer, lBufferLen)
  306.     
  307.              If rc <> 0 Then
  308.                  'lVerPointer is a pointer to four 4 bytes of Hex number,
  309.                  'first two bytes are language id, and last two bytes are code
  310.                  'page. However, Lang_Charset_String needs a  string of
  311.                  '4 hex digits, the first two characters correspond to the
  312.                  'language id and last two the last two character correspond
  313.                  'to the code page id.
  314.         
  315.                  MoveMemory bytebuffer(0), lVerPointer, lBufferLen
  316.         
  317.                  HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + _
  318.                  bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
  319.                  Lang_Charset_String = Hex(HexNumber)
  320.                  'now we change the order of the language id and code page
  321.                  'and convert it into a string representation.
  322.                  'For example, it may look like 040904E4
  323.                  'Or to pull it all apart:
  324.                  '04------        = SUBLANG_ENGLISH_USA
  325.                  '--09----        = LANG_ENGLISH
  326.                  ' ----04E4 = 1252 = Codepage for Windows:Multilingual
  327.         
  328.                  Do While Len(Lang_Charset_String) < 8
  329.                     Lang_Charset_String = "0" & Lang_Charset_String
  330.                  Loop
  331.                 
  332.                 With FileInformation
  333.                     .sCompanyName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "CompanyName", lVerPointer, lBufferLen, sBuffer)
  334.                     .sFileDescription = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "FileDescription", lVerPointer, lBufferLen, sBuffer)
  335.                     .sFileVersion = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "FileVersion", lVerPointer, lBufferLen, sBuffer)
  336.                     .sInternalName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "InternalName", lVerPointer, lBufferLen, sBuffer)
  337.                     .sLegalCopyright = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "LegalCopyright", lVerPointer, lBufferLen, sBuffer)
  338.                     .sOriginalFileName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "OriginalFileName", lVerPointer, lBufferLen, sBuffer)
  339.                     .sProductName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "ProductName", lVerPointer, lBufferLen, sBuffer)
  340.                     .sProductVersion = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "ProductVersion", lVerPointer, lBufferLen, sBuffer)
  341.                 End With
  342.             End If
  343.         End If
  344.     End If
  345.     
  346.     If showMsgBox = True Then
  347.         With FileInformation
  348.             MessageString = "Path:" & vbCr & "Filename:" & vbTab & vbTab & .cFilename & vbCr & _
  349.             "Directory:" & vbTab & vbTab & .cDirectory & vbCr & _
  350.             "Full Path:" & vbTab & vbTab & .cFullFilePath & vbCr & vbCr & "Date:" & vbCr & _
  351.             "Creation Date:" & vbTab & Format(.dtCreationDate, "dddd, mmm dd yyyy H:MM:SS AMPM") & vbCr & _
  352.             "Modify Date:" & vbTab & Format(.dtLastModifyTime, "dddd, mmm dd yyyy H:MM:SS AMPM") & vbCr & _
  353.             "Access Date:" & vbTab & Format(.dtLastAccessTime, "dddd, mmm dd yyyy") & vbCr & vbCr & "Attributes:" & vbCr & _
  354.             "Archive:" & vbTab & vbTab & .faFileAttributes.bArchive & vbCr & _
  355.             "Compressed:" & vbTab & .faFileAttributes.bCompressed & vbCr & _
  356.             "Directory:" & vbTab & vbTab & .faFileAttributes.bDirectory & vbCr & _
  357.             "Hidden:" & vbTab & vbTab & .faFileAttributes.bHidden & vbCr & _
  358.             "Normal:" & vbTab & vbTab & .faFileAttributes.bNormal & vbCr & _
  359.             "Read Only:" & vbTab & .faFileAttributes.bReadOnly & vbCr & _
  360.             "System:" & vbTab & vbTab & .faFileAttributes.bSystem & vbCr & _
  361.             "Temporary:" & vbTab & .faFileAttributes.bTemporary & vbCr & vbCr & "String Info:" & vbCr & _
  362.             "Company Name:" & vbTab & .sCompanyName & vbCr & _
  363.             "File Description:" & vbTab & .sFileDescription & vbCr & _
  364.             "File Version:" & vbTab & .sFileVersion & vbCr & _
  365.             "Internal Name:" & vbTab & .sInternalName & vbCr & _
  366.             "Original Filename:" & vbTab & .sOriginalFileName & vbCr & _
  367.             "Product Name:" & vbTab & .sProductName & vbCr & _
  368.             "Product Version:" & vbTab & .sProductVersion & vbCr & _
  369.             "Legal Copyright:" & vbTab & .sLegalCopyright & vbCr & vbCr & "Misc.:" & vbCr & _
  370.             "File Size:" & vbTab & vbTab & Format(.nFileSize / 1024, "###,###,### KB (") & Format(.nFileSize, "###,###,### bytes)") & vbCr
  371.             If .nFileType <> VFT_UNKNOWN Then
  372.                 MessageString = MessageString & "File Type:" & vbTab & vbTab & .cFileType & vbCr
  373.             End If
  374.             If lsize >= 1 Then
  375.                 MessageString = MessageString & "Version:" & vbTab & vbTab & .nVerMajor & "." & .nVerMinor & "." & .nVerRevision
  376.             End If
  377.             
  378.             Call MsgBox(MessageString, vbOKOnly + vbInformation, "Information")
  379.         End With
  380.     End If
  381. '         strVersionInfo(0) = "CompanyName"
  382. '         strVersionInfo(1) = "FileDescription"
  383. '         strVersionInfo(2) = "FileVersion"
  384. '         strVersionInfo(3) = "InternalName"
  385. '         strVersionInfo(4) = "LegalCopyright"
  386. '         strVersionInfo(5) = "OriginalFileName"
  387. '         strVersionInfo(6) = "ProductName"
  388. '         strVersionInfo(7) = "ProductVersion"
  389.  
  390.     GetFileInformation = True
  391.     Exit Function
  392.     
  393. e_HandleFileInformationError:
  394.     GetFileInformation = False
  395.     Exit Function
  396. End Function
  397. Private Function GetStringValue(ByRef searchString As String, ByVal lVerPointer As Long, ByVal lBufferLen As Long, ByRef sBuffer() As Byte) As String
  398. Dim buffer As String
  399. Dim strTemp As String
  400. Dim rc As Long
  401.  
  402.     GetStringValue = ""
  403.     buffer = String(255, 0)
  404.     rc = VerQueryValue(sBuffer(0), searchString, lVerPointer, lBufferLen)
  405.     
  406.     If rc <> 0 Then
  407.         lstrcpy buffer, lVerPointer
  408.         GetStringValue = Mid$(buffer, 1, InStr(buffer, Chr(0)) - 1)
  409.     End If
  410.  
  411. End Function
  412. Private Function DetermineDirectory(inputString As String) As String
  413. Dim pos As Integer
  414.     pos = InStrRev(inputString, "\", , vbTextCompare)
  415.     DetermineDirectory = Mid(inputString, 1, pos)
  416. End Function
  417. Private Function DetermineFilename(inputString As String) As String
  418. Dim pos As Integer
  419.     pos = InStrRev(inputString, "\", , vbTextCompare)
  420.     DetermineFilename = Mid(inputString, pos + 1, Len(inputString) - pos)
  421. End Function
  422. Private Function DetermineDrive(inputString As String) As String
  423. Dim pos As Integer
  424.     If inputString = "" Then Exit Function
  425.     pos = InStr(1, inputString, ":\", vbTextCompare)
  426.     DetermineDrive = Mid(inputString, 1, pos - 1)
  427. End Function
  428.  
  429.