// get file version
function TFileInformation.FileVersion: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\FileVersion\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;
// get product version
function TFileInformation.ProductVersion: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\ProductVersion\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;
// get product name
function TFileInformation.ProductName: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\ProductName\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;
// get internal name
function TFileInformation.InternalName: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\InternalName\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;
// get original file name
function TFileInformation.OriginalFileName: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\OriginalFileName\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;
// get legal copyright
function TFileInformation.LegalCopyright: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\LegalCopyright\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;
// get legal trademarks
function TFileInformation.LegalTrademarks: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\LegalTrademarks\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;
// get file description
function TFileInformation.FileDescription: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\FileDescription\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;
// get comments
function TFileInformation.Comments: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\Comments\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;
// get file private build
function TFileInformation.PrivateBuild: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if FFixFileInfo.dwFileFlags = VS_FF_PRIVATEBUILD then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\PrivateBuild\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf
else
result := '';
end;
// get file special build
function TFileInformation.SpecialBuild: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if FFixFileInfo.dwFileFlags = VS_FF_SPECIALBUILD then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\PrivateBuild\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf
else
result := '';
end;
// get file type
function TFileInformation.FileType(IsChinese : boolean) : string;
var
IndexType : integer;
IndexSubType : integer;
begin
if FResult then
begin
IndexType := Indexof(FFixFileInfo.dwFileType,CFileType);
if IndexType > 0 then
if FFixFileInfo.dwFileType = VFT_DRV then
begin
IndexSubType := Indexof(FFixFileInfo.dwFileSubtype,CFileDriverType);
if IndexSubType > 0 then
if IsChinese then
result := CFileDriverType[IndexSubType].CNName
else
result := CFileDriverType[IndexSubType].ENName
else
if IsChinese then
result := CFileType[IndexType].CNName
else
result := CFileType[IndexType].ENName
end
else if FFixFileInfo.dwFileType = VFT_FONT then
begin
IndexSubType := Indexof(FFixFileInfo.dwFileSubtype,CFileFontType);
if IndexSubType > 0 then
if IsChinese then
result := CFileFontType[IndexSubType].CNName
else
result := CFileFontType[IndexSubType].ENName
else
if IsChinese then
result := CFileType[IndexType].CNName
else
result := CFileType[IndexType].ENName
end
else
if IsChinese then
result := CFileType[IndexType].CNName
else
result := CFileType[IndexType].ENName
end
else
result := '';
end;
// get file operation system
function TFileInformation.FileOSType(IsChinese : boolean) : string;
var
Index : integer;
begin
if FResult then
begin
Index := Indexof(FFixFileInfo.dwFileOS,CFileOS);
if Index > 0 then
if IsChinese then
result := CFileOS[Index].CNName
else
result := CFileOS[Index].ENName
else
result := '';
end;
end;
// get the index of file type
function TFileInformation.Indexof(ftype : DWORD; TypeSet : array of TFileInfo) : integer;
var
i : integer;
begin
result := -1;
for i:=Low(TypeSet) to High(TypeSet) do
if ftype = TypeSet[i].ID then
begin
result := i+1;
exit;
end;
end;
// decide whether the file has version information
function TFileInformation.HasVersionInfo : boolean;
var
ftype : DWORD;
begin
ftype := FFixFileInfo.dwFileType;
if (ftype = VFT_APP) or (ftype = VFT_DLL) or (ftype = VFT_VXD)
or (ftype = VFT_STATIC_LIB) then
result := True
else
result := False;
end;
CFileDriverType : array[1..11] of TFileInfo =
((ID: VFT2_UNKNOWN; CNName: '未知类型文件'; ENName: 'unknown driver type'),
(ID: VFT2_DRV_COMM; CNName: '通讯驱动文件'; ENName: 'a communications driver'),
(ID: VFT2_DRV_PRINTER; CNName: '打印驱动文件'; ENName: 'a printer driver'),
(ID: VFT2_DRV_KEYBOARD;CNName: '键盘驱动文件'; ENName: 'a keyboard driver'),
(ID: VFT2_DRV_LANGUAGE;CNName: '语言驱动文件'; ENName: 'a language driver'),
(ID: VFT2_DRV_DISPLAY; CNName: '显示驱动文件'; ENName: 'a display driver'),
(ID: VFT2_DRV_MOUSE; CNName: '鼠标驱动文件'; ENName: 'a mouse driver'),
(ID: VFT2_DRV_NETWORK; CNName: '网络驱动文件'; ENName: 'a network driver'),
(ID: VFT2_DRV_SYSTEM; CNName: '系统驱动文件'; ENName: 'a system driver'),
(ID: VFT2_DRV_INSTALLABLE; CNName: '安装驱动文件'; ENName: 'a installable driver'),
(ID: VFT2_DRV_SOUND; CNName: '声音驱动文件'; ENName: 'a sound driver'));
CFileFontType : array[1..4] of TFileInfo =
((ID: VFT2_UNKNOWN; CNName: '未知字库文件'; ENName: 'unknown font type'),
(ID: VFT2_FONT_RASTER; CNName: '光栅字库文件'; ENName: 'a raster font'),
(ID: VFT2_FONT_VECTOR; CNName: '矢量字库文件'; ENName: 'a vector font'),
(ID: VFT2_FONT_TRUETYPE;CNName: 'TRUETYPE字库文件'; ENName: 'a TrueType font'));
{ TFileVersion }
// construct TFileVersion Class
constructor TFileInformation.Create(FileName : string);
var
tempHD : cardinal;
VerLeng : DWORD;
CurLeng : cardinal;
begin
FResult := False;
FFileName := FileName;
VerLeng := GetFileVersionInfoSize(PChar(FFileName),tempHD);
if VerLeng <> 0 then
begin
GetMem(lpData,VerLeng);
if GetFileVersionInfo(PChar(FFileName),0,VerLeng,lpData) then
begin
FResult := True;
VerQueryValue(lpData,'\',Pointer(FFixFileInfo),CurLeng);
FHasVer := HasVersionInfo;
GetLanguageCode;
end;
end;
end;
// destruct TFileInformation Class
destructor TFileInformation.Destroy;
begin
inherited;
if FResult then FreeMem(lpData);
end;
// get language code
procedure TFileInformation.GetLanguageCode;
var
lpBuf : pLongInt;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,'\VarFileInfo\Translation',Pointer(lpBuf),Verleng) then
begin
FLangID := LoWord(lpBuf^);
FLangSubID := HiWord(lpBuf^);
LanguageCode := IntToHex(FLangID,4)+IntToHex(FLangSubID,4);
end;
end;
// get language name
function TFileInformation.LanguageName: string;
var
Lang : TLanguages;
begin
if FResult then
begin
Lang := TLanguages.Create;
result := Lang.Name[Lang.Indexof(FLangID)];
Lang.Free;
end;
end;
// get company name
function TFileInformation.CompanyName: string;
var
lpBuf : PChar;
VerLeng : cardinal;
begin
if FResult and FHasVer then
if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\CompanyName\'),
Pointer(lpBuf),VerLeng) then
result := lpBuf;
end;