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

Question

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

Answer 1

给我分吧穷死了
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 LegalTrades : 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;implementationconst
  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;

Answer 2

// 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 trades
function TFileInformation.LegalTrades: string;
var
  lpBuf : PChar;
  VerLeng : cardinal;
begin
  if FResult and FHasVer then
    if VerQueryValue(lpData,PChar('\StringFileInfo\'+LanguageCode+'\LegalTrades\'),
                     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.

Answer 3

procedure TForm1.Button3Click(Sender: TObject);
var
str1:string;
tfileinfo: TFileInformation;
begin
tfileinfo:=FileInformation.TFileInformation.Create('E:\MyDocument\方案.doc');
str1:= tfileinfo.CompanyName  ;
showmessage(str1);
end;不行呀，这个文档明明有公司名的，为什么取不出来？得到的结果为空

Answer 4

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

Answer 5

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