PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

PB 4.4 Datei kommentare auslesen

https://www.purebasic.fr/german/viewtopic.php?t=21705

Seite 1 von 1

PB 4.4 Datei kommentare auslesen

Verfasst: 22.01.2010 09:36
von manibaerchen
Hallo Zusammen,

hab ein kleines Problem, hatte vor Urzeiten hier mal
ein Script erhalten mit welchen ich die Kommentare
einer Datei auslesen kann. Nur leider ist das für PB 3.9.

Ich bekomme das irgendwie nicht unter PB 4.4 zum laufen.

DANKE für jede Hilfe

Mani


Code: Alles auswählen

Enumeration;- element name keys
  #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 GFVI_GetElementName(elementKey.l);- get element name from key [gfvi]
  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 GFVI_GetInfo(lptstrFilename$,lekFlags,bFieldName);- get exe/dll file information [gfvi]
  Protected lpdwHandle.l, dwLen.w, lpData.l, lplpBuffer.l, puLen.l, *pBlock, lpSubBlock$
  Protected nSize.w, szLang$, bBit.b, lekFlag.l, sElement$, sGFVI$

  lplpBuffer = 0 : puLen = 0 : sGFVI$ = "" : nSize = 128 : szLang$ = Space(nSize)

  If FileSize(lptstrFilename$)>0
    If OpenLibrary(1,"Version.dll")
      dwLen = CallFunction(1,"GetFileVersionInfoSizeA",lptstrFilename$,@lpdwHandle)
      If dwLen>0
        *pBlock=AllocateMemory(dwLen)
        If *pBlock>0
          Result = CallFunction(1,"GetFileVersionInfoA",lptstrFilename$,0,dwLen,*pBlock)
          If Result
            lpSubBlock$ = "\\VarFileInfo\\Translation"
            Result      = CallFunction(1,"VerQueryValueA",*pBlock,lpSubBlock$,@lplpBuffer,@puLen)
            If Result
              CPLI$  = RSet(Hex(PeekW(lplpBuffer)),4,"0")+RSet(Hex(PeekW(lplpBuffer+2)),4,"0")
              Result = CallFunction(1,"VerLanguageNameA",PeekW(lplpBuffer),@szLang$,nSize)
            EndIf
            lekFlag = 1
            For bBit = 1 To 12
              If lekFlag & lekFlags
                sElement$   = GFVI_GetElementName(lekFlag)
                lpSubBlock$ = "\\StringFileInfo\\"+CPLI$+"\\"+sElement$
                Result      = CallFunction(1,"VerQueryValueA",*pBlock,lpSubBlock$,@lplpBuffer,@puLen)
                If Result
                  If sGFVI$<>"" : sGFVI$+Chr(10) : EndIf
                  If bFieldName
                    sGFVI$=sGFVI$+sElement$+":"+Chr(9)+PeekS(lplpBuffer)
                  Else
                    sGFVI$=sGFVI$+PeekS(lplpBuffer)
                  EndIf
                 
                EndIf
              EndIf
              lekFlag << 1
            Next
            If lekFlag & lekFlags
              If sGFVI$<>"" : sGFVI$+Chr(10) : EndIf
              If bFieldName
                sElement$ = GFVI_GetElementName(lekFlag)
                sGFVI$    = sGFVI$+sElement$+":"+Chr(9)+szLang$
              Else
                sGFVI$    = sGFVI$+szLang$
              EndIf
            EndIf
          EndIf
          FreeMemory(*pBlock)
        EndIf
      EndIf
      CloseLibrary(1)
    EndIf
  EndIf
  ProcedureReturn sGFVI$
EndProcedure

;- test GFVI-functions

File$  = OpenFileRequester("Open File", "gfvi.exe", "GFVI |*.exe;*.dll|all files (*.*)|*.*", 0)
VInfo$ = GFVI_GetInfo(File$,#GFVI_CompanyName,1)
MessageRequester("Fileinfo for "+GetFilePart(File$),VInfo$,#MB_OK|#MB_ICONINFORMATION)
VInfo$ = GFVI_GetInfo(File$,#GFVI_All,#True)
MessageRequester("Fileinfo for "+GetFilePart(File$),VInfo$,#MB_OK|#MB_ICONINFORMATION)

End

Re: PB 4.4 Datei kommentare auslesen

Verfasst: 22.01.2010 12:10
von c4s
Eine genauere Problembeschreibung für diejenigen die helfen wollen wäre auch nicht schlecht - "geht nicht" ist da etwas dürftig.

Habe jetzt (trotzdem) mal deinen Code getestet und bin zu dem Entschluss gekommen, dass du einfach bei jedem angemeckerten Parameter-Typ ein "@" davor setzen musst.

Re: PB 4.4 Datei kommentare auslesen

Verfasst: 22.01.2010 13:31
von manibaerchen
Oh Mann, seh den Wald vor lauter Bäumen nicht mehr !!!
DANKE hat einwandfrei funktioniert !!

:)

Danke

Mani

Re: PB 4.4 Datei kommentare auslesen

Verfasst: 22.01.2010 14:55
von ts-soft
Der Tipp von C4S ist lediglich ein WorkAround und nicht zu empfehlen, da CallFunction eine veraltete Funktion ist.
Ich hab den Code mal angepaßt, so das kein CallFunction erforderlich ist, desweiteren läuft es jetzt auch unter
Unicode sowie 64-Bit.

Code: Alles auswählen

EnableExplicit

Import "kernel32.lib"
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
  VerLanguageName(wLang.i, szLang.p-unicode, cchLang.i) As "VerLanguageNameW"
  CompilerElse
  VerLanguageName(wLang.i, szLang.p-unicode, cchLang.i) As "_VerLanguageNameW@12"
  CompilerEndIf
EndImport

Import "version.lib"
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
  GetFileVersionInfoSize(strFileName.p-unicode, dwHandle.i) As "GetFileVersionInfoSizeW"
  GetFileVersionInfo(strFileName.p-unicode, dwHandle.i, dwLen.i, *lpData) As "GetFileVersionInfoW"
  VerFindFile(dwFlags.i, szFileName.p-unicode, szWinDir.p-unicode, szAppDir.p-unicode, szCurDir.p-unicode, uCurDirLen.i, szDestDir.p-unicode, uDestDirLen.i) As "VerFindFileW"
  VerInstallFile(uFlags.i, szSrcFileName.p-unicode, szSrcDir.p-unicode, szDestDir.p-unicode, szCurDir.p-unicode, szTmpFile.p-unicode, uTmpFileLen.i) As "VerInstallFileW"
  VerQueryValue(pBlock.i, SubBlock.p-unicode, *lpBuffer, puLen.i) As "VerQueryValueW"
  CompilerElse
  GetFileVersionInfoSize(strFileName.p-unicode, dwHandle.i) As "_GetFileVersionInfoSizeW"
  GetFileVersionInfo(strFileName.p-unicode, dwHandle.i, dwLen.i, *lpData) As "_GetFileVersionInfoW"
  VerFindFile(dwFlags.i, szFileName.p-unicode, szWinDir.p-unicode, szAppDir.p-unicode, szCurDir.p-unicode, uCurDirLen.i, szDestDir.p-unicode, uDestDirLen.i) As "_VerFindFileW"
  VerInstallFile(uFlags.i, szSrcFileName.p-unicode, szSrcDir.p-unicode, szDestDir.p-unicode, szCurDir.p-unicode, szTmpFile.p-unicode, uTmpFileLen.i) As "_VerInstallFileW"
  VerQueryValue(pBlock.i, SubBlock.p-unicode, *lpBuffer, puLen.i) As "_VerQueryValueW"
  CompilerEndIf
EndImport


Enumeration;- element name keys
  #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 GFVI_GetElementName(elementKey.i);- get element name from key [gfvi]
  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 GFVI_GetInfo(lptstrFilename$, lekFlags, bFieldName);- get exe/dll file information [gfvi]
  Protected lpdwHandle.i, dwLen.w, lpData.i, lplpBuffer.i, puLen.i, *pBlock, lpSubBlock$
  Protected nSize.w, szLang$, bBit.b, lekFlag.i, sElement$, sGFVI$, Result.i, CPLI$

  lplpBuffer = 0 : puLen = 0 : sGFVI$ = "" : nSize = 128 : szLang$ = Space(nSize)

  If FileSize(lptstrFilename$)  > 0
    dwLen = GetFileVersionInfoSize(lptstrFilename$, @lpdwHandle)
    If dwLen > 0
      *pBlock = AllocateMemory(dwLen)
      If *pBlock > 0
        Result = GetFileVersionInfo(lptstrFilename$, 0, dwLen, *pBlock)
        If Result
          lpSubBlock$ = "\\VarFileInfo\\Translation"
          Result      = VerQueryValue(*pBlock, lpSubBlock$, @lplpBuffer, @puLen)
          If Result
            CPLI$  = RSet(Hex(PeekU(lplpBuffer)), 4, "0") + RSet(Hex(PeekU(lplpBuffer + 2)), 4, "0")
            Result = VerLanguageName(PeekU(lplpBuffer), szLang$, nSize)
          EndIf
          lekFlag = 1
          For bBit = 1 To 12
            If lekFlag & lekFlags
              sElement$   = GFVI_GetElementName(lekFlag)
              lpSubBlock$ = "\\StringFileInfo\\" + CPLI$ + "\\" + sElement$
              Result      = VerQueryValue(*pBlock, lpSubBlock$, @lplpBuffer, @puLen)
              If Result
                If sGFVI$ <> "" : sGFVI$ + Chr(10) : EndIf
                If bFieldName
                  sGFVI$ = sGFVI$ + sElement$ + ":" + Chr(9)  + PeekS(lplpBuffer, -1, #PB_Unicode)
                Else
                  sGFVI$ = sGFVI$ + PeekS(lplpBuffer, -1, #PB_Unicode)
                EndIf

              EndIf
            EndIf
            lekFlag << 1
          Next
          If lekFlag & lekFlags
            If sGFVI$ <> "" : sGFVI$ + Chr(10) : EndIf
            If bFieldName
              sElement$ = GFVI_GetElementName(lekFlag)
              sGFVI$    = sGFVI$ + sElement$ + ":" + Chr(9) + szLang$
            Else
              sGFVI$    = sGFVI$ + szLang$
            EndIf
          EndIf
        EndIf
        FreeMemory(*pBlock)
      EndIf
    EndIf
  EndIf
  ProcedureReturn sGFVI$
EndProcedure

DisableExplicit
;- test GFVI-functions

File$  = OpenFileRequester("Open File", "gfvi.exe", "GFVI |*.exe;*.dll|all files (*.*)|*.*", 0)
VInfo$ = GFVI_GetInfo(File$, #GFVI_CompanyName, 1)
MessageRequester("Fileinfo for " + GetFilePart(File$), VInfo$, #MB_OK | #MB_ICONINFORMATION)
VInfo$ = GFVI_GetInfo(File$, #GFVI_All, #True)
MessageRequester("Fileinfo for " + GetFilePart(File$), VInfo$, #MB_OK | #MB_ICONINFORMATION)

End
Gruß
Thomas
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de