如何获得可执行文件的公司名,或相关属性

[fsybaby]

如何获得 外部可执行文件(只提供文件名) 的公司名,或相关属性
有没有相关的函数?

[王集鹄]

type
TFileVersionInfomation = record
rCommpanyName: string;
rFileDescription: string;
rFileVersion: string;
rInternalName: string;
rLegalCopyright: string;
rLegalTrademarks: string;
rOriginalFileName: string;
rProductName: string;
rProductVersion: string;
rComments: string;
rVsFixedFileInfo: VS_FIXEDFILEINFO;
rDefineValue: string;
end;

function GetFileVersionInfomation(mFileName: TFileName;
var nFileVersionInfomation: TFileVersionInfomation;
mDefineName: string = ''): Boolean;
var
vHandle: Cardinal;
vInfoSize: Cardinal;
vVersionInfo: Pointer;
vTranslation: Pointer;
vVersionValue: string;
vInfoPointer: Pointer;
begin
Result := False;
vInfoSize := GetFileVersionInfoSize(PChar(mFileName), vHandle);
FillChar(nFileVersionInfomation, SizeOf(nFileVersionInfomation), 0);
if vInfoSize <= 0 then Exit;
GetMem(vVersionInfo, vInfoSize);
with nFileVersionInfomation do try
if not GetFileVersionInfo(PChar(mFileName),
vHandle, vInfoSize, vVersionInfo) then Exit;
VerQueryValue(vVersionInfo, '\VarFileInfo\Translation',
vTranslation, vInfoSize);
vVersionValue := Format('\StringFileInfo\%.4x%.4x\',
[LOWORD(Longint(vTranslation^)), HIWORD(Longint(vTranslation^))]);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'CompanyName'),
vInfoPointer, vInfoSize);
rCommpanyName := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'FileDescription'),
vInfoPointer, vInfoSize);
rFileDescription := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'FileVersion'),
vInfoPointer, vInfoSize);
rFileVersion := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'InternalName'),
vInfoPointer, vInfoSize);
rInternalName := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'LegalCopyright'),
vInfoPointer, vInfoSize);
rLegalCopyright := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'LegalTrademarks'),
vInfoPointer, vInfoSize);
rLegalTrademarks := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'OriginalFileName'),
vInfoPointer, vInfoSize);
rOriginalFileName := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'ProductName'),
vInfoPointer, vInfoSize);
rProductName := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'ProductVersion'),
vInfoPointer, vInfoSize);
rProductVersion := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, PChar(vVersionValue + 'Comments'),
vInfoPointer, vInfoSize);
rComments := PChar(vInfoPointer);
VerQueryValue(vVersionInfo, '\', vInfoPointer, vInfoSize);
rVsFixedFileInfo := TVSFixedFileInfo(vInfoPointer^);
if mDefineName <> '' then begin
VerQueryValue(vVersionInfo, PChar(vVersionValue + mDefineName),
vInfoPointer, vInfoSize);
rDefineValue := PChar(vInfoPointer);
end else rDefineValue := '';
finally
FreeMem(vVersionInfo, vInfoSize);
end;
Result := True;
end; { GetFileVersionInfomation }

[DieGhost]

楼上真详细啊

[leeshine]

zswang(伴水清清)(专家门诊清洁工) 的代码,收藏!

[fsybaby]

谢谢,试验中,先不着急给分

[fly0612]

顶！

[ly_liuyang]

呵呵，你用了第三方的，称为ABC的组件，那就什么代码都不用了，用组件搞定

API的方法，就是上问所言的

http://lysoft.7u7.net

[Kshape]

获取文件信息
type
TFileInfo = packed record
CommpanyName: string;
FileDescription: string;
FileVersion: string;
InternalName: string;
LegalCopyright: string;
LegalTrademarks: string;
OriginalFileName: string;
ProductName: string;
ProductVersion: string;
Comments: string;
VsFixedFileInfo:VS_FIXEDFILEINFO;
UserDefineValue:string;
end;

function GetFileVersionInfomation(const FileName: string; var info: TFileInfo;UserDefine:string=''):
boolean;
const
SFInfo= '\StringFileInfo\';
var
VersionInfo: Pointer;
InfoSize: DWORD;
InfoPointer: Pointer;
Translation: Pointer;
VersionValue: string;
unused: DWORD;
begin
unused := 0;
Result := False;
InfoSize := GetFileVersionInfoSize(pchar(FileName), unused);
if InfoSize > 0 then
begin
GetMem(VersionInfo, InfoSize);
Result := GetFileVersionInfo(pchar(FileName), 0, InfoSize, VersionInfo);
if Result then
begin
VerQueryValue(VersionInfo, '\VarFileInfo\Translation', Translation, InfoSize);
VersionValue := SFInfo + IntToHex(LoWord(Longint(Translation^)), 4) +
IntToHex(HiWord(Longint(Translation^)), 4) + '\';
VerQueryValue(VersionInfo, pchar(VersionValue + 'CompanyName'), InfoPointer, InfoSize);
info.CommpanyName := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'FileDescription'), InfoPointer, InfoSize);
info.FileDescription := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'FileVersion'), InfoPointer, InfoSize);
info.FileVersion := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'InternalName'), InfoPointer, InfoSize);
info.InternalName := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'LegalCopyright'), InfoPointer, InfoSize);
info.LegalCopyright := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'LegalTrademarks'), InfoPointer, InfoSize);
info.LegalTrademarks := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'OriginalFileName'), InfoPointer, InfoSize);
info.OriginalFileName := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'ProductName'), InfoPointer, InfoSize);
info.ProductName := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'ProductVersion'), InfoPointer, InfoSize);
info.ProductVersion := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'Comments'), InfoPointer, InfoSize);
info.Comments := string(pchar(InfoPointer));
if VerQueryValue(VersionInfo, '\', InfoPointer, InfoSize) then
info.VsFixedFileInfo := TVSFixedFileInfo(InfoPointer^);
if UserDefine<>'' then
begin
if VerQueryValue(VersionInfo,pchar(VersionValue+UserDefine),InfoPointer,InfoSize) then
info.UserDefineValue:=string(pchar(InfoPointer));
end;
end;
FreeMem(VersionInfo);
end;
end;

调用演示：

procedure TForm1.Button1Click(Sender: TObject);
var
info: TFileInfo;
begin
if OpenDialog1.Execute then
begin
if GetFileVersionInfomation(opendialog1.FileName, info,'WOW Version') then
begin
Listbox1.Items.Add(OpenDialog1.FileName);
ListBox1.Items.Add('Comments:' + info.Comments);
ListBox1.Items.Add('CommpanyName:' + info.CommpanyName);
ListBox1.Items.Add('FileDescription:' + info.FileDescription);
ListBox1.Items.Add('FileVersion:' + info.FileVersion);
ListBox1.Items.Add('InternalName:' + info.InternalName);
ListBox1.Items.Add('LegalCopyright:' + info.LegalCopyright);
ListBox1.Items.Add('LegalTrademarks:' + info.LegalTrademarks);
ListBox1.Items.Add('OriginalFileName:' + info.OriginalFileName);
ListBox1.Items.Add('ProductName:' + info.ProductName);
ListBox1.Items.Add('ProductVersion:' + info.ProductVersion);
ListBox1.Items.Add('UserDefineValue:' + info.UserDefineValue);
if boolean(info.VsFixedFileInfo.dwFileFlags and vs_FF_Debug) then
listbox1.Items.Add('Debug:True')
else
ListBox1.Items.Add('Debug:False');
ListBox1.Items.Add('');
end;
end;
end;
*******************