source: cprs/branches/tmg-cprs/dklang-package-3.01/DKL_ResFile.pas@ 797

Last change on this file since 797 was 468, checked in by Kevin Toppenberg, 16 years ago

CPRS v1.0.26.76
File size: 14.4 KB
RevLine 
[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//
27unit DKL_ResFile;
28
29interface
30uses Windows, SysUtils, Classes, Contnrs, TntClasses;
31
32type
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
136implementation //=======================================================================================================
137uses 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
414end.
Note: See TracBrowser for help on using the repository browser.