Текущий архив: 2006.02.12;
Скачать: CL | DM;

Вниз

-= Версия файла =-   Найти похожие ветки 

← →
WST   (2006-01-23 20:41) [0]

Есть кусок кода извлекающий версию файла, производителя и т.д. Но он у меня работает только с exe, а dll  например не хочет использовать, может чего не так, исправте, плз!!!


uses
 Windows, SysUtils, Classes, ShellApi;

type
 TFileVersionInfo = record
   FileType,
   CompanyName,
   FileDescription,
   FileVersion,
   InternalName,
   LegalCopyRight,
   LegalTradeMarks,
   OriginalFileName,
   ProductName,
   ProductVersion,
   Comments,
   SpecialBuildStr,
   PrivateBuildStr,
   FileFunction : string;
   DebugBuild,
   PreRelease,
   SpecialBuild,
   PrivateBuild,
   Patched,
   InfoInferred : Boolean;
 end;

{$R *.res}

function FileVersionInfo(const sAppNamePath: TFileName): TFileVersionInfo;
var
 rSHFI: TSHFileInfo;
 iRet: Integer;
 VerSize: Integer;
 VerBuf: PChar;
 VerBufValue: Pointer;
 VerHandle: Cardinal;
 VerBufLen: Cardinal;
 VerKey: string;
 FixedFileInfo: PVSFixedFileInfo;

 //================================================================
 function GetFileSubType(FixedFileInfo: PVSFixedFileInfo) : string;
 begin
   case FixedFileInfo.dwFileType of

     VFT_UNKNOWN: Result := "Unknown";
     VFT_APP: Result := "Application";
     VFT_DLL: Result := "DLL";
     VFT_STATIC_LIB: Result := "Static-link Library";

     VFT_DRV:
       case
         FixedFileInfo.dwFileSubtype of
         VFT2_UNKNOWN: Result := "Unknown Driver";
         VFT2_DRV_COMM: Result := "Communications Driver";
         VFT2_DRV_PRINTER: Result := "Printer Driver";
         VFT2_DRV_KEYBOARD: Result := "Keyboard Driver";
         VFT2_DRV_LANGUAGE: Result := "Language Driver";
         VFT2_DRV_DISPLAY: Result := "Display Driver";
         VFT2_DRV_MOUSE: Result := "Mouse Driver";
         VFT2_DRV_NETWORK: Result := "Network Driver";
         VFT2_DRV_SYSTEM: Result := "System Driver";
         VFT2_DRV_INSTALLABLE: Result := "InstallableDriver";
         VFT2_DRV_SOUND: Result := "Sound Driver";
       end;
     VFT_FONT:
        case FixedFileInfo.dwFileSubtype of
         VFT2_UNKNOWN: Result := "Unknown Font";
         VFT2_FONT_RASTER: Result := "Raster Font";
         VFT2_FONT_VECTOR: Result := "Vector Font";
         VFT2_FONT_TRUETYPE: Result :="Truetype Font";
         else;
       end;
     VFT_VXD: Result :="Virtual Defice Identifier = " +
         IntToHex(FixedFileInfo.dwFileSubtype, 8);
   end;
 end;
 //======================================================
 function HasdwFileFlags(FixedFileInfo: PVSFixedFileInfo;
 Flag : Word) : Boolean;
 begin
   Result := (FixedFileInfo.dwFileFlagsMask and
             FixedFileInfo.dwFileFlags and
             Flag) = Flag;
 end;
 //======================================================
 function GetFixedFileInfo: PVSFixedFileInfo;
 begin
   if not VerQueryValue(VerBuf, "", Pointer(Result), VerBufLen) then
     Result := nil
 end;
 //======================================================
 function GetInfo(const aKey: string): string;
 begin
   Result := "";
   VerKey := Format("\StringFileInfo\%.4x%.4x\%s",
             [LoWord(Integer(VerBufValue^)),
              HiWord(Integer(VerBufValue^)), aKey]);
   if VerQueryValue(VerBuf, PChar(VerKey),VerBufValue,VerBufLen) then
     Result := StrPas(VerBufValue);
 end;
 //======================================================
 function QueryValue(const aValue: string): string;
 begin
   Result := "";
   if GetFileVersionInfo(PChar(sAppNamePath), VerHandle,
   VerSize, VerBuf) and
      VerQueryValue(VerBuf, "\VarFileInfo\Translation",
      VerBufValue, VerBufLen) then
        Result := GetInfo(aValue);
 end;
 //======================================================
begin
 with Result do
 begin
   FileType := "";
   CompanyName := "";
   FileDescription := "";
   FileVersion := "";
   InternalName := "";
   LegalCopyRight := "";
   LegalTradeMarks := "";
   OriginalFileName := "";
   ProductName := "";
   ProductVersion := "";
   Comments := "";
   SpecialBuildStr:= "";
   PrivateBuildStr := "";
   FileFunction := "";
   DebugBuild := False;
   Patched := False;
   PreRelease:= False;
   SpecialBuild:= False;
   PrivateBuild:= False;
   InfoInferred := False;
 end;

 if SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI),
   SHGFI_TYPENAME) <> 0 then
 begin
   Result.FileType := rSHFI.szTypeName;
 end;

 iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI,
 SizeOf(rSHFI), SHGFI_EXETYPE);
 if iRet <> 0 then
 begin
   VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);
   if VerSize > 0 then
   begin
     VerBuf := AllocMem(VerSize);
     try
       with Result do
       begin
         CompanyName      := QueryValue("CompanyName");
         FileDescription  := QueryValue("FileDescription");
         FileVersion      := QueryValue("FileVersion");
         InternalName     := QueryValue("InternalName");
         LegalCopyRight   := QueryValue("LegalCopyRight");
         LegalTradeMarks  := QueryValue("LegalTradeMarks");
         OriginalFileName := QueryValue("OriginalFileName");
         ProductName      := QueryValue("ProductName");
         ProductVersion   := QueryValue("ProductVersion");
         Comments         := QueryValue("Comments");
         SpecialBuildStr  := QueryValue("SpecialBuild");
         PrivateBuildStr  := QueryValue("PrivateBuild");
         //= fill the VS_FIXEDFILEINFO ==========================
         FixedFileInfo    := GetFixedFileInfo;
         DebugBuild       := HasdwFileFlags(FixedFileInfo,VS_FF_DEBUG);
         PreRelease       := HasdwFileFlags(FixedFileInfo,VS_FF_PRERELEASE);
         PrivateBuild     := HasdwFileFlags(FixedFileInfo,VS_FF_PRIVATEBUILD);
         SpecialBuild     := HasdwFileFlags(FixedFileInfo,VS_FF_SPECIALBUILD);
         Patched          := HasdwFileFlags(FixedFileInfo,VS_FF_PATCHED);
         InfoInferred     := HasdwFileFlags(FixedFileInfo,VS_FF_INFOINFERRED);
         FileFunction     := GetFileSubType(FixedFileInfo);
       end;
     finally
       FreeMem(VerBuf, VerSize);
     end
   end;
 end
end;

function GetFileVersionInfo(AFile: String): TFileVersionInfo; stdcall;
const
 Tabulator: array[0..0] of Integer = (70);
 BoolValues: array[Boolean] of string = ("No", "Yes");
begin
 Result := FileVersionInfo(AFile);
//  ListBox1.TabWidth := 1;
//  SendMessage(ListBox1.Handle, LB_SETTABSTOPS, 1, Longint(@Tabulator));
end;



---

← →
begin...end ©   (2006-01-23 22:10) [1]

Всё не проверял, но одну ошибку нашёл:

> iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI,
> SizeOf(rSHFI), SHGFI_EXETYPE);
> if iRet <> 0 then

Во-первых, SHGFI_EXETYPE в качестве параметра будет приводить к неудаче вызова SHGetFileInfo для любого файла, отличного от EXE, так что на этом функция FileVersionInfo завершится. Во-вторых, зачем вообще нужен этот повторный вызов функции SHGetFileInfo? Для EXE-файла она возвратит в iRet тип исполняемого файла, но Вы это, вроде, нигде не сохраняете и не используете. Думаю, повторный вызов и if надо убрать.

---

Страницы: 1 вся ветка

Текущий архив: 2006.02.12;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.04 c