/packages/fcl-res/src/versionresource.pp

  1{
  2    This file is part of the Free Pascal run time library.
  3    Copyright (c) 2008 by Giulio Bernardi
  4
  5    Version information resource type
  6
  7    See the file COPYING.FPC, included in this distribution,
  8    for details about the copyright.
  9
 10    This program is distributed in the hope that it will be useful,
 11    but WITHOUT ANY WARRANTY; without even the implied warranty of
 12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 13
 14 **********************************************************************}
 15
 16unit versionresource;
 17
 18{$MODE OBJFPC}
 19
 20interface
 21
 22uses
 23  SysUtils, Classes, resource, versiontypes;
 24
 25type
 26  TVerBlockHeader = packed record
 27    length    : word;
 28    vallength : word;
 29    valtype   : word;
 30    key       : string;
 31  end;
 32
 33type
 34
 35  { TVersionResource }
 36
 37  TVersionResource = class(TAbstractResource)
 38  private
 39    fType : TResourceDesc;
 40    fName : TResourceDesc;
 41    fFixedInfo : TVersionFixedInfo;
 42    fStringFileInfo : TVersionStringFileInfo;
 43    fVarFileInfo : TVersionVarFileInfo;
 44    function SwapVersion(const aData : qword) : qword;
 45    procedure AlignDWordReading;
 46    procedure AlignDWordWriting;
 47    function GetFileInfo : TVersionStringFileInfo;
 48    function GetFixedInfo : TVersionFixedInfo;
 49    function GetVarInfo : TVersionVarFileInfo;
 50    procedure CheckDataLoaded;
 51    procedure LoadData;
 52    procedure LoadFixedInfos;
 53    function ReadBlockHeader(out aBlock : TVerBlockHeader) : integer;
 54    function ReadStringFileInfo(toread : integer) : integer;
 55    function ReadVarFileInfo(toread : integer) : integer;
 56    function ReadStringTable(toread : integer;aName : string) : integer;
 57    function ReadWideString: string;
 58    procedure WriteFixedBlockLength(const position : int64);
 59    procedure WriteData;
 60    procedure WriteFixedInfos;
 61    procedure WriteStringFileInfo;
 62    procedure WriteStringTable(aTable : TVersionStringTable);
 63    procedure WriteStringEntry(const aKey, aValue : string);
 64    procedure WriteVarFileInfo;
 65    procedure WriteVarEntry(aEntry : TVerTranslationInfo);
 66    procedure WriteWideString(const aString : string);
 67  protected
 68    function GetType : TResourceDesc; override;
 69    function GetName : TResourceDesc; override;
 70    function ChangeDescTypeAllowed(aDesc : TResourceDesc) : boolean; override;
 71    function ChangeDescValueAllowed(aDesc : TResourceDesc) : boolean; override;
 72    procedure NotifyResourcesLoaded; override;
 73  public
 74    constructor Create; override;
 75    constructor Create(aType,aName : TResourceDesc); override;
 76    destructor Destroy; override;
 77    procedure UpdateRawData; override;
 78    property FixedInfo : TVersionFixedInfo read GetFixedInfo;
 79    property StringFileInfo : TVersionStringFileInfo read GetFileInfo;
 80    property VarFileInfo : TVersionVarFileInfo read GetVarInfo;
 81  end;
 82
 83
 84implementation
 85
 86uses
 87  resfactory;
 88  
 89type
 90  TVSFixedFileInfo = packed record
 91    signature : longword;
 92    verMinor  : word;
 93    verMajor  : word;
 94    FileVersion : qword;
 95    ProductVersion : qword;
 96    FileFlagsMask : longword;
 97    FileFlags     : longword;
 98    FileOS        : longword;
 99    FileType      : longword;
100    FileSubType   : longword;
101    FileDate      : qword;
102  end;
103
104
105{ TVersionResource }
106
107function TVersionResource.SwapVersion(const aData: qword): qword;
108begin
109  {$IFDEF ENDIAN_BIG}
110  Result:=Swap(aData);                      //MSLW is stored first...
111  Result:=SwapEndian(Result);
112  {$ELSE}
113  Result:=Swap(longword(hi(aData)));
114  Result:=Result shl 32;
115  Result:=Result or Swap(longword(lo(aData)));
116  {$ENDIF}
117end;
118
119procedure TVersionResource.AlignDWordReading;
120var toskip : integer;
121begin
122  toskip:=4-(RawData.Position mod 4);
123  if toskip<>4 then RawData.Seek(toskip,soFromCurrent);
124end;
125
126procedure TVersionResource.AlignDWordWriting;
127var topad : integer;
128    lw : longword;
129begin
130  lw:=0;
131  topad:=4-(RawData.Position mod 4);
132  if topad<>4 then RawData.WriteBuffer(lw,topad);
133end;
134
135function TVersionResource.GetFileInfo: TVersionStringFileInfo;
136begin
137  CheckDataLoaded;
138  Result:=fStringFileInfo;
139end;
140
141function TVersionResource.GetFixedInfo: TVersionFixedInfo;
142begin
143  CheckDataLoaded;
144  Result:=fFixedInfo;
145end;
146
147function TVersionResource.GetVarInfo: TVersionVarFileInfo;
148begin
149  CheckDataLoaded;
150  Result:=fVarFileInfo;
151end;
152
153procedure TVersionResource.CheckDataLoaded;
154begin
155  if fFixedInfo<>nil then exit;
156  //if we have no data stream, create empty structures
157  if RawData.Size=0 then
158  begin
159    fFixedInfo:=TVersionFixedInfo.Create;
160    fStringFileInfo:=TVersionStringFileInfo.Create;
161    fVarFileInfo:=TVersionVarFileInfo.Create;
162  end
163  else LoadData;
164end;
165
166procedure TVersionResource.LoadData;
167var tmp : integer;
168    toread : word;
169    block : TVerBlockHeader;
170    i : integer;
171begin
172  RawData.Position:=0;
173  tmp:=ReadBlockHeader(block);
174                                        //block.key should be 'VS_VERSION_INFO'
175  toread:=block.length;
176  LoadFixedInfos;
177  AlignDWordReading;
178  dec(toread,RawData.Position);
179  
180  fStringFileInfo:=TVersionStringFileInfo.Create;
181  fVarFileInfo:=TVersionVarFileInfo.Create;
182
183  for i:=1 to 2 do
184  begin
185    if toread<=0 then exit;
186    tmp:=ReadBlockHeader(block);
187    dec(toread,tmp);
188    if block.key='StringFileInfo' then tmp:=ReadStringFileInfo(block.length-tmp)
189    else if block.key='VarFileInfo' then tmp:=ReadVarFileInfo(block.length-tmp);
190    dec(toread,tmp);
191  end;
192
193end;
194
195procedure TVersionResource.LoadFixedInfos;
196var infodata : TVSFixedFileInfo;
197begin
198  RawData.ReadBuffer(infodata,sizeof(infodata));
199  infodata.FileVersion:=SwapVersion(infodata.FileVersion);
200  infodata.ProductVersion:=SwapVersion(infodata.ProductVersion);
201  infodata.FileDate:=Swap(infodata.FileDate);             //MSLW is stored first...
202  {$IFDEF ENDIAN_BIG}
203  infodata.signature:=SwapEndian(infodata.signature);
204  infodata.verMinor:=SwapEndian(infodata.verMinor);
205  infodata.verMajor:=SwapEndian(infodata.verMajor);
206  infodata.FileFlagsMask:=SwapEndian(infodata.FileFlagsMask);
207  infodata.FileFlags:=SwapEndian(infodata.FileFlags);
208  infodata.FileOS:=SwapEndian(infodata.FileOS);
209  infodata.FileType:=SwapEndian(infodata.FileType);
210  infodata.FileSubType:=SwapEndian(infodata.FileSubType);
211  infodata.FileDate:=SwapEndian(infodata.FileDate);
212  {$ENDIF}
213  fFixedInfo:=TVersionFixedInfo.Create;
214  fFixedInfo.FileVersion:=TFileProductVersion(infodata.FileVersion);
215  fFixedInfo.ProductVersion:=TFileProductVersion(infodata.ProductVersion);
216  fFixedInfo.FileFlagsMask:=infodata.FileFlagsMask;
217  fFixedInfo.FileFlags:=infodata.FileFlags;
218  fFixedInfo.FileOS:=infodata.FileOS;
219  fFixedInfo.FileType:=infodata.FileType;
220  fFixedInfo.FileSubType:=infodata.FileSubType;
221  fFixedInfo.FileDate:=infodata.FileDate;
222end;
223
224function TVersionResource.ReadBlockHeader(out aBlock: TVerBlockHeader
225  ): integer;
226var before : int64;
227begin
228  before:=RawData.Position;
229  RawData.ReadBuffer(aBlock,6);
230  {$IFDEF ENDIAN_BIG}
231  aBlock.length:=SwapEndian(aBlock.length);
232  aBlock.vallength:=SwapEndian(aBlock.vallength);
233  aBlock.valtype:=SwapEndian(aBlock.valtype);
234  {$ENDIF}
235  aBlock.key:=ReadWideString;
236  AlignDWordReading;
237  Result:=RawData.Position-before;
238end;
239
240function TVersionResource.ReadStringFileInfo(toread : integer) : integer;
241var block : TVerBlockHeader;
242    tmp : integer;
243begin
244  Result:=0;
245  while toread>0 do
246  begin
247    tmp:=ReadBlockHeader(block);
248    dec(toread,tmp); inc(Result,tmp);
249    tmp:=ReadStringTable(block.length-tmp,block.key);
250    dec(toread,tmp); inc(Result,tmp);
251  end;
252end;
253
254function TVersionResource.ReadVarFileInfo(toread : integer) : integer;
255var block : TVerBlockHeader;
256    tmp : integer;
257    vinfo : TVerTranslationInfo;
258    before : int64;
259begin
260  Result:=0;
261  while toread>0 do
262  begin
263    before:=RawData.Position;
264    ReadBlockHeader(block);
265    if (block.valtype<>0) or (block.key<>'Translation') then
266      RawData.Seek(block.vallength,soFromCurrent)
267    else
268    begin
269      RawData.ReadBuffer(vinfo,sizeof(vinfo));
270      {$IFDEF ENDIAN_BIG}
271      vinfo.language:=SwapEndian(vinfo.language);
272      vinfo.codepage:=SwapEndian(vinfo.codepage);
273      {$ENDIF}
274      fVarFileInfo.Add(vinfo);
275    end;
276    AlignDWordReading;
277    tmp:=RawData.Position-before;
278    dec(toread,tmp); inc(Result,tmp);
279  end;
280end;
281
282function TVersionResource.ReadStringTable(toread: integer; aName: string
283  ): integer;
284var strtable : TVersionStringTable;
285    tmp : integer;
286    block : TVerBlockHeader;
287    value : string;
288    before : int64;
289begin
290  Result:=0;
291  strtable:=TVersionStringTable.Create(aName);
292  fStringFileInfo.Add(strtable);
293  while toread>0 do
294  begin
295    before:=RawData.Position;
296    ReadBlockHeader(block);
297    value:=ReadWideString;
298    AlignDWordReading;
299    tmp:=RawData.Position-before;
300    dec(toread,tmp); inc(Result,tmp);
301    strtable.Add(block.key,value);
302  end;
303end;
304
305function TVersionResource.ReadWideString: string;
306var w : word;
307    ws : widestring;
308begin
309  ws:='';
310  w:=0;
311  repeat
312    RawData.ReadBuffer(w,2);
313    if w = 0 then break;
314    {$IFDEF ENDIAN_BIG}
315    w:=SwapEndian(w);
316    {$ENDIF}
317    ws:=ws+widechar(w);
318  until false;
319  Result:=ws;
320end;
321
322procedure TVersionResource.WriteFixedBlockLength(const position: int64);
323var after : int64;
324    len : word;
325begin
326  after:=RawData.Position;
327  len:=after-position;
328  {$IFDEF ENDIAN_BIG}
329  len:=SwapEndian(len);
330  {$ENDIF}
331  RawData.Position:=position;
332  RawData.WriteBuffer(len,2);
333  RawData.Position:=after;
334end;
335
336procedure TVersionResource.WriteData;
337var block : TVerBlockHeader;
338begin
339  RawData.Size:=0;
340  RawData.Position:=0;
341
342  block.length:=0;
343  block.vallength:=$34;
344  block.valtype:=0;
345  block.key:='VS_VERSION_INFO';
346  {$IFDEF ENDIAN_BIG}
347  block.vallength:=SwapEndian(block.vallength);
348  block.valtype:=SwapEndian(block.valtype);
349  {$ENDIF}
350
351  RawData.WriteBuffer(block,6);
352  WriteWideString(block.key);
353  AlignDWordWriting;
354
355  WriteFixedInfos;
356  AlignDWordWriting;
357
358  if fStringFileInfo.Count>0 then WriteStringFileInfo;
359  if fVarFileInfo.Count>0 then WriteVarFileInfo;
360
361  WriteFixedBlockLength(0);
362end;
363
364procedure TVersionResource.WriteFixedInfos;
365var infodata : TVSFixedFileInfo;
366begin
367  infodata.signature:=$FEEF04BD;
368  infodata.verMinor:=0;
369  infodata.verMajor:=1;
370  infodata.FileVersion:=qword(fFixedInfo.FileVersion);
371  infodata.ProductVersion:=qword(fFixedInfo.ProductVersion);
372  infodata.FileFlagsMask:=fFixedInfo.FileFlagsMask;
373  infodata.FileFlags:=fFixedInfo.FileFlags;
374  infodata.FileOS:=fFixedInfo.FileOS;
375  infodata.FileType:=fFixedInfo.FileType;
376  infodata.FileSubType:=fFixedInfo.FileSubType;
377  infodata.FileDate:=fFixedInfo.FileDate;
378  {$IFDEF ENDIAN_BIG}
379  infodata.signature:=SwapEndian(infodata.signature);
380  infodata.verMinor:=SwapEndian(infodata.verMinor);
381  infodata.verMajor:=SwapEndian(infodata.verMajor);
382  infodata.FileFlagsMask:=SwapEndian(infodata.FileFlagsMask);
383  infodata.FileFlags:=SwapEndian(infodata.FileFlags);
384  infodata.FileOS:=SwapEndian(infodata.FileOS);
385  infodata.FileType:=SwapEndian(infodata.FileType);
386  infodata.FileSubType:=SwapEndian(infodata.FileSubType);
387  infodata.FileDate:=SwapEndian(infodata.FileDate);
388  {$ENDIF}
389  infodata.FileVersion:=SwapVersion(infodata.FileVersion);
390  infodata.ProductVersion:=SwapVersion(infodata.ProductVersion);
391  infodata.FileDate:=Swap(infodata.FileDate);             //MSLW is stored first...
392  RawData.WriteBuffer(infodata,sizeof(infodata));
393end;
394
395procedure TVersionResource.WriteStringFileInfo;
396var block : TVerBlockHeader;
397    i : integer;
398    before : int64;
399begin
400  before:=RawData.Position;
401  block.length:=0;
402  block.vallength:=0;
403  block.valtype:=1;
404  block.key:='StringFileInfo';
405  {$IFDEF ENDIAN_BIG}
406  block.vallength:=SwapEndian(block.vallength);
407  block.valtype:=SwapEndian(block.valtype);
408  {$ENDIF}
409  RawData.WriteBuffer(block,6);
410  WriteWideString(block.key);
411  AlignDWordWriting;
412  
413  for i:=0 to fStringFileInfo.Count-1 do
414    WriteStringTable(fStringFileInfo[i]);
415  
416  WriteFixedBlockLength(before);
417end;
418
419procedure TVersionResource.WriteStringTable(aTable: TVersionStringTable);
420var block : TVerBlockHeader;
421    i : integer;
422    before : int64;
423begin
424  before:=RawData.Position;
425  block.length:=0;
426  block.vallength:=0;
427  block.valtype:=1;
428  block.key:=aTable.Name;
429  {$IFDEF ENDIAN_BIG}
430  block.vallength:=SwapEndian(block.vallength);
431  block.valtype:=SwapEndian(block.valtype);
432  {$ENDIF}
433  RawData.WriteBuffer(block,6);
434  WriteWideString(block.key);
435  AlignDWordWriting;
436
437  for i:=0 to aTable.Count-1 do
438    WriteStringEntry(aTable.Keys[i],aTable.ValuesByIndex[i]);
439
440  WriteFixedBlockLength(before);
441end;
442
443procedure TVersionResource.WriteStringEntry(const aKey, aValue: string);
444var block : TVerBlockHeader;
445    before: int64;
446begin
447  before:=RawData.Position;
448  block.length:=0;
449  block.vallength:=length(aValue)+1;
450  block.valtype:=1;
451  block.key:=aKey;
452  {$IFDEF ENDIAN_BIG}
453  block.vallength:=SwapEndian(block.vallength);
454  block.valtype:=SwapEndian(block.valtype);
455  {$ENDIF}
456  RawData.WriteBuffer(block,6);
457  WriteWideString(block.key);
458  AlignDWordWriting;
459  WriteWideString(aValue);
460  AlignDWordWriting;
461
462  WriteFixedBlockLength(before);
463end;
464
465procedure TVersionResource.WriteVarFileInfo;
466var block : TVerBlockHeader;
467    i : integer;
468    before : int64;
469begin
470  before:=RawData.Position;
471  block.length:=0;
472  block.vallength:=0;
473  block.valtype:=1;
474  block.key:='VarFileInfo';
475  {$IFDEF ENDIAN_BIG}
476  block.vallength:=SwapEndian(block.vallength);
477  block.valtype:=SwapEndian(block.valtype);
478  {$ENDIF}
479  RawData.WriteBuffer(block,6);
480  WriteWideString(block.key);
481  AlignDWordWriting;
482
483  for i:=0 to fVarFileInfo.Count-1 do
484    WriteVarEntry(fVarFileInfo[i]);
485
486  WriteFixedBlockLength(before);
487end;
488
489procedure TVersionResource.WriteVarEntry(aEntry: TVerTranslationInfo);
490var block : TVerBlockHeader;
491    before: int64;
492begin
493  before:=RawData.Position;
494  block.length:=0;
495  block.vallength:=4;
496  block.valtype:=0;
497  block.key:='Translation';
498  {$IFDEF ENDIAN_BIG}
499  block.vallength:=SwapEndian(block.vallength);
500  block.valtype:=SwapEndian(block.valtype);
501  aEntry.language:=SwapEndian(aEntry.language);
502  aEntry.codepage:=SwapEndian(aEntry.codepage);
503  {$ENDIF}
504  RawData.WriteBuffer(block,6);
505  WriteWideString(block.key);
506  AlignDWordWriting;
507  RawData.WriteBuffer(aEntry,sizeof(aEntry));
508  WriteFixedBlockLength(before);
509end;
510
511procedure TVersionResource.WriteWideString(const aString: string);
512var ws : widestring;
513    w : word;
514    i : integer;
515begin
516  ws:=aString;
517  for i:=1 to length(ws) do
518  begin
519    w:=word(ws[i]);
520    {$IFDEF ENDIAN_BIG}
521    w:=SwapEndian(w);
522    {$ENDIF}
523    RawData.WriteBuffer(w,2);
524  end;
525  w:=0;
526  RawData.WriteBuffer(w,2);
527end;
528
529function TVersionResource.GetType: TResourceDesc;
530begin
531  Result:=fType;
532end;
533
534function TVersionResource.GetName: TResourceDesc;
535begin
536  Result:=fName;
537end;
538
539function TVersionResource.ChangeDescTypeAllowed(aDesc: TResourceDesc): boolean;
540begin
541  Result:=false;
542end;
543
544function TVersionResource.ChangeDescValueAllowed(aDesc: TResourceDesc
545  ): boolean;
546begin
547  Result:=false;
548end;
549
550procedure TVersionResource.NotifyResourcesLoaded;
551begin
552end;
553
554constructor TVersionResource.Create;
555begin
556  inherited Create;
557  fType:=TResourceDesc.Create(RT_VERSION);
558  fName:=TResourceDesc.Create(1);
559  SetDescOwner(fType);
560  SetDescOwner(fName);
561  fFixedInfo:=nil;
562  fStringFileInfo:=nil;
563  fVarFileInfo:=nil;
564end;
565
566constructor TVersionResource.Create(aType, aName: TResourceDesc);
567begin
568  Create;
569end;
570
571destructor TVersionResource.Destroy;
572begin
573  fType.Free;
574  fName.Free;
575  if fFixedInfo<>nil then fFixedInfo.Free;
576  if fStringFileInfo<>nil then fStringFileInfo.Free;
577  if fVarFileInfo<>nil then fVarFileInfo.Free;
578  inherited Destroy;
579end;
580
581procedure TVersionResource.UpdateRawData;
582begin
583  if fFixedInfo=nil then exit;
584  WriteData;
585  FreeAndNil(fFixedInfo);
586  FreeAndNil(fStringFileInfo);
587  FreeAndNil(fVarFileInfo);
588end;
589
590initialization
591  TResourceFactory.RegisterResourceClass(RT_VERSION,TVersionResource);
592
593end.