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

Вниз

Нужен бесплатный компонент   Найти похожие ветки 

← →
GEN++ ©   (2006-05-25 23:44) [0]

Информация о версии приложения
во время выполнения.
Если кто располагает и может поделиться -
буду очень признателен.

---

← →
Джо ©   (2006-05-25 23:53) [1]

А зачем там компонент?
--
Вот, нарыл в старье свой класс, когда-то написал, срочно понадобилось.
Написано довольно небрежно, пинать без озлобления.

----
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.


---

← →
Джо ©   (2006-05-25 23:54) [2]

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

 -----------------------------------------------------------
//   Пример 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;


---

← →
Игорь Шевченко ©   (2006-05-25 23:54) [3]

type
 PVerLang = ^TVerLang;
 TVerLang = record
   Charset : Word;
   LangID  : Word;
 end;

procedure HSGetVersionInfo (const FileName: string; var Info: THSVersionInfo);
var
 InfoSize: DWORD;
 Dummy: DWORD;
 VerInfo: Pointer;
 FileInfo: PVSFixedFileInfo;
 VTranslation: PVerLang;
 VerKey, LangID: string;
 VerDesc: PChar;
begin
 Info.Version := "";
 Info.CompanyName := "";
 Info.Description := "";
 Info.Comment := "";
 InfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
 if InfoSize = 0 then
   Exit;
 GetMem (VerInfo, InfoSize);
 try
   if not GetFileVersionInfo(PChar(FileName), 0, InfoSize, VerInfo) then
     Exit;
   VerQueryValue (VerInfo, "\", Pointer(FileInfo), Dummy);
   Info.Version := Format("%d.%d.%d.%d", [FileInfo.dwFileVersionMS shr 16,
     FileInfo.dwFileVersionMS and $FFFF, FileInfo.dwFileVersionLS shr 16,
     FileInfo.dwFileVersionLS and $FFFF]);
   VerQueryValue( VerInfo, "\VarFileInfo\Translation", Pointer(VTranslation),
     Dummy);
   if Dummy = 4 then begin
     LangID := Format("%.4x%.4x", [VTranslation^.CharSet,
       VTranslation^.LangID]);
     VerKey := "\StringFileInfo\"+LangID+"\FileDescription";
     if VerQueryValue (VerInfo, PChar(VerKey), Pointer(VerDesc), Dummy) and
         (Dummy <> 0) then
       Info.Description := VerDesc;
     VerKey := "\StringFileInfo\"+LangID+"\CompanyName";
     if VerQueryValue (VerInfo, PChar(VerKey), Pointer(VerDesc), Dummy) and
         (Dummy <> 0) then
       Info.CompanyName := VerDesc;
     VerKey := "\StringFileInfo\"+LangID+"\Comments";
     if VerQueryValue (VerInfo, PChar(VerKey), Pointer(VerDesc), Dummy) and
         (Dummy <> 0) then
       Info.Comment := VerDesc;
   end;
 finally
   FreeMem(VerInfo);
 end;
end;

---

← →
Карелин Артем ©   (2006-05-25 23:58) [4]

Jedi

---

← →
GEN++ ©   (2006-05-26 00:00) [5]

>Джо
>Игорь Шевченко

 Спасибо  !!!!!! - то что нужно

---

← →
Игорь Шевченко ©   (2006-05-26 00:04) [6]

Забыл:

 THSVersionInfo = packed record
   Version: string;
   CompanyName: string;
   Description: string;
   Comment: string;
 end;



---

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

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

Наверх

Память: 0.48 MB
Время: 0.011 c