1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127:
| Function GetFileInfo (aFilename: String; Var aInfo: tFileInfo): Boolean; Const cBuildValues : Array [tFileInfoBuild] Of Word = ( VS_FF_DEBUG, VS_FF_PRERELEASE, VS_FF_PATCHED, VS_FF_PRIVATEBUILD, VS_FF_INFOINFERRED, VS_FF_SPECIALBUILD );
cSpecificAspectValues : Array [tFileInfoSpecificAspect] Of String = ( 'CompanyName', 'FileDescription', 'FileVersion', 'InternalName', 'LegalCopyright', 'LegalTrademarks', 'OriginalFilename', 'PrivateBuild', 'ProductName', 'ProductVersion', 'SpecialBuild', 'Comments' );
cTypeValues : Array [tFileInfoType] Of Word = ( VFT_UNKNOWN, VFT_APP, VFT_DLL, VFT_DRV, VFT_FONT, VFT_VXD, VFT_STATIC_LIB );
cTypeDriverValues : Array [tFileInfoTypeDriver] Of Word = ( VFT2_UNKNOWN, VFT2_DRV_COMM, VFT2_DRV_PRINTER, VFT2_DRV_KEYBOARD, VFT2_DRV_LANGUAGE, VFT2_DRV_DISPLAY, VFT2_DRV_MOUSE, VFT2_DRV_NETWORK, VFT2_DRV_SYSTEM, VFT2_DRV_INSTALLABLE, VFT2_DRV_SOUND );
cTypeFontValues : Array [tFileInfoTypeFont] Of Word = ( VFT2_UNKNOWN, VFT2_FONT_RASTER, VFT2_FONT_VECTOR, VFT2_FONT_TRUETYPE ); Var VersionInfoSize, VersionInfoValueSize, Zero: DWord; VersionInfo, VersionInfoValue: Pointer;
BuildLoop: tFileInfoBuild; TypeLoop: tFileInfoType; TypeDriverLoop: tFileInfoTypeDriver; TypeFontLoop: tFileInfoTypeFont; SpecificAspectLoop: tFileInfoSpecificAspect; LangId: String; Begin Result := False;
if FileExists (aFilename) then Begin VersionInfoSize := GetFileVersionInfoSize (PChar (aFilename), Zero);
if VersionInfoSize = 0 then Exit;
GetMem (VersionInfo, VersionInfoSize); Try If GetFileVersionInfo (PChar (aFilename), 0, VersionInfoSize, VersionInfo) and (0 <> LongInt (VersionInfoValueSize)) Then Begin
If VerQueryValue (VersionInfo, '\', VersionInfoValue, VersionInfoValueSize) Then with TVSFixedFileInfo (VersionInfoValue^) Do Begin With aInfo.Version do Begin Major := HiWord (dwFileVersionMS); Minor := LoWord (dwFileVersionMS); Release := HiWord (dwFileVersionLS); Build := LoWord (dwFileVersionLS); End;
aInfo.Builds := []; For BuildLoop := Low (BuildLoop) To High (BuildLoop) Do If (dwFileFlagsMask and dwFileFlags and cBuildValues [BuildLoop]) <> 0 Then Include (aInfo.Builds, BuildLoop);
For TypeLoop := Low (TypeLoop) To High (TypeLoop) Do If cTypeValues [TypeLoop] = dwFileType Then Begin aInfo.FileType := TypeLoop; Break; End;
Case aInfo.FileType of fitDeviceDriver: For TypeDriverLoop := Low (TypeDriverLoop) To High (TypeDriverLoop) Do If cTypeDriverValues [TypeDriverLoop] = dwFileSubtype Then Begin aInfo.TypeDriver := TypeDriverLoop; Break; End; fitFont: For TypeFontLoop := Low (TypeFontLoop) To High (TypeFontLoop) Do If cTypeFontValues [TypeFontLoop] = dwFileSubtype Then Begin aInfo.TypeFont := TypeFontLoop; Break; End; End; End;
If VerQueryValue (VersionInfo, '\VarFileInfo\Translation', VersionInfoValue, VersionInfoValueSize) Then Begin LangId := IntToHex (LoWord (PLongInt (VersionInfoValue)^), 4) + IntToHex (HiWord (PLongInt (VersionInfoValue)^), 4);
For SpecificAspectLoop := Low (SpecificAspectLoop) To High (SpecificAspectLoop) Do If VerQueryValue ( VersionInfo, PChar ( '\StringFileInfo\' + LangId + '\' + cSpecificAspectValues [SpecificAspectLoop] ), VersionInfoValue, VersionInfoValueSize ) Then aInfo.SpecificAspect [SpecificAspectLoop] := pChar (VersionInfoValue); End;
Result := True; End; Finally FreeMem (VersionInfo); End; End; End; |