Mega Code Archive

 
Categories / Delphi / Files
 

Etrieve version information for a specified file

Title: etrieve version information for a specified file? uses ShellApi; type TFileVersionInfo = record FileType, CompanyName, FileDescription, FileVersion, InternalName, LegalCopyRight, LegalTradeMarks, OriginalFileName, ProductName, ProductVersion, Comments, SpecialBuildStr, PrivateBuildStr, FileFunction: string; DebugBuild, PreRelease, SpecialBuild, PrivateBuild, Patched, InfoInferred: Boolean; end; function FileVersionInfo(const sAppNamePath: TFileName): TFileVersionInfo; var rSHFI: TSHFileInfo; iRet: Integer; VerSize: Integer; VerBuf: PChar; VerBufValue: Pointer; VerHandle: Cardinal; VerBufLen: Cardinal; VerKey: string; FixedFileInfo: PVSFixedFileInfo; // dwFileType, dwFileSubtype function GetFileSubType(FixedFileInfo: PVSFixedFileInfo): string; begin case FixedFileInfo.dwFileType of VFT_UNKNOWN: Result := 'Unknown'; VFT_APP: Result := 'Application'; VFT_DLL: Result := 'DLL'; VFT_STATIC_LIB: Result := 'Static-link Library'; VFT_DRV: case FixedFileInfo.dwFileSubtype of VFT2_UNKNOWN: Result := 'Unknown Driver'; VFT2_DRV_COMM: Result := 'Communications Driver'; VFT2_DRV_PRINTER: Result := 'Printer Driver'; VFT2_DRV_KEYBOARD: Result := 'Keyboard Driver'; VFT2_DRV_LANGUAGE: Result := 'Language Driver'; VFT2_DRV_DISPLAY: Result := 'Display Driver'; VFT2_DRV_MOUSE: Result := 'Mouse Driver'; VFT2_DRV_NETWORK: Result := 'Network Driver'; VFT2_DRV_SYSTEM: Result := 'System Driver'; VFT2_DRV_INSTALLABLE: Result := 'InstallableDriver'; VFT2_DRV_SOUND: Result := 'Sound Driver'; end; VFT_FONT: case FixedFileInfo.dwFileSubtype of VFT2_UNKNOWN: Result := 'Unknown Font'; VFT2_FONT_RASTER: Result := 'Raster Font'; VFT2_FONT_VECTOR: Result := 'Vector Font'; VFT2_FONT_TRUETYPE: Result := 'Truetype Font'; else; end; VFT_VXD: Result := 'Virtual Defice Identifier = ' + IntToHex(FixedFileInfo.dwFileSubtype, 8); end; end; function HasdwFileFlags(FixedFileInfo: PVSFixedFileInfo; Flag: Word): Boolean; begin Result := (FixedFileInfo.dwFileFlagsMask and FixedFileInfo.dwFileFlags and Flag) = Flag; end; function GetFixedFileInfo: PVSFixedFileInfo; begin if not VerQueryValue(VerBuf, '', Pointer(Result), VerBufLen) then Result := nil end; function GetInfo(const aKey: string): string; begin Result := ''; VerKey := Format('\StringFileInfo\%.4x%.4x\%s', [LoWord(Integer(VerBufValue^)), HiWord(Integer(VerBufValue^)), aKey]); if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, VerBufLen) then Result := StrPas(VerBufValue); end; function QueryValue(const aValue: string): string; begin Result := ''; // obtain version information about the specified file if GetFileVersionInfo(PChar(sAppNamePath), VerHandle, VerSize, VerBuf) and // return selected version information VerQueryValue(VerBuf, '\VarFileInfo\Translation', VerBufValue, VerBufLen) then Result := GetInfo(aValue); end; begin // Initialize the Result with Result do begin FileType := ''; CompanyName := ''; FileDescription := ''; FileVersion := ''; InternalName := ''; LegalCopyRight := ''; LegalTradeMarks := ''; OriginalFileName := ''; ProductName := ''; ProductVersion := ''; Comments := ''; SpecialBuildStr := ''; PrivateBuildStr := ''; FileFunction := ''; DebugBuild := False; Patched := False; PreRelease := False; SpecialBuild := False; PrivateBuild := False; InfoInferred := False; end; // Get the file type if SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI), SHGFI_TYPENAME) 0 then begin Result.FileType := rSHFI.szTypeName; end; iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI), SHGFI_EXETYPE); if iRet 0 then begin // determine whether the OS can obtain version information VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle); if VerSize 0 then begin VerBuf := AllocMem(VerSize); try with Result do begin CompanyName := QueryValue('CompanyName'); FileDescription := QueryValue('FileDescription'); FileVersion := QueryValue('FileVersion'); InternalName := QueryValue('InternalName'); LegalCopyRight := QueryValue('LegalCopyRight'); LegalTradeMarks := QueryValue('LegalTradeMarks'); OriginalFileName := QueryValue('OriginalFileName'); ProductName := QueryValue('ProductName'); ProductVersion := QueryValue('ProductVersion'); Comments := QueryValue('Comments'); SpecialBuildStr := QueryValue('SpecialBuild'); PrivateBuildStr := QueryValue('PrivateBuild'); // Fill the VS_FIXEDFILEINFO structure FixedFileInfo := GetFixedFileInfo; DebugBuild := HasdwFileFlags(FixedFileInfo, VS_FF_DEBUG); PreRelease := HasdwFileFlags(FixedFileInfo, VS_FF_PRERELEASE); PrivateBuild := HasdwFileFlags(FixedFileInfo, VS_FF_PRIVATEBUILD); SpecialBuild := HasdwFileFlags(FixedFileInfo, VS_FF_SPECIALBUILD); Patched := HasdwFileFlags(FixedFileInfo, VS_FF_PATCHED); InfoInferred := HasdwFileFlags(FixedFileInfo, VS_FF_INFOINFERRED); FileFunction := GetFileSubType(FixedFileInfo); end; finally FreeMem(VerBuf, VerSize); end end; end end; // Test it: procedure TForm1.Button1Click(Sender: TObject); var FvI: TFileVersionInfo; const Tabulator: array[0..0] of Integer = (70); BoolValues: array[Boolean] of string = ('No', 'Yes'); begin FvI := FileVersionInfo('C:\FileName.exe'); ListBox1.TabWidth := 1; SendMessage(ListBox1.Handle, LB_SETTABSTOPS, 1, Longint(@Tabulator)); with FvI, ListBox1.Items do begin Add('FileType:'#9 + FileType); Add('CompanyName:'#9 + CompanyName); Add('FileDescription:'#9 + FileDescription); // siehe Eigenschaftsdialog des Explorers Add('FileVersion:'#9 + FileVersion); Add('InternalName:'#9 + InternalName); Add('LegalCopyRight:'#9 + LegalCopyRight); Add('LegalTradeMarks:'#9 + LegalTradeMarks); Add('OriginalFileName:'#9 + OriginalFileName); Add('ProductName:'#9 + ProductName); Add('ProductVersion:'#9 + ProductVersion); Add('SpecialBuildStr:'#9 + SpecialBuildStr); Add('PrivateBuildStr:'#9 + PrivateBuildStr); Add('FileFunction:'#9 + FileFunction); Add('DebugBuild:'#9 + BoolValues[DebugBuild]); Add('PreRelease:'#9 + BoolValues[PreRelease]); Add('PrivateBuild:'#9 + BoolValues[PrivateBuild]); Add('SpecialBuild:'#9 + BoolValues[SpecialBuild]); end; end;