function GetVersionInfo(fullpath: string; var Major,Minor,Release,Build,ProductName: string): boolean;
var
  VerInfoSize: Cardinal;
  VerValueSize: Cardinal;
  Dummy: Cardinal;
  PVerInfo: Pointer;
  PVerValue: PVSFixedFileInfo;
begin
  Result := false;

  VerInfoSize := GetFileVersionInfoSize(PChar(fullpath), Dummy);
  if VerInfoSize > 0 then
  begin
    GetMem(PVerInfo, VerInfoSize);
    try
      if GetFileVersionInfo(PChar(fullpath), 0, VerInfoSize, PVerInfo) then
      begin
        if VerQueryValue(PVerInfo, '\', Pointer(PVerValue), VerValueSize) then
        begin
          Major   := IntToStr(HiWord(PVerValue^.dwFileVersionMS));
          Minor   := IntToStr(LoWord(PVerValue^.dwFileVersionMS));
          Release := IntToStr(HiWord(PVerValue^.dwFileVersionLS));
          Build   := IntToStr(LoWord(PVerValue^.dwFileVersionLS));
        end;

        Result := true;
      end;

    finally
      FreeMem(PVerInfo, VerInfoSize);
    end;
  end;

end;

function GetVersionInfo(fullpath: string; var Major,Minor,Release,Build,ProductName: string): boolean;
// Вх. fullpath - полный путь к EXE-файлу
// Вых. - true, значит все ОК. Возвращаются значения Major,Minor,Release,Build,ProductName
var
  VerInfoSize: Cardinal;
  Len: DWORD;
  Buff,TranslateBuffer: PChar;
  Value: PChar;

  Temp: integer;
  CalcLangCharSet: string;

  ProductVersion: string;
begin
  result:=false;
  Major:='0'; Minor:='0'; Release:='0'; Build:='0';
  ProductVersion:='0.0.0.0';
  ProductName:='';

  Len := GetFileVersionInfoSize(PChar(Application.ExeName), Len);
  if Len <=0 then exit;

  Buff := AllocMem(Len);
  try
    if GetFileVersionInfo(PChar(Application.ExeName), 0, Len, Buff) then
    // определим язык CalcLangCharSet
    // CalcLangCharSet:='040904E3';
    VerQueryValue(Buff, '\VarFileInfo\Translation', pointer(TranslateBuffer), Len);
    if Len >= 4 then
    begin
      temp:=0;
      StrLCopy(@temp, TranslateBuffer, 1);
      CalcLangCharSet:=IntToHex(temp, 4);
      StrLCopy(@temp, TranslateBuffer+1, 1);
      CalcLangCharSet := CalcLangCharSet + IntToHex(temp, 4);
    end
    else exit;

    // Достаем название ПО
    if VerQueryValue(Buff, PChar('StringFileInfo\'+CalcLangCharSet+'\ProductName'), Pointer(Value), Len) then ProductName := Value
      else exit;
    // Достаем версию в виде '4.2.0.0'
    if VerQueryValue(Buff, PChar('StringFileInfo\'+CalcLangCharSet+'\ProductVersion'), Pointer(Value), Len) then ProductVersion := Value
      else exit;
    // Парсим версию на составляющие
    Major:=copy(ProductVersion, 1, pos('.',ProductVersion)-1);   delete(ProductVersion, 1, pos('.',ProductVersion));
    Minor:=copy(ProductVersion, 1, pos('.',ProductVersion)-1);   delete(ProductVersion, 1, pos('.',ProductVersion));
    Release:=copy(ProductVersion, 1, pos('.',ProductVersion)-1); delete(ProductVersion, 1, pos('.',ProductVersion));
    Build:=ProductVersion;

    result:=true;
  finally
    FreeMem(Buff, Len); // освобождаем память
  end;
end;

Posted via ActualForum NNTP Server 1.5

Posted via ActualForum NNTP Server 1.5

program Project1;
uses
 System.Types;
type
 TCustomRes = packed record
               size : UInt32;
               data : array[0 .. 3] of byte;
              end;
var
 version : TCustomRes;
exports
 version name '__rsrc_N6RCDATA7versionE';
begin
 version.size := 4;
 version.data[0] := 1;
 version.data[1] := 2;
 version.data[2] := 3;
 version.data[3] := 4;
 var res := FindResource(hInstance, 'version', RT_RCDATA);
 var ptr : PByte := Pointer(res);
 writeln(ptr[0], '.', ptr[1], '.', ptr[2], '.', ptr[3]);
end.

Posted via ActualForum NNTP Server 1.5

Posted via ActualForum NNTP Server 1.5

Posted via ActualForum NNTP Server 1.5

Posted via ActualForum NNTP Server 1.5

Posted via ActualForum NNTP Server 1.5

Posted via ActualForum NNTP Server 1.5