Code: Alles auswählen
EnableExplicit
DeclareModule FileInfo
EnableExplicit
Declare.s GetFixedProductVersion(File.s)
Declare.s GetFixedFileVersion(File.s)
Declare.s GetFixedFileType(File.s)
Declare.s GetProductVersion(File.s)
Declare.s GetFileVersion(File.s)
Declare.s GetProductName(File.s)
Declare.s GetFileDescription(File.s)
Declare.s GetFileComments(File.s)
Declare.s GetFileCompanyName(File.s)
Declare.s GetFileInternalName(File.s)
Declare.s GetFileLegalCopyright(File.s)
Declare.s GetFileLegalTrademarks(File.s)
Declare.s GetFileOriginalFilename(File.s)
EndDeclareModule
Module FileInfo
Procedure.s GetFixedProductVersion(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer.VS_FIXEDFILEINFO
Protected.s RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\",@*Pointer,@PointerLen)
If *Pointer
RetVal = Str(*Pointer\dwProductVersionMS >> 16 & $FFFF) + "." +
Str(*Pointer\dwProductVersionMS & $FFFF) + "." +
Str(*Pointer\dwProductVersionLS >> 16 & $FFFF) + "." +
Str(*Pointer\dwProductVersionLS & $FFFF)
EndIf
FreeMemory(*Buffer)
ProcedureReturn RetVal
EndProcedure
Procedure.s GetFixedFileVersion(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer.VS_FIXEDFILEINFO
Protected.s RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\",@*Pointer,@PointerLen)
If *Pointer
RetVal = Str(*Pointer\dwFileVersionMS >> 16 & $FFFF) + "." +
Str(*Pointer\dwFileVersionMS & $FFFF) + "." +
Str(*Pointer\dwFileVersionLS >> 16 & $FFFF) + "." +
Str(*Pointer\dwFileVersionLS & $FFFF)
EndIf
FreeMemory(*Buffer)
ProcedureReturn RetVal
EndProcedure
Procedure.s GetFixedFileType(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer.VS_FIXEDFILEINFO
Protected.s RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\",@*Pointer,@PointerLen)
If *Pointer
Select *Pointer\dwFileType
Case #VFT_APP
RetVal = "Application"
Case #VFT_DLL
RetVal = "DLL"
Case #VFT_DRV
Select *Pointer\dwFileSubtype
Case #VFT2_DRV_COMM
RetVal = "Communications Driver"
Case #VFT2_DRV_DISPLAY
RetVal = "Display Driver"
Case #VFT2_DRV_INSTALLABLE
RetVal = "Installable Driver"
Case #VFT2_DRV_KEYBOARD
RetVal = "Keyboard Driver"
Case #VFT2_DRV_LANGUAGE
RetVal = "Language Driver"
Case #VFT2_DRV_MOUSE
RetVal = "Mouse Driver"
Case #VFT2_DRV_NETWORK
RetVal = "Network Driver"
Case #VFT2_DRV_PRINTER
RetVal = "Printer Driver"
Case #VFT2_DRV_SOUND
RetVal = "Sound Driver"
Case #VFT2_DRV_SYSTEM
RetVal = "System Driver"
;Case #VFT2_DRV_VERSIONED_PRINTER
; RetVal = "Versioned Printer Driver"
Case #VFT2_UNKNOWN
RetVal = "Unkown by the system"
EndSelect
Case #VFT_FONT
Select *Pointer\dwFileSubtype
Case #VFT2_FONT_RASTER
RetVal = "Raster Font"
Case #VFT2_FONT_TRUETYPE
RetVal = "TrueType Font"
Case #VFT2_FONT_VECTOR
RetVal = "Vector Font"
Case #VFT2_UNKNOWN
RetVal = "Unkown by the system"
EndSelect
Case #VFT_STATIC_LIB
RetVal = "Static-link Library"
Case #VFT_UNKNOWN
RetVal = "Unkown by the system"
Case #VFT_VXD
RetVal = "Virtual Device"
EndSelect
EndIf
FreeMemory(*Buffer)
ProcedureReturn RetVal
EndProcedure
Procedure.s GetProductVersion(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\ProductVersion",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\ProductVersion",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
Procedure.s GetFileVersion(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\FileVersion",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\FileVersion",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
Procedure.s GetProductName(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\ProductName",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\ProductName",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
Procedure.s GetFileDescription(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\FileDescription",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\FileDescription",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
Procedure.s GetFileComments(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\Comments",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\Comments",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
Procedure.s GetFileCompanyName(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\CompanyName",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\CompanyName",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
Procedure.s GetFileInternalName(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\InternalName",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\InternalName",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
Procedure.s GetFileLegalCopyright(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\LegalCopyright",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\LegalCopyright",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
Procedure.s GetFileLegalTrademarks(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\LegalTrademarks",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\LegalTrademarks",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
Procedure.s GetFileOriginalFilename(File.s)
Protected.i NeededBufferSize, PointerLen
Protected *Buffer, *Pointer
Protected.s TranslationCode, RetVal
NeededBufferSize = GetFileVersionInfoSize_(@File,0)
If NeededBufferSize < 1: ProcedureReturn "": EndIf
*Buffer = AllocateMemory(NeededBufferSize)
GetFileVersionInfo_(@File,0,NeededBufferSize,*Buffer)
VerQueryValue_(*Buffer,"\\VarFileInfo\\Translation",@*Pointer,@PointerLen)
If *Pointer
TranslationCode = RSet(Hex(PeekW(*Pointer)),4,"0") + RSet(Hex(PeekW(*Pointer + 2)),4,"0")
If VerQueryValue_(*Buffer,"\\StringFileInfo\\" + TranslationCode + "\\OriginalFilename",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
Else
; Manche Programme haben einen falschen TranslationCode, zu dem es kein Informationen-Block gibt.
; Ich habe die Erfahrung gemacht, dass in diesem Fall immer ein Block mit diesem TranslationCode vorhanden ist:
If VerQueryValue_(*Buffer,"\\StringFileInfo\\040904E4\\OriginalFilename",@*Pointer,@PointerLen)
RetVal = Trim(PeekS(*Pointer))
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
ProcedureReturn Trim(RetVal)
EndProcedure
EndModule
Define File.s = "notepad.exe"
Debug "FileComments: " + FileInfo::GetFileComments(File)
Debug "FileCompanyName: " + FileInfo::GetFileCompanyName(File)
Debug "FileDescription: " + FileInfo::GetFileDescription(File)
Debug "FileInternalName: " + FileInfo::GetFileInternalName(File)
Debug "FileLegalCopyright: " + FileInfo::GetFileLegalCopyright(File)
Debug "FileLegalTrademarks: " + FileInfo::GetFileLegalTrademarks(File)
Debug "FileOriginalFilename: " + FileInfo::GetFileOriginalFilename(File)
Debug "FileVersion: " + FileInfo::GetFileVersion(File)
Debug "FixedFileType: " + FileInfo::GetFixedFileType(File)
Debug "FixedFileVersion: " + FileInfo::GetFixedFileVersion(File)
Debug "FixedProductVersion: " + FileInfo::GetFixedProductVersion(File)
Debug "ProductName: " + FileInfo::GetProductName(File)
Debug "ProductVersion: " + FileInfo::GetProductVersion(File)
