Return to VersionInfo.pas CVS log

Up to [mozdev] / mozptch

Annotation of mozptch/VersionInfo.pas, revision 1.2

1.1       oertel      1: (*
                      2: Most parts of this unit are from:
                      3: 
                      4: Campulka Jirí
                      5: B. Nemcové 630
                      6: 388 01 Blatná
                      7: Czech Republic
                      8: Tel:+420 603 793409
                      9: E-mail:        campulka@seznam.cz
                     10: admin@campulka.net
                     11: 
                     12: some parts are added from the unit VersionInfo from:
                     13: George Cornea
                     14: (george@bg.com.ro)
                     15: 
                     16: both from torry's delphi page
                     17: http://www.torry.net/sustem_versioninfo.htm
                     18: 
                     19: detlef oertel 23.4.03
                     20: Additional Copyright (c) uib umwelt informatik buero gmbh (www.uib.de)
                     21:  This sourcecode is owned by uib
                     22:  and published under the Terms of the General Public License.
                     23: #*###CVS_HEAD_START###******************************************************
1.2     ! oertel     24: # $Id: VersionInfo.pas,v 1.1 2004/03/14 12:49:07 oertel Exp $
1.1       oertel     25: #
                     26: #*###EXCLUDE_CVS_LOG###*****************************************************
                     27: # History:
                     28: # ========
                     29: #
1.2     ! oertel     30: # $Log: VersionInfo.pas,v $
        !            31: # Revision 1.1  2004/03/14 12:49:07  oertel
        !            32: # Initial commit version 9.29
        !            33: #
1.1       oertel     34: *)
                     35: 
                     36: unit VersionInfo;
                     37: 
                     38: interface
1.2     ! oertel     39: {$IFDEF MSWINDOWS}
1.1       oertel     40: uses
                     41:   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
                     42: 
                     43: type
                     44:   TVerInfoHeader = record
                     45:     Len: Word;
                     46:     ValueLen: Word;
                     47:     DataType: Word;
                     48:     Key: String;
                     49:   end;
                     50: 
                     51:   PLangIdRec = ^TLangIdRec;
                     52:   TLangIdRec = packed record
                     53:     case Integer of
                     54:     0: (
                     55:       LangId: Word;
                     56:       CodePage: Word);
                     57:     1: (
                     58:       Pair: DWORD);
                     59:   end;
                     60: 
                     61:   TVerInfoFixed = record
                     62:     FixedInfo: TVSFixedFileInfo;
                     63:     LangIdRec: TLangIdRec;
                     64:   end;
                     65: 
                     66:   type  TVersionInfoRec = record
                     67:            CompanyName      : string;
                     68:            FileDescription  : string;
                     69:            FileVersion      : string;
                     70:            InternalName     : string;
                     71:            LegalCopyright   : string;
                     72:            LegalTradeMarks  : string;
                     73:            OriginalFilename : string;
                     74:            ProductName      : string;
                     75:            ProductVersion   : string;
                     76:            Comments         : string;
                     77:       end;
                     78: 
                     79: 
                     80: 
                     81: 
                     82: function GetVersionInfoRec(FileName: String): TVersionInfoRec;
                     83: function GetVersionInfo(Name: String; Appname : string): string;
1.2     ! oertel     84: {$ENDIF}
1.1       oertel     85: implementation
1.2     ! oertel     86: {$IFDEF MSWINDOWS}
1.1       oertel     87: 
                     88: 
                     89: procedure Padding(var P: PChar);
                     90: begin
                     91:     while DWORD(P) and 3 <> 0 do Inc(P);
                     92: end;
                     93: 
                     94: function GetHeader(var P: PChar): TVerInfoHeader;
                     95: var
                     96:   TempKey: PWideChar;
                     97: begin
                     98:   Result.Len := PWord(P)^;
                     99:   if Result.Len = 0 then
                    100:   begin
                    101:     Exit;
                    102:   end;
                    103:   Inc(P, SizeOf(Word));
                    104:   Result.ValueLen := PWord(P)^;
                    105:   Inc(P, SizeOf(Word));
                    106:   Result.DataType := PWord(P)^;
                    107:   Inc(P, SizeOf(Word));
                    108:   TempKey := PWideChar(P);
                    109:   Inc(P, (lstrlenW(TempKey) + 1) * SizeOf(WideChar));
                    110:   Result.Key := TempKey;
                    111:   Padding(P);
                    112: end;
                    113: 
                    114: function GetFixedInfo(var P: PChar): TVerInfoFixed;
                    115: var IH: TVerInfoHeader;
                    116: begin
                    117:   IH:=GetHeader(P);
                    118:   FillChar(Result,SizeOf(TVerInfoFixed),#0);
                    119:   if IH.Key='VS_VERSION_INFO' then
                    120:   begin
                    121:     Result.FixedInfo:=PVSFixedFileInfo(P)^;
                    122:     Inc(P,IH.ValueLen);
                    123:     Padding(P);
                    124:     IH:=GetHeader(P);
                    125:     Inc(P,IH.ValueLen);
                    126:     if IH.Key = 'StringFileInfo' then
                    127:     begin
                    128:       IH:=GetHeader(P);
                    129:       Padding(P);
                    130:       Result.LangIdRec.LangId := StrToIntDef('$' + Copy(IH.Key, 1, 4), 0);
                    131:       Result.LangIdRec.CodePage := StrToIntDef('$' + Copy(IH.Key, 5, 4), 0);
                    132:     end;
                    133:   end;
                    134: end;
                    135: 
                    136: function GetFixedFileInfo: TVSFixedFileInfo;
                    137: var AppName: String;
                    138:     Handle,Size1: DWORD;
                    139:     Buf: PChar;
                    140:     VIF: TVerInfoFixed;
                    141: begin
                    142:   FillChar(Result,SizeOf(TVSFixedFileInfo),#0);
                    143:   AppName:=Application.ExeName;
                    144:   Size1:=GetFileVersionInfoSize(PChar(AppName),Handle);
                    145:   GetMem(Buf,Size1);
                    146:   if GetFileVersionInfo(PChar(AppName),Handle,Size1,Buf) then
                    147:   begin
                    148:     VIF:=GetFixedInfo(Buf);
                    149:     Result:=VIF.FixedInfo;
                    150:   end;
                    151:   FreeMem(Buf,Size1);
                    152: end;
                    153: 
                    154: function GetVersionInfo(Name: String; Appname : String): string;
                    155: var //AppName: String;
                    156:     Handle,Size1,Size2: DWORD;
                    157:     Buf,Info,IBuf: PChar;
                    158:     VeIn: String;
                    159:     VIF: TVerInfoFixed;
                    160:     LocaleStr: String;
                    161: begin
                    162:   AppName:=Application.ExeName;
                    163:   Size1:=GetFileVersionInfoSize(PChar(AppName),Handle);
                    164:   GetMem(Buf,Size1);
                    165:   if GetFileVersionInfo(PChar(AppName),Handle,Size1,Buf) then
                    166:   begin
                    167:     IBuf:=Pointer(Buf);
                    168:     VIF:=GetFixedInfo(IBuf);
                    169:     LocaleStr:=IntToHex(VIF.LangIdRec.LangId,4)+IntToHex(VIF.LangIdRec.CodePage,4);
                    170:     if VerQueryValue(Buf,PChar('\\StringFileInfo\\'+LocaleStr+'\\'+Name),Pointer(Info),Size2) then
                    171:     begin
                    172:       VeIn:=Info;
                    173:       Result:=VeIn;
                    174:     end else Result:='';
                    175:   end else Result:='';
                    176:   FreeMem(Buf,Size1);
                    177: end;
                    178: 
                    179: function GetVersionInfoRec(FileName: String): TVersionInfoRec;
                    180: begin
                    181:  with Result do
                    182:  begin
                    183:   CompanyName       := GetVersionInfo('CompanyName',Filename);
                    184:   FileDescription   := GetVersionInfo('FileDescription',Filename);
                    185:   FileVersion       := GetVersionInfo('FileVersion',Filename);
                    186:   InternalName      := GetVersionInfo('InternalName',Filename);
                    187:   LegalCopyright    := GetVersionInfo('LegalCopyright',Filename);
                    188:   LegalTradeMarks   := GetVersionInfo('LegalTradeMarks',Filename);
                    189:   OriginalFilename  := GetVersionInfo('OriginalFilename',Filename);
                    190:   ProductName       := GetVersionInfo('ProductName',Filename);
                    191:   ProductVersion    := GetVersionInfo('ProductVersion',Filename);
                    192:   Comments          := GetVersionInfo('Comments',Filename);
                    193:  end;
                    194: end;
                    195: 
1.2     ! oertel    196: {$ENDIF}
1.1       oertel    197: end.