/packages/fcl-res/src/versionresource.pp
Puppet | 593 lines | 526 code | 67 blank | 0 comment | 26 complexity | 6aa2114f2552950f17c280ea7387d109 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
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.