Текущий архив: 2005.10.02;
Скачать: CL | DM;

Вниз

Как получить номер версии своей программы ?   Найти похожие ветки 

← →
ANB ©   (2005-08-09 09:14) [0]

Нашел функции и примеры. Никак не могу подобрать параметры для русского языка. Включил в проекте английский, все заработало (на коде из хелпа). Включаешь русский - все отрубается.

---

← →
WondeRu ©   (2005-08-09 09:21) [1]

я пользуюсь вот этим:
unit uVersionInfo;

interface

uses Windows, Classes, SysUtils;
type
 TVersionInfo = class
 fModule : THandle;
 fVersionInfo : PChar;
 fVersionHeader : PChar;
 fChildStrings : TStringList;
 fTranslations : TList;
 fFixedInfo : PVSFixedFileInfo;
 fVersionResHandle : THandle;
 fModuleLoaded : boolean;

 private
   function GetInfo : boolean;
   function GetKeyCount: Integer;
   function GetKeyName(idx: Integer): string;
   function GetKeyValue(const idx: string): string;
   procedure SetKeyValue(const idx, Value: string);
 public
   constructor Create (AModule : THandle); overload;
   constructor Create (AVersionInfo : PChar); overload;
   constructor Create (const AFileName : string); overload;
   destructor Destroy; override;
   procedure SaveToStream (strm : TStream);

   property KeyCount : Integer read GetKeyCount;
   property KeyName [idx : Integer] : string read GetKeyName;
   property KeyValue [const idx : string] : string read GetKeyValue write SetKeyValue;
 end;

implementation

{ TVersionInfo }

type
TVersionStringValue = class
 fValue : string;
 fLangID, fCodePage : Integer;

 constructor Create (const AValue : string; ALangID, ACodePage : Integer);
end;

constructor TVersionInfo.Create(AModule: THandle);
var
 resHandle : THandle;
begin
 fModule := AModule;
 fChildStrings := TStringList.Create;
 fTranslations := TList.Create;
 resHandle := FindResource (fModule, pointer (1), RT_VERSION);
 if resHandle <> 0 then
 begin
   fVersionResHandle := LoadResource (fModule, resHandle);
   if fVersionResHandle <> 0 then
     fVersionInfo := LockResource (fVersionResHandle)
 end;

 if not Assigned (fVersionInfo) then
   raise Exception.Create ("Unable to load version info resource");
end;

constructor TVersionInfo.Create(AVersionInfo: PChar);
begin
 fChildStrings := TStringList.Create;
 fTranslations := TList.Create;
 fVersionInfo := AVersionInfo;
end;

constructor TVersionInfo.Create(const AFileName: string);
var
 handle : THandle;
begin
 handle := LoadLibraryEx (PChar (AFileName), 0, LOAD_LIBRARY_AS_DATAFILE);
 if handle <> 0 then
 begin
   Create (handle);
   fModuleLoaded := True
 end
 else
   raiseLastOSError;
end;

destructor TVersionInfo.Destroy;
var
 i : Integer;
begin
 for i := 0 to fChildStrings.Count - 1 do
   fChildStrings.Objects [i].Free;

 fChildStrings.Free;
 fTranslations.Free;
 if fVersionResHandle <> 0 then
   FreeResource (fVersionResHandle);
 if fModuleLoaded then
   FreeLibrary (fModule);
 inherited;
end;

function TVersionInfo.GetInfo : boolean;
var
 p : PChar;
 t, wLength, wValueLength, wType : word;
 key : string;

 varwLength, varwValueLength, varwType : word;
 varKey : string;

 function GetVersionHeader (var p : PChar; var wLength, wValueLength, wType : word; var key : string) : Integer;
 var
   szKey : PWideChar;
   baseP : PChar;
 begin
   baseP := p;
   wLength := PWord (p)^;
   Inc (p, sizeof (word));
   wValueLength := PWord (p)^;
   Inc (p, sizeof (word));
   wType := PWord (p)^;
   Inc (p, sizeof (word));
   szKey := PWideChar (p);
   Inc (p, (lstrlenw (szKey) + 1) * sizeof (WideChar));
   while Integer (p) mod 4 <> 0 do
     Inc (p);
   result := p - baseP;
   key := szKey;
 end;

 procedure GetStringChildren (var base : PChar; len : word);
 var
   p, strBase : PChar;
   t, wLength, wValueLength, wType, wStrLength, wStrValueLength, wStrType : word;
   key, value : string;
   i, langID, codePage : Integer;

 begin
   p := base;
   while (p - base) < len do
   begin
     t := GetVersionHeader (p, wLength, wValueLength, wType, key);
     Dec (wLength, t);

     langID := StrToInt ("$" + Copy (key, 1, 4));
     codePage := StrToInt ("$" + Copy (key, 5, 4));

     strBase := p;
     for i := 0 to fChildStrings.Count - 1 do
       fChildStrings.Objects [i].Free;
     fChildStrings.Clear;

     while (p - strBase) < wLength do
     begin
       t := GetVersionHeader (p, wStrLength, wStrValueLength, wStrType, key);
       Dec (wStrLength, t);

       if wStrValueLength = 0 then
         value := ""
       else
         value := PWideChar (p);
       Inc (p, wStrLength);
       while Integer (p) mod 4 <> 0 do
         Inc (p);

       fChildStrings.AddObject (key, TVersionStringValue.Create (value, langID, codePage))
     end
   end;
   base := p
 end;

 procedure GetVarChildren (var base : PChar; len : word);
 var
   p, strBase : PChar;
   t, wLength, wValueLength, wType: word;
   key : string;
   v : DWORD;

 begin
   p := base;
   while (p - base) < len do
   begin
     t := GetVersionHeader (p, wLength, wValueLength, wType, key);
     Dec (wLength, t);

     strBase := p;
     fTranslations.Clear;

     while (p - strBase) < wLength do
     begin
       v := PDWORD (p)^;
       Inc (p, sizeof (DWORD));
       fTranslations.Add (pointer (v));
     end
   end;
   base := p
 end;

begin
 result := False;
 if not Assigned (fFixedInfo) then
 try
   p := fVersionInfo;
   GetVersionHeader (p, wLength, wValueLength, wType, key);

   if wValueLength <> 0 then
   begin
     fFixedInfo := PVSFixedFileInfo (p);
     if fFixedInfo^.dwSignature <> $feef04bd then
       raise Exception.Create ("Invalid version resource");

     Inc (p, wValueLength);
     while Integer (p) mod 4 <> 0 do
       Inc (p);
   end
   else
     fFixedInfo := Nil;

   while wLength > (p - fVersionInfo) do
   begin
     t := GetVersionHeader (p, varwLength, varwValueLength, varwType, varKey);
     Dec (varwLength, t);

     if varKey = "StringFileInfo" then
       GetStringChildren (p, varwLength)
     else
       if varKey = "VarFileInfo" then
         GetVarChildren (p, varwLength)
       else
         break;
   end;

   result := True;
 except
 end
 else
   result := True
end;

---

← →
WondeRu ©   (2005-08-09 09:22) [2]

function TVersionInfo.GetKeyCount: Integer;
begin
 if GetInfo then
   result := fChildStrings.Count
 else
   result := 0;
end;

function TVersionInfo.GetKeyName(idx: Integer): string;
begin
 if idx >= KeyCount then
   raise ERangeError.Create ("Index out of range")
 else
   result := fChildStrings [idx];
end;

function TVersionInfo.GetKeyValue(const idx: string): string;
var
 i : Integer;
begin
 if GetInfo then
 begin
   i := fChildStrings.IndexOf (idx);
   if i <> -1 then
     result := TVersionStringValue (fChildStrings.Objects [i]).fValue
   else
     raise Exception.Create ("Key not found")
 end
 else
   raise Exception.Create ("Key not found")
end;

procedure TVersionInfo.SaveToStream(strm: TStream);
var
 zeros, v : DWORD;
 wSize : WORD;
 stringInfoStream : TMemoryStream;
 strg : TVersionStringValue;
 i, p, p1 : Integer;
 wValue : WideString;

 procedure PadStream (strm : TStream);
 begin
   if strm.Position mod 4 <> 0 then
     strm.Write (zeros, 4 - (strm.Position mod 4))
 end;

 procedure SaveVersionHeader (strm : TStream; wLength, wValueLength, wType : word; const key : string; const value);
 var
   wKey : WideString;
   valueLen : word;
   keyLen : word;
 begin
   wKey := key;
   strm.Write (wLength, sizeof (wLength));

   strm.Write (wValueLength, sizeof (wValueLength));
   strm.Write (wType, sizeof (wType));
   keyLen := (Length (wKey) + 1) * sizeof (WideChar);
   strm.Write (wKey [1], keyLen);

   PadStream (strm);

   if wValueLength > 0 then
   begin
     valueLen := wValueLength;
     if wType = 1 then
       valueLen := valueLen * sizeof (WideChar);
     strm.Write (value, valueLen)
   end;
 end;

begin { SaveToStream }
 if GetInfo then
 begin
   zeros := 0;

   SaveVersionHeader (strm, 0, sizeof (fFixedInfo^), 0, "VS_VERSION_INFO", fFixedInfo^);

   if fChildStrings.Count > 0 then
   begin
     stringInfoStream := TMemoryStream.Create;
     try
       strg := TVersionStringValue (fChildStrings.Objects [0]);

       SaveVersionHeader (stringInfoStream, 0, 0, 0, IntToHex (strg.fLangID, 4) + IntToHex (strg.fCodePage, 4), zeros);

       for i := 0 to fChildStrings.Count - 1 do
       begin
         PadStream (stringInfoStream);

         p := stringInfoStream.Position;
         strg := TVersionStringValue (fChildStrings.Objects [i]);
         wValue := strg.fValue;
         SaveVersionHeader (stringInfoStream, 0, Length (strg.fValue) + 1, 1, fChildStrings [i], wValue [1]);
         wSize := stringInfoStream.Size - p;
         stringInfoStream.Seek (p, soFromBeginning);
         stringInfoStream.Write (wSize, sizeof (wSize));
         stringInfoStream.Seek (0, soFromEnd);

       end;

       stringInfoStream.Seek (0, soFromBeginning);
       wSize := stringInfoStream.Size;
       stringInfoStream.Write (wSize, sizeof (wSize));

       PadStream (strm);
       p := strm.Position;
       SaveVersionHeader (strm, 0, 0, 0, "StringFileInfo", zeros);
       strm.Write (stringInfoStream.Memory^, stringInfoStream.size);
       wSize := strm.Size - p;
     finally
       stringInfoStream.Free
     end;
     strm.Seek (p, soFromBeginning);
     strm.Write (wSize, sizeof (wSize));
     strm.Seek (0, soFromEnd)
   end;

   if fTranslations.Count > 0 then
   begin
     PadStream (strm);
     p := strm.Position;
     SaveVersionHeader (strm, 0, 0, 0, "VarFileInfo", zeros);
     PadStream (strm);

     p1 := strm.Position;
     SaveVersionHeader (strm, 0, 0, 0, "Translation", zeros);

     for i := 0 to fTranslations.Count - 1 do
     begin
       v := Integer (fTranslations [i]);
       strm.Write (v, sizeof (v))
     end;

     wSize := strm.Size - p1;
     strm.Seek (p1, soFromBeginning);
     strm.Write (wSize, sizeof (wSize));
     wSize := sizeof (Integer) * fTranslations.Count;
     strm.Write (wSize, sizeof (wSize));

     wSize := strm.Size - p;
     strm.Seek (p, soFromBeginning);
     strm.Write (wSize, sizeof (wSize));
   end;

   strm.Seek (0, soFromBeginning);
   wSize := strm.Size;
   strm.Write (wSize, sizeof (wSize));
   strm.Seek (0, soFromEnd);
 end
 else
   raise Exception.Create ("Invalid version resource");
end;

procedure TVersionInfo.SetKeyValue(const idx, Value: string);
var
 i : Integer;
begin
 if GetInfo then
 begin
   i := fChildStrings.IndexOf (idx);
   if i = -1 then
     i := fChildStrings.AddObject (idx, TVersionStringValue.Create (idx, 0, 0));

   TVersionStringValue (fChildStrings.Objects [i]).fValue := Value
 end
 else
   raise Exception.Create ("Invalid version resource");
end;

{ TVersionStringValue }

constructor TVersionStringValue.Create(const AValue: string; ALangID,
 ACodePage: Integer);
begin
 fValue := AValue;
 fCodePage := ACodePage;
 fLangID := ALangID;
end;

end.


---

← →
Rouse_ ©   (2005-08-09 10:15) [3]

Ему же только версию:

procedure TForm1.Button1Click(Sender: TObject);
var
 VerInfoSize, Dummy: DWORD;
 PVerBbuff, PFixed : Pointer;
 FlName: PChar;
 FixLength: UINT;
 FVersionMS, FVersionLS: Cardinal;
begin
 FlName := PCHar(Application.ExeName);
 VerInfoSize := GetFileVersionInfoSize(FlName, Dummy);
 if VerInfoSize = 0 then Exit;
 GetMem(PVerBbuff, VerInfoSize);
 try
   if GetFileVersionInfo(FlName, 0, VerInfoSize, PVerBbuff) then
   begin
     if VerQueryValue(PVerBbuff, "\", PFixed, FixLength) then
     begin
       FVersionMS := PVSFixedFileInfo(PFixed)^.dwFileVersionMS;
       FVersionLS := PVSFixedFileInfo(PFixed)^.dwFileVersionLS;
     end;
     ShowMessage(Format("%d.%d.%d.%d", [LongRec(FVersionMS).Hi,
       LongRec(FVersionMS).Lo, LongRec(FVersionLS).Hi, LongRec(FVersionLS).Lo]));
   end;
 finally
   FreeMem(PVerBbuff);
 end;
end;

---

← →
ANB ©   (2005-08-09 11:17) [4]

Ой, млин, как много то. Это целый свой парсер VersionInfo ? Достать только номер версии и у меня получалось. Хотел через ключи, а не вышло.
А как большой класс юзать то ?
Может я свой код опубликую ?

---

← →
Rouse_ ©   (2005-08-09 11:27) [5]

Смотри мой вариант, там только то, что тебе и нужно...

---

← →
ANB ©   (2005-08-09 11:34) [6]

> Rouse_ ©   (09.08.05 11:27) [5]
спасибо. Я уже делал твоим вариантом. Действительно, все работает. В принципе, мне и английский как язык не мешает. Вот если придется все параметры из версии доставать, и при этом делать локализацию, то будет попа.

---

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

Текущий архив: 2005.10.02;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.061 c