| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

version info [D7, WinXP]

Александр_ ©   (2004-05-26 16:34:00) 

Подскажите пожалуйста как вытащить информацию version info
программно в хелпе дельфи есть пример но он не работает :(

Где здесь грабли ?

procedure TForm1.Button1Click(Sender: TObject);

const
 InfoNum = 10;
 InfoStr: array[1..InfoNum] of string = ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName', 'LegalCopyright', 'LegalTradeMarks', 'OriginalFileName', 'ProductName', 'ProductVersion', 'Comments');
var
 S: string;
 n, Len, i: DWORD;
 Buf: PChar;
 Value: PChar;
begin
 S := Application.ExeName;
 n := GetFileVersionInfoSize(PChar(S), n);
 if n > 0 then
 begin

   Buf := AllocMem(n);
   Memo1.Lines.Add('VersionInfoSize = ' + IntToStr(n));
   GetFileVersionInfo(PChar(S), 0, n, Buf);
   for i := 1 to InfoNum do
     if VerQueryValue(Buf, PChar('StringFileInfo\040904E4\' + InfoStr[i]), Pointer(Value), Len) then
       Memo1.Lines.Add(InfoStr[i] + ' = ' + Value);
   FreeMem(Buf, n);
 end
 else
   Memo1.Lines.Add('No version information found');
end;

---

Werewolf   (2004-05-26 18:09:00) [1]

Чей то код, не помню, но позволяет достать все что угодно:


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;

 // dwFileType, dwFileSubtype
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 := '';
  // obtain version information about the specified file
  if GetFileVersionInfo(PChar(sAppNamePath),VerHandle,VerSize,VerBuf) and
  // return selected version information
     VerQueryValue(VerBuf,'\VarFileInfo\Translation',
     VerBufValue, VerBufLen) then Result:=GetInfo(aValue);
 end;

begin
// Initialize the Result
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;

// Get the file type
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
  // determine whether the OS can obtain version information
  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 structure
       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;


---

Clickmaker   (2004-05-26 17:04:00) [2]

вместо 040904E4 попробуй
VerQueryValue(Buf, '\VarFileInfo\Translation', T
+
IntToHex(MakeLong(HiWord(Longint(T^)), LoWord(Longint(T^))), 8);

---

Clickmaker   (2004-05-26 17:03:00) [3]

вместо 040904E4 попробуй
VerQueryValue(FBuffer, '\VarFileInfo\Translation', T
+
IntToHex(MakeLong(HiWord(Longint(T^)), LoWord(Longint(T^))), 8);

---

Наверх