PureBasic Forums - English

Code: Select all

;///////////////////////////////////////////////////////////////////
;
; Demo:             Windows API File Version Info
; Author:           Lloyd Gallant (netmaestro)
; Date:             May 06, 2010
; Target Compiler:  PureBasic 4.20 and later
; Target OS:        Microsoft Windows All (x86)
; License:          Free, no restrictions, no warranty whatsoever
;
;//////////////////////////////////////////////////////////////////

Macro MyVersion()
	FileGetVersion(ProgramFilename(), "FileVersion")
EndMacro

CompilerIf #PB_Compiler_Unicode
	Import "version.lib"
	  GetFileVersionInfoSize( *lptstrFilename, *lpdwHandle ) As "GetFileVersionInfoSizeW"
	  GetFileVersionInfo( *lptstrFilename, dwHandle, dwLen, *lpData) As "GetFileVersionInfoW"
	  VerQueryValue( *pBlock, *lpSubBlock, *lplpBuffer, *puLen) As "VerQueryValueW"
	EndImport
CompilerElse ; ascii
	Import "version.lib"
	  GetFileVersionInfoSize( *lptstrFilename, *lpdwHandle ) As "GetFileVersionInfoSizeA"
	  GetFileVersionInfo( *lptstrFilename, dwHandle, dwLen, *lpData) As "GetFileVersionInfoA"
	  VerQueryValue( *pBlock, *lpSubBlock, *lplpBuffer, *puLen) As "VerQueryValueA"
	EndImport
CompilerEndIf
Structure LANGANDCODEPAGE 
  wLanguage.w
  wCodePage.w
EndStructure

Global cFileGetVersionReturn.s
ProcedureDLL.s FileGetVersion( filename$,cGetWhat$ = "FileVersion" )
	Protected.i handle,i,j
	Protected *lpData, *lplpBuffer, puLen, *stringbuffer, Bytes
	Protected cReturn.s = ""
	Protected infosize = GetFileVersionInfoSize( @filename$, @handle)
	Protected *readptr.LANGANDCODEPAGE
	Protected langandcodepage$, SubBlock$
	
	Dim Stringname$(12)
	
	Restore FileVersionElementsByName
	For i=1 To 12
	  Read$ Stringname$(i)
	Next
		If infosize
		  *lpData = AllocateMemory(infosize)
		  If GetFileVersionInfo( @filename$, 0, infosize, *lpdata)
		    If VerQueryValue( *lpdata, @"\VarFileInfo\Translation", @*lplpBuffer, @puLen)
		      *readptr = *lplpBuffer
		      For i=0 To puLen/SizeOf(LANGANDCODEPAGE) - 1
		        langandcodepage$ = RSet(Hex(*readptr\wLanguage),4,"0") + RSet(Hex(*readptr\wCodePage), 4, "0")
		        For j=1 To 12
		          SubBlock$ ="\\StringFileInfo\\" + langandcodepage$ + "\\" + Stringname$(j)
		          If VerQueryValue( *lpdata, @SubBlock$, @*stringbuffer, @Bytes) And Bytes
		          	Debug Stringname$(j)+": "+PeekS(*stringbuffer, Bytes)
		          	If LCase(Stringname$(j)) = LCase(cGetWhat$)
		          		cReturn = PeekS(*stringbuffer, Bytes)
		          		Break 
		          	EndIf
		          EndIf
		        Next
		        *readptr + SizeOf(LANGANDCODEPAGE)
		      Next
		    EndIf
		  Else
		    OutputDebugString_( "No version information available (A): "+filename$)
		  EndIf
		  FreeMemory(*lpData)
		Else
			OutputDebugString_( "No version information available (B): "+ filename$)
		EndIf
		cFileGetVersionReturn=cReturn
		
		ProcedureReturn cFileGetVersionReturn
EndProcedure

DataSection 
  FileVersionElementsByName:
  Data.s "Comments",        "InternalName",     "ProductName"
  Data.s "CompanyName",     "LegalCopyright",   "ProductVersion"
  Data.s "FileDescription", "LegalTrademarks",  "PrivateBuild"
  Data.s "FileVersion",     "OriginalFilename", "SpecialBuild"
EndDataSection

;Pattern$ = "Executables (*.exe)|*.exe;|Dynamic Link Library (*.dll)|*.dll;|All files (*.*)|*.*"
;Filename$ = OpenFileRequester("Please choose file to load", "", Pattern$, 0)

;Debug "HERE: "+FileGetVersion( filename$ )

ProcedureDLL  CompareVersions( cVersion1.s, cVersion2.s )
  Protected nResults=-2, bTemp=#True
  Protected Dim Version1(4)
  Protected Dim Version2(4)
  Protected x
  For x = 1 To 4
    Version1(x-1) = Val( StringField(cVersion1,x,".") )
    Version2(x-1) = Val( StringField(cVersion2,x,".") )
    ;     bTemp = bTemp And ( Version1(x-1) = Version2(x-1) )
  Next
  If #False And bTemp
    nResults = 0
  Else
    nResults = 0
    For x = 1 To 4
      
      If Version1(x-1)>version2(x-1)
        nResults = 1
        Break;
      ElseIf Version1(x-1)<version2(x-1)
        nResults = -1
        Break;
      EndIf
    Next
  EndIf
  ProcedureReturn nResults
EndProcedure

Macro CompareFileVersions( cFile1,cFile2)
	CompareVersions( FileGetVersion(cFile1), FileGetVersion(cFile2))
EndMacro