delphi获取进程版本信息

发布于:2024-04-30 ⋅ 阅读:(23) ⋅ 点赞:(0)

结构体声明

type
  TFileInfo = packed record
    CommpanyName: widestring;
    FileDescription: widestring;
    FileVersion: widestring;
    InternalName: widestring;
    LegalCopyright: widestring;
    LegalTrademarks: widestring;
    OriginalFileName: widestring;
    ProductName: widestring;
    ProductVersion: widestring;
    Comments: widestring;
    VsFixedFileInfo: VS_FIXEDFILEINFO;
    UserDefineValue: widestring;
  end;

功能函数 

function GetFileVersionInfomation(const FileName: string; var info: TFileInfo; UserDefine: string = ''): boolean;
const
  SFInfo = '\StringFileInfo\';
var
  VersionInfo: PChar;
  InfoSize: DWORD;
  InfoPointer: Pointer;
  Translation: Pointer;
  VersionValue: widestring;
  unused: DWORD;
begin
  try
    unused := 0;
    Result := False;
    InfoSize := GetFileVersionInfoSizeW(pwidechar(FileName), unused);
    if InfoSize > 0 then
    begin
      try
        VersionInfo := AllocMem(InfoSize);
        Result := GetFileVersionInfoW(pwidechar(FileName), 0, InfoSize, VersionInfo);
        if Result then
        begin
          VerQueryValueW(VersionInfo, '\VarFileInfo\Translation', Translation, InfoSize);
          if Translation <> nil then
            VersionValue := SFInfo + IntToHex(LoWord(Longint(Translation^)), 4) + IntToHex(HiWord(Longint(Translation^)), 4) + '\';

          VerQueryValueW(VersionInfo, pwidechar(VersionValue + 'CompanyName'), InfoPointer, InfoSize);
          info.CommpanyName := string(pwidechar(InfoPointer));

          VerQueryValueW(VersionInfo, pwidechar(VersionValue + 'FileDescription'), InfoPointer, InfoSize);
          info.FileDescription := string(pwidechar(InfoPointer));

          VerQueryValueW(VersionInfo, pwidechar(VersionValue + 'FileVersion'), InfoPointer, InfoSize);
          info.FileVersion := string(pwidechar(InfoPointer));

          VerQueryValueW(VersionInfo, pwidechar(VersionValue + 'InternalName'), InfoPointer, InfoSize);
          info.InternalName := string(pwidechar(InfoPointer));
          if info.InternalName = info.FileVersion then
            info.InternalName := 'UnKnown';

          VerQueryValueW(VersionInfo, pwidechar(VersionValue + 'LegalCopyright'), InfoPointer, InfoSize);
          info.LegalCopyright := string(pwidechar(InfoPointer));

          VerQueryValueW(VersionInfo, pwidechar(VersionValue + 'LegalTrademarks'), InfoPointer, InfoSize);
          info.LegalTrademarks := string(pwidechar(InfoPointer));
          if info.LegalTrademarks = info.LegalCopyright then
            info.LegalTrademarks := 'UnKnown';

          VerQueryValueW(VersionInfo, pwidechar(VersionValue + 'ProductName'), InfoPointer, InfoSize);
          info.ProductName := string(pwidechar(InfoPointer));

          VerQueryValueW(VersionInfo, pwidechar(VersionValue + 'ProductVersion'), InfoPointer, InfoSize);
          info.ProductVersion := string(pwidechar(InfoPointer));

          VerQueryValueW(VersionInfo, pwidechar(VersionValue + 'Comments'), InfoPointer, InfoSize);
          info.Comments := string(pwidechar(InfoPointer));
          if info.Comments = info.ProductVersion then
            info.Comments := 'UnKnown';

        end;
      finally
        FreeMemory(VersionInfo);
      end;
    end;
  except
    Result := False;
  end;
end;
function GetFileVersion(FileName: string; index: integer): string;
var
  Info: TFileInfo;
begin
  Result := '';
  try
    if GetFileVersionInfomation(FileName, Info, 'WOW Version') then
    begin
      case index of
        0:
          Result := Info.Comments;
        1:
          Result := Info.CommpanyName;
        2:
          Result := Info.FileDescription;
        3:
          Result := Info.FileVersion;
        4:
          Result := Info.InternalName;
        5:
          Result := Info.LegalCopyright;
        6:
          Result := Info.LegalTrademarks;
        7:
          Result := Info.OriginalFileName;
        8:
          Result := Info.ProductName;
        9:
          Result := Info.ProductVersion;
        10:
          Result := Info.UserDefineValue;
      end;
    end
    else
    begin
      Result := 'Unknown';
    end;
  except
    Result := 'Unknown';
  end;
end;

调用此函数传入参数获取对应信息,其中filename是进程文件的路径