Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Отобразить версию EXE в label 
:(
    Опции темы
Cron
  Дата 21.8.2007, 22:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 20
Регистрация: 26.4.2007

Репутация: нет
Всего: нет
В названии темы все сказано, от программы требуется отображать в label версию постороннего exe файла, тоесть текст который пишется в Свойства>Версия>Версия файла: xxx. Помогите если кто нибудь знает как это осуществить. smile 
PM MAIL   Вверх
ne0n
Дата 21.8.2007, 22:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


PlayBoy
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 5.8.2005
Где: Н.Новгород

Репутация: 1
Всего: 11
вот так наверно...
Код

function GetFileVersion(const FileName: string): string;
type
  PDWORD = ^DWORD;
  PLangAndCodePage = ^TLangAndCodePage;
  TLangAndCodePage = packed record
    wLanguage: WORD;
    wCodePage: WORD;
  end;
  PLangAndCodePageArray = ^TLangAndCodePageArray;
  TLangAndCodePageArray = array[0..0] of TLangAndCodePage;
var
  loc_InfoBufSize: DWORD;
  loc_InfoBuf: PChar;
  loc_VerBufSize: DWORD;
  loc_VerBuf: PChar;
  cbTranslate: DWORD;
  lpTranslate: PDWORD;
  i: DWORD;
begin
  Result := '';
  if (Length(FileName) = 0) or (not Fileexists(FileName)) then
    Exit;
  loc_InfoBufSize := GetFileVersionInfoSize(PChar(FileName), loc_InfoBufSize);
  if loc_InfoBufSize > 0 then
  begin
    loc_VerBuf := nil;
    loc_InfoBuf := AllocMem(loc_InfoBufSize);
    try
      if not GetFileVersionInfo(PChar(FileName), 0, loc_InfoBufSize, loc_InfoBuf)
        then
        exit;
      if not VerQueryValue(loc_InfoBuf, '\\VarFileInfo\\Translation',
        Pointer(lpTranslate), DWORD(cbTranslate)) then
        exit;
      for i := 0 to (cbTranslate div SizeOf(TLangAndCodePage)) - 1 do
      begin
        if VerQueryValue(
          loc_InfoBuf,
          PChar(Format(
          'StringFileInfo\0%x0%x\FileVersion', [
          PLangAndCodePageArray(lpTranslate)[i].wLanguage,
            PLangAndCodePageArray(lpTranslate)[i].wCodePage])),
            Pointer(loc_VerBuf),
          DWORD(loc_VerBufSize)
          ) then
        begin
          Result := loc_VerBuf;
          Break;
        end;
      end;
    finally
      FreeMem(loc_InfoBuf, loc_InfoBufSize);
    end;
  end;
end;



а использовать так:

Код

 label1.caption:=GetFileVersion('your file');


Это сообщение отредактировал(а) ne0n - 21.8.2007, 22:56


--------------------
http://sa-sec.org
как я вам?smile
PM MAIL ICQ   Вверх
Cron
Дата 22.8.2007, 09:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 20
Регистрация: 26.4.2007

Репутация: нет
Всего: нет
Хм. Не получается, Label остается пустым 
PM MAIL   Вверх
sentry
Дата 22.8.2007, 09:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Code Monkey
*


Профиль
Группа: Участник
Сообщений: 133
Регистрация: 29.1.2007
Где: Москва

Репутация: 2
Всего: 10
Может, это то, что нужно...
PM MAIL   Вверх
Pavelbej
Дата 22.8.2007, 16:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6
Вот как у меня:

Код

function FileVersion(AFileName: string): string;
var
  szName: array[0..255] of Char;
  P: Pointer;
  Value: Pointer;
  Len: UINT;
  GetTranslationString: string;
  FFileName: PChar;
  FValid: boolean;
  FSize: DWORD;
  FHandle: DWORD;
  FBuffer: PChar;
begin
  try
    FFileName := StrPCopy(StrAlloc(Length(AFileName) + 1), AFileName);
    FValid := False;
    FSize := GetFileVersionInfoSize(FFileName, FHandle);
    if FSize > 0 then
    try
      GetMem(FBuffer, FSize);
      FValid := GetFileVersionInfo(FFileName, FHandle, FSize, FBuffer);
    except
      FValid := False;
      raise;
    end;
    Result := '';
    if FValid then
      VerQueryValue(FBuffer, '\VarFileInfo\Translation', p, Len)
    else
      p := nil;
    if P <> nil then
      GetTranslationString := IntToHex(MakeLong(HiWord(Longint(P^)),
        LoWord(Longint(P^))), 8);
    if FValid then
    begin
      StrPCopy(szName, '\StringFileInfo\' + GetTranslationString +
        '\FileVersion');
      if VerQueryValue(FBuffer, szName, Value, Len) then
        Result := StrPas(PChar(Value));
    end;
  finally
    try
      if FBuffer <> nil then
        FreeMem(FBuffer, FSize);
    except
    end;
    try
      StrDispose(FFileName);
    except
    end;
  end;
end;


Код

procedure TForm1.FormCreate(Sender: TObject);
begin
  label1.Caption:='Version: '+FileVersion(Paramstr(0));
end;
PM MAIL   Вверх
ne0n
Дата 22.8.2007, 17:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


PlayBoy
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 5.8.2005
Где: Н.Новгород

Репутация: 1
Всего: 11
Цитата(Cron @  22.8.2007,  09:04 Найти цитируемый пост)
Хм. Не получается, Label остается пустым 


Cron, все прекрасно работает...может стоит попробовать указать полный путь к файлу!!!




--------------------
http://sa-sec.org
как я вам?smile
PM MAIL ICQ   Вверх
Cron
Дата 26.8.2007, 20:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 20
Регистрация: 26.4.2007

Репутация: нет
Всего: нет
Да действительно работает, но версию считывает не от туда, видимо поэтому лэйбл остается пустым.
Вот exe с которым взаимодействует моя программа

Скачать
PM MAIL   Вверх
ne0n
Дата 26.8.2007, 21:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


PlayBoy
**


Профиль
Группа: Участник
Сообщений: 733
Регистрация: 5.8.2005
Где: Н.Новгород

Репутация: 1
Всего: 11
Cron, угу ты прав...не работает видимо это потому что он защищен протектором...но вот ктстаи код приведенный Pavelbej исправно работает smile 


--------------------
http://sa-sec.org
как я вам?smile
PM MAIL ICQ   Вверх
MetalFan
Дата 26.8.2007, 22:16 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128
а вот так:
Код

function GetVersion: string;
 var
   VerInfoSize: DWORD;
   VerInfo: Pointer;
   VerValueSize: DWORD;
   VerValue: PVSFixedFileInfo;
   Dummy: DWORD;
 begin
   VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
   GetMem(VerInfo, VerInfoSize);
   GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
   VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
   with VerValue^ do
   begin
     Result := IntToStr(dwFileVersionMS shr 16);
     Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF);
     Result := Result + '.' + IntToStr(dwFileVersionLS shr 16);
     Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF);
   end;
   FreeMem(VerInfo, VerInfoSize);
 end;

 procedure Form1.Button1Click(Sender: TObject);
 begin
   label1.Caption := GetVersion;
 end;

?

з.ы. взято с DelphiWorld


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Cron
Дата 26.8.2007, 23:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 20
Регистрация: 26.4.2007

Репутация: нет
Всего: нет
Спасибо всем огромное за подсказки  smile 

Это сообщение отредактировал(а) Cron - 26.8.2007, 23:29
PM MAIL   Вверх
EvilsInterrupt
Дата 27.8.2007, 06:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Executables research
***


Профиль
Группа: Завсегдатай
Сообщений: 1019
Регистрация: 14.7.2007
Где: Железнодорожный, МО, Россия

Репутация: 3
Всего: 9
Cron, Я вчера узнал о JvVersionInfo и применил так:
Код

  procedure TfrmAbout.SetAppVersion;
  var
    FAppVerI  : TJvVersionInfo;
  begin
    FAppVerI  := TJvVersionInfo.Create(Application.ExeName);
    lbAppVerValue.Caption := FAppVerI.FileVersion;
    FAppVerI.Free;
  end;



--------------------
про реверсинг, вроде чтото даже интересно
PM MAIL WWW ICQ Jabber   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0541 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.