PureBoard

Verfasst: **15.12.2009 06:18**

Na dann dürftest du mich für den folgenden Code eher vierteilen, weil ichs doch ohne Prototype gemacht habe, aber Hauptsache es läuft erstmal.

Code: Alles auswählen

; PB 4.40 compatible GetFileVersion Function, use the PB "version.lib".

Import "version.lib"
  CompilerIf #PB_Compiler_Unicode
    GetFileVersionInfo(lptstrFilename.s,dwHandle.l,dwLen.l,*lpData) As "_GetFileVersionInfoW"
    GetFileVersionInfoSize(lptstrFilename.s,*lpdwHandle) As "_GetFileVersionInfoSizeW"
    VerQueryValue(pBlock,lpSubBlock.s,lplpBuffer,puLen) As "_VerQueryValueW"
  CompilerElse
    GetFileVersionInfo(lptstrFilename.s,dwHandle.l,dwLen.l,*lpData) As "_GetFileVersionInfoA"
    GetFileVersionInfoSize(lptstrFilename.s,*lpdwHandle) As "_GetFileVersionInfoSizeA"
    VerQueryValue(pBlock,lpSubBlock.s,lplpBuffer,puLen) As "_VerQueryValueA"
  CompilerEndIf
EndImport  

Enumeration 
  #GFVI_FileVersion      = $0001 
  #GFVI_FileDescription  = $0002 
  #GFVI_LegalCopyright   = $0004 
  #GFVI_InternalName     = $0008 
  #GFVI_OriginalFilename = $0010 
  #GFVI_ProductName      = $0020 
  #GFVI_ProductVersion   = $0040 
  #GFVI_CompanyName      = $0080 
  #GFVI_LegalTrademarks  = $0100 
  #GFVI_SpecialBuild     = $0200 
  #GFVI_PrivateBuild     = $0400 
  #GFVI_Comments         = $0800 
  #GFVI_Language         = $1000 
  #GFVI_All              = $1FFF 
EndEnumeration

Procedure.s GetElementNameInternal(elementKey.l)
  If     elementKey = #GFVI_FileVersion      : ProcedureReturn "FileVersion" 
  ElseIf elementKey = #GFVI_FileDescription  : ProcedureReturn "FileDescription" 
  ElseIf elementKey = #GFVI_LegalCopyright   : ProcedureReturn "LegalCopyright" 
  ElseIf elementKey = #GFVI_InternalName     : ProcedureReturn "InternalName" 
  ElseIf elementKey = #GFVI_OriginalFilename : ProcedureReturn "OriginalFilename" 
  ElseIf elementKey = #GFVI_ProductName      : ProcedureReturn "ProductName" 
  ElseIf elementKey = #GFVI_ProductVersion   : ProcedureReturn "ProductVersion" 
  ElseIf elementKey = #GFVI_CompanyName      : ProcedureReturn "CompanyName" 
  ElseIf elementKey = #GFVI_LegalTrademarks  : ProcedureReturn "LegalTrademarks" 
  ElseIf elementKey = #GFVI_SpecialBuild     : ProcedureReturn "SpecialBuild" 
  ElseIf elementKey = #GFVI_PrivateBuild     : ProcedureReturn "PrivateBuild" 
  ElseIf elementKey = #GFVI_Comments         : ProcedureReturn "Comments" 
  ElseIf elementKey = #GFVI_Language         : ProcedureReturn "Language" 
  EndIf 
EndProcedure

Procedure.s GetFileVersion(lptstrFilename.s,Which,FieldName)
  Protected lpdwHandle.i, dwLen.w, lplpBuffer.i, puLen.l, *lpData, lpSubBlock.s 
  Protected cchLang.l, szLang.s, bBit.b, lekFlag.l, sElement.s, sGFVI.s, CPLI.s 
   
  cchLang = 128 : szLang.s = Space(cchLang)
  
  If FileSize(lptstrFilename) > 0
    dwLen = GetFileVersionInfoSize(lptstrFilename,@lpdwHandle)
    If dwLen > 0
      *lpData = AllocateMemory(dwLen)
      If *lpData > 0
        If GetFileVersionInfo(lptstrFilename,0,dwLen,*lpData)
          lpSubBlock.s = "\\VarFileInfo\\Translation"
          If VerQueryValue(*lpData,lpSubBlock,@lplpBuffer,@puLen)
            CPLI = RSet(Hex(PeekW(lplpBuffer)),4,"0")+RSet(Hex(PeekW(lplpBuffer+2)),4,"0")
            VerLanguageName_(Str(PeekW(lplpBuffer)),szLang,cchLang)
          EndIf
          lekFlag = 1 
          For bBit = 1 To 12 
            If lekFlag & Which 
              sElement   = GetElementNameInternal(lekFlag) 
              lpSubBlock = "\\StringFileInfo\\"+CPLI+"\\"+sElement
              If VerQueryValue(*lpData,lpSubBlock,@lplpBuffer,@puLen)
                If sGFVI<>"" : sGFVI+Chr(10) : EndIf 
                If FieldName 
                  sGFVI=sGFVI+sElement+":"+Chr(9)+PeekS(lplpBuffer) 
                Else 
                  sGFVI=sGFVI+PeekS(lplpBuffer) 
                EndIf
              EndIf 
            EndIf 
            lekFlag << 1 
          Next 
          If lekFlag & Which 
            If sGFVI<>"" : sGFVI+Chr(10) : EndIf 
            If FieldName 
              sElement = GetElementNameInternal(lekFlag) 
              sGFVI    = sGFVI+sElement+":"+Chr(9)+szLang 
            Else 
              sGFVI    = sGFVI+szLang
            EndIf 
          EndIf 
        EndIf
        FreeMemory(*lpData)
      EndIf
    EndIf
  EndIf
  ProcedureReturn sGFVI
EndProcedure

Wäre nett wenn mal Jemand drüber gucken könnte ob ich irgendwo irgendwas etwas falsch gecodet habe, auch wenn der Code so funktioniert wie er aktuell ist.

PureBoard

Erweiterte Dateiinfos auslesen

Re: Erweiterte Dateiinfos auslesen