[468] | 1 | ///*********************************************************************************************************************
|
---|
| 2 | /// $Id: DKL_ResFile.pas,v 1.4 2006/08/11 06:16:56 dale Exp $
|
---|
| 3 | ///---------------------------------------------------------------------------------------------------------------------
|
---|
| 4 | /// DKLang Localization Package
|
---|
| 5 | /// Copyright 2002-2006 DK Software, http://www.dk-soft.org
|
---|
| 6 | ///*********************************************************************************************************************
|
---|
| 7 | ///
|
---|
| 8 | /// The contents of this package are subject to the Mozilla Public License
|
---|
| 9 | /// Version 1.1 (the "License"); you may not use this file except in compliance
|
---|
| 10 | /// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
|
---|
| 11 | ///
|
---|
| 12 | /// Alternatively, you may redistribute this library, use and/or modify it under the
|
---|
| 13 | /// terms of the GNU Lesser General Public License as published by the Free Software
|
---|
| 14 | /// Foundation; either version 2.1 of the License, or (at your option) any later
|
---|
| 15 | /// version. You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/
|
---|
| 16 | ///
|
---|
| 17 | /// Software distributed under the License is distributed on an "AS IS" basis,
|
---|
| 18 | /// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
|
---|
| 19 | /// specific language governing rights and limitations under the License.
|
---|
| 20 | ///
|
---|
| 21 | /// The initial developer of the original code is Dmitry Kann, http://www.dk-soft.org/
|
---|
| 22 | ///
|
---|
| 23 | ///**********************************************************************************************************************
|
---|
| 24 | // Routines and classes to handle .res resource files.
|
---|
| 25 | // WARNING: TDKLang_ResFile only handles 32-bit resource files and does not support 16-bit ones!
|
---|
| 26 | //
|
---|
| 27 | unit DKL_ResFile;
|
---|
| 28 |
|
---|
| 29 | interface
|
---|
| 30 | uses Windows, SysUtils, Classes, Contnrs, TntClasses;
|
---|
| 31 |
|
---|
| 32 | type
|
---|
| 33 |
|
---|
| 34 | //===================================================================================================================
|
---|
| 35 | // Resource entry header
|
---|
| 36 | //===================================================================================================================
|
---|
| 37 |
|
---|
| 38 | PResResourceEntryHeader = ^TResResourceEntryHeader;
|
---|
| 39 | TResResourceEntryHeader = packed record
|
---|
| 40 | iDataSize: Integer; // Data size in bytes
|
---|
| 41 | iHeaderSize: Integer; // Header size in bytes
|
---|
| 42 | end;
|
---|
| 43 |
|
---|
| 44 | //===================================================================================================================
|
---|
| 45 | // Resource entry properties
|
---|
| 46 | //===================================================================================================================
|
---|
| 47 |
|
---|
| 48 | PResResourceEntryProps = ^TResResourceEntryProps;
|
---|
| 49 | TResResourceEntryProps = packed record
|
---|
| 50 | cDataVersion: Cardinal;
|
---|
| 51 | wMemoryFlags: Word;
|
---|
| 52 | wLanguage: LANGID;
|
---|
| 53 | cVersion: Cardinal;
|
---|
| 54 | cCharacteristics: Cardinal;
|
---|
| 55 | end;
|
---|
| 56 |
|
---|
| 57 | //===================================================================================================================
|
---|
| 58 | // .res file handler
|
---|
| 59 | //===================================================================================================================
|
---|
| 60 |
|
---|
| 61 | TDKLang_ResEntry = class;
|
---|
| 62 |
|
---|
| 63 | TDKLang_ResFile = class(TObject)
|
---|
| 64 | private
|
---|
| 65 | // Entry list
|
---|
| 66 | FEntries: TObjectList;
|
---|
| 67 | // Loads .res file contents from the stream
|
---|
| 68 | procedure LoadFromStream(Stream: TStream);
|
---|
| 69 | // Saves .res file contents into the stream
|
---|
| 70 | procedure SaveToStream(Stream: TStream);
|
---|
| 71 | function GetEntries(Index: Integer): TDKLang_ResEntry;
|
---|
| 72 | function GetEntryCount: Integer;
|
---|
| 73 | public
|
---|
| 74 | constructor Create;
|
---|
| 75 | destructor Destroy; override;
|
---|
| 76 | // Adds an entry and returns its index
|
---|
| 77 | function AddEntry(Item: TDKLang_ResEntry): Integer;
|
---|
| 78 | // Deletes the entry
|
---|
| 79 | procedure DeleteEntry(Index: Integer);
|
---|
| 80 | // Removes the entry and returns index it had before the deletion
|
---|
| 81 | function RemoveEntry(Item: TDKLang_ResEntry): Integer;
|
---|
| 82 | // Clears the entry list
|
---|
| 83 | procedure ClearEntries;
|
---|
| 84 | // Loads .res file contents from the file
|
---|
| 85 | procedure LoadFromFile(const wsFileName: WideString);
|
---|
| 86 | // Saves .res file contents into the file
|
---|
| 87 | procedure SaveToFile(const wsFileName: WideString);
|
---|
| 88 | // Tries to find an entry by its type and name. Returns nil if not found
|
---|
| 89 | function FindEntry(const wsType, wsName: WideString): TDKLang_ResEntry;
|
---|
| 90 | // Props
|
---|
| 91 | // -- Entry count
|
---|
| 92 | property EntryCount: Integer read GetEntryCount;
|
---|
| 93 | // -- Entries by index
|
---|
| 94 | property Entries[Index: Integer]: TDKLang_ResEntry read GetEntries; default;
|
---|
| 95 | end;
|
---|
| 96 |
|
---|
| 97 | //===================================================================================================================
|
---|
| 98 | // Single resource entry
|
---|
| 99 | //===================================================================================================================
|
---|
| 100 |
|
---|
| 101 | TDKLang_ResEntry = class(TObject)
|
---|
| 102 | private
|
---|
| 103 | // Prop storage
|
---|
| 104 | FCharacteristics: Cardinal;
|
---|
| 105 | FDataVersion: Cardinal;
|
---|
| 106 | FLanguage: LANGID;
|
---|
| 107 | FMemoryFlags: Word;
|
---|
| 108 | FName: WideString;
|
---|
| 109 | FRawData: String;
|
---|
| 110 | FResType: WideString;
|
---|
| 111 | FVersion: Cardinal;
|
---|
| 112 | public
|
---|
| 113 | // Stores resource entry into the stream
|
---|
| 114 | procedure SaveToStream(Stream: TStream);
|
---|
| 115 | // Creates and returns an exact copy of the entry
|
---|
| 116 | function Clone: TDKLang_ResEntry;
|
---|
| 117 | // Props
|
---|
| 118 | // -- Characteristics
|
---|
| 119 | property Characteristics: Cardinal read FCharacteristics write FCharacteristics;
|
---|
| 120 | // -- Data version
|
---|
| 121 | property DataVersion: Cardinal read FDataVersion write FDataVersion;
|
---|
| 122 | // -- Language
|
---|
| 123 | property Language: LANGID read FLanguage write FLanguage;
|
---|
| 124 | // -- Memory flags
|
---|
| 125 | property MemoryFlags: Word read FMemoryFlags write FMemoryFlags;
|
---|
| 126 | // -- Entry name
|
---|
| 127 | property Name: WideString read FName write FName;
|
---|
| 128 | // -- Raw (unparsed) entry data
|
---|
| 129 | property RawData: String read FRawData write FRawData;
|
---|
| 130 | // -- Entry resource type
|
---|
| 131 | property ResType: WideString read FResType write FResType;
|
---|
| 132 | // -- Version
|
---|
| 133 | property Version: Cardinal read FVersion write FVersion;
|
---|
| 134 | end;
|
---|
| 135 |
|
---|
| 136 | implementation //=======================================================================================================
|
---|
| 137 | uses TntDialogs;
|
---|
| 138 |
|
---|
| 139 | //===================================================================================================================
|
---|
| 140 | // TDKLang_ResFile
|
---|
| 141 | //===================================================================================================================
|
---|
| 142 |
|
---|
| 143 | function TDKLang_ResFile.AddEntry(Item: TDKLang_ResEntry): Integer;
|
---|
| 144 | begin
|
---|
| 145 | Result := FEntries.Add(Item);
|
---|
| 146 | end;
|
---|
| 147 |
|
---|
| 148 | procedure TDKLang_ResFile.ClearEntries;
|
---|
| 149 | begin
|
---|
| 150 | FEntries.Clear;
|
---|
| 151 | end;
|
---|
| 152 |
|
---|
| 153 | constructor TDKLang_ResFile.Create;
|
---|
| 154 | begin
|
---|
| 155 | inherited Create;
|
---|
| 156 | FEntries := TObjectList.Create(True);
|
---|
| 157 | end;
|
---|
| 158 |
|
---|
| 159 | procedure TDKLang_ResFile.DeleteEntry(Index: Integer);
|
---|
| 160 | begin
|
---|
| 161 | FEntries.Delete(Index);
|
---|
| 162 | end;
|
---|
| 163 |
|
---|
| 164 | destructor TDKLang_ResFile.Destroy;
|
---|
| 165 | begin
|
---|
| 166 | FEntries.Free;
|
---|
| 167 | inherited Destroy;
|
---|
| 168 | end;
|
---|
| 169 |
|
---|
| 170 | function TDKLang_ResFile.FindEntry(const wsType, wsName: WideString): TDKLang_ResEntry;
|
---|
| 171 | var i: Integer;
|
---|
| 172 | begin
|
---|
| 173 | for i := 0 to EntryCount-1 do begin
|
---|
| 174 | Result := Entries[i];
|
---|
| 175 | if WideSameText(Result.ResType, wsType) and WideSameText(Result.Name, wsName) then Exit;
|
---|
| 176 | end;
|
---|
| 177 | Result := nil;
|
---|
| 178 | end;
|
---|
| 179 |
|
---|
| 180 | function TDKLang_ResFile.GetEntries(Index: Integer): TDKLang_ResEntry;
|
---|
| 181 | begin
|
---|
| 182 | Result := TDKLang_ResEntry(FEntries[Index]);
|
---|
| 183 | end;
|
---|
| 184 |
|
---|
| 185 | function TDKLang_ResFile.GetEntryCount: Integer;
|
---|
| 186 | begin
|
---|
| 187 | Result := FEntries.Count;
|
---|
| 188 | end;
|
---|
| 189 |
|
---|
| 190 | procedure TDKLang_ResFile.LoadFromFile(const wsFileName: WideString);
|
---|
| 191 | var Stream: TStream;
|
---|
| 192 | begin
|
---|
| 193 | Stream := TTntFileStream.Create(wsFileName, fmOpenRead or fmShareDenyWrite);
|
---|
| 194 | try
|
---|
| 195 | LoadFromStream(Stream);
|
---|
| 196 | finally
|
---|
| 197 | Stream.Free;
|
---|
| 198 | end;
|
---|
| 199 | end;
|
---|
| 200 |
|
---|
| 201 | procedure TDKLang_ResFile.LoadFromStream(Stream: TStream);
|
---|
| 202 | var
|
---|
| 203 | pBuffer, pData: PByte;
|
---|
| 204 | iBufferSize, iBytesLeft, iBlockSize: Integer;
|
---|
| 205 | Header: TResResourceEntryHeader;
|
---|
| 206 |
|
---|
| 207 | // Retrieves a string or numeric identifier from the data and shifts the pointer appropriately
|
---|
| 208 | function RetrieveIdentifier(var p: PByte): WideString;
|
---|
| 209 | begin
|
---|
| 210 | // Numeric ID
|
---|
| 211 | if PWord(p)^=$ffff then begin
|
---|
| 212 | Inc(p, SizeOf(Word));
|
---|
| 213 | Result := IntToStr(PWord(p)^);
|
---|
| 214 | Inc(p, SizeOf(Word))
|
---|
| 215 | // A wide string name
|
---|
| 216 | end else begin
|
---|
| 217 | Result := WideString(PWideChar(p));
|
---|
| 218 | Inc(p, (Length(Result)+1)*SizeOf(WideChar));
|
---|
| 219 | end;
|
---|
| 220 | end;
|
---|
| 221 |
|
---|
| 222 | // Processes a resource entry
|
---|
| 223 | procedure ProcessResourceEntry;
|
---|
| 224 | var
|
---|
| 225 | p: PByte;
|
---|
| 226 | wsName, wsType: WideString;
|
---|
| 227 | EntryProps: TResResourceEntryProps;
|
---|
| 228 | Entry: TDKLang_ResEntry;
|
---|
| 229 | sRawData: String;
|
---|
| 230 | begin
|
---|
| 231 | p := pData;
|
---|
| 232 | // Skip the header
|
---|
| 233 | Inc(p, SizeOf(Header));
|
---|
| 234 | // Retrieve resource type and name
|
---|
| 235 | wsType := RetrieveIdentifier(p);
|
---|
| 236 | wsName := RetrieveIdentifier(p);
|
---|
| 237 | // Skip the dummy 32-bit indicator entry
|
---|
| 238 | if (wsType<>'0') or (wsName<>'0') then begin
|
---|
| 239 | // Align the pointer to a 4-byte boundary
|
---|
| 240 | if (Integer(p) mod 4)<>0 then Inc(p, 4-Integer(p) mod 4);
|
---|
| 241 | // Read entry properties
|
---|
| 242 | Move(p^, EntryProps, SizeOf(EntryProps));
|
---|
| 243 | // Create an entry
|
---|
| 244 | Entry := TDKLang_ResEntry.Create;
|
---|
| 245 | try
|
---|
| 246 | Entry.ResType := wsType;
|
---|
| 247 | Entry.Name := wsName;
|
---|
| 248 | Entry.DataVersion := EntryProps.cDataVersion;
|
---|
| 249 | Entry.MemoryFlags := EntryProps.wMemoryFlags;
|
---|
| 250 | Entry.Language := EntryProps.wLanguage;
|
---|
| 251 | Entry.Version := EntryProps.cVersion;
|
---|
| 252 | Entry.Characteristics := EntryProps.cCharacteristics;
|
---|
| 253 | SetString(sRawData, PChar(Integer(pData)+Header.iHeaderSize), Header.iDataSize);
|
---|
| 254 | Entry.RawData := sRawData;
|
---|
| 255 | // Register the entry in the list
|
---|
| 256 | AddEntry(Entry);
|
---|
| 257 | except
|
---|
| 258 | Entry.Free;
|
---|
| 259 | raise;
|
---|
| 260 | end;
|
---|
| 261 | end;
|
---|
| 262 | end;
|
---|
| 263 |
|
---|
| 264 | begin
|
---|
| 265 | // Clear the entry list
|
---|
| 266 | ClearEntries;
|
---|
| 267 | // Allocate the buffer
|
---|
| 268 | iBufferSize := Stream.Size;
|
---|
| 269 | GetMem (pBuffer, iBufferSize);
|
---|
| 270 | try
|
---|
| 271 | // Read the entire file into the buffer
|
---|
| 272 | Stream.ReadBuffer(pBuffer^, iBufferSize);
|
---|
| 273 | // Scan the buffer
|
---|
| 274 | iBytesLeft := iBufferSize;
|
---|
| 275 | pData := pBuffer;
|
---|
| 276 | while iBytesLeft>=SizeOf(Header) do begin
|
---|
| 277 | // Read the header
|
---|
| 278 | Move(pData^, Header, SizeOf(Header));
|
---|
| 279 | // Process the entry
|
---|
| 280 | ProcessResourceEntry;
|
---|
| 281 | // Shift pointers
|
---|
| 282 | iBlockSize := ((Header.iDataSize+Header.iHeaderSize+3) div 4)*4;
|
---|
| 283 | Inc(pData, iBlockSize);
|
---|
| 284 | Dec(iBytesLeft, iBlockSize);
|
---|
| 285 | end;
|
---|
| 286 | finally
|
---|
| 287 | FreeMem(pBuffer);
|
---|
| 288 | end;
|
---|
| 289 | end;
|
---|
| 290 |
|
---|
| 291 | function TDKLang_ResFile.RemoveEntry(Item: TDKLang_ResEntry): Integer;
|
---|
| 292 | begin
|
---|
| 293 | Result := FEntries.Remove(Item);
|
---|
| 294 | end;
|
---|
| 295 |
|
---|
| 296 | procedure TDKLang_ResFile.SaveToFile(const wsFileName: WideString);
|
---|
| 297 | var Stream: TStream;
|
---|
| 298 | begin
|
---|
| 299 | Stream := TTntFileStream.Create(wsFileName, fmCreate);
|
---|
| 300 | try
|
---|
| 301 | SaveToStream(Stream);
|
---|
| 302 | finally
|
---|
| 303 | Stream.Free;
|
---|
| 304 | end;
|
---|
| 305 | end;
|
---|
| 306 |
|
---|
| 307 | procedure TDKLang_ResFile.SaveToStream(Stream: TStream);
|
---|
| 308 | var
|
---|
| 309 | REIndicator: TDKLang_ResEntry;
|
---|
| 310 | i: Integer;
|
---|
| 311 | begin
|
---|
| 312 | // Write dummy 32-bit resource indicator
|
---|
| 313 | REIndicator := TDKLang_ResEntry.Create;
|
---|
| 314 | try
|
---|
| 315 | REIndicator.ResType := '0';
|
---|
| 316 | REIndicator.Name := '0';
|
---|
| 317 | REIndicator.SaveToStream(Stream);
|
---|
| 318 | finally
|
---|
| 319 | REIndicator.Free;
|
---|
| 320 | end;
|
---|
| 321 | // Write real entries
|
---|
| 322 | for i := 0 to EntryCount-1 do Entries[i].SaveToStream(Stream);
|
---|
| 323 | end;
|
---|
| 324 |
|
---|
| 325 | //===================================================================================================================
|
---|
| 326 | // TDKLang_ResEntry
|
---|
| 327 | //===================================================================================================================
|
---|
| 328 |
|
---|
| 329 | function TDKLang_ResEntry.Clone: TDKLang_ResEntry;
|
---|
| 330 | begin
|
---|
| 331 | Result := TDKLang_ResEntry.Create;
|
---|
| 332 | try
|
---|
| 333 | Result.Characteristics := Characteristics;
|
---|
| 334 | Result.DataVersion := DataVersion;
|
---|
| 335 | Result.Language := Language;
|
---|
| 336 | Result.MemoryFlags := MemoryFlags;
|
---|
| 337 | Result.Name := Name;
|
---|
| 338 | Result.RawData := RawData;
|
---|
| 339 | Result.ResType := ResType;
|
---|
| 340 | Result.Version := Version;
|
---|
| 341 | except
|
---|
| 342 | Result.Free;
|
---|
| 343 | raise;
|
---|
| 344 | end;
|
---|
| 345 | end;
|
---|
| 346 |
|
---|
| 347 | procedure TDKLang_ResEntry.SaveToStream(Stream: TStream);
|
---|
| 348 | var
|
---|
| 349 | msHeaderBlock: TMemoryStream;
|
---|
| 350 | Header: TResResourceEntryHeader;
|
---|
| 351 | Props: TResResourceEntryProps;
|
---|
| 352 |
|
---|
| 353 | // Writes a numeric or string identifier into the stream
|
---|
| 354 | procedure WriteIdentifier(const wsID: WideString; Stream: TStream);
|
---|
| 355 | var
|
---|
| 356 | iNumericID: Integer;
|
---|
| 357 | w: Word;
|
---|
| 358 | begin
|
---|
| 359 | iNumericID := StrToIntDef(wsID, -1);
|
---|
| 360 | // String ID
|
---|
| 361 | if iNumericID<0 then
|
---|
| 362 | Stream.WriteBuffer(wsID[1], (Length(wsID)+1)*SizeOf(WideChar))
|
---|
| 363 | // Numeric ID
|
---|
| 364 | else begin
|
---|
| 365 | w := $ffff;
|
---|
| 366 | Stream.WriteBuffer(w, SizeOf(w));
|
---|
| 367 | w := iNumericID;
|
---|
| 368 | Stream.WriteBuffer(w, SizeOf(w));
|
---|
| 369 | end;
|
---|
| 370 | end;
|
---|
| 371 |
|
---|
| 372 | // Aligns the stream position to a 4-byte boundary
|
---|
| 373 | procedure AlignStream4(Stream: TStream);
|
---|
| 374 | const IZero: Integer = 0;
|
---|
| 375 | var iMod: Integer;
|
---|
| 376 | begin
|
---|
| 377 | iMod := Stream.Position mod 4;
|
---|
| 378 | if iMod>0 then Stream.WriteBuffer(IZero, 4-iMod);
|
---|
| 379 | end;
|
---|
| 380 |
|
---|
| 381 | begin
|
---|
| 382 | // Prepare header block
|
---|
| 383 | msHeaderBlock := TMemoryStream.Create;
|
---|
| 384 | try
|
---|
| 385 | // Write type and name identifiers
|
---|
| 386 | WriteIdentifier(ResType, msHeaderBlock);
|
---|
| 387 | WriteIdentifier(Name, msHeaderBlock);
|
---|
| 388 | // Align the stream pointer
|
---|
| 389 | AlignStream4(msHeaderBlock);
|
---|
| 390 | // Fill properties record
|
---|
| 391 | Props.cDataVersion := DataVersion;
|
---|
| 392 | Props.wMemoryFlags := MemoryFlags;
|
---|
| 393 | Props.wLanguage := Language;
|
---|
| 394 | Props.cVersion := Version;
|
---|
| 395 | Props.cCharacteristics := Characteristics;
|
---|
| 396 | // Write properties
|
---|
| 397 | msHeaderBlock.WriteBuffer(Props, SizeOf(Props));
|
---|
| 398 | // Fill header record
|
---|
| 399 | Header.iDataSize := ((Length(FRawData)+3) div 4)*4;
|
---|
| 400 | Header.iHeaderSize := msHeaderBlock.Size+SizeOf(Header);
|
---|
| 401 | // Put the header record
|
---|
| 402 | Stream.WriteBuffer(Header, SizeOf(Header));
|
---|
| 403 | // Put the header block
|
---|
| 404 | Stream.CopyFrom(msHeaderBlock, 0);
|
---|
| 405 | // Put entry data
|
---|
| 406 | Stream.WriteBuffer(RawData[1], Length(RawData));
|
---|
| 407 | // Align the stream pointer
|
---|
| 408 | AlignStream4(Stream);
|
---|
| 409 | finally
|
---|
| 410 | msHeaderBlock.Free;
|
---|
| 411 | end;
|
---|
| 412 | end;
|
---|
| 413 |
|
---|
| 414 | end.
|
---|