如何获取文档的作者？这个问题真的很难吗？？斑竹请回答

[lonaerd]

如何获取文档的作者？这个问题真的很难吗？？上次已经问过，就是没有人知道，斑竹请回答

[lonaerd]

谢谢海天子，从哪弄的这个类？

是哪个函数获取作者呀？

[railgunman]

up

[lonaerd]

procedure TForm1.Button3Click(Sender: TObject);
var
str1:string;
tfileinfo: TFileInformation;
begin
tfileinfo:=FileInformation.TFileInformation.Create('E:\MyDocument\方案.doc');
str1:= tfileinfo.CompanyName ;
showmessage(str1);
end;

不行呀，这个文档明明有公司名的，为什么取不出来？得到的结果为空

[hiflower]

要看是什么类型的文档了，调用该文档应用程序对象的函数

[huojiehai]

给我分吧穷死了
unit FileInformation;

interface

uses windows,classes,sysutils;

Type TFileInfo = record
ID : DWORD;
CNName : string;
ENName : string;
end;

Type
TFileInformation = class(TObject)
private
FFileName : string;
lpData : PChar;
FResult : boolean;
FLangID : WORD;
FLangSubID : WORD;
FFixFileInfo : PVSFixedFileInfo;
FHasVer : boolean;
protected
LanguageCode : string;
Procedure GetLanguageCode;
function Indexof(ftype : DWORD; TypeSet : array of TFileInfo) : integer;
function HasVersionInfo : boolean;
public
constructor Create(FileName : string);
destructor Destroy; override;
function LanguageName : string;
function CompanyName : string;
function FileVersion : string;
function ProductVersion : string;
function ProductName : string;
function InternalName : string;
function OriginalFileName : string;
function LegalCopyright : string;
function LegalTrademarks : string;
function FileDescription : string;
function Comments : string;
function PrivateBuild : string;
function SpecialBuild : string;
function FileType(IsChinese : boolean=True) : string;
function FileOSType(IsChinese : boolean=True) : string;
end;

implementation

const
CFileOS : array[1..9] of TFileInfo =
((ID: VOS_DOS; CNName: 'MS-DOS程序'; ENName: 'designed for MS-DOS'),
(ID: VOS_NT; CNName: 'Windows NT/Windows 2000程序'; ENName: 'designed for Windows NT/Windows 2000'),
(ID: VOS__WINDOWS16; CNName: '16-bit Windows程序'; ENName: 'designed for 16-bit Windows'),
(ID: VOS__WINDOWS32; CNName: '32-bit Windows程序'; ENName: 'designed for 32-bit Windows API'),
(ID: VOS_OS216; CNName: '16-bit OS/2程序'; ENName: 'designed for 16-bit OS/2'),
(ID: VOS_OS232; CNName: '32-bit OS/2程序'; ENName: 'designed for 32-bit OS/2'),
(ID: VOS__PM16; CNName: '16-bit OS/2 Presentation Manager'; ENName: 'designed for 16-bit Presentation Manager'),
(ID: VOS_OS232; CNName: '32-bit OS/2 Presentation Manager'; ENName: 'designed for 32-bit Presentation Manager'),
(ID: VOS_UNKNOWN; CNName: '未知平台程序'; ENName: 'designed for unknown Operation system'));

CFileType : array[1..7] of TFileInfo =
((ID: VFT_UNKNOWN; CNName: '未知类型文件'; ENName: 'unknown file type'),
(ID: VFT_APP; CNName: '应用程序'; ENName: 'an application'),
(ID: VFT_DLL; CNName: '动态链接库(DLL)';ENName: 'dynamic-link library (DLL)'),
(ID: VFT_DRV; CNName: '设备驱动文件'; ENName: 'a device driver'),
(ID: VFT_FONT; CNName: '字库文件'; ENName: 'a font'),
(ID: VFT_VXD; CNName: '虚拟设备文件'; ENName: 'a virtual device'),
(ID: VFT_STATIC_LIB;CNName: '静态链接库(LIB)';ENName: 'a static-link library'));

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;

[huojiehai]

// 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;

end.

[lonaerd]

TO 海天子：

我知道了，我上面的调用方法是对的，关键是大部分OFFICE文档、图片文件都没有版本信息，只用一些应用程序才有；
而这个类创建的前提是要获得文件的版本才可以，但是OFFICE文件都没有版本信息，也就是上面的方法还是不可用啊！

[lonaerd]

TO 海天子：

能不能再帮我一把？为什么我调用里面的构造函数运行到函数里面的
VerLeng := GetFileVersionInfoSize(PChar(FFileName),tempHD);
获得的VerLeng 总是为0 ？