File:  [mozdev] / mozptch / VersionInfo.pas
Revision 1.2: download - view: text, annotated - select for diffs - revision graph
Sun May 30 19:51:15 2004 UTC (15 years, 6 months ago) by oertel
Branches: MAIN
CVS tags: version_30_05_04, HEAD
-Linux support ready for delivery (beta)
-New Variables for EmailAddress, ncoming and outgoing server
-INI-Files debuged
- new bin zip file

(*
Most parts of this unit are from:

Campulka Jirí
B. Nemcové 630
388 01 Blatná
Czech Republic
Tel:+420 603 793409
E-mail: 	campulka@seznam.cz
admin@campulka.net

some parts are added from the unit VersionInfo from:
George Cornea
(george@bg.com.ro)

both from torry's delphi page
http://www.torry.net/sustem_versioninfo.htm

detlef oertel 23.4.03
Additional Copyright (c) uib umwelt informatik buero gmbh (www.uib.de)
 This sourcecode is owned by uib
 and published under the Terms of the General Public License.
#*###CVS_HEAD_START###******************************************************
# $Id: VersionInfo.pas,v 1.2 2004/05/30 19:51:15 oertel Exp $
#
#*###EXCLUDE_CVS_LOG###*****************************************************
# History:
# ========
#
# $Log: VersionInfo.pas,v $
# Revision 1.2  2004/05/30 19:51:15  oertel
# -Linux support ready for delivery (beta)
# -New Variables for EmailAddress, ncoming and outgoing server
# -INI-Files debuged
# - new bin zip file
#
# Revision 1.1  2004/03/14 12:49:07  oertel
# Initial commit version 9.29
#
*)

unit VersionInfo;

interface
{$IFDEF MSWINDOWS}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TVerInfoHeader = record
    Len: Word;
    ValueLen: Word;
    DataType: Word;
    Key: String;
  end;

  PLangIdRec = ^TLangIdRec;
  TLangIdRec = packed record
    case Integer of
    0: (
      LangId: Word;
      CodePage: Word);
    1: (
      Pair: DWORD);
  end;

  TVerInfoFixed = record
    FixedInfo: TVSFixedFileInfo;
    LangIdRec: TLangIdRec;
  end;

  type  TVersionInfoRec = record
           CompanyName      : string;
           FileDescription  : string;
           FileVersion      : string;
           InternalName     : string;
           LegalCopyright   : string;
           LegalTradeMarks  : string;
           OriginalFilename : string;
           ProductName      : string;
           ProductVersion   : string;
           Comments         : string;
      end;




function GetVersionInfoRec(FileName: String): TVersionInfoRec;
function GetVersionInfo(Name: String; Appname : string): string;
{$ENDIF}
implementation
{$IFDEF MSWINDOWS}


procedure Padding(var P: PChar);
begin
    while DWORD(P) and 3 <> 0 do Inc(P);
end;

function GetHeader(var P: PChar): TVerInfoHeader;
var
  TempKey: PWideChar;
begin
  Result.Len := PWord(P)^;
  if Result.Len = 0 then
  begin
    Exit;
  end;
  Inc(P, SizeOf(Word));
  Result.ValueLen := PWord(P)^;
  Inc(P, SizeOf(Word));
  Result.DataType := PWord(P)^;
  Inc(P, SizeOf(Word));
  TempKey := PWideChar(P);
  Inc(P, (lstrlenW(TempKey) + 1) * SizeOf(WideChar));
  Result.Key := TempKey;
  Padding(P);
end;

function GetFixedInfo(var P: PChar): TVerInfoFixed;
var IH: TVerInfoHeader;
begin
  IH:=GetHeader(P);
  FillChar(Result,SizeOf(TVerInfoFixed),#0);
  if IH.Key='VS_VERSION_INFO' then
  begin
    Result.FixedInfo:=PVSFixedFileInfo(P)^;
    Inc(P,IH.ValueLen);
    Padding(P);
    IH:=GetHeader(P);
    Inc(P,IH.ValueLen);
    if IH.Key = 'StringFileInfo' then
    begin
      IH:=GetHeader(P);
      Padding(P);
      Result.LangIdRec.LangId := StrToIntDef('$' + Copy(IH.Key, 1, 4), 0);
      Result.LangIdRec.CodePage := StrToIntDef('$' + Copy(IH.Key, 5, 4), 0);
    end;
  end;
end;

function GetFixedFileInfo: TVSFixedFileInfo;
var AppName: String;
    Handle,Size1: DWORD;
    Buf: PChar;
    VIF: TVerInfoFixed;
begin
  FillChar(Result,SizeOf(TVSFixedFileInfo),#0);
  AppName:=Application.ExeName;
  Size1:=GetFileVersionInfoSize(PChar(AppName),Handle);
  GetMem(Buf,Size1);
  if GetFileVersionInfo(PChar(AppName),Handle,Size1,Buf) then
  begin
    VIF:=GetFixedInfo(Buf);
    Result:=VIF.FixedInfo;
  end;
  FreeMem(Buf,Size1);
end;

function GetVersionInfo(Name: String; Appname : String): string;
var //AppName: String;
    Handle,Size1,Size2: DWORD;
    Buf,Info,IBuf: PChar;
    VeIn: String;
    VIF: TVerInfoFixed;
    LocaleStr: String;
begin
  AppName:=Application.ExeName;
  Size1:=GetFileVersionInfoSize(PChar(AppName),Handle);
  GetMem(Buf,Size1);
  if GetFileVersionInfo(PChar(AppName),Handle,Size1,Buf) then
  begin
    IBuf:=Pointer(Buf);
    VIF:=GetFixedInfo(IBuf);
    LocaleStr:=IntToHex(VIF.LangIdRec.LangId,4)+IntToHex(VIF.LangIdRec.CodePage,4);
    if VerQueryValue(Buf,PChar('\\StringFileInfo\\'+LocaleStr+'\\'+Name),Pointer(Info),Size2) then
    begin
      VeIn:=Info;
      Result:=VeIn;
    end else Result:='';
  end else Result:='';
  FreeMem(Buf,Size1);
end;

function GetVersionInfoRec(FileName: String): TVersionInfoRec;
begin
 with Result do
 begin
  CompanyName       := GetVersionInfo('CompanyName',Filename);
  FileDescription   := GetVersionInfo('FileDescription',Filename);
  FileVersion       := GetVersionInfo('FileVersion',Filename);
  InternalName      := GetVersionInfo('InternalName',Filename);
  LegalCopyright    := GetVersionInfo('LegalCopyright',Filename);
  LegalTradeMarks   := GetVersionInfo('LegalTradeMarks',Filename);
  OriginalFilename  := GetVersionInfo('OriginalFilename',Filename);
  ProductName       := GetVersionInfo('ProductName',Filename);
  ProductVersion    := GetVersionInfo('ProductVersion',Filename);
  Comments          := GetVersionInfo('Comments',Filename);
 end;
end;

{$ENDIF}
end.

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>