PureBasic Forums - English

Code: Select all

;=====================================================================
;Test Version for reading out FileVersionInfo Block
;Special: Read out ALL Information that is contained in the InfoBlock
;not just the official values - all languages
;---------------------------------------------------------------------
;Date: March 17th 2007 - Beta Version - stillt needs to be tested.
;Author: Mike Doran
;Written in PB 4.02 / Windows XP Pro SP2
;=====================================================================


Procedure.s GetVersionInfo (File$, Getinfo$) 
    info$="" 
    If FileSize (File$) > 0 
        zero = 10 
        If OpenLibrary (1, "version.dll") 
            length = CallFunction (1, "GetFileVersionInfoSizeA", File$, @zero) 
            If length 
                *mem1 = AllocateMemory (length) 
                If *mem1 
                    result = CallFunction (1, "GetFileVersionInfoA", File$, 0, length, *mem1) 
                    If result
                    
                    	
                    	lpSubBlock$ = "\\VarFileInfo\\Translation" 
            					Result1      = CallFunction(1,"VerQueryValueA",*mem1,lpSubBlock$,@lplpBuffer,@puLen) 
            					If Result1 
              					CPLI$  = RSet(Hex(PeekW(lplpBuffer)),4,"0")+RSet(Hex(PeekW(lplpBuffer+2)),4,"0") 
              					;MessageRequester("Info",CPLI$,0)   ; LanguageCode ID
              					Result1 = CallFunction(1,"VerLanguageNameA",PeekW(lplpBuffer),@szLang$,nSize) 
            					EndIf 
                    
                    
                        infobuffer = 0 
                        infolen = 0 
                        ;Language must be specified in order to work: !!!
                        getinfo$ = "\\StringFileInfo\\"+CPLI$+"\\" + getinfo$ 
                        result = CallFunction (1, "VerQueryValueA", *mem1, getinfo$, @infobuffer, @infolen) 
                        If result 
                            info$ = PeekS(infobuffer) 
                        EndIf 
                    EndIf 
                    FreeMemory (*mem1) 
                EndIf 
            EndIf 
            CloseLibrary (1) 
        EndIf 
    EndIf  
ProcedureReturn info$ 
EndProcedure 




;-========= Select File =======================
SelectFile:
SelectFile$ = OpenFileRequester("Select File", "", "Exe (*.exe;*.dll)|*.exe;*.dll|", 0)
If SelectFile$
  FileName$ = SelectFile$
Else
  End  
EndIf  


;-===== Reading FileVesionInfo Block =======
ItemCount = 0 ;Needed for formating / to see how many strings were found in the search
InitFlag = 0
If FileSize(Filename$)>0 
    If OpenLibrary(1,"Version.dll") 
      dwLen = CallFunction(1,"GetFileVersionInfoSizeA",Filename$,@lpdwHandle) 
      ;SetGadgetText(#String_55,StrU(dwLen,#Word))
      If dwLen>0 ; Length of FileVersionInfoBlock must be greater than zero
        *pBlock=AllocateMemory(dwLen) ;Allocate buffer memory for FileVersionInfoBlock
        If *pBlock>0 
          Result = CallFunction(1,"GetFileVersionInfoA",Filename$,0,dwLen,*pBlock) 
          If Result ; if successful continue and start the search
          	Gesamt$ = ""
          	BCount = 0
          	;----- Begin Loop Length of VersionInfoBlock --------
          	For I = 0 To dwLen-1 
          		Byte.C = PeekC(*pBlock+I)
          		If Byte = 0
          		  
          			BCount +1
          			
          			If BCount >2  ;Two consecutive ZeroBytes = StringEnd ------------
          				          				
          				If Len(AddString$)>1
          					;----- End VersionInfoBlock ----
          					If AddString$ = "VarFileInfo" ; Detecting End of InfoBlock
          						Break
          					;---- Begin VersionInfoBlock ---- 
          					ElseIf AddString$ = "StringFileInfo" ; Detect Start of FileInfo
          						Gesamt$ = ""  ;Begin of FileVersionBlock
          						ItemCount = 0:InitFlag =1
          					Else
          					  Gesamt$+AddString$+Chr(10) ; Adding FoundString to Gesamt$
          					  If InitFlag
          					    ItemCount+1 ; Increase found string counter by 1 after new string found
          					    Even +1
          					    ;MessageRequester("ItemCount",Str(Itemcount)+" - "+Addstring$,0)
          					  EndIf  
          					EndIf
          					
          					AddString$ = "" ; resetting ADDString after its been added to Gesamt$
          					BCount = 0    ; Resetting ZeroByte Counter
          				Else
          					
          					AddString$ = "" ;Resetting AddString when length was smaller than 1
          					BCount = 0	  ; Resetting ZeroByte Counter
          				EndIf	
          			EndIf
          		ElseIf Byte <32 And Byte > 0 ;Allow only valid characters in AddString
          			AddString$ = ""; Resetting AddString after invalid Character found
          			BCount=0     ;Resetting ZeroByte Counter
          		Else
          		  AddString$ +Chr(Byte) ;Adding character to AddString
          			BCount = 0           ; Resetting ZeroByte counter
          		EndIf
          	Next I ;========Loop End ===================
         	
          EndIf	
        FreeMemory(*pBlock) ; Free allocated memory block
        EndIf
      EndIf 
    CloseLibrary(1)
    EndIf      	
EndIf


;-==== Formating Output-String - Showing Result in Total$ =========
Total$ = ""
For i = 2 To Itemcount ;Step 2
  Field$ = StringField(Gesamt$,I,Chr(10))
  If Field$
    Value$ = GetVersionInfo(FileName$, Field$)
    If Len(Value$) >0
      Add$ =Field$+": "+Value$
      If Not FindString(Total$,Add$,1)
        Total$+Field$+": "+Value$+Chr(10)
      EndIf
    EndIf  
  EndIf
Next i

MessageRequester("Info","Version Info:"+Chr(10)+"========"+Chr(10)+Total$,0)