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