How to retrieve the version stamp of a file (Views: 713)
Problem/Question/Abstract: How do you retrieve the version stamp of a file? I'm getting real tired of setting versions in the Delphi Project | Options dialog box and then defining a (redundant) constant for use in my Help | About boxes ! Answer: Solve 1: procedure TfrmSplash.GetBuildInfo(var v1, v2, v3, v4: Word); var VerInfoSize: DWord; VerInfo: Pointer; VerValueSize: DWord; VerValue: PVSFixedFileInfo; Dummy: DWord; begin VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName), dummy); GetMem(VerInfo, VerInfoSize); GetFileVersionInfo(PChar(Application.ExeName), 0, VerInfoSize, VerInfo); VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize); with VerValue^ do begin v1 := dwFileVersionMS shr 16; v2 := dwFileVersionMS and $FFFF; v3 := dwFileVersionLS shr 16; v4 := dwFileVersionLS and $FFFF; end; FreeMem(VerInfo, VerInfoSize); end; function TfrmSplash.GetBuildInfoString: string; var v1, v2, v3, v4: Word; begin GetBuildInfo(v1, v2, v3, v4); Result := Format('%d.%d.%d (Build %d)', [v1, v2, v3, v4]); end; Solve 2: This function should do it. uses Windows, SysUtils, { ... }; function GetFileVersion(const Filename: string): string; var VerInfSize, Sz: Cardinal; VerInfo: Pointer; FxFileInfo: PVSFixedFileInfo; function MSLSToString(MS, LS: DWORD): string; begin Result := Format('%d.%d.%d.%d', [MS shr 16, MS and $FFFF, LS shr 16, LS and $FFFF]); end; begin Result := ''; if FileExists(Filename) then begin VerInfSize := GetFileVersionInfoSize(PCHAR(Filename), Sz); if VerInfSize > 0 then begin VerInfo := Allocmem(VerInfSize); try GetFileVersionInfo(PCHAR(Filename), 0, VerInfSize, VerInfo); VerQueryValue(VerInfo, '\\', POINTER(FxFileInfo), Sz); if Sz > 0 then Result := MSLSToString(FxFileInfo^.dwFileVersionMS, FxFileInfo^.dwFileVersionLS); finally FreeMem(VerInfo); end; end; end; end; Solve 3: type TFileVersionInfo = record fCompanyName, fFileDescription, fFileVersion, fInternalName, fLegalCopyRight, fLegalTradeMark, fOriginalFileName, fProductName, fProductVersion, fComments: string; end; var FileVersionInfo: TFileVersionInfo procedure GetAllFileVersionInfo(FileName: string); { proc to get all version info from a file. } var Buf: PChar; fInfoSize: DWord; procedure InitVersion; var FileNamePtr: PChar; begin with FileVersionInfo do begin FileNamePtr := PChar(FileName); fInfoSize := GetFileVersionInfoSize(FileNamePtr, fInfoSize); if fInfoSize > 0 then begin ReAllocMem(Buf, fInfoSize); GetFileVersionInfo(FileNamePtr, 0, fInfoSize, Buf); end; end; end; function GetVersion(What: string): string; var tmpVersion: string; Len: Dword; Value: PChar; begin Result := 'Not defined'; if fInfoSize > 0 then begin SetLength(tmpVersion, 200); Value := @tmpVersion; { If you are not using an English OS, then replace the language and codepage identifier with the correct one. English (U.S.) is 0409 (language) and 04E4 (codepage). See CodePage Identifiers and Language Identifiers in the Win32 help file for info. } if VerQueryValue(Buf, PChar('StringFileInfo\040904E4\' + What), Pointer(Value), Len) then Result := Value; end; end; begin Buf := nil; with FileVersionInfo do begin InitVersion; fCompanyName := GetVersion('CompanyName'); fFileDescription := GetVersion('FileDescription'); fFileVersion := GetVersion('FileVersion'); fInternalName := GetVersion('InternalName'); fLegalCopyRight := GetVersion('LegalCopyRight'); fLegalTradeMark := GetVersion('LegalTradeMark'); fOriginalFileName := GetVersion('OriginalFileName'); fProductName := GetVersion('ProductName'); fProductVersion := GetVersion('ProductVersion'); fComments := GetVersion('Comments'); end; if Buf <> nil then FreeMem(Buf); end; To use it just call it like GetAllFileVersionInfo(ParamStr(0)); Solve 4: Call GetVersionDetails and specify the filename. { ... } type pTransArrar = ^TTransArrar; TTransArrar = record wLanugageID: Word; wCharacterSet: Word; end; function DecodeTranslationInfo(Buffer: TTransArrar): string; begin Result := IntToHex(Buffer.wLanugageID, 4) + IntToHex(Buffer.wCharacterSet, 4); end; function GetVersionDetails(Filename: string; const LookupString: string = 'FileVersion'): string; var ID: DWord; iStructSize: DWord; p: PChar; pbuf: Pointer; plen: DWord; ResponseString: string; begin {get the size of the fileinfo structure} iStructSize := GetFileVersionInfoSize(PChar(Filename), ID); {allocate memory to hold file info data structure} p := stralloc(iStructSize); {retrieve file version details} ResponseString := ''; if GetFileVersionInfo(PChar(Filename), 0, istructSize, p) then begin if VerQueryValue(p, pchar('\VarFileInfo\Translation'), pbuf, plen) then begin if VerQueryValue(p, pchar('\StringFileInfo\' + DecodeTranslationInfo(pTransArrar(pbuf)^) + '\' + LookupString), pbuf, plen) then ResponseString := PChar(pbuf); end; end; strdispose(p); Result := ResponseString; end; Solve 5: This functions returns the version as a string. function GetFileVersion(FileName: string): string; var ResourceSize: Integer; ResourceBuffer: PChar; GetData: Boolean; Ignore: THandle; InfoPtr: Pointer; VerSize: Cardinal; FileInfo: VS_FIXEDFILEINFO; Major, Minor, Rleas, Build, Hex: string; begin ResourceSize := GetFileVersionInfoSize(PChar(FileName), Ignore); if ResourceSize > 0 then begin {You need to allocate the ResourceBuffer before you can fillchar it} GetMem(ResourceBuffer, ResourceSize); GetData := GetFileVersionInfo(PChar(FileName), Ignore, ResourceSize, ResourceBuffer); if GetData then begin GetData := VerQueryValue(ResourceBuffer, '\', InfoPtr, VerSize); if GetData then begin Move(InfoPtr^, FileInfo, sizeof(VS_FIXEDFILEINFO)); Hex := IntToHex(FileInfo.dwFileVersionMS, 8) + IntToHex(FileInfo.dwFileVersionLS, 8); Major := '$' + Copy(Hex, 1, 4); Minor := '$' + Copy(Hex, 5, 4); Rleas := '$' + Copy(Hex, 9, 4); Build := '$' + Copy(Hex, 13, 4); Result := IntToStr(StrToInt(Major)) + '.' + IntToStr(StrToInt(Minor)) + '.' + IntToStr(StrToInt(Rleas)) + '.' + IntToStr(StrToInt(Build)); end else begin Result := ''; end; end else begin Result := ''; end; {need this because you allocated it up above} FreeMem(ResourceBuffer); end else begin Result := ''; end; end; |