Delphi: Определение Версии Программы

[Sascha]

Для определении версии программы, можно воспользоваться одной из следующих функций:
вариант 1:

function AppVersion(const Filename: string):string;
var dwHandle: THandle;
    dwSize: DWORD;
    lpData, lpData2: Pointer;
    uiSize: UINT;
begin
  Result := '';
  dwSize := GetFileVersionInfoSize(PChar(FileName), dwSize);
  if dwSize <> 0 then
  begin
    GetMem(lpData, dwSize);
    if GetFileVersionInfo(PChar(FileName), dwHandle, dwSize, lpData) then
      begin
        uiSize := Sizeof(TVSFixedFileInfo);
        VerQueryValue(lpData, '\', lpData2, uiSize);
        with PVSFixedFileInfo(lpData2)^ do
          Result := Format('%d.%02d.%02d.%02d', [HiWord(dwProductVersionMS), LoWord(dwProductVersionMS),HiWord(dwProductVersionLS), LoWord(dwProductVersionLS)]);
      end;
    FreeMem(lpData, dwSize);
  end;
end;

вариант 2:

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;

Определение программой своей версии:

function GetSelfVersion: string;
type
  TVerInfo=packed record
    Nevazhno: array[0..47] of byte;
    Minor, Major, Build, Release: word;
  end;
var
  s: TResourceStream;
  v: TVerInfo;
begin
  result:='';
  try
    s:=TResourceStream.Create(HInstance, '#1', RT_VERSION);
    if s.Size > 0 then begin
      s.Read(v, SizeOf(v));
      result:=IntToStr(v.Major) + '.' +
                IntToStr(v.Minor) + '.' +
                IntToStr(v.Release) + '.' +
                IntToStr(v.Build);
    end;
    s.Free;
  except;
  end;
end;

 

[Mazahaka_lab]

Мой пример :

function GetFileVersion(FileName: string; var VerInfo : TVSFixedFileInfo): boolean;
var
InfoSize, puLen: DWORD;
Pt, InfoPtr: Pointer;
begin
InfoSize := GetFileVersionInfoSize( PChar(FileName), puLen );
FillChar(VerInfo, SizeOf(TVSFixedFileInfo), 0);
if InfoSize > 0 then
begin
GetMem(Pt,InfoSize);
GetFileVersionInfo( PChar(FileName), 0, InfoSize, Pt);
VerQueryValue(Pt,'\',InfoPtr,puLen);
Move(InfoPtr^, VerInfo, sizeof(TVSFixedFileInfo) );
FreeMem(Pt);
Result := True;
end
else
Result := False;
end;
function ShowVersion(FileName:string):string;
var
VerInfo : TVSFixedFileInfo;
begin
if GetFileVersion(FileName, VerInfo) then
Result:=Format('%u.%u.%u',[HiWord(VerInfo.dwProductVersionMS), LoWord(VerInfo.dwProductVersionMS),
HiWord(VerInfo.dwProductVersionLS), LoWord(VerInfo.dwProductVersionLS)])
else
Result:='------';
end;

//Как использовать
procedure TForm2.FormCreate(Sender: TObject);
begin
caption:= ShowVersion(Application.ExeName);
end;
end.