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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Получить версию программно. 
V
    Опции темы
Avers
Дата 21.11.2008, 11:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 113
Регистрация: 20.6.2008
Где: 26rus

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



Хотелось бы, чтобы приложение программно получало информацию о собственной версии. 
Т.е. хотелось бы что-то вроде Application.Version.... Ну, так просто, конечно не получиться, но все же... 
Какие есть решения данной проблемы?
--------------------
Born to be wild
PM MAIL   Вверх
Matematik
Дата 21.11.2008, 11:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 7
Всего: 50



Код

function FileVersion(AFileName:AnsiString): AnsiString;
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
  Result := '';
  FBuffer := nil;
  FSize := 0;
  FFileName := nil;
  try
    FFileName := StrPCopy(StrAlloc(Length(AFileName) + 1), AFileName);
    FSize := GetFileVersionInfoSize(FFileName, FHandle);
    if FSize > 0 then
    begin
      GetMem(FBuffer, FSize);
      FValid := GetFileVersionInfo(FFileName, FHandle, FSize, FBuffer);
      if FValid then
      begin
        VerQueryValue(FBuffer, '\VarFileInfo\Translation', p, Len);
        GetTranslationString := IntToHex(MakeLong(HiWord(Longint(P^)), LoWord(Longint(P^))), 8);
        StrPCopy(szName, '\StringFileInfo\' + GetTranslationString + '\FileVersion');
        if VerQueryValue(FBuffer, szName, Value, Len) then
          Result := StrPas(PChar(Value));
      end;
    end;
  finally
    if FBuffer<>nil then
      FreeMem(FBuffer, FSize);
    StrDispose(FFileName);
  end;
end;



PM MAIL WWW ICQ   Вверх
Poseidon
Дата 21.11.2008, 11:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 9
Всего: 133



Код
function GetExeVersion(sAppName:string):string;
type
  PTransBuffer = ^TTransBuffer;
  TTransBuffer = array[1..4] of smallint;
var
  iAppSize, iLenOfValue : DWord;
  pcBuf,pcValue         : PChar;
  VerSize               : DWord;
  pTrans                : PTransBuffer;
  TransStr              : string;
  fvip                  : pointer;
begin
  iAppSize:= GetFileVersionInfoSize(PChar(sAppName),iAppSize);
  if iAppSize > 0 then
    begin
      pcBuf := AllocMem(iAppSize);
      GetFileVersionInfo(PChar(sAppName),0,iAppSize,pcBuf);

      VerQueryValue(pcBuf, '\', fvip, iLenOfValue);
      VerQueryValue(pcBuf, PChar('\VarFileInfo\Translation'),pointer(ptrans), verSize);
      TransStr:= IntToHex(ptrans^[1], 4) + IntToHex(ptrans^[2], 4);

      if VerQueryValue(pcBuf,PChar('StringFileInfo\' + TransStr + '\FileVersion'), Pointer(pcValue),iLenOfValue)
      then Result := pcValue;
      FreeMem(pcBuf,iAppSize);
    end;
end;



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Avers
Дата 21.11.2008, 12:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 113
Регистрация: 20.6.2008
Где: 26rus

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



благодарю)
--------------------
Born to be wild
PM MAIL   Вверх
Poseidon
Дата 21.11.2008, 14:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 9
Всего: 133



Только сейчас заметил что я и Matematik привели одинаковый код smile


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Bose
Дата 21.11.2008, 15:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 8
Всего: 51



Цитата(Poseidon @  21.11.2008,  14:07 Найти цитируемый пост)
Только сейчас заметил что я и Matematik привели одинаковый код

Drkb рулит =)
PM MAIL WWW Skype   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

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

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

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

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


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »


 




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


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

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