home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PWBROW.ZIP / VER.BAS < prev    next >
BASIC Source File  |  1994-01-27  |  10KB  |  194 lines
  1. Declare Function VerInstallFile& Lib "ver.dll" (ByVal Flags%, ByVal SrcFile$, ByVal DestFile$, ByVal SrcPath$, ByVal DestPath$, ByVal CurrDir$, ByVal TmpFile$, lpwTmpFileLen%)
  2. Declare Function GetFileVersionInfoSize Lib "ver.dll" (ByVal lpszFileName As String, lpdwHandle As Long) As Long
  3. Declare Function GetFileVersionInfo Lib "ver.dll" (ByVal lpszFileName As String, ByVal lpdwHandle As Long, ByVal cbbuf As Long, ByVal lpvdata As String) As Integer
  4. Declare Function VerQueryValue Lib "ver.dll" (ByVal lpvBlock As String, ByVal lpszSubBlock As String, lplpBuffer As Long, lpcb As Integer) As Integer
  5. Declare Function VerLanguageName Lib "ver.dll" (ByVal LangID As Integer, ByVal LangName As String, ByVal LangLen As Integer) As Integer
  6. Declare Function lstrcpyn Lib "Kernel" (ByVal lpszString1 As Any, ByVal lpszString2 As Long, ByVal cChars As Integer) As Long
  7. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
  8. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  9. Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
  10.  
  11. Type VerInfo
  12.     FileVersion As String
  13.     FileDescription As String
  14.     CompanyName As String
  15.     Language As String
  16.     Comments As String
  17.     OriginalFileName As String
  18.     InternalName As String
  19.     LegalCopyright As String
  20.     LegalTrademarks As String
  21.     ProductName As String
  22.     ProductVersion As String
  23.     SpecialBuild As String
  24.     PrivateBuild As String
  25. End Type
  26.  
  27. Global BrowseTop As Integer
  28. Global BrowseLeft As Integer
  29. Global DispTop As Integer
  30. Global DispLeft As Integer
  31. Global PrintTop As Integer
  32. Global PrintLeft As Integer
  33.  
  34. Dim ResName(16) As String
  35. Dim ResValue(16) As String
  36.  
  37. Function GetFileVersion (FileToCheck As String, VI As VerInfo) As Integer
  38.     Dim VersionInfoSize As Long  ' size of Version Resource
  39.     Dim Handle As Long ' Handle to Version Resource
  40.     Dim VerRes As String ' Version resource, retrieved from File
  41.     Dim Value As String '  String returned by API call
  42.     Dim ValueLen As Integer ' Length of String returned by API call (Value)
  43.     Dim Pointer As Long ' 32-bit address of string returned by API call
  44.     Dim Result As Integer ' 16-bit value returned by API call
  45.     Dim lResult As Long ' 32-bit value returned by API call
  46.     Dim Translation As String ' Language/Charset value, in hex
  47.     
  48.     ' Reset Version info
  49.     VI.FileVersion = ""
  50.     VI.FileDescription = ""
  51.     VI.CompanyName = ""
  52.     VI.Language = ""
  53.     VI.OriginalFileName = ""
  54.     VI.InternalName = ""
  55.     VI.Comments = ""
  56.     VI.LegalCopyright = ""
  57.     VI.LegalTrademarks = ""
  58.     VI.ProductName = ""
  59.     VI.ProductVersion = ""
  60.     VI.SpecialBuild = ""
  61.     VI.PrivateBuild = ""
  62.     
  63.     On Error Resume Next
  64.     VersionInfoSize = GetFileVersionInfoSize(FileToCheck, Handle) ' How big is the V/R?
  65.     If VersionInfoSize = 0 Then ' No Version Resource present :(
  66.         GetFileVersion = False
  67.         Exit Function
  68.     End If
  69.  
  70.     VerRes = String$(VersionInfoSize, Chr$(0))
  71.     Result = GetFileVersionInfo(FileToCheck, Handle, VersionInfoSize, VerRes) ' get copy of V/R
  72.  
  73.     Result = VerQueryValue(VerRes, "\VarFileInfo\Translation", Pointer, ValueLen) ' Get translation info
  74.     If ValueLen = 4 Then ' Looks like we've got a valid translation info
  75.         Value = String$(ValueLen + 1, Chr$(0))
  76.         lResult = lstrcpyn(Value, Pointer, ValueLen + 1)
  77.         Translation = ToHex(Left$(Value, 4)) ' trim the trailing null, and convert to hex
  78.         GoTo GetValues ' Let's start extracting version info!
  79.     Else ' apparently the Translation info is not there, let's try guessing ...
  80.         Translation = "040904E4" ' Let's guess it's U.S. English/Charset 1252 (Windows Multilingual)
  81.         Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\CompanyName", Pointer, ValueLen)
  82.         If Result <> 0 Then GoTo GetValues ' Good Guess!
  83.     End If
  84.  
  85.     GetFileVersion = False ' No Luck
  86.     Exit Function
  87.  
  88. GetValues:
  89.     'Retrieve File information
  90.     Value = String$(32, " ")
  91.     Result = VerLanguageName(Val("&h" + Left$(Translation, 4)), Value, 32)
  92.     If Result Then
  93.         VI.Language = Left$(Value, InStr(Value, Chr$(0)) - 1)
  94.     End If
  95.  
  96.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\FileVersion", Pointer, ValueLen)
  97.     If Result = 1 Then
  98.         VI.FileVersion = String$(ValueLen + 2, Chr$(0))
  99.         lResult = lstrcpyn(VI.FileVersion, Pointer, ValueLen + 1)
  100.         VI.FileVersion = Left$(VI.FileVersion, InStr(VI.FileVersion, Chr$(0)) - 1)
  101.       End If
  102.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\FileDescription", Pointer, ValueLen)
  103.     If Result = 1 Then
  104.         VI.FileDescription = String$(ValueLen + 2, Chr$(0))
  105.         lResult = lstrcpyn(VI.FileDescription, Pointer, ValueLen + 1)
  106.         VI.FileDescription = Left$(VI.FileDescription, InStr(VI.FileDescription, Chr$(0)) - 1)
  107.     End If
  108.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\CompanyName", Pointer, ValueLen)
  109.     If Result = 1 Then
  110.         VI.CompanyName = String$(ValueLen + 2, Chr$(0))
  111.         lResult = lstrcpyn(VI.CompanyName, Pointer, ValueLen + 1)
  112.         VI.CompanyName = Left$(VI.CompanyName, InStr(VI.CompanyName, Chr$(0)) - 1)
  113.     End If
  114.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\OriginalFileName", Pointer, ValueLen)
  115.     If Result = 1 Then
  116.         VI.OriginalFileName = String$(ValueLen + 2, Chr$(0))
  117.         lResult = lstrcpyn(VI.OriginalFileName, Pointer, ValueLen + 1)
  118.         VI.OriginalFileName = Left$(VI.OriginalFileName, InStr(VI.OriginalFileName, Chr$(0)) - 1)
  119.     End If
  120.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\InternalName", Pointer, ValueLen)
  121.     If Result = 1 Then
  122.         VI.InternalName = String$(ValueLen + 2, Chr$(0))
  123.         lResult = lstrcpyn(VI.InternalName, Pointer, ValueLen + 1)
  124.         VI.InternalName = Left$(VI.InternalName, InStr(VI.InternalName, Chr$(0)) - 1)
  125.     End If
  126.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\Comments", Pointer, ValueLen)
  127.     If Result = 1 Then
  128.         VI.Comments = String$(ValueLen + 2, Chr$(0))
  129.         lResult = lstrcpyn(VI.Comments, Pointer, ValueLen + 1)
  130.         VI.Comments = Left$(VI.Comments, InStr(VI.Comments, Chr$(0)) - 1)
  131.     End If
  132.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\LegalCopyright", Pointer, ValueLen)
  133.     If Result = 1 Then
  134.         VI.LegalCopyright = String$(ValueLen + 2, Chr$(0))
  135.         lResult = lstrcpyn(VI.LegalCopyright, Pointer, ValueLen)
  136.         VI.LegalCopyright = Left$(VI.LegalCopyright, InStr(VI.LegalCopyright, Chr$(0)) - 1)
  137.     End If
  138.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\LegalTrademarks", Pointer, ValueLen)
  139.     If Result = 1 Then
  140.         VI.LegalTrademarks = String$(ValueLen + 2, Chr$(0))
  141.         lResult = lstrcpyn(VI.LegalTrademarks, Pointer, ValueLen + 1)
  142.         VI.LegalTrademarks = Left$(VI.LegalTrademarks, InStr(VI.LegalTrademarks, Chr$(0)) - 1)
  143.     End If
  144.     
  145.     ' Retrieve Product information
  146.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\ProductName", Pointer, ValueLen)
  147.     If Result = 1 Then
  148.         VI.ProductName = String$(ValueLen + 2, Chr$(0))
  149.         lResult = lstrcpyn(VI.ProductName, Pointer, ValueLen + 1)
  150.         VI.ProductName = Left$(VI.ProductName, InStr(VI.ProductName, Chr$(0)) - 1)
  151.     End If
  152.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\ProductVersion", Pointer, ValueLen)
  153.     If Result = 1 Then
  154.         VI.ProductVersion = String$(ValueLen + 2, Chr$(0))
  155.         lResult = lstrcpyn(VI.ProductVersion, Pointer, ValueLen + 1)
  156.         VI.ProductVersion = Left$(VI.ProductVersion, InStr(VI.ProductVersion, Chr$(0)) - 1)
  157.     End If
  158.  
  159.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\SpecialBuild", Pointer, ValueLen)
  160.     If Result = 1 Then
  161.         VI.SpecialBuild = String$(ValueLen + 2, Chr$(0))
  162.         lResult = lstrcpyn(VI.SpecialBuild, Pointer, ValueLen + 1)
  163.         VI.SpecialBuild = Left$(VI.SpecialBuild, InStr(VI.SpecialBuild, Chr$(0)) - 1)
  164.     End If
  165.     Result = VerQueryValue(VerRes, "\StringFileInfo\" & Translation & "\PrivateBuild", Pointer, ValueLen)
  166.     If Result = 1 Then
  167.         VI.PrivateBuild = String$(ValueLen + 2, Chr$(0))
  168.         lResult = lstrcpyn(VI.PrivateBuild, Pointer, ValueLen + 1)
  169.         VI.PrivateBuild = Left$(VI.PrivateBuild, InStr(VI.PrivateBuild, Chr$(0)) - 1)
  170.     End If
  171.     
  172.     GetFileVersion = True
  173. End Function
  174.  
  175. Function ToHex (In As String) As String
  176.     Dim Out As String
  177.     Dim Temp As String
  178.  
  179.     If (Len(In) Mod 2) <> 0 Then In = "0" + In ' add leading 0 if needed
  180.  
  181.     Out = ""
  182.     For i = 1 To Len(In) Step 2
  183.         Temp = Hex$(Asc(Mid$(In, i + 1, 1))) ' Because of Intel's "Reversed-Byte" architecture
  184.         If Len(Temp) = 1 Then Out = Out + "0" ' handle second byte first
  185.         Out = Out + Temp
  186.  
  187.         Temp = Hex$(Asc(Mid$(In, i, 1)))  ' now handle first byte in word
  188.         If Len(Temp) = 1 Then Out = Out + "0" ' add leading zero if necessary
  189.         Out = Out + Temp
  190.     Next
  191.     ToHex = Out
  192. End Function
  193.  
  194.