Форум: "Прочее";
Текущий архив: 2006.07.16;
Скачать: [xml.tar.bz2];

Вниз

Версия приложения   Найти похожие ветки 

← →
iamdanil ©   (2006-06-13 11:53) [0]

Как получить в string версию приложения ?
application.version вроде не работает

---

← →
Ketmar ©   (2006-06-13 12:21) [1]

а её, собственно, куда вписали? оттуда и получить. %-)

---

← →
iamdanil ©   (2006-06-13 12:34) [2]

Я её вписывал так: Delphi7 -> меню -> Project -> Options... -> Version Info

---

← →
iamdanil ©   (2006-06-13 12:36) [3]

Просто я хочу, чтобы в моей программе в окне "О программе" была написана её версия, а LABEL1.CAPTION каждый раз менять не хочется вот я и хочу чтоб прога узнавала свою версию

---

← →
tesseract ©   (2006-06-13 12:38) [4]

небольшой класс, вроде работал:

unit FileVer;

interface
uses Windows,sysUtils;

type pCodePage = record
    dLang,
    dCodePage:word
end;
type pVerInfo = record
     CompName,
     FileDescr,
     FileVer,
     IntName,
     LegalCpr,
     LegalTM,
     OrgFileName,
     ProductName,
     ProductVer,
     Comments,
     Lang,
     LangCode:string;
     CPage:word;
 end;
type TFileVer = class
  private
     fFilePath:PChar;
     fCodePage:PCodePage;
     fVerBufLen,fVerLen:longWORD;
     fVersion:PChar;
     fVerBuf:PChar;
     fVerInfo:PVerInfo;
     fLastError:integer;
     ftmpLang:LongWord;
  protected
  public
   function GetVersion(FilePath:PChar):PVerInfo; overload;
   procedure GetVersion; overload;
   property FilePath:PChar read fFilePAth write fFilePAth;
   property CodePage:pCodePage read fCodePage write fCodePage;
   property LastError: integer read fLastError;
   property VerInfo:pVerInfo read fVerInfo write fVerInfo;
 end;
implementation

function TfileVer.GetVersion(FilePath:PChar):PVerInfo;
var TmpPtr:pointer;
begin
  // Размер инфы
  fVerBufLen:= GetFileVersionInfoSize(FilePath,fVerBufLen);
  // Если она есть
  if fVerBufLen> 0 then
   begin
    // Выделяем память
   fVerBuf:=AllocMem(fVerBufLen);
   fVersion:=AllocMem(128);
   tmpptr:=allocmem(128);
    // Размер версии
    GetFileVersionInfo(fFilePAth,0,fVerBufLen,fVerBuf);
    // Язык мой какой-же ты
    VerQueryValue(fVerBuf,PChar("\VarFileInfo\Translation"),TmpPtr,fVerLen);
    fTmpLang:=longword(tmpPtr^);
    // Определяем язык
    fCodePage.dLang:=word(fTmpLang);
    fCodePage.dCodePage:=word(fTmpLang shr 16);
    fVerLen:=VerLanguageName(longword(fCodePage.dLang),fVersion,fVerLen);
    if fverLen>0 then fverinfo.Lang:=string(fVersion);
    fVerinfo.CPage:=fcodepage.dCodePage;
    // Код найденного языка для ресурсов
    fverInfo.LangCode:=inttohex(fcodepage.dLang,4)+inttohex(fcodepage.dCodePage,4);
   // Выдираем ресурсы
    VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\FileVersion"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.FileVer:=PChar(TmpPtr);
     VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\InternalName"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.IntName:=PChar(TmpPtr);
     VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\ProductName"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.ProductName :=PChar(TmpPtr);
     VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\CompanyName"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.CompName :=PChar(TmpPtr);
     VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\LegalCopyright"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.LegalCpr :=PChar(TmpPtr);
    VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\ProductVersion"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.ProductVer :=PChar(TmpPtr);
    VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\FileDecription"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.FileDescr :=PChar(TmpPtr);
     VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\LegalTrademarks"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.LegalTM  :=PChar(TmpPtr);
     VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\OriginalFilename"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.OrgFileName :=PChar(TmpPtr);
     VerQueryValue(fVerBuf,PChar("\StringFileInfo\"+fverinfo.LangCode+"\Comments"),TmpPtr,fVerLen);
    if fVerLen>0 then fVerinfo.Comments :=PChar(TmpPtr);
  // чистим за собой
    FreeMem(fverBuf,fVerBufLen);
    FreeMem(fVersion,128);
   end;
   result:=fVerInfo;   // Что в итоге
end;

procedure TfileVer.GetVersion;
begin
 GetVersion(fFilePAth);
end;

end.


---

← →
Игорь Шевченко ©   (2006-06-13 12:39) [5]

procedure TfrmAbout.FormCreate(Sender: TObject);

 procedure GetFileVersion(FileName: string; var Major1, Major2,
                Minor1, Minor2: Integer);
 { Helper function to get the actual file version information }
 var
   Info: Pointer;
   InfoSize: DWORD;
   FileInfo: PVSFixedFileInfo;
   FileInfoSize: DWORD;
   Tmp: DWORD;
 begin
   // Get the size of the FileVersionInformatioin
   InfoSize := GetFileVersionInfoSize(PChar(FileName), Tmp);
   // If InfoSize = 0, then the file may not exist, or
   // it may not have file version information in it.
   if InfoSize = 0 then
     raise Exception.Create("Can""t get file version information for "
                    + FileName);
   // Allocate memory for the file version information
   GetMem(Info, InfoSize);
   try
     // Get the information
     GetFileVersionInfo(PChar(FileName), 0, InfoSize, Info);
     // Query the information for the version
     VerQueryValue(Info, "\", Pointer(FileInfo), FileInfoSize);
     // Now fill in the version information
     Major1 := FileInfo.dwFileVersionMS shr 16;
     Major2 := FileInfo.dwFileVersionMS and $FFFF;
     Minor1 := FileInfo.dwFileVersionLS shr 16;
     Minor2 := FileInfo.dwFileVersionLS and $FFFF;
   finally
     FreeMem(Info, FileInfoSize);
   end;
 end;

var
 VersionMajor: Integer;
 VersionMinor: Integer;
 Release, BuildNumber: Integer;
begin
 if FileExists(ParamStr(0)) then begin
   // Get the file version
   GetFileVersion(ParamStr(0), VersionMajor, VersionMinor, Release, BuildNumber);
   cVersion.Caption := Format("Версия:     %d.%d.%d", [VersionMajor, VersionMinor, Release]);
   lbBuild.Caption := Format("(сборка %d)", [BuildNumber]);
 end;
end;


---

← →
unknown ©   (2006-06-13 12:44) [6]

procedure GetBuildInfo(var V1, V2, V3, V4: Word);
var
 VerInfoSize: DWORD;
 VerInfo: Pointer;
 VerValueSize: DWORD;
 VerValue: PVSFixedFileInfo;
 Dummy: DWORD;
begin
 VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
 if VerInfoSize = 0 then begin
   Dummy := GetLastError;
   ShowMessage(IntToStr(Dummy));
 end; {if}
 GetMem(VerInfo, VerInfoSize);
 GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
 VerQueryValue(VerInfo, "\", Pointer(VerValue), VerValueSize);
 with VerValue^ do begin
   V1 := dwFileVersionMS shr 16;
   V2 := dwFileVersionMS and $FFFF;
   V3 := dwFileVersionLS shr 16;
   V4 := dwFileVersionLS and $FFFF;
 end;
 FreeMem(VerInfo, VerInfoSize);
end;

procedure TForm1.Button1Click(Sender: TObject);
var V1, V2, V3, V4: Word;
begin
GetBuildInfo(V1, V2, V3, V4);
Caption:=Format("%d.%d.%d.%d",[V1, V2, V3, V4]);
end;

---

← →
iamdanil ©   (2006-06-13 12:53) [7]

thanks

---

← →
Fiend ©   (2006-06-13 13:16) [8]

мать чесная, шо с местным народом случилось?
сразу три варианта ответа на простой вопрос, а ведь могли послать ;)

Изменения в лучшую сторону на лицо!

---

← →
КиТаЯц ©   (2006-06-13 13:41) [9]

> Fiend ©   (13.06.06 13:16) [8]

Кхм... спасибо за доброе слово ))) Дай-ка и я свою писанину подкину:

function GetFileDate(FileName: string): string;
 var FileHandle: Integer;
     DT: TDateTime;
begin
Result:= "";
 FileHandle:= FileOpen(FileName, fmShareDenyNone);
 if (FileHandle > 0) then
   if (FileGetDate(FileHandle)> -1) then begin
     DT:=FileDateToDateTime(FileGetDate(FileHandle));
     Result:=DateToStr(DT);
   end;
 FileClose(FileHandle);
end;

function  GetFileVersion(FName: string): String;
 type
   TLangChrSet = array[0..1] of word;
   PLangChrset = ^TLangChrSet;
 var S: String;
   n, Len: Cardinal;
   Buf, Value: PChar;
   LangChrSet: PLangChrSet;
begin
Result:="";
 n:= GetFileVersionInfoSize(PChar(FName), n);
 if (n = 0) then Exit;
   Buf:= AllocMem(n); GetFileVersionInfo(PChar(FName), 0, n, Buf);
   VerQueryValue(Buf, PChar("VarFileInfo\Translation"), Pointer(LangChrset), Len);
     S:=Format("%.4x%.4x",[LangChrSet^[0], LangChrSet^[1]]);
   if VerQueryValue(Buf, PChar("StringFileInfo\"+S+"\FileVersion"), Pointer(Value), Len)
     then Result:=Value;
 FreeMem(Buf, n);
end;


---

← →
Джо ©   (2006-06-14 01:05) [10]

> [8] Fiend ©   (13.06.06 13:16)
> мать чесная, шо с местным народом случилось?
> сразу три варианта ответа на простой вопрос, а ведь могли
> послать ;)

Это что. Тема еще не раскрыта полностью ;)


unit VerInfo;

interface
uses Windows;

const
MaxInfoStrings = 7;

INFO_CompanyName = "CompanyName";
INFO_FileDescription = "FileDescription";
INFO_FileVersion = "FileVersion";
INFO_InternalName = "InternalName";
INFO_LegalCopyright = "LegalCopyright";
INFO_OriginalFileName = "OriginalFileName";
INFO_ProductName = "ProductName";
INFO_ProductVersion = "ProductVersion";

VersionInfoStrings: array [0..MaxInfoStrings] of string =
(
  INFO_CompanyName,
  INFO_FileDescription,
  INFO_FileVersion,
  INFO_InternalName,
  INFO_LegalCopyright,
  INFO_OriginalFileName,
  INFO_ProductName,
  INFO_ProductVersion
);

type
TFileVersion = record
  Minor,
  Major,
  Build,
  Release: WORD;
end;

TFileVersionInfo = class
private
  FFileName: string;
  FBuffer: PChar;
  FBuffLen: Cardinal;
  FLocale: string;
  procedure SetFileName(const Value: string);
  procedure LoadFile (AFileName: string);
  procedure UnloadFile;
  function GetHasInfo: Boolean;
public
  constructor Create (AFileName: string);
  destructor Destroy; override;

  property HasInfo: Boolean read GetHasInfo;
  property FileName: string read FFileName write SetFileName;
  property Locale: string read FLocale;

  function GetString (AString: string): string;
  function GetVersion: TFileVersion;

end;

implementation
uses SysUtils;

{ TFileVersionInfo }

type
TVer1 = record
  Minor: Word;
  Major: Word;
end;
TVer2 = record
  Build: Word;
  Release: Word;
end;

constructor TFileVersionInfo.Create(AFileName: string);
begin
FFileName := AFileName;
LoadFile(AFileName);
end;

destructor TFileVersionInfo.Destroy;
begin
UnloadFile;
inherited;
end;

function TFileVersionInfo.GetHasInfo: Boolean;
begin
Result := (FFileName <> "") and (FBuffLen <> 0);
end;

function TFileVersionInfo.GetString(AString: string): string;
var
InfoLen: Cardinal;
PInfo: PChar;
begin
if VerQueryValue(
  FBuffer,
  PChar("\StringFileInfo\" + FLocale + "\"+AString),
  Pointer(PInfo),
  InfoLen
) then
begin
  Result := PInfo;
end
else
  Result := ""
end;

function TFileVersionInfo.GetVersion: TFileVersion;
var
FI: PVSFixedFileInfo;
VerSize: Cardinal;
Ver1: TVer1;
Ver2: TVer2;
begin
if VerQueryValue(FBuffer,"\",Pointer(FI),VerSize) then
begin
  Ver1 := TVer1(FI.dwFileVersionMS);
  Ver2 := TVer2(FI.dwFileVersionLS);

  Result.Minor := Ver1.Minor;
  Result.Major := Ver1.Major;
  Result.Build := Ver2.Build;
  Result.Release := Ver2.Release;
end;
end;

procedure TFileVersionInfo.LoadFile(AFileName: string);
var
Dummy,LangLen: Cardinal;
LangBuff: PChar;
begin
UnloadFile;

FBuffLen := 0;

// Buffer size
FBuffLen := GetFileVersionInfoSize(
  PChar(AFileName),
  Dummy
);

if FBuffLen <> 0 then
begin
  GetMem (FBuffer,FBuffLen);

  // read resource data
  GetFileVersionInfo(
    PChar(FileName),
    0,
    FBuffLen,
    FBuffer
  );

  // check string locale
  VerQueryValue(FBuffer, "\VarFileInfo\Translation", pointer(LangBuff), LangLen);
  if langLen >= 4 then // if specified
  begin
    StrLCopy(@Dummy, LangBuff, 2);
    FLocale:= Format("%4.4x", [Dummy]);
    StrLCopy(@Dummy, LangBuff+2, 2);
    FLocale := FLocale + Format("%4.4x", [Dummy]);
  end
  else
    // use Amer. Engl, ANSI
    FLocale := "040904E4";
end;
end;

procedure TFileVersionInfo.SetFileName(const Value: string);
begin
FFileName := Value;
LoadFile(Value);
end;

procedure TFileVersionInfo.UnloadFile;
begin
FreeMem (FBuffer);
end;

end.



ПРИМЕРЫ ИСПОЛЬЗОВАНИЯ.
-----------------------------------------------------------


//   Пример 1:
 var
   FileInfo: TFileVersionInfo
   VerInfo: FFileVersion;
 begin
   // file name passed to constructor
   FileInfo := TFileVersionInfo.Create ("c:\prog.exe");
   try
     if FileInfo.HasInfo then
     begin
       Label1.Caption := FileInfo.GetString (INFO_CompanyName);
       Label2.Caption := FileInfo.GetString (INFO_FileDescription);

       VerInfo := FileInfo.GetVersion;
       Label3.Caption := Format ("%d.%d",[VerInfo.Minor,VerInfo.Major]);
     end;
   finally
     FileInfo.Free;
   end;
 end;
 
-----------------------------------------------------------
//   Пример 2:
 var
   FileInfo: TFileVersionInfo
   VerInfo: FFileVersion;

 begin
   // no file name passed to constructor
   FileInfo := TFileVersionInfo.Create;
   try

     FileInfo.FileName := "c:\myprog1.Exe";  // specify file
     if FileInfo.HasInfo then
     begin
       Label1.Caption := FileInfo.GetString (INFO_CompanyName);
       Label2.Caption := FileInfo.GetString (INFO_FileDescription);

       VerInfo := FileInfo.GetVersion;
       Label3.Caption := Format ("%d.%d",[VerInfo.Minor,VerInfo.Major]);
     end;

     FileInfo.FileName := "c:\myprog2.Exe";  // specify file
     if FileInfo.HasInfo then
     begin
       Label4.Caption := FileInfo.GetString (INFO_CompanyName);
       Label5.Caption := FileInfo.GetString (INFO_FileDescription);

       VerInfo := FileInfo.GetVersion;
       Label6.Caption := Format ("%d.%d",[VerInfo.Minor,VerInfo.Major]);
     end;

   finally
     FileInfo.Free;
   end;
 end;



Остальное тут: :)
http://delphimaster.net/view/15-1148586287/

---

Страницы: 1 вся ветка

Форум: "Прочее";
Текущий архив: 2006.07.16;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.55 MB
Время: 0.009 c